87a2553 · typeable/schematic

git.iko.soy/typeable/schematic

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) parent30d932b cf38e1f

6 files changed+33−27

compare with master

unifiedsplit

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

3+## HEAD

5+Support ghc-8.4 and drop support for older versions

37## 0.4.1.0 -- 2017-11-05

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

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