git.iko.soy/typeable/xml-isogen
on master help sign in
Upd: add tests, but they work
commit6e11429d3dab47aac2f20e3634c9b950ec97f5b3 authorAleksey Uimanov <s9gf4ult@gmail.com> dateTue 24 Oct 2017, 13:11 (9 years ago) parent4340262
6 files changed+76−9
ghc-802.yaml+1 ghc-821.yaml+1 stack.yaml+1 test/Main.hs+25−1 test/TestDefs.hs+24−2 xml-isogen.cabal+24−6
ghc-802.yaml+1
@@ -5,3 +5,4 @@ packages:
55
66extra-deps:
77- dom-parser-3.0.0
8+- generic-arbitrary-0.1.0
ghc-821.yaml+1
@@ -5,3 +5,4 @@ packages:
55
66extra-deps:
77- dom-parser-3.0.0
8+- generic-arbitrary-0.1.0
stack.yaml+1
@@ -5,3 +5,4 @@ packages:
55
66extra-deps:
77- dom-parser-3.0.0
8+- generic-arbitrary-0.1.0
test/Main.hs+25−1
@@ -1,7 +1,31 @@
11{-# OPTIONS -fno-warn-unused-imports #-}
22module Main where
33
4+import Control.Exception
5+import Text.XML
6+import Data.Default
7+import System.IO.Unsafe
8+import Test.Hspec
9+import Test.Hspec.QuickCheck
10+import Test.QuickCheck
411import TestDefs
12+import Text.XML.DOM.Parser
13+import Text.XML.Writer
14+
15+isomorphicFoo :: XmlRoot -> Property
16+isomorphicFoo a = a === isogen
17+ where
18+ isogen :: XmlRoot
19+ isogen =
20+ let
21+ doc = document "Root" $ toXML a
22+ res = case runDomParser doc fromDom of
23+ Left e -> unsafePerformIO $ do
24+ pprint doc
25+ throwIO e
26+ Right a' -> a'
27+ in res
528
629main :: IO ()
7−main = return ()
30+main = hspec $ do
31+ prop "isomorphic" isomorphicFoo
test/TestDefs.hs+24−2
@@ -1,12 +1,14 @@
11{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE TemplateHaskell #-}
42
53{-# OPTIONS -ddump-splices #-}
64
75module TestDefs where
86
7+import Data.List.NonEmpty
98import Data.THGen.XML
9+import GHC.Generics (Generic)
10+import Test.QuickCheck.Arbitrary.Generic
11+import Test.QuickCheck.Instances ()
1012
1113"Bar" =:= enum
1214 & "baroque"
@@ -25,3 +27,23 @@ import Data.THGen.XML
2527 + "Bar"
2628 ? "Baz" [t|Text|]
2729 !% "Quux"
30+ ?% "Muux" [t|XmlQuux|]
31+
32+"Root" =:= record
33+ ! "Foo"
34+
35+deriving instance Generic XmlRoot
36+
37+instance Arbitrary XmlRoot where
38+ arbitrary = genericArbitrary
39+ shrink = genericShrink
40+
41+deriving instance Generic XmlFoo
42+
43+instance Arbitrary XmlFoo where
44+ arbitrary = genericArbitrary
45+ shrink = genericShrink
46+
47+instance Arbitrary (NonEmpty XmlBar) where
48+ arbitrary = genericArbitrary
49+ shrink = genericShrink
xml-isogen.cabal+24−6
@@ -45,17 +45,35 @@ library
4545 hs-source-dirs: src
4646
4747 default-language: Haskell2010
48− default-extensions: TemplateHaskell
49− LambdaCase
50− FlexibleInstances
51− TypeFamilies
52− TupleSections
48+ default-extensions: FlexibleInstances
49+ , LambdaCase
50+ , TemplateHaskell
51+ , TupleSections
52+ , TypeFamilies
5353
5454test-suite spec
5555 type: exitcode-stdio-1.0
5656 hs-source-dirs: test
5757 main-is: Main.hs
5858 other-modules: TestDefs
59− build-depends: base, xml-isogen
59+ build-depends: base
60+ , QuickCheck
61+ , data-default
62+ , dom-parser
63+ , generic-arbitrary
64+ , hspec
65+ , quickcheck-instances
66+ , semigroups
67+ , xml-conduit
68+ , xml-conduit-writer
69+ , xml-isogen
6070 default-language: Haskell2010
71+ default-extensions: DeriveGeneric
72+ , FlexibleInstances
73+ , LambdaCase
74+ , OverloadedStrings
75+ , StandaloneDeriving
76+ , TemplateHaskell
77+ , TupleSections
78+ , TypeFamilies
6179 ghc-options: -Wall -fno-warn-missing-signatures