add tests

This commit is contained in:
Filip Gralinski 2015-09-04 22:21:51 +02:00
parent f3a473d83e
commit c05a3c55ef
2 changed files with 62 additions and 1 deletions

View File

@ -8,12 +8,17 @@ import Handler.Shared
import Handler.Extract
import System.Directory (doesFileExist)
import System.FilePath.Find as SFF
import qualified Data.Text as T
import Crypto.Hash.SHA1
import PersistSHA1
getCreateChallengeR :: Handler Html
getCreateChallengeR = do
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text)
let submission = Nothing :: Maybe (Import.FileInfo, Text)
handlerName = "getCreateChallengeR" :: Text
defaultLayout $ do
aDomId <- newIdent
@ -62,8 +67,62 @@ addChallenge name publicRepoId privateRepoId chan = do
challengeTitle=(T.pack $ title),
challengeDescription=(T.pack $ description),
challengeStamp=time}
updateTests challengeId chan
return ()
updateTests :: (Key Challenge) -> Channel -> Handler ()
updateTests challengeId chan = do
challenge <- runDB $ get404 challengeId
let repoId = challengePrivateRepo challenge
let repoDir = getRepoDir repoId
repo <- runDB $ get404 repoId
let commit = repoCurrentCommit repo
testDirs <- liftIO $ findTestDirs repoDir
mapM_ (checkTestDir chan challengeId commit) testDirs
msg chan (T.pack $ show testDirs)
return ()
expectedFileName = "expected.tsv"
doesExpectedExist :: FilePath -> IO Bool
doesExpectedExist fp = doesFileExist (fp </> expectedFileName)
checkTestDir :: Channel -> (Key Challenge) -> SHA1 -> FilePath -> Handler ()
checkTestDir chan challengeId commit testDir = do
expectedExists <- liftIO $ doesExpectedExist testDir
if expectedExists
then do
msg chan $ concat ["Test dir ", (T.pack testDir), " found."]
checksum <- liftIO $ gatherSHA1 testDir
testId <- runDB $ insert $ Test {
testChallenge=challengeId,
testChecksum=(SHA1 checksum),
testCommit=commit,
testActive=True }
return ()
else
msg chan $ concat ["Test dir ", (T.pack testDir), " does not have expected results."]
return ()
gatherSHA1 :: FilePath -> IO ByteString
gatherSHA1 testDir = do
files <- SFF.find always isTestDirHashedFile testDir
contentss <- mapM readFile $ sort files
return $ finalize $ foldl' Crypto.Hash.SHA1.update init contentss
isTestDirHashedFile :: FindClause Bool
isTestDirHashedFile = fileType ==? RegularFile
findTestDirs :: FilePath -> IO [FilePath]
findTestDirs = SFF.find never testDirFilter
never :: FindClause Bool
never = depth ==? 0
testDirFilter :: FindClause Bool
testDirFilter = (fileType ==? Directory) &&? (SFF.fileName ~~? "dev-*" ||? SFF.fileName ~~? "test-*")
sampleForm :: Form (Text, Text, Text, Text, Text)
sampleForm = renderBootstrap3 BootstrapBasicForm $ (,,,,)

View File

@ -97,6 +97,8 @@ library
, random
, pandoc
, pandoc-types
, filemanip
, cryptohash
executable gonito
if flag(library-only)