diff --git a/schematic.cabal b/schematic.cabal index feaeada..df00704 100644 --- a/schematic.cabal +++ b/schematic.cabal @@ -65,7 +65,7 @@ library , TypeOperators , TypeSynonymInstances , UndecidableInstances - build-depends: base >=4.11 && <4.12 + build-depends: base >=4.11 && <4.13 , bytestring , aeson >= 1 , containers @@ -95,7 +95,7 @@ test-suite spec default-language: Haskell2010 build-depends: HUnit , aeson >= 1 - , base >=4.11 && <4.12 + , base >=4.11 && <4.13 , bytestring , containers , hjsonschema diff --git a/src/Data/Schematic/DSL.hs b/src/Data/Schematic/DSL.hs index c6c8114..da16bfd 100644 --- a/src/Data/Schematic/DSL.hs +++ b/src/Data/Schematic/DSL.hs @@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} module Data.Schematic.DSL where @@ -17,11 +18,19 @@ import Data.Vinyl import Data.Vinyl.Functor +#if MIN_VERSION_base(4,12,0) type Constructor a - = forall fields b. (fields ~ FieldsOf a, FSubset fields b (FImage fields b)) + = forall fields b + . (fields ~ FieldsOf a, FSubset fields b (FImage fields b), RMap fields) => Rec (Tagged fields :. FieldRepr) b -> JsonRepr ('SchemaObject fields) - +#else +type Constructor a + = forall fields b + . (fields ~ FieldsOf a, FSubset fields b (FImage fields b)) + => Rec (Tagged fields :. FieldRepr) b + -> JsonRepr ('SchemaObject fields) +#endif withRepr :: Constructor a withRepr = ReprObject . rmap (unTagged . getCompose) . fcast diff --git a/src/Data/Schematic/Migration.hs b/src/Data/Schematic/Migration.hs index ad870a5..b8cc197 100644 --- a/src/Data/Schematic/Migration.hs +++ b/src/Data/Schematic/Migration.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} module Data.Schematic.Migration where @@ -8,7 +9,7 @@ import Data.Schematic.DSL import Data.Schematic.Lens import Data.Schematic.Path import Data.Schematic.Schema -import Data.Singletons.Prelude hiding (All, (:.)) +import Data.Singletons.Prelude hiding ((:.), All) import Data.Singletons.TypeLits import Data.Tagged import Data.Vinyl @@ -156,10 +157,17 @@ data MList :: (Type -> Type) -> [Schema] -> Type where infixr 7 :&& +#if MIN_VERSION_base(4,12,0) +migrateObject + :: forall m fs fh. (FSubset fs fs (FImage fs fs), Monad m, RMap fh, RMap fs) + => (Rec (Tagged fs :. FieldRepr) fh -> m (Rec (Tagged fs :. FieldRepr) fs)) + -> Tagged ('SchemaObject fs) (JsonRepr ('SchemaObject fh) -> m (JsonRepr ('SchemaObject fs))) +#else migrateObject :: forall m fs fh. (FSubset fs fs (FImage fs fs), Monad m) => (Rec (Tagged fs :. FieldRepr) fh -> m (Rec (Tagged fs :. FieldRepr) fs)) -> Tagged ('SchemaObject fs) (JsonRepr ('SchemaObject fh) -> m (JsonRepr ('SchemaObject fs))) +#endif migrateObject f = Tagged $ \(ReprObject r) -> do res <- f $ rmap (Compose . Tagged) r pure $ withRepr @('SchemaObject fs) res diff --git a/src/Data/Schematic/Schema.hs b/src/Data/Schematic/Schema.hs index 90a35ef..d5664c8 100644 --- a/src/Data/Schematic/Schema.hs +++ b/src/Data/Schematic/Schema.hs @@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fprint-explicit-kinds #-} module Data.Schematic.Schema where @@ -12,8 +13,8 @@ import Data.Aeson.Types as J import Data.HashMap.Strict as H import Data.Kind import Data.Maybe -import Data.Schematic.Instances () import Data.Schematic.Generator +import Data.Schematic.Instances () import Data.Scientific import Data.Singletons.Prelude.List hiding (All, Union) import Data.Singletons.TH @@ -373,8 +374,16 @@ instance Show (JsonRepr 'SchemaNull) where show _ = "ReprNull" instance Show (JsonRepr s) => Show (JsonRepr ('SchemaArray acs s)) where show (ReprArray v) = "ReprArray " P.++ show v +#if MIN_VERSION_base(4,12,0) +instance + ( V.RecAll FieldRepr fs Show, RMap fs, ReifyConstraint Show FieldRepr fs + , RecordToList fs ) + => Show (JsonRepr ('SchemaObject fs)) where + show (ReprObject fs) = "ReprObject " P.++ show fs +#else instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where show (ReprObject fs) = "ReprObject " P.++ show fs +#endif instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where show (ReprOptional s) = "ReprOptional " P.++ show s diff --git a/stack-13.7.yaml b/stack-13.7.yaml new file mode 100644 index 0000000..468882c --- /dev/null +++ b/stack-13.7.yaml @@ -0,0 +1,5 @@ +resolver: lts-13.7 +extra-deps: + - hjsonpointer-1.4.0@rev:0 + - hjsonschema-1.9.0@rev:0 + - validationt-0.2.1.0