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 Handler.Extract
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.FilePath.Find as SFF
import qualified Data.Text as T import qualified Data.Text as T
import Crypto.Hash.SHA1
import PersistSHA1
getCreateChallengeR :: Handler Html getCreateChallengeR :: Handler Html
getCreateChallengeR = do getCreateChallengeR = do
(formWidget, formEnctype) <- generateFormPost sampleForm (formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text) let submission = Nothing :: Maybe (Import.FileInfo, Text)
handlerName = "getCreateChallengeR" :: Text handlerName = "getCreateChallengeR" :: Text
defaultLayout $ do defaultLayout $ do
aDomId <- newIdent aDomId <- newIdent
@ -62,8 +67,62 @@ addChallenge name publicRepoId privateRepoId chan = do
challengeTitle=(T.pack $ title), challengeTitle=(T.pack $ title),
challengeDescription=(T.pack $ description), challengeDescription=(T.pack $ description),
challengeStamp=time} challengeStamp=time}
updateTests challengeId chan
return () 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 :: Form (Text, Text, Text, Text, Text)
sampleForm = renderBootstrap3 BootstrapBasicForm $ (,,,,) sampleForm = renderBootstrap3 BootstrapBasicForm $ (,,,,)

View File

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