git.iko.soy/typeable/schematic
on master help sign in
simplistic test suite
commit52169207ace1e2a0d0dffc67a8e84b0bccaa4ca1 authorDenis Redozubov <denis.redozubov@gmail.com> dateThu 4 May 2017, 17:45 (9 years ago) parent06e017b
4 files changed+70−15
compare with master
unifiedsplit
schematic.cabal+41−2 src/Data/Schematic/Schema.hs−13 test/SchemaSpec.hs+28 test/Spec.hs+1
schematic.cabal+41−2
@@ -17,6 +17,7 @@ cabal-version: >=1.10
1717
1818library
1919 exposed-modules: Data.Schematic
20+ , Data.Schematic.Schema
2021 -- ghc-options:
2122 -- other-modules:
2223 default-extensions: ConstraintKinds
@@ -44,10 +45,48 @@ library
4445 , TypeOperators
4546 , TypeSynonymInstances
4647 build-depends: base >=4.9 && <4.10
47− , recursion-schemes
48− , singletons
4948 , regex-compat
5049 , text
5150 , vinyl
5251 hs-source-dirs: src
5352 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 @@
77
88module Data.Schematic.Schema where
99
10−import Data.Functor.Foldable
1110import Data.Kind hiding (Type)
1211import Data.Proxy
13−import Data.Singletons.TH
1412import Data.Text (Text)
15−import Data.Type.Equality
16−import Data.Vinyl
17−import Data.Vinyl.Functor
1813import GHC.TypeLits (KnownNat, natVal, KnownSymbol, symbolVal, Symbol, Nat)
1914
2015
@@ -133,18 +128,12 @@ instance (Verifiable 'JText cs) => Schematic (SText cs) where
133128 type JT (SText cs) = 'JText
134129 build _ = constructor (Proxy @(JT (SText cs))) $ schema (Proxy @JText) (Proxy @cs)
135130
136−-- example
137−type TextSchema = SText '[LengthEqNat 3]
138−
139131data SNumber cs
140132
141133instance (Verifiable 'JNumber cs) => Schematic (SNumber cs) where
142134 type JT (SNumber cs) = 'JNumber
143135 build _ = constructor (Proxy @(JT (SNumber cs))) $ schema (Proxy @'JNumber) (Proxy @cs)
144136
145−-- example
146−type NumberSchema = SNumber '[ Gt 3]
147−
148137instance (Verifiable (JT ty) cs, SchemaConstructor (JT ty)) => Schematic (Field field ty cs) where
149138 type JT (Field field ty cs) = JT ty
150139 build _ = constructor (Proxy @(JT (Field field ty cs)))
@@ -170,5 +159,3 @@ instance Schematic (SObject els) => TopLevel (SObject els)
170159-- => Proxy (SObject els)
171160-- -> Schema
172161-- 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 #-}