{- This file is part of language-kort.
-
- Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
-
- ♡ 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
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
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