on master help sign in
Merge pull request #10 from 4e6/ghc-84

Support GHC 8.4

commit87a2553354c5c88c562aea6c40f3d78133fe19f6 authorDenis Redozubov <denis.redozubov@gmail.com> dateThu 12 Jul 2018, 18:39 (8 years ago) parent30d932bcf38e1f
6 files changed+33−27
ChangeLog.md+4 schematic.cabal+6−6 src/Data/Schematic/Migration.hs+3−3 src/Data/Schematic/Path.hs+4−6 src/Data/Schematic/Schema.hs+11−11 stack.yaml+5−1
ChangeLog.md+4
@@ -1,5 +1,9 @@
11# Revision history for schematic
22
3+## HEAD
4+
5+Support ghc-8.4 and drop support for older versions
6+
37## 0.4.1.0 -- 2017-11-05
48
59Convenience isomorphisms: txt, num, opt, bln etc
schematic.cabal+6−6
@@ -57,7 +57,7 @@ library
5757 , TypeOperators
5858 , TypeSynonymInstances
5959 , UndecidableInstances
60− build-depends: base >=4.9 && <4.11
60+ build-depends: base >=4.11 && <4.12
6161 , bytestring
6262 , aeson >= 1
6363 , containers
@@ -67,14 +67,14 @@ library
6767 , regex-tdfa
6868 , regex-tdfa-text
6969 , scientific
70− , singletons >= 2.2
70+ , singletons >= 2.4
7171 , smallcheck
7272 , tagged
7373 , template-haskell
7474 , text
7575 , union
7676 , unordered-containers
77− , validationt >= 0.1.0.1
77+ , validationt >= 0.2.1.0
7878 , vector
7979 , vinyl
8080 hs-source-dirs: src
@@ -87,7 +87,7 @@ test-suite spec
8787 default-language: Haskell2010
8888 build-depends: HUnit
8989 , aeson >= 1
90− , base >=4.9 && <4.11
90+ , base >=4.11 && <4.12
9191 , bytestring
9292 , containers
9393 , hjsonschema
@@ -104,9 +104,9 @@ test-suite spec
104104 , tagged
105105 , text
106106 , unordered-containers
107− , validationt >= 0.1.0.1
107+ , validationt >= 0.2.1.0
108108 , vinyl
109109 other-modules: SchemaSpec
110110 , HelpersSpec
111111 , LensSpec
112− , JsonSchemaSpec
112+ , JsonSchemaSpec
src/Data/Schematic/Migration.hs+3−3
@@ -42,8 +42,8 @@ type family SchemaByKey (fs :: [(Symbol, Schema)]) (s :: Symbol) :: Schema where
4242 SchemaByKey ( '(a, s) ': tl) fn = SchemaByKey tl fn
4343
4444type family DeleteKey (acc :: [(Symbol, Schema)]) (fn :: Symbol) (fs :: [(Symbol, Schema)]) :: [(Symbol, Schema)] where
45− DeleteKey acc fn ('(fn, a) ': tl) = acc :++ tl
46− DeleteKey acc fn (fna ': tl) = acc :++ (fna ': tl)
45+ DeleteKey acc fn ('(fn, a) ': tl) = acc ++ tl
46+ DeleteKey acc fn (fna ': tl) = acc ++ (fna ': tl)
4747
4848type family UpdateKey
4949 (fn :: Symbol)
@@ -146,7 +146,7 @@ data instance Sing (v :: Versioned) where
146146
147147type DataMigration s m h = Tagged s (JsonRepr h -> m (JsonRepr s))
148148
149−data MList :: (* -> *) -> [Schema] -> Type where
149+data MList :: (Type -> Type) -> [Schema] -> Type where
150150 MNil :: (Monad m, SingI s, TopLevel s) => MList m '[s]
151151 (:&&)
152152 :: (TopLevel s, SingI s)
src/Data/Schematic/Path.hs+4−6
@@ -1,8 +1,6 @@
11module Data.Schematic.Path where
22
33import Data.Foldable as F
4−import Data.Monoid
5−import Data.Singletons
64import Data.Singletons.Prelude
75import Data.Singletons.TypeLits
86import Data.Text as T
@@ -26,10 +24,10 @@ demotePath = go []
2624 where
2725 go :: [DemotedPathSegment] -> Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
2826 go acc SNil = acc
29− go acc (SCons p ps) = go (acc ++ [demote p]) ps
30− demote :: Sing (ps :: PathSegment) -> DemotedPathSegment
31− demote (SKey s) = DKey $ T.pack $ withKnownSymbol s $ symbolVal s
32− demote (SIx n) = DIx $ withKnownNat n $ natVal n
27+ go acc (SCons p ps) = go (acc ++ [demotePathSeg p]) ps
28+ demotePathSeg :: Sing (ps :: PathSegment) -> DemotedPathSegment
29+ demotePathSeg (SKey s) = DKey $ T.pack $ withKnownSymbol s $ symbolVal s
30+ demotePathSeg (SIx n) = DIx $ withKnownNat n $ fromIntegral $ natVal n
3331
3432demotedPathToText :: [DemotedPathSegment] -> JSONPath
3533demotedPathToText = JSONPath . F.foldl' renderPathSegment ""
src/Data/Schematic/Schema.hs+11−11
@@ -48,11 +48,11 @@ data TextConstraint
4848instance SingKind TextConstraint where
4949 type Demote TextConstraint = DemotedTextConstraint
5050 fromSing = \case
51− STEq n -> withKnownNat n (DTEq $ natVal n)
52− STLt n -> withKnownNat n (DTLt $ natVal n)
53− STLe n -> withKnownNat n (DTLe $ natVal n)
54− STGt n -> withKnownNat n (DTGt $ natVal n)
55− STGe n -> withKnownNat n (DTGe $ natVal n)
51+ STEq n -> withKnownNat n (DTEq . fromIntegral $ natVal n)
52+ STLt n -> withKnownNat n (DTLt . fromIntegral $ natVal n)
53+ STLe n -> withKnownNat n (DTLe . fromIntegral $ natVal n)
54+ STGt n -> withKnownNat n (DTGt . fromIntegral $ natVal n)
55+ STGe n -> withKnownNat n (DTGe . fromIntegral $ natVal n)
5656 STRegex s -> withKnownSymbol s (DTRegex $ T.pack $ symbolVal s)
5757 STEnum s -> let
5858 d :: Sing (s :: [Symbol]) -> [Text]
@@ -153,11 +153,11 @@ instance Eq (Sing ('NGe n)) where _ == _ = True
153153instance SingKind NumberConstraint where
154154 type Demote NumberConstraint = DemotedNumberConstraint
155155 fromSing = \case
156− SNEq n -> withKnownNat n (DNEq $ natVal n)
157− SNGt n -> withKnownNat n (DNGt $ natVal n)
158− SNGe n -> withKnownNat n (DNGe $ natVal n)
159− SNLt n -> withKnownNat n (DNLt $ natVal n)
160− SNLe n -> withKnownNat n (DNLe $ natVal n)
156+ SNEq n -> withKnownNat n (DNEq . fromIntegral $ natVal n)
157+ SNGt n -> withKnownNat n (DNGt . fromIntegral $ natVal n)
158+ SNGe n -> withKnownNat n (DNGe . fromIntegral $ natVal n)
159+ SNLt n -> withKnownNat n (DNLt . fromIntegral $ natVal n)
160+ SNLe n -> withKnownNat n (DNLe . fromIntegral $ natVal n)
161161 toSing = \case
162162 DNEq n -> case someNatVal n of
163163 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SNEq (SNat :: Sing n))
@@ -193,7 +193,7 @@ instance Eq (Sing ('AEq n)) where _ == _ = True
193193instance SingKind ArrayConstraint where
194194 type Demote ArrayConstraint = DemotedArrayConstraint
195195 fromSing = \case
196− SAEq n -> withKnownNat n (DAEq $ natVal n)
196+ SAEq n -> withKnownNat n (DAEq . fromIntegral $ natVal n)
197197 toSing = \case
198198 DAEq n -> case someNatVal n of
199199 Just (SomeNat (_ :: Proxy n)) -> SomeSing (SAEq (SNat :: Sing n))
stack.yaml+5−1
@@ -1 +1,5 @@
1−resolver: lts-10.0
1+resolver: lts-12.0
2+extra-deps:
3+ - hjsonpointer-1.4.0@rev:0
4+ - hjsonschema-1.9.0@rev:0
5+ - validationt-0.2.1.0