schematic 0.1.2.0 → 0.1.3.0

raw patch · 3 files changed

+37/−39 lines, 3 files

Files

• schematic.cabal +1/−2
• src/Data/Schematic.hs +11/−28
• test/SchemaSpec.hs +25/−9

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                schematic-version:             0.1.2.0+version:             0.1.3.0 synopsis:            JSON-biased spec and validation tool -- description: license:             BSD3@@ -17,7 +17,6 @@  library   exposed-modules:     Data.Schematic-                     -- , Data.Schematic.Class                      , Data.Schematic.Instances                      , Data.Schematic.Path                      , Data.Schematic.Schema

@@ -70,7 +70,10 @@     -> J.Value     -> ParseResult (JsonRepr (Snd (Head revisions))) -instance {-# OVERLAPPING #-} (TopLevel (Snd rev), SingI (Snd rev)) => Migratable '[rev] where+instance+  {-# OVERLAPPING #-}+  ( TopLevel (Snd rev), SingI (Snd rev) )+  => Migratable '[rev] where   mparse _ = parseAndValidateJson  instance {-# OVERLAPPABLE #-}@@ -79,35 +82,10 @@   , SingI (Snd (Head revisions)))   => Migratable revisions where   mparse s v = case parseEither parseJSON v of-    Left _  -> migrate <$> mparse (sTail s) v+    Left _  ->+      migrate <$> (mparse (sTail s) v :: ParseResult (JsonRepr (Snd (Head (Tail revisions)))))     Right x -> Valid x--- type family Migratable (revisions :: [(Revision, Schema)]) = (cs :: Constraint) where---   Migratable '[rev] = (TopLevel (Snd rev), SingI (Snd rev))---   Migratable  revisions =---    ( Migratable (Tail revisions)---    , MigrateSchema (Snd (Head (Tail revisions))) (Snd (Head revisions))---    , SingI (Snd (Head revisions))) --- mparseBySing---   :: Sing schema---   -> J.Value---   -> ParseResult (JsonRepr (Snd (Head revisions)))--- mparseBySing s v = undefined---- mparse---   :: Migratable revisions---   => Sing revisions---   -> J.Value---   -> ParseResult (JsonRepr (Snd (Head revisions)))--- mparse s v =---   let---     st = sTail s---     sth = sSnd $ sHead st---   SCons x SNil -> parseAndValidateJson v---   SCons sch _   -> case parseEither parseJSON v of---     Left _  -> migrate <$> mparse (sTail s) v---     Right x -> Valid x- parseAndValidateVersionedJson   :: forall proxy v. (SingI (AllVersions v), Migratable (AllVersions v))   => proxy v@@ -132,3 +110,8 @@ decodeAndValidateVersionedJson vp bs = case decode bs of   Nothing -> DecodingError "malformed json"   Just x  -> parseAndValidateVersionedJson vp x++decodeAndValidate+  :: MList revisions+  ->+decodeAndValidate = undefined

@@ -8,6 +8,7 @@ import Data.Proxy import Data.Schematic import Data.Singletons+import Data.Singletons.Prelude import Data.Vinyl import Test.Hspec import Test.Hspec.SmallCheck@@ -16,16 +17,17 @@   type SchemaExample-  = SchemaObject-    '[ '("foo", SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))-     , '("bar", SchemaOptional (SchemaText '[TEnum '["foo", "bar"]]))]+  = 'SchemaObject+    '[ '("foo", 'SchemaArray '[AEq 1] ('SchemaNumber '[NGt 10]))+     , '("bar", 'SchemaOptional ('SchemaText '[TEnum '["foo", "bar"]]))] -type VS =-  'Versioned SchemaExample-    '[ 'Migration "test_revision"-       '[ 'Diff '[ 'PKey "bar" ] ('Update ('SchemaText '[]))-        , 'Diff '[ 'PKey "foo" ] ('Update ('SchemaNumber '[])) ] ]+type TestMigration =+  'Migration "test_revision"+    '[ 'Diff '[ 'PKey "bar" ] ('Update ('SchemaText '[]))+     , 'Diff '[ 'PKey "foo" ] ('Update ('SchemaNumber '[])) ] +type VS = 'Versioned SchemaExample '[ TestMigration ]+ exampleTest :: JsonRepr (SchemaOptional (SchemaText '[TEq 3])) exampleTest = ReprOptional (Just (ReprText "lil")) @@ -50,6 +52,19 @@ schemaJsonTopVersion :: ByteString schemaJsonTopVersion = "{ \"foo\": 42, \"bar\": \"bar\" }" +instance+     MigrateSchema+       ('SchemaObject+          '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10 ])),+             '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))])+       ('SchemaObject+         '[ '("foo", 'SchemaNumber '[]), '("bar", 'SchemaText '[])])+  where+  migrate _ = ReprObject $+    FieldRepr (ReprNumber 42)+      :& FieldRepr (ReprText "test")+      :& RNil+ spec :: Spec spec = do   -- it "show/read JsonRepr properly" $@@ -66,8 +81,9 @@     ((decodeAndValidateJson schemaJson2) :: ParseResult (JsonRepr SchemaExample))       `shouldSatisfy` isValidationError   it "validates versioned json" $ do-    (decodeAndValidateVersionedJson (Proxy @VS) schemaJsonTopVersion)+    decodeAndValidateVersionedJson (Proxy @VS) schemaJson       `shouldSatisfy` isValid+  main :: IO () main = hspec spec