git.iko.soy/typeable/schematic
on master help sign in
simplistic test suite
5216920Denis Redozubov
schematic.cabal+41−2
compare with master
unifiedsplit
@@ -17,6 +17,7 @@ cabal-version: >=1.10
17
17
18library
18library
19 exposed-modules: Data.Schematic
19 exposed-modules: Data.Schematic
20+ , Data.Schematic.Schema
20 -- ghc-options:
21 -- ghc-options:
21 -- other-modules:
22 -- other-modules:
22 default-extensions: ConstraintKinds
23 default-extensions: ConstraintKinds
@@ -44,10 +45,48 @@ library
44 , TypeOperators
45 , TypeOperators
45 , TypeSynonymInstances
46 , TypeSynonymInstances
46 build-depends: base >=4.9 && <4.10
47 build-depends: base >=4.9 && <4.10
47− , recursion-schemes
48− , singletons
49 , regex-compat
48 , regex-compat
50 , text
49 , text
51 , vinyl
50 , vinyl
52 hs-source-dirs: src
51 hs-source-dirs: src
53 default-language: Haskell2010
52 default-language: Haskell2010
53+
54+test-suite spec
55+ type: exitcode-stdio-1.0
56+ hs-source-dirs: test
57+ main-is: Spec.hs
58+ default-language: Haskell2010
59+ default-extensions: ConstraintKinds
60+ , DataKinds
61+ , DeriveFunctor
62+ , DeriveFoldable
63+ , DeriveDataTypeable
64+ , FlexibleContexts
65+ , FlexibleInstances
66+ , FunctionalDependencies
67+ , GADTs
68+ , KindSignatures
69+ , InstanceSigs
70+ , MultiParamTypeClasses
71+ , OverloadedStrings
72+ , PolyKinds
73+ , QuasiQuotes
74+ , PartialTypeSignatures
75+ , RecordWildCards
76+ , ScopedTypeVariables
77+ , TemplateHaskell
78+ , TypeApplications
79+ , TypeFamilies
80+ , TypeInType
81+ , TypeOperators
82+ , TypeSynonymInstances
83+ build-depends: HUnit
84+ , base >=4.9 && <4.10
85+ , hspec >= 2.2.0
86+ , hspec-core
87+ , hspec-discover
88+ , regex-compat
89+ , schematic
90+ , text
91+ , vinyl
92+ other-modules: SchemaSpec
src/Data/Schematic/Schema.hs−13
@@ -7,14 +7,9 @@
7
7
8module Data.Schematic.Schema where
8module Data.Schematic.Schema where
9
9
10−import Data.Functor.Foldable
11import Data.Kind hiding (Type)
10import Data.Kind hiding (Type)
12import Data.Proxy
11import Data.Proxy
13−import Data.Singletons.TH
14import Data.Text (Text)
12import Data.Text (Text)
15−import Data.Type.Equality
16−import Data.Vinyl
17−import Data.Vinyl.Functor
18import GHC.TypeLits (KnownNat, natVal, KnownSymbol, symbolVal, Symbol, Nat)
13import GHC.TypeLits (KnownNat, natVal, KnownSymbol, symbolVal, Symbol, Nat)
19
14
20
15
@@ -133,18 +128,12 @@ instance (Verifiable 'JText cs) => Schematic (SText cs) where
133 type JT (SText cs) = 'JText
128 type JT (SText cs) = 'JText
134 build _ = constructor (Proxy @(JT (SText cs))) $ schema (Proxy @JText) (Proxy @cs)
129 build _ = constructor (Proxy @(JT (SText cs))) $ schema (Proxy @JText) (Proxy @cs)
135
130
136−-- example
137−type TextSchema = SText '[LengthEqNat 3]
138−
139data SNumber cs
131data SNumber cs
140
132
141instance (Verifiable 'JNumber cs) => Schematic (SNumber cs) where
133instance (Verifiable 'JNumber cs) => Schematic (SNumber cs) where
142 type JT (SNumber cs) = 'JNumber
134 type JT (SNumber cs) = 'JNumber
143 build _ = constructor (Proxy @(JT (SNumber cs))) $ schema (Proxy @'JNumber) (Proxy @cs)
135 build _ = constructor (Proxy @(JT (SNumber cs))) $ schema (Proxy @'JNumber) (Proxy @cs)
144
136
145−-- example
146−type NumberSchema = SNumber '[ Gt 3]
147−
148instance (Verifiable (JT ty) cs, SchemaConstructor (JT ty)) => Schematic (Field field ty cs) where
137instance (Verifiable (JT ty) cs, SchemaConstructor (JT ty)) => Schematic (Field field ty cs) where
149 type JT (Field field ty cs) = JT ty
138 type JT (Field field ty cs) = JT ty
150 build _ = constructor (Proxy @(JT (Field field ty cs)))
139 build _ = constructor (Proxy @(JT (Field field ty cs)))
@@ -170,5 +159,3 @@ instance Schematic (SObject els) => TopLevel (SObject els)
170-- => Proxy (SObject els)
159-- => Proxy (SObject els)
171-- -> Schema
160-- -> Schema
172-- toSchema p = constructor p $ schema (Proxy @(JT (SObject els))) (Proxy @els)
161-- toSchema p = constructor p $ schema (Proxy @(JT (SObject els))) (Proxy @els)
173−
174−type TestStruct = SObject '[ Field "carrier" 'JText [SText '[LengthEqNat 3] ] ]
test/SchemaSpec.hsnew file+28
@@ -0,0 +1,28 @@
1+module SchemaSpec (spec, main) where
2+
3+import Data.Proxy
4+import Data.Schematic.Schema
5+import Test.Hspec
6+
7+type TextSchema = SText '[LengthEqNat 3]
8+
9+type NumberSchema = SNumber '[ Gt 3]
10+
11+type ObjectSchema = SObject '[ Field "carrier" 'JText [TextSchema] ]
12+
13+spec :: Spec
14+spec = do
15+ describe "Schema translation: " $ do
16+ let
17+ textSchema = SchemaText [LengthEq 2]
18+ numberSchema = SchemaNumber [Gt 3]
19+ it "translate string schema"
20+ $ build (Proxy @TextSchema) `shouldBe` textSchema
21+ it "translates number schema"
22+ $ build (Proxy @NumberSchema) `shouldBe` numberSchema
23+ it "translates object schema" $ do
24+ build (Proxy @ObjectSchema) `shouldBe`
25+ SchemaObject [("carrier", textSchema), ("number_gt_3", numberSchema)]
26+
27+main :: IO ()
28+main = hspec spec
test/Spec.hsnew file+1
@@ -0,0 +1 @@
1+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}