Migrated to be compatible with lts-14.22

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for schematic
 
+## 0.6.0.0 -- 2020-02-04
+
+Added compatability with aeson-1.4.3.0. Since version 1.4.3 the module `Data.Aeson` started exporting `JSONPath`, which was conflicting with our own `JSONPath`. Furthermore, started using `JSONPathElement` from `aeson` instead of `DemotedPathSegment`.
+
 ## 0.5.0.0 -- 2019-02-20
 
 GHC 8.6, json generation by schema definition, validation bug fixes, better

src/Data/Schematic/Path.hs

@@ -4,36 +4,33 @@ import Data.Foldable as F
 import Data.Singletons.Prelude
 import Data.Singletons.TypeLits
 import Data.Text as T
+import Data.Aeson.Internal
 
 
-data PathSegment = Key Symbol | Ix Nat
+newtype JSONPathText = JSONPathText Text
+  deriving (Show)
+
+data PathSegment = PathKey Symbol | PathIx Nat
 
 data instance Sing (jp :: PathSegment) where
-  SKey :: (SingI k) => Sing (k :: Symbol) -> Sing ('Key k)
-  SIx :: (SingI n) => Sing (n :: Nat) -> Sing ('Ix n)
+  SKey :: (SingI k) => Sing (k :: Symbol) -> Sing ('PathKey k)
+  SIx :: (SingI n) => Sing (n :: Nat) -> Sing ('PathIx n)
 
-data DemotedPathSegment = DKey Text | DIx Integer
-  deriving (Show)
-
--- | Textual representation of json path.
-newtype JSONPath = JSONPath Text
-  deriving (Show)
-
-demotePath :: Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
+demotePath :: Sing (ps :: [PathSegment]) -> JSONPath
 demotePath = go []
   where
-    go :: [DemotedPathSegment] -> Sing (ps :: [PathSegment]) -> [DemotedPathSegment]
+    go :: JSONPath -> Sing (ps :: [PathSegment]) -> JSONPath
     go acc SNil = acc
     go acc (SCons p ps) = go (acc ++ [demotePathSeg p]) ps
-    demotePathSeg :: Sing (ps :: PathSegment) -> DemotedPathSegment
-    demotePathSeg (SKey s) = DKey $ T.pack $ withKnownSymbol s $ symbolVal s
-    demotePathSeg (SIx n) = DIx $ withKnownNat n $ fromIntegral $ natVal n
+    demotePathSeg :: Sing (ps :: PathSegment) -> JSONPathElement
+    demotePathSeg (SKey s) = Key $ T.pack $ withKnownSymbol s $ symbolVal s
+    demotePathSeg (SIx n) = Index $ withKnownNat n $ fromIntegral $ natVal n
 
-demotedPathToText :: [DemotedPathSegment] -> JSONPath
-demotedPathToText = JSONPath . F.foldl' renderPathSegment ""
+demotedPathToText :: JSONPath -> JSONPathText
+demotedPathToText = JSONPathText . F.foldl' renderPathSegment ""
   where
-    renderPathSegment acc (DKey t) = acc <> "." <> t
-    renderPathSegment acc (DIx n)  = acc <> "[" <> T.pack (show n) <> "]"
+    renderPathSegment acc (Key t) = acc <> "." <> t
+    renderPathSegment acc (Index n)  = acc <> "[" <> T.pack (show n) <> "]"
 
-pathToText :: Sing (ps :: [PathSegment]) -> JSONPath
+pathToText :: Sing (ps :: [PathSegment]) -> JSONPathText
 pathToText = demotedPathToText . demotePath

src/Data/Schematic/Validation.hs

@@ -3,6 +3,7 @@ module Data.Schematic.Validation where
 import Control.Monad
 import Control.Monad.Validation
 import Data.Aeson
+import Data.Aeson.Internal
 import Data.Aeson.Types
 import Data.Foldable
 import Data.Functor.Identity
@@ -49,11 +50,11 @@ isValidationError (ValidationError _) = True
 isValidationError _                   = False
 
 validateTextConstraint
-  :: JSONPath
+  :: JSONPathText
   -> Text
   -> Sing (tcs :: TextConstraint)
   -> Validation ()
-validateTextConstraint (JSONPath path) t = \case
+validateTextConstraint (JSONPathText path) t = \case
   STEq n -> do
     let
       nlen      = withKnownNat n $ natVal n
@@ -106,11 +107,11 @@ validateTextConstraint (JSONPath path) t = \case
     unless (matching ss) warn
 
 validateNumberConstraint
-  :: JSONPath
+  :: JSONPathText
   -> Scientific
   -> Sing (tcs :: NumberConstraint)
   -> Validation ()
-validateNumberConstraint (JSONPath path) num = \case
+validateNumberConstraint (JSONPathText path) num = \case
   SNEq n -> do
     let
       nlen      = withKnownNat n $ natVal n
@@ -148,11 +149,11 @@ validateNumberConstraint (JSONPath path) num = \case
     unless predicate warn
 
 validateArrayConstraint
-  :: JSONPath
+  :: JSONPathText
   -> V.Vector a
   -> Sing (tcs :: ArrayConstraint)
   -> Validation ()
-validateArrayConstraint (JSONPath path) v = \case
+validateArrayConstraint (JSONPathText path) v = \case
   SAEq n -> do
     let
       nlen      = withKnownNat n $ natVal n
@@ -191,7 +192,7 @@ validateArrayConstraint (JSONPath path) v = \case
 
 validateJsonRepr
   :: Sing schema
-  -> [DemotedPathSegment]
+  -> JSONPath
   -> JsonRepr schema
   -> Validation ()
 validateJsonRepr sschema dpath jr = case jr of
@@ -225,7 +226,7 @@ validateJsonRepr sschema dpath jr = case jr of
           process cs
       process acs
       for_ (V.indexed v) $ \(ix, jr') -> do
-        let newPath = dpath <> pure (DIx $ fromIntegral ix)
+        let newPath = dpath <> pure (Index $ fromIntegral ix)
         validateJsonRepr s newPath jr'
   ReprOptional d -> case sschema of
     SSchemaOptional ss -> case d of
@@ -237,7 +238,7 @@ validateJsonRepr sschema dpath jr = case jr of
         go :: Rec FieldRepr (ts :: [(Symbol, Schema)] ) -> Validation ()
         go RNil                     = pure ()
         go (f@(FieldRepr d) :& ftl) = do
-          let newPath = dpath <> [DKey (knownFieldName f)]
+          let newPath = dpath <> [Key (knownFieldName f)]
           validateJsonRepr (knownFieldSchema f) newPath d
           go ftl
   ReprUnion _ -> pure () -- FIXME
@@ -249,7 +250,7 @@ validateJsonRepr sschema dpath jr = case jr of
     --           fail "impossible to produce subUnion, please report this as a bug"
     --         Just x -> do
     --           let
-    --             JSONPath path = demotedPathToText dpath
+    --             JSONPathText path = demotedPathToText dpath
     --           case stl of
     --             SNil -> void $ vWarning $ mmSingleton path
     --               $ pure "union handling error, please report this as bug"

stack.yaml

@@ -1,5 +1,6 @@
-resolver: lts-12.0
+resolver: lts-14.22
 extra-deps:
-  - hjsonpointer-1.4.0@rev:0
-  - hjsonschema-1.9.0@rev:0
-  - validationt-0.2.1.0
+- hjsonpointer-1.4.0@rev:0
+- hjsonschema-1.9.0@rev:0
+- git: https://github.com/typeable/validationt.git
+  commit: 97fea97c4015ab5e99f3efb2c73e1fef4b8857d8