gdritter repos s-cargot / d691c39
Added basic QuickCheck-based test suite, which should be expanded more Getty Ritter 8 years ago
2 changed file(s) with 122 addition(s) and 3 deletion(s). Collapse all Expand all
+21
-3
s-cargot.cabal less more
2020 cabal-version: >=1.10
2121
2222 source-repository head
23 type: git
24 location: git://github.com/aisamanra/s-cargot.git
23 type: git
24 location: git://github.com/aisamanra/s-cargot.git
25
26 flag build-example
27 description: Build example application
28 default: False
2529
2630 library
2731 exposed-modules: Data.SCargot,
4448 ghc-options: -Wall
4549
4650 executable example
51 if flag(build-example)
52 main-is: example.hs
53 else
54 buildable: False
4755 hs-source-dirs: example
48 main-is: example.hs
4956 build-depends: base >=4.7 && <5,
5057 containers >=0.5 && <1,
5158 parsec >=3.1 && <4,
5360 text >=1.2 && <2
5461 default-language: Haskell2010
5562 ghc-options: -threaded -rtsopts -with-rtsopts=-N
63
64 test-suite s-cargot-qc
65 default-language: Haskell2010
66 type: exitcode-stdio-1.0
67 hs-source-dirs: test
68 main-is: SCargotQC.hs
69 build-depends: s-cargot ==0.1.0.0,
70 base >=4.7 && <5,
71 parsec >=3.1 && <4,
72 QuickCheck >=2.8 && <3,
73 text >=1.2 && <2
+101
-0
test/SCargotQC.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Data.SCargot.ReprQC (reprQC) where
4
5 import Data.SCargot ( SExprParser
6 , SExprPrinter
7 , mkParser
8 , flatPrint
9 , encodeOne
10 , decodeOne
11 , asRich
12 , asWellFormed
13 )
14 import Data.SCargot.Repr ( SExpr(..)
15 , RichSExpr
16 , fromRich
17 , toRich
18 , WellFormedSExpr(..)
19 , fromWellFormed
20 , toWellFormed
21 )
22 import Test.QuickCheck
23 import Test.QuickCheck.Arbitrary
24 import Text.Parsec (char)
25 import Text.Parsec.Text (Parser)
26
27 instance Arbitrary a => Arbitrary (SExpr a) where
28 arbitrary = sized $ \n ->
29 if n <= 0
30 then pure SNil
31 else oneof [ SAtom <$> arbitrary
32 , do
33 k <- choose (0, n)
34 elems <- sequence [ resize (n-k) arbitrary
35 | _ <- [0..k]
36 ]
37 tail <- oneof [ SAtom <$> arbitrary
38 , pure SNil
39 ]
40 pure (foldr SCons tail elems)
41 ]
42
43 instance Arbitrary a => Arbitrary (RichSExpr a) where
44 arbitrary = toRich `fmap` arbitrary
45
46 instance Arbitrary a => Arbitrary (WellFormedSExpr a) where
47 arbitrary = sized $ \n ->
48 oneof [ WFSAtom <$> arbitrary
49 , do
50 k <- choose (0, n)
51 WFSList <$> sequence
52 [ resize (n-k) arbitrary
53 | _ <- [0..k]
54 ]
55 ]
56
57 parser :: SExprParser () (SExpr ())
58 parser = mkParser (() <$ char 'X')
59
60 printer :: SExprPrinter () (SExpr ())
61 printer = flatPrint (const "X")
62
63 richIso :: SExpr () -> Bool
64 richIso s = fromRich (toRich s) == s
65
66 richIsoBk :: RichSExpr () -> Bool
67 richIsoBk s = toRich (fromRich s) == s
68
69
70 wfIso :: SExpr () -> Bool
71 wfIso s = case toWellFormed s of
72 Left _ -> True
73 Right y -> s == fromWellFormed y
74
75 wfIsoBk :: WellFormedSExpr () -> Bool
76 wfIsoBk s = toWellFormed (fromWellFormed s) == Right s
77
78
79 encDec :: SExpr () -> Bool
80 encDec s = decodeOne parser (encodeOne printer s) == Right s
81
82 encDecRich :: RichSExpr () -> Bool
83 encDecRich s = decodeOne (asRich parser) (encodeOne printer (fromRich s))
84 == Right s
85
86 encDecWF :: WellFormedSExpr () -> Bool
87 encDecWF s = decodeOne (asWellFormed parser) (encodeOne printer (fromWellFormed s))
88 == Right s
89
90 reprQC :: IO ()
91 reprQC = do
92 putStrLn "The SExpr <--> Rich translation should be isomorphic"
93 quickCheck richIso
94 quickCheck richIsoBk
95 putStrLn "The SExpr <--> WF translation should be near-isomorphic"
96 quickCheck wfIso
97 quickCheck wfIsoBk
98 putStrLn "This should be true when parsing, as well"
99 quickCheck encDec
100 quickCheck encDecRich
101 quickCheck encDecWF