git.iko.soy/schematic
on master help sign in
kinda works
1fcea69Denis Redozubov
src/Data/Schematic.hs+21−26
compare with master
unifiedsplit
@@ -83,35 +83,30 @@ parseAndValidateTopVersionJson _ v =
83
83
84-- [("top version", schemaTopVersion), ("n-1 version", schemaNminusOneVersion), ...]
84-- [("top version", schemaTopVersion), ("n-1 version", schemaNminusOneVersion), ...]
85
85
86+-- type family Migratable (rs :: [(Revision, Schema)]) :: Constraint where
87+-- -- constraint duplication
88+-- Migratable ('(r,s) ': '(r', s') ': tl) =
89+-- (SingI s, MigrateSchema s s', TopLevel s, Migratable ('(r',s') ': tl))
90+-- Migratable ('(r,s) ': '[]) = (TopLevel s, SingI s)
91+-- -- Migratable '[] = ('True ~ 'False)
92+
93+class Migratable (revisions :: [(Revision, Schema)]) where
94+ mparse :: Sing revisions -> J.Value -> Either String (JsonRepr (Snd (Head revisions)))
95+
96+instance {-# OVERLAPPING #-} (Migratable (Tail revisions), MigrateSchema (Snd (Head (Tail revisions))) (Snd (Head revisions)), SingI (Snd (Head revisions))) => Migratable revisions where
97+ mparse s v = case parseEither parseJSON v of
98+ Left _ -> migrate <$> mparse (sTail s) v
99+ Right x -> Right x
100+
101+instance {-# OVERLAPPABLE #-} (TopLevel (Snd rev), SingI (Snd rev)) => Migratable '[rev] where
102+ mparse _ = parseEither parseJSON
103+
86parseAndValidateVersionedJson
104parseAndValidateVersionedJson
87− :: forall proxy rav av (v :: Versioned) rs tv
88− . ( SingI (AllVersions v)
89− , Migratable (AllVersions v)
105+ :: forall proxy v. (SingI (AllVersions v), Migratable (AllVersions v))
90− , SingI (TopVersion (AllVersions v))
91− , SingI (AllVersions v))
92 => proxy v
106 => proxy v
93 -> J.Value
107 -> J.Value
94− -> ParseResult (JsonRepr (TopVersion (AllVersions v)))
108+ -> Either String (JsonRepr (Snd (Head (AllVersions v))))
95−parseAndValidateVersionedJson _ v =
109+parseAndValidateVersionedJson s v = mparse (sing :: Sing (AllVersions v)) v
96− let
97− rss :: Sing (AllVersions v)
98− rss = sing
99− stv :: Sing (TopVersion (AllVersions v))
100− stv = sing
101− in parseAndValidateVersionedJsonByVersions stv rss v
102−
103−parseAndValidateVersionedJsonByVersions
104− :: forall (rs :: [(Revision, Schema)]) tv proxy
105− . (Migratable rs)
106− => proxy (tv :: Schema)
107− -> Sing rs
108− -> J.Value
109− -> ParseResult (JsonRepr tv)
110−parseAndValidateVersionedJsonByVersions stv srs value = case srs of
111− SNil -> DecodingError "blabla"
112− SCons (STuple2 r s) tl -> case parseAndValidateJsonBySing s value of
113− Valid a -> Valid $ migrate a
114− _ -> DecodingError "dummy plug"
115
110
116decodeAndValidateJson
111decodeAndValidateJson
117 :: forall schema
112 :: forall schema
src/Data/Schematic/Migration.hs−7
@@ -81,13 +81,6 @@ type family SchemaByRevision (r :: Revision) (vd :: Versioned) :: Schema where
81-- Reverse acc '[] = acc
81-- Reverse acc '[] = acc
82-- Reverse acc (h ': tl) = Reverse (h ': acc) tl
82-- Reverse acc (h ': tl) = Reverse (h ': acc) tl
83
83
84−type family Migratable (rs :: [(Revision, Schema)]) :: Constraint where
85− -- constraint duplication
86− Migratable ('(r,s) ': '(r', s') ': tl) =
87− (SingI s, MigrateSchema s s', TopLevel s, Migratable ('(r',s') ': tl))
88− Migratable ('(r,s) ': '[]) = (TopLevel s, SingI s)
89− -- Migratable '[] = ('True ~ 'False)
90−
91type family ElemOf (e :: k) (l :: [(a,k)]) :: Constraint where
84type family ElemOf (e :: k) (l :: [(a,k)]) :: Constraint where
92 ElemOf e '[] = 'True ~ 'False
85 ElemOf e '[] = 'True ~ 'False
93 ElemOf e ( '(a, e) ': es) = ()
86 ElemOf e ( '(a, e) ': es) = ()