git.iko.soy/project-m36
on e5bb4e5 help sign in
project-m36/test/TutorialD/Printer.hs
47 lines 3.1 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2import Test.HUnit
3import ProjectM36.Base
4import System.Exit
5import Data.Text.Prettyprint.Doc
6import Data.Map (fromList)
7import TutorialD.Printer ()
8import TutorialD.Interpreter.RelationalExpr
9import Text.Megaparsec
10import Data.Text (pack)
12testList :: Test
13testList = TestList [
14 testPretty "true" (RelationVariable "true" ()),
15 testPretty "relation{tuple{a 3, b \"x\"}, tuple{a 4, b \"y\"}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",NakedAtomExpr (IntegerAtom 3)),("b",NakedAtomExpr (TextAtom "x"))]),TupleExpr (fromList [("a",NakedAtomExpr (IntegerAtom 4)),("b",NakedAtomExpr (TextAtom "y"))])])),
16 testPretty "true:{a:=1, b:=1}" (Extend (AttributeExtendTupleExpr "b" (NakedAtomExpr (IntegerAtom 1))) (Extend (AttributeExtendTupleExpr "a" (NakedAtomExpr (IntegerAtom 1))) (RelationVariable "true" ()))),
17 testPretty "relation{tuple{a fromGregorian(2014, 2, 4)}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",FunctionAtomExpr "fromGregorian" [NakedAtomExpr (IntegerAtom 2014),NakedAtomExpr (IntegerAtom 2),NakedAtomExpr (IntegerAtom 4)] ())])])),
18 testPretty "relation{tuple{a bytestring(\"dGVzdGRhdGE=\")}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",FunctionAtomExpr "bytestring" [NakedAtomExpr (TextAtom "dGVzdGRhdGE=")] ())])])),
19 testPretty "relation{tuple{a t}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",NakedAtomExpr (BoolAtom True))])])),
20 testPretty "relation{tuple{a Cons 4 (Cons 5 Empty)}}" (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (fromList [("a",ConstructedAtomExpr "Cons" [NakedAtomExpr (IntegerAtom 4),ConstructedAtomExpr "Cons" [NakedAtomExpr (IntegerAtom 5),ConstructedAtomExpr "Empty" [] ()] ()] ())])])),
21 testPretty "relation{a Int, b Text, c Bool}{}" (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "a" (ADTypeConstructor "Int" []) (),AttributeAndTypeNameExpr "b" (ADTypeConstructor "Text" []) (),AttributeAndTypeNameExpr "c" (ADTypeConstructor "Bool" []) ()]) (TupleExprs () [])),
22 testPretty "relation{a relation{b Int}}{}" (MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "a" (RelationAtomTypeConstructor [AttributeAndTypeNameExpr "b" (ADTypeConstructor "Int" []) ()]) ()]) (TupleExprs () []))
23 ]
25main :: IO ()
26main = do
27 tcounts <- runTestTT testList
28 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
30testPretty :: String -> RelationalExpr -> Test
31testPretty tutdStr relExprADT =
32 TestCase $ do
33 let relExprStr = show (pretty relExprADT)
34 print relExprStr
35 roundTrip <- parseRelExpr relExprStr
36 {-tutdIn <- parseRelExpr tutdStr
37 print ("tutd parsed", tutdIn)-}
38 assertEqual ("pretty ADT " <> tutdStr) tutdStr relExprStr
39 assertEqual ("round-trip " <> tutdStr) relExprADT roundTrip
41--round trip tutoriald
42parseRelExpr :: String -> IO RelationalExpr
43parseRelExpr tutdStr =
44 case parse relExprP "test" (pack tutdStr) of
45 Left err ->
46 assertFailure (show err)
47 Right parsed -> pure parsed