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

windows12.cabal

@@ -92,3 +92,36 @@ executable windows12
 
     -- Base language which the package is written in.
     default-language: Haskell2010
+
+executable windows12-qc
+    -- Import common warning flags.
+    import:           warnings
+
+    -- .hs or .lhs file containing the Main module.
+    main-is:          QuickCheckTests.hs
+
+    -- Modules included in this executable, other than Main.
+    other-modules:
+        Windows12.Ast
+        Windows12.Lexer
+        Windows12.Parser
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    build-depends:
+        base >= 4.15.1 && < 4.16,
+        megaparsec >= 9.6.1 && < 9.7,
+        text >= 1.2.5 && < 1.3,
+        parser-combinators >= 1.3.0 && < 1.4,
+        prettyprinter >= 1.5.1 && < 1.6,
+        string-conversions >= 0.4.0 && < 0.5,
+        mtl >= 2.2.2 && < 2.3,
+        QuickCheck >= 2.14.2 && < 2.15,
+
+    -- Directories containing source files.
+    hs-source-dirs:   src
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010