git.iko.soy/typeable/schematic
on master help sign in
parsing api wip
fb0244eDenis Redozubov
src/Data/Schematic.hs+25
compare with master
unifiedsplit
@@ -3,6 +3,7 @@ module Data.Schematic
3 , module Data.Schematic.Utils
3 , module Data.Schematic.Utils
4 , decodeAndValidateJson
4 , decodeAndValidateJson
5 , parseAndValidateJson
5 , parseAndValidateJson
6+ , parseAndValidateVersionedJson
6 , isValid
7 , isValid
7 , isDecodingError
8 , isDecodingError
8 , isValidationError
9 , isValidationError
@@ -14,6 +15,7 @@ import Data.Aeson as J
14import Data.Aeson.Types as J
15import Data.Aeson.Types as J
15import Data.ByteString.Lazy as BL
16import Data.ByteString.Lazy as BL
16import Data.Functor.Identity
17import Data.Functor.Identity
18+import Data.Schematic.Migration
17import Data.Schematic.Schema
19import Data.Schematic.Schema
18import Data.Schematic.Utils
20import Data.Schematic.Utils
19import Data.Schematic.Validation
21import Data.Schematic.Validation
@@ -36,6 +38,29 @@ parseAndValidateJson v =
36 Left em -> ValidationError em
38 Left em -> ValidationError em
37 Right () -> Valid jsonRepr
39 Right () -> Valid jsonRepr
38
40
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+
39decodeAndValidateJson
64decodeAndValidateJson
40 :: forall schema
65 :: forall schema
41 . (J.FromJSON (JsonRepr schema), TopLevel schema, Known (Sing schema))
66 . (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
38 UpdateKey acc fn ( '(fn, n) ': tl ) s = '(fn, s) ': tl
38 UpdateKey acc fn ( '(fn, n) ': tl ) s = '(fn, s) ': tl
39 UpdateKey acc fn ( '(a, n) ': tl) s = UpdateKey (acc :++ '[ '(a,n) ]) fn tl s
39 UpdateKey acc fn ( '(a, n) ': tl) s = UpdateKey (acc :++ '[ '(a,n) ]) fn tl s
40
40
41+-- schema updates
42+
41type family Build (b :: Builder) :: Schema where
43type family Build (b :: Builder) :: Schema where
42 Build ('BKey ('SchemaObject fs) fn z) = 'SchemaObject (UpdateKey '[] fn fs (Build z))
44 Build ('BKey ('SchemaObject fs) fn z) = 'SchemaObject (UpdateKey '[] fn fs (Build z))
43 Build ('BTraverse ('SchemaArray acs s) z) = 'SchemaArray acs (Build z)
45 Build ('BTraverse ('SchemaArray acs s) z) = 'SchemaArray acs (Build z)
@@ -60,12 +62,19 @@ type family ApplyMigration (m :: Migration) (s :: Schema) :: (Revision, Schema)
60 ApplyMigration ('Migration r (d ': ds)) s =
62 ApplyMigration ('Migration r (d ': ds)) s =
61 '(r, Snd (ApplyMigration ('Migration r ds) (Build (MakeBuilder s d))))
63 '(r, Snd (ApplyMigration ('Migration r ds) (Build (MakeBuilder s d))))
62
64
65+-- working with revisions
66+
63type family SchemaByRevision (r :: Revision) (vd :: Versioned) :: Schema where
67type family SchemaByRevision (r :: Revision) (vd :: Versioned) :: Schema where
64 SchemaByRevision r ('Versioned s (('Migration r ds) ': ms)) =
68 SchemaByRevision r ('Versioned s (('Migration r ds) ': ms)) =
65 Snd (ApplyMigration ('Migration r ds) s)
69 Snd (ApplyMigration ('Migration r ds) s)
66 SchemaByRevision r ('Versioned s (m ': ms)) =
70 SchemaByRevision r ('Versioned s (m ': ms)) =
67 SchemaByRevision r ('Versioned (Snd (ApplyMigration m s)) ms)
71 SchemaByRevision r ('Versioned (Snd (ApplyMigration m s)) ms)
68
72
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+
69class MigrateSchema (a :: Schema) (b :: Schema) where
78class MigrateSchema (a :: Schema) (b :: Schema) where
70 migrate :: JsonRepr a -> JsonRepr b
79 migrate :: JsonRepr a -> JsonRepr b
71
80
@@ -111,8 +120,6 @@ data instance Sing (m :: Migration) where
111
120
112data Versioned = Versioned Schema [Migration]
121data Versioned = Versioned Schema [Migration]
113
122
114−type family TypedVersionedSchema
115−
116data instance Sing (v :: Versioned) where
123data instance Sing (v :: Versioned) where
117 SVersioned
124 SVersioned
118 :: (Known (Sing s), Known (Sing ms))
125 :: (Known (Sing s), Known (Sing ms))
@@ -130,7 +137,7 @@ type VS =
130 '[ 'Migration "test_revision"
137 '[ 'Migration "test_revision"
131 '[ 'Diff '[ 'PKey "foo" ] ('Update ('SchemaText '[])) ] ]
138 '[ 'Diff '[ 'PKey "foo" ] ('Update ('SchemaText '[])) ] ]
132
139
133−jsonExample :: JsonRepr (SchemaByRevision "test_revision" VS)
140+jsonExample :: JsonRepr (TopVersion VS)
134jsonExample = ReprObject $
141jsonExample = ReprObject $
135 FieldRepr (ReprText "foo")
142 FieldRepr (ReprText "foo")
136 :& FieldRepr (ReprOptional (Just (ReprText "bar")))
143 :& FieldRepr (ReprOptional (Just (ReprText "bar")))