git.iko.soy/typeable/schematic
on master help sign in
parsing api wip
commitfb0244ef864ef337387e296cd91f88b622884bcb authorDenis Redozubov <denis.redozubov@gmail.com> dateFri 26 May 2017, 18:55 (9 years ago) parent0ae6fb8
2 files changed+35−3
compare with master
unifiedsplit
src/Data/Schematic.hs+25 src/Data/Schematic/Migration.hs+10−3
src/Data/Schematic.hs+25
@@ -3,6 +3,7 @@ module Data.Schematic
33 , module Data.Schematic.Utils
44 , decodeAndValidateJson
55 , parseAndValidateJson
6+ , parseAndValidateVersionedJson
67 , isValid
78 , isDecodingError
89 , isValidationError
@@ -14,6 +15,7 @@ import Data.Aeson as J
1415import Data.Aeson.Types as J
1516import Data.ByteString.Lazy as BL
1617import Data.Functor.Identity
18+import Data.Schematic.Migration
1719import Data.Schematic.Schema
1820import Data.Schematic.Utils
1921import Data.Schematic.Validation
@@ -36,6 +38,29 @@ parseAndValidateJson v =
3638 Left em -> ValidationError em
3739 Right () -> Valid jsonRepr
3840
41+parseAndValidateTopVersionJson
42+ :: forall proxy v. (FromJSON (JsonRepr (TopVersion v)), Known (Sing (TopVersion v)))
43+ => proxy (v :: Versioned)
44+ -> J.Value
45+ -> ParseResult (JsonRepr (TopVersion v))
46+parseAndValidateTopVersionJson _ v =
47+ case parseEither parseJSON v of
48+ Left s -> DecodingError $ T.pack s
49+ Right jsonRepr ->
50+ let
51+ validate = validateJsonRepr (known :: Sing (TopVersion v)) [] jsonRepr
52+ res = runIdentity . runValidationTEither $ validate
53+ in case res of
54+ Left em -> ValidationError em
55+ Right () -> Valid jsonRepr
56+
57+parseAndValidateVersionedJson
58+ :: forall proxy v . ()
59+ => proxy (v :: Versioned)
60+ -> J.Value
61+ -> ParseResult (JsonRepr (TopVersion v))
62+parseAndValidateVersionedJson = undefined
63+
3964decodeAndValidateJson
4065 :: forall schema
4166 . (J.FromJSON (JsonRepr schema), TopLevel schema, Known (Sing schema))
src/Data/Schematic/Migration.hs+10−3
@@ -38,6 +38,8 @@ type family UpdateKey (acc :: [(Symbol, Schema)]) (fn :: Symbol) (fs :: [(Symbol
3838 UpdateKey acc fn ( '(fn, n) ': tl ) s = '(fn, s) ': tl
3939 UpdateKey acc fn ( '(a, n) ': tl) s = UpdateKey (acc :++ '[ '(a,n) ]) fn tl s
4040
41+-- schema updates
42+
4143type family Build (b :: Builder) :: Schema where
4244 Build ('BKey ('SchemaObject fs) fn z) = 'SchemaObject (UpdateKey '[] fn fs (Build z))
4345 Build ('BTraverse ('SchemaArray acs s) z) = 'SchemaArray acs (Build z)
@@ -60,12 +62,19 @@ type family ApplyMigration (m :: Migration) (s :: Schema) :: (Revision, Schema)
6062 ApplyMigration ('Migration r (d ': ds)) s =
6163 '(r, Snd (ApplyMigration ('Migration r ds) (Build (MakeBuilder s d))))
6264
65+-- working with revisions
66+
6367type family SchemaByRevision (r :: Revision) (vd :: Versioned) :: Schema where
6468 SchemaByRevision r ('Versioned s (('Migration r ds) ': ms)) =
6569 Snd (ApplyMigration ('Migration r ds) s)
6670 SchemaByRevision r ('Versioned s (m ': ms)) =
6771 SchemaByRevision r ('Versioned (Snd (ApplyMigration m s)) ms)
6872
73+type family TopVersion (vd :: Versioned) :: Schema where
74+ TopVersion ('Versioned s '[]) = s
75+ TopVersion ('Versioned s (m ': ms)) =
76+ TopVersion ('Versioned (Snd (ApplyMigration m s)) ms)
77+
6978class MigrateSchema (a :: Schema) (b :: Schema) where
7079 migrate :: JsonRepr a -> JsonRepr b
7180
@@ -111,8 +120,6 @@ data instance Sing (m :: Migration) where
111120
112121data Versioned = Versioned Schema [Migration]
113122
114−type family TypedVersionedSchema
115−
116123data instance Sing (v :: Versioned) where
117124 SVersioned
118125 :: (Known (Sing s), Known (Sing ms))
@@ -130,7 +137,7 @@ type VS =
130137 '[ 'Migration "test_revision"
131138 '[ 'Diff '[ 'PKey "foo" ] ('Update ('SchemaText '[])) ] ]
132139
133−jsonExample :: JsonRepr (SchemaByRevision "test_revision" VS)
140+jsonExample :: JsonRepr (TopVersion VS)
134141jsonExample = ReprObject $
135142 FieldRepr (ReprText "foo")
136143 :& FieldRepr (ReprOptional (Just (ReprText "bar")))