Added basic QuickCheck-based test suite, which should be expanded more

s-cargot.cabal

@@ -20,8 +20,12 @@ build-type:          Simple
 cabal-version:       >=1.10
 
 source-repository head
-   type: git
-   location: git://github.com/aisamanra/s-cargot.git
+  type: git
+  location: git://github.com/aisamanra/s-cargot.git
+
+flag build-example
+  description: Build example application
+  default:     False
 
 library
   exposed-modules:     Data.SCargot,
@@ -44,8 +48,11 @@ library
   ghc-options:         -Wall
 
 executable example
+  if flag(build-example)
+    main-is:           example.hs
+  else
+    buildable:         False
   hs-source-dirs:      example
-  main-is:             example.hs
   build-depends:       base        >=4.7 && <5,
                        containers  >=0.5 && <1,
                        parsec      >=3.1 && <4,
@@ -53,3 +60,14 @@ executable example
                        text        >=1.2 && <2
   default-language:    Haskell2010
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+
+test-suite s-cargot-qc
+  default-language: Haskell2010
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          SCargotQC.hs
+  build-depends:    s-cargot      ==0.1.0.0,
+                    base          >=4.7 && <5,
+                    parsec        >=3.1 && <4,
+                    QuickCheck    >=2.8 && <3,
+                    text          >=1.2 && <2

test/SCargotQC.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.SCargot.ReprQC (reprQC) where
+
+import Data.SCargot ( SExprParser
+                    , SExprPrinter
+                    , mkParser
+                    , flatPrint
+                    , encodeOne
+                    , decodeOne
+                    , asRich
+                    , asWellFormed
+                    )
+import Data.SCargot.Repr ( SExpr(..)
+                         , RichSExpr
+                         , fromRich
+                         , toRich
+                         , WellFormedSExpr(..)
+                         , fromWellFormed
+                         , toWellFormed
+                         )
+import Test.QuickCheck
+import Test.QuickCheck.Arbitrary
+import Text.Parsec (char)
+import Text.Parsec.Text (Parser)
+
+instance Arbitrary a => Arbitrary (SExpr a) where
+  arbitrary = sized $ \n ->
+    if n <= 0
+       then pure SNil
+       else oneof [ SAtom <$> arbitrary
+                  , do
+                      k <- choose (0, n)
+                      elems <- sequence [ resize (n-k) arbitrary
+                                        | _ <- [0..k]
+                                        ]
+                      tail <- oneof [ SAtom <$> arbitrary
+                                    , pure SNil
+                                    ]
+                      pure (foldr SCons tail elems)
+                  ]
+
+instance Arbitrary a => Arbitrary (RichSExpr a) where
+  arbitrary = toRich `fmap` arbitrary
+
+instance Arbitrary a => Arbitrary (WellFormedSExpr a) where
+  arbitrary = sized $ \n ->
+    oneof [ WFSAtom <$> arbitrary
+          , do
+              k <- choose (0, n)
+              WFSList <$> sequence
+                [ resize (n-k) arbitrary
+                | _ <- [0..k]
+                ]
+          ]
+
+parser :: SExprParser () (SExpr ())
+parser = mkParser (() <$ char 'X')
+
+printer :: SExprPrinter () (SExpr ())
+printer = flatPrint (const "X")
+
+richIso :: SExpr () -> Bool
+richIso s = fromRich (toRich s) == s
+
+richIsoBk :: RichSExpr () -> Bool
+richIsoBk s = toRich (fromRich s) == s
+
+
+wfIso :: SExpr () -> Bool
+wfIso s = case toWellFormed s of
+  Left _  -> True
+  Right y -> s == fromWellFormed y
+
+wfIsoBk :: WellFormedSExpr () -> Bool
+wfIsoBk s = toWellFormed (fromWellFormed s) == Right s
+
+
+encDec :: SExpr () -> Bool
+encDec s = decodeOne parser (encodeOne printer s) == Right s
+
+encDecRich :: RichSExpr () -> Bool
+encDecRich s = decodeOne (asRich parser) (encodeOne printer (fromRich s))
+                == Right s
+
+encDecWF :: WellFormedSExpr () -> Bool
+encDecWF s = decodeOne (asWellFormed parser) (encodeOne printer (fromWellFormed s))
+               == Right s
+
+reprQC :: IO ()
+reprQC = do
+  putStrLn "The SExpr <--> Rich translation should be isomorphic"
+  quickCheck richIso
+  quickCheck richIsoBk
+  putStrLn "The SExpr <--> WF translation should be near-isomorphic"
+  quickCheck wfIso
+  quickCheck wfIsoBk
+  putStrLn "This should be true when parsing, as well"
+  quickCheck encDec
+  quickCheck encDecRich
+  quickCheck encDecWF