5e6c70a · schematic · git.iko.soy

schematic.cabal+2−2

compare with master

unifiedsplit

@@ -65,7 +65,7 @@ library

65 , TypeOperators

66 , TypeSynonymInstances

67 , UndecidableInstances

68− build-depends: base >=4.11 && <4.12

68+ build-depends: base >=4.11 && <4.13

69 , bytestring

70 , aeson >= 1

71 , containers

@@ -95,7 +95,7 @@ test-suite spec

95 default-language: Haskell2010

96 build-depends: HUnit

97 , aeson >= 1

98− , base >=4.11 && <4.12

98+ , base >=4.11 && <4.13

99 , bytestring

100 , containers

101 , hjsonschema

src/Data/Schematic/DSL.hs+11−2

@@ -1,4 +1,5 @@

1{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE CPP #-}

2

3

3module Data.Schematic.DSL where

4module Data.Schematic.DSL where

4

5

@@ -17,11 +18,19 @@ import Data.Vinyl

17import Data.Vinyl.Functor

18import Data.Vinyl.Functor

18

19

20

21+#if MIN_VERSION_base(4,12,0)

20type Constructor a

22type Constructor a

23+ = forall fields b

21− = forall fields b. (fields ~ FieldsOf a, FSubset fields b (FImage fields b))

24+ . (fields ~ FieldsOf a, FSubset fields b (FImage fields b), RMap fields)

22 => Rec (Tagged fields :. FieldRepr) b

25 => Rec (Tagged fields :. FieldRepr) b

23 -> JsonRepr ('SchemaObject fields)

26 -> JsonRepr ('SchemaObject fields)

24−

27+#else

28+type Constructor a

29+ = forall fields b

30+ . (fields ~ FieldsOf a, FSubset fields b (FImage fields b))

31+ => Rec (Tagged fields :. FieldRepr) b

32+ -> JsonRepr ('SchemaObject fields)

33+#endif

25withRepr :: Constructor a

34withRepr :: Constructor a

26withRepr = ReprObject . rmap (unTagged . getCompose) . fcast

35withRepr = ReprObject . rmap (unTagged . getCompose) . fcast

27

36

src/Data/Schematic/Migration.hs+10−2

@@ -1,5 +1,6 @@

1{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE CPP #-}

2−{-# LANGUAGE TemplateHaskell #-}

3+{-# LANGUAGE TemplateHaskell #-}

3

4

4module Data.Schematic.Migration where

5module Data.Schematic.Migration where

5

6

@@ -8,7 +9,7 @@ import Data.Schematic.DSL

8import Data.Schematic.Lens

9import Data.Schematic.Lens

9import Data.Schematic.Path

10import Data.Schematic.Path

10import Data.Schematic.Schema

11import Data.Schematic.Schema

11−import Data.Singletons.Prelude hiding (All, (:.))

12+import Data.Singletons.Prelude hiding ((:.), All)

12import Data.Singletons.TypeLits

13import Data.Singletons.TypeLits

13import Data.Tagged

14import Data.Tagged

14import Data.Vinyl

15import Data.Vinyl

@@ -156,10 +157,17 @@ data MList :: (Type -> Type) -> [Schema] -> Type where

156

157

157infixr 7 :&&

158infixr 7 :&&

158

159

160+#if MIN_VERSION_base(4,12,0)

161+migrateObject

162+ :: forall m fs fh. (FSubset fs fs (FImage fs fs), Monad m, RMap fh, RMap fs)

163+ => (Rec (Tagged fs :. FieldRepr) fh -> m (Rec (Tagged fs :. FieldRepr) fs))

164+ -> Tagged ('SchemaObject fs) (JsonRepr ('SchemaObject fh) -> m (JsonRepr ('SchemaObject fs)))

165+#else

159migrateObject

166migrateObject

160 :: forall m fs fh. (FSubset fs fs (FImage fs fs), Monad m)

167 :: forall m fs fh. (FSubset fs fs (FImage fs fs), Monad m)

161 => (Rec (Tagged fs :. FieldRepr) fh -> m (Rec (Tagged fs :. FieldRepr) fs))

168 => (Rec (Tagged fs :. FieldRepr) fh -> m (Rec (Tagged fs :. FieldRepr) fs))

162 -> Tagged ('SchemaObject fs) (JsonRepr ('SchemaObject fh) -> m (JsonRepr ('SchemaObject fs)))

169 -> Tagged ('SchemaObject fs) (JsonRepr ('SchemaObject fh) -> m (JsonRepr ('SchemaObject fs)))

170+#endif

163migrateObject f = Tagged $ \(ReprObject r) -> do

171migrateObject f = Tagged $ \(ReprObject r) -> do

164 res <- f $ rmap (Compose . Tagged) r

172 res <- f $ rmap (Compose . Tagged) r

165 pure $ withRepr @('SchemaObject fs) res

173 pure $ withRepr @('SchemaObject fs) res

src/Data/Schematic/Schema.hs+11−2

@@ -1,6 +1,7 @@

1{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedLists #-}

3+{-# LANGUAGE OverloadedLists #-}

3−{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE OverloadedStrings #-}

4{-# OPTIONS_GHC -fprint-explicit-kinds #-}

5{-# OPTIONS_GHC -fprint-explicit-kinds #-}

5

6

6module Data.Schematic.Schema where

7module Data.Schematic.Schema where

@@ -376,8 +377,16 @@ instance Show (JsonRepr 'SchemaNull) where show _ = "ReprNull"

376instance Show (JsonRepr s) => Show (JsonRepr ('SchemaArray acs s)) where

377instance Show (JsonRepr s) => Show (JsonRepr ('SchemaArray acs s)) where

377 show (ReprArray v) = "ReprArray " P.++ show v

378 show (ReprArray v) = "ReprArray " P.++ show v

378

379

380+#if MIN_VERSION_base(4,12,0)

381+instance

382+ ( V.RecAll FieldRepr fs Show, RMap fs, ReifyConstraint Show FieldRepr fs

383+ , RecordToList fs )

384+ => Show (JsonRepr ('SchemaObject fs)) where

385+ show (ReprObject fs) = "ReprObject " P.++ show fs

386+#else

379instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where

387instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where

380 show (ReprObject fs) = "ReprObject " P.++ show fs

388 show (ReprObject fs) = "ReprObject " P.++ show fs

389+#endif

381

390

382instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where

391instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where

383 show (ReprOptional s) = "ReprOptional " P.++ show s

392 show (ReprOptional s) = "ReprOptional " P.++ show s

stack-13.7.yamlnew file+5

@@ -0,0 +1,5 @@

1+resolver: lts-13.7

2+extra-deps:

3+ - hjsonpointer-1.4.0@rev:0

4+ - hjsonschema-1.9.0@rev:0

5+ - validationt-0.2.1.0