Add QuickCheck print/parse tests

src/QuickCheckTests.hs

@@ -0,0 +1,94 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Test.QuickCheck
+
+import Windows12.Ast
+import Windows12.Parser (programP)
+import Text.Megaparsec (parse)
+
+import Data.String.Conversions (cs)
+
+import Data.Text
+import Data.Text.Internal
+import Data.Text.Prettyprint.Doc (pretty)
+
+main :: IO ()
+main = quickCheck prop_print_parse
+
+-- Ensure that pretty-printing and parsing are inverses
+prop_print_parse :: Program -> Bool
+prop_print_parse p = Right p == (parse programP "" (cs (show (pretty p))))
+
+instance Arbitrary Data.Text.Internal.Text where
+  arbitrary = listOf1 (elements ['a'..'z']) >>= return . Data.Text.pack
+
+instance Arbitrary BinOp where
+  arbitrary = elements [Add, Sub, Mul, Div, Mod, Eq, Ne, Lt, Gt, Le, Ge, And, Or,
+    BitAnd, BitOr, BitXor, ShiftL, ShiftR]
+
+instance Arbitrary UnOp where
+  arbitrary = elements [Neg, Not, BitNot]
+
+instance Arbitrary AssignOp where
+  arbitrary = elements [BaseAssign, AddAssign, SubAssign, MulAssign, DivAssign,
+    ModAssign, BitAndAssign, BitOrAssign, BitXorAssign, ShiftLAssign, ShiftRAssign]
+
+instance Arbitrary Expr where
+  arbitrary = oneof
+    [ Id <$> arbitrary
+    , IntLit <$> arbitrary
+    , UIntLit <$> arbitrary
+    , FloatLit <$> arbitrary
+    , StrLit <$> arbitrary
+    , BoolLit <$> arbitrary
+    , CharLit <$> arbitrary
+    , BinOp <$> arbitrary <*> arbitrary <*> arbitrary
+    , UnOp <$> arbitrary <*> arbitrary
+    , Call <$> arbitrary <*> arbitrary
+    , Index <$> arbitrary <*> arbitrary
+    , Member <$> arbitrary <*> arbitrary
+    , Cast <$> arbitrary <*> arbitrary
+    , Sizeof <$> arbitrary
+    , StructInit <$> arbitrary <*> arbitrary
+    ]
+
+instance Arbitrary Stmt where
+  arbitrary = oneof
+    [ Expr <$> arbitrary
+    , Return <$> arbitrary
+    , If <$> arbitrary <*> arbitrary <*> arbitrary
+    , While <$> arbitrary <*> arbitrary
+    , Assign <$> arbitrary <*> arbitrary <*> arbitrary
+    , Block <$> arbitrary
+    , Var <$> arbitrary <*> arbitrary <*> arbitrary
+    ]
+
+-- Massively simplified types: No pointers, void, structs, enums
+instance Arbitrary Type where
+    arbitrary = elements [IntType, UIntType, FloatType, StrType, BoolType,
+      CharType, PtrType IntType, ArrayType IntType]
+
+instance Arbitrary Bind where
+    arbitrary = Bind <$> arbitrary <*> arbitrary
+
+instance Arbitrary TLStruct where
+    arbitrary = Struct <$> arbitrary <*> arbitrary
+
+-- ensure the enum has at least one field
+instance Arbitrary TLEnum where
+    arbitrary = Enum <$> arbitrary <*> listOf1 arbitrary
+
+instance Arbitrary TLFunc where
+    arbitrary = Func <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary TL where
+    arbitrary = oneof
+      [ TLStruct <$> arbitrary
+      , TLEnum <$> arbitrary
+      , TLFunc <$> arbitrary
+      ]
+
+instance Arbitrary Program where
+    arbitrary = Program <$> arbitrary <*> arbitrary <*> arbitrary