{- This file is part of language-kort. - - Written in 2015 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} import Control.Monad (unless) import Data.Either (either, rights) import qualified Data.Smaoin as S import qualified Data.Text.Lazy as T import Language.Kort import System.Exit import Test.QuickCheck import Test.QuickCheck.Test import Text.Printf import Input ------------------------------------------------------------------------------- -- Run all tests: > cabal test -- Debug and play with tests and utilities: > cabal repl test ------------------------------------------------------------------------------- type Lists = ([Statement], [Statement], [Statement], [Statement], [S.Statement]) notTwo (l, _, _, _, _) = l hasGen (_, l, _, _, _) = l notRes (_, _, l, _, _) = l invVal (_, _, _, l, _) = l stmts (_, _, _, _, l) = l reverseLists :: Lists -> Lists reverseLists (nt, hg, nr, iv, s) = ( reverse nt , reverse hg , reverse nr , reverse iv , reverse s ) printLists :: Lists -> IO () printLists (nt, hg, nr, iv, s) = mapM_ (mapM_ print) [nt, hg, nr, iv] >> mapM_ print s inputDoc, inputDocNoGens, inputDocClean :: Document inputDoc = map (\ (x, _, _) -> x) input inputDocNoGens = [s | (s, _, True) <- input] inputDocClean = [s | (s, Clean, _) <- input] writtenText, writtenTextNoGens, writtenTextClean :: T.Text writtenText = writeText inputDoc writtenTextNoGens = writeText inputDocNoGens writtenTextClean = writeText inputDocClean parsedResult, parsedResultNoGens, parsedResultClean :: ParseResult parsedResult = parseText writtenText parsedResultNoGens = parseText writtenTextNoGens parsedResultClean = parseText writtenTextClean emptyLists :: Lists emptyLists = ([], [], [], [], []) parsedLists, parsedListsNoGens, parsedListsClean :: Lists parsedLists = either (const emptyLists) toSmaoinModel parsedResult parsedListsNoGens = either (const emptyLists) toSmaoinModel parsedResultNoGens parsedListsClean = either (const emptyLists) toSmaoinModel parsedResultClean writtenDoc, writtenDocNoGens, writtenDocClean :: Document writtenDoc = fromSmaoinModel $ stmts parsedLists writtenDocNoGens = fromSmaoinModel $ stmts parsedListsNoGens writtenDocClean = fromSmaoinModel $ stmts parsedListsClean againLists, againListsNoGens, againListsClean :: Lists againLists = toSmaoinModel writtenDoc againListsNoGens = toSmaoinModel writtenDocNoGens againListsClean = toSmaoinModel writtenDocClean ------------------------------------------------------------------ UidGen ----- -- Determine using the API whether a given Kort line is clean of generators lineClean :: Line -> Bool lineClean = either (const True) (not . stmtHasGens) -- Check if an input record's has-gens status matches the gens-clean column recordHasGensCorrect :: Record -> Bool recordHasGensCorrect (Left _, _, c) = c recordHasGensCorrect (Right s, _, c) = stmtHasGens s == not c prop_stmtHasGens :: Bool prop_stmtHasGens = and [stmtHasGens s == not c | (Right s, _, c) <- input] prop_docHasGens :: Bool prop_docHasGens = docHasGens inputDoc == not (and inputClean) where inputClean = map (\ (_, _, x) -> x) input prop_generateResourcesIO1 :: IO Bool prop_generateResourcesIO1 = do doc <- generateResourcesIO inputDoc return $ length doc == length inputDoc prop_generateResourcesIO2 :: IO Bool prop_generateResourcesIO2 = do doc <- generateResourcesIO inputDoc return $ not $ docHasGens doc prop_generateResourcesIO3 :: IO Bool prop_generateResourcesIO3 = do doc <- generateResourcesIO inputDocNoGens return $ doc == inputDocNoGens prop_sweepGenerators1 :: Bool prop_sweepGenerators1 = length (sweepGenerators inputDoc) == length inputDoc prop_sweepGenerators2 :: Bool prop_sweepGenerators2 = not $ docHasGens $ sweepGenerators inputDoc prop_sweepGenerators3 :: Bool prop_sweepGenerators3 = sweepGenerators inputDocNoGens == inputDocNoGens ------------------------------------------------------------------ Writer ----- prop_writeText1 :: Bool prop_writeText1 = T.null $ writeText [] prop_writeText2 :: Bool prop_writeText2 = (length . T.lines) writtenTextClean == length inputDocClean -- The +1 accounts for the middle comment, which has a '\n' inside it prop_writeText3 :: Bool prop_writeText3 = (length . T.lines) writtenTextNoGens == length inputDocNoGens + 1 -- The +1 accounts for the middle comment, which has a '\n' inside it prop_writeText4 :: Bool prop_writeText4 = (length . T.lines) writtenText == length inputDoc + 1 prop_fromSmaoinModel1 :: Bool prop_fromSmaoinModel1 = null $ fromSmaoinModel [] prop_fromSmaoinModel2 :: Bool prop_fromSmaoinModel2 = writtenDocClean == reverse inputDocClean prop_fromSmaoinModel3 :: Bool prop_fromSmaoinModel3 = stmts parsedListsClean == reverse (stmts againListsClean) prop_fromSmaoinModel4 :: Bool prop_fromSmaoinModel4 = stmts parsedListsNoGens == reverse (stmts againListsNoGens) prop_fromSmaoinModel5 :: Bool prop_fromSmaoinModel5 = stmts parsedLists == reverse (stmts againLists) ------------------------------------------------------------------ Parser ----- prop_parseText1 :: Bool prop_parseText1 = either (const False) null $ parseText T.empty prop_parseText2 :: Bool prop_parseText2 = either (const False) ((== rights inputDocClean) . rights) parsedResultClean prop_parseText3 :: Bool prop_parseText3 = either (const False) ((== rights inputDocNoGens) . rights) parsedResultNoGens prop_parseText4 :: Bool prop_parseText4 = either (const False) ((== rights inputDoc) . rights) parsedResult prop_toSmaoinModel1 :: Bool prop_toSmaoinModel1 = f $ toSmaoinModel [] where f ([], [], [], [], []) = True f _ = False prop_toSmaoinModel2 :: Bool prop_toSmaoinModel2 = f parsedListsClean where f ([], [], [], [], s) = length s == length inputDocClean f _ = False prop_toSmaoinModel3 :: Bool prop_toSmaoinModel3 = f parsedListsNoGens where f (nottwo, [], notres, invval, s) = nottwo == reverse [t | (Right t, NotTwo, True) <- input] && notres == reverse [t | (Right t, NotRes, True) <- input] && invval == reverse [t | (Right t, InvVal, True) <- input] && length s == length [() | (_, Clean, True) <- input] f _ = False prop_toSmaoinModel4 :: Bool prop_toSmaoinModel4 = f parsedLists where f (nottwo, hasgen, notres, invval, s) = nottwo == reverse [t | (Right t, NotTwo, _) <- input] && hasgen == reverse [t | (Right t, HasGen, False) <- input] && notres == reverse [t | (Right t, NotRes, True) <- input] && invval == reverse [t | (Right t, InvVal, True) <- input] && length s == length [() | (_, Clean, True) <- input] ------------------------------------------------------------ tests & main ----- tests :: [(String, IO Result)] tests = [ ("stmtHasGens", quickCheckResult prop_stmtHasGens) , ("docHasGens", quickCheckResult prop_docHasGens) , ("generateResourcesIO1", quickCheckResult =<< prop_generateResourcesIO1) , ("generateResourcesIO2", quickCheckResult =<< prop_generateResourcesIO2) , ("generateResourcesIO3", quickCheckResult =<< prop_generateResourcesIO3) , ("sweepGenerators1", quickCheckResult prop_sweepGenerators1) , ("sweepGenerators2", quickCheckResult prop_sweepGenerators2) , ("sweepGenerators3", quickCheckResult prop_sweepGenerators3) , ("writeText1", quickCheckResult prop_writeText1) , ("writeText2", quickCheckResult prop_writeText2) , ("writeText3", quickCheckResult prop_writeText3) , ("writeText4", quickCheckResult prop_writeText4) , ("parseText1", quickCheckResult prop_parseText1) , ("parseText2", quickCheckResult prop_parseText2) , ("parseText3", quickCheckResult prop_parseText3) , ("parseText4", quickCheckResult prop_parseText4) , ("toSmaoinModel1", quickCheckResult prop_toSmaoinModel1) , ("toSmaoinModel2", quickCheckResult prop_toSmaoinModel2) , ("toSmaoinModel3", quickCheckResult prop_toSmaoinModel3) , ("toSmaoinModel4", quickCheckResult prop_toSmaoinModel4) , ("fromSmaoinModel1", quickCheckResult prop_fromSmaoinModel1) , ("fromSmaoinModel2", quickCheckResult prop_fromSmaoinModel2) , ("fromSmaoinModel3", quickCheckResult prop_fromSmaoinModel3) , ("fromSmaoinModel4", quickCheckResult prop_fromSmaoinModel4) , ("fromSmaoinModel5", quickCheckResult prop_fromSmaoinModel5) ] main :: IO () main = do results <- mapM (\ (name ,action) -> printf "%-25s: " name >> action) tests unless (all isSuccess results) exitFailure