git.iko.soy/schematic
on master help sign in
Remove useless code
00285b6Denis Redozubov
src/Data/Schematic.hs+10−3
compare with master
unifiedsplit
@@ -58,6 +58,11 @@ parseAndValidateJsonBySing sschema v = case parseEither parseJSON v of
58 Left em -> ValidationError em
58 Left em -> ValidationError em
59 Right () -> Valid jsonRepr
59 Right () -> Valid jsonRepr
60
60
61+-- parseAndValidateVersionedJson
62+-- :: MList (m ': ms)
63+-- -> J.Value
64+-- -> ParseResult (JsonRepr)
65+
61parseAndValidateTopVersionJson
66parseAndValidateTopVersionJson
62 :: forall proxy (v :: Versioned)
67 :: forall proxy (v :: Versioned)
63 . (SingI (TopVersion (AllVersions v)))
68 . (SingI (TopVersion (AllVersions v)))
@@ -76,18 +81,20 @@ parseAndValidateTopVersionJson _ v =
76 Left em -> ValidationError em
81 Left em -> ValidationError em
77 Right () -> Valid jsonRepr
82 Right () -> Valid jsonRepr
78
83
84+-- [("top version", schemaTopVersion), ("n-1 version", schemaNminusOneVersion), ...]
85+
79parseAndValidateVersionedJson
86parseAndValidateVersionedJson
80 :: forall proxy rav av (v :: Versioned) rs tv
87 :: forall proxy rav av (v :: Versioned) rs tv
81 . ( SingI (AllVersions v)
88 . ( SingI (AllVersions v)
82− , Migratable (SchemaPairs (AllVersions v))
89+ , Migratable (AllVersions v)
83 , SingI (TopVersion (AllVersions v))
90 , SingI (TopVersion (AllVersions v))
84− , SingI (SchemaPairs (AllVersions v)))
91+ , SingI (AllVersions v))
85 => proxy v
92 => proxy v
86 -> J.Value
93 -> J.Value
87 -> ParseResult (JsonRepr (TopVersion (AllVersions v)))
94 -> ParseResult (JsonRepr (TopVersion (AllVersions v)))
88parseAndValidateVersionedJson _ v =
95parseAndValidateVersionedJson _ v =
89 let
96 let
90− rss :: Sing (SchemaPairs (AllVersions v))
97+ rss :: Sing (AllVersions v)
91 rss = sing
98 rss = sing
92 stv :: Sing (TopVersion (AllVersions v))
99 stv :: Sing (TopVersion (AllVersions v))
93 stv = sing
100 stv = sing
src/Data/Schematic/Migration.hs+22−34
@@ -6,7 +6,6 @@ module Data.Schematic.Migration where
6import Data.Kind
6import Data.Kind
7import Data.Schematic.Path
7import Data.Schematic.Path
8import Data.Schematic.Schema
8import Data.Schematic.Schema
9−import Data.Schematic.Utils
10import Data.Singletons.Prelude hiding (All)
9import Data.Singletons.Prelude hiding (All)
11import Data.Singletons.TypeLits
10import Data.Singletons.TypeLits
12import Data.Vinyl hiding (Dict)
11import Data.Vinyl hiding (Dict)
@@ -89,47 +88,22 @@ type family Migratable (rs :: [(Revision, Schema)]) :: Constraint where
89 Migratable ('(r,s) ': '[]) = (TopLevel s, SingI s)
88 Migratable ('(r,s) ': '[]) = (TopLevel s, SingI s)
90 -- Migratable '[] = ('True ~ 'False)
89 -- Migratable '[] = ('True ~ 'False)
91
90
92−-- data NonEmpty a = a :| [a]
93−
94−-- data instance Sing (ne :: NonEmpty a) where
95−-- SNECons :: Known (Sing e), Known (Sing l))=> Sing (e :: k) -> Sing (l :: [k]) -> Sing (e ':| l)
96−
97−data Revisions = Revisions
98− Schema -- top version
99− [(Revision, Schema)]
100−
101−data instance Sing (rs :: Revisions) where
102− SRevisions
103− :: (SingI schema, SingI rps, Known (Dict (ElemOf schema prs)))
104− => Sing schema
105− -> Sing rps
106− -> Sing ('Revisions schema rps)
107−
108−-- -- | Heterogenous list with a proof of element schema included in the list itself.
109−-- data ElemList :: k -> [k] -> Type where
110−-- Singl :: Known (Sing schema) => Sing schema -> ElemList schema '[schema]
111−-- KeepProof :: Known (Sing new) => Sing new -> ElemList schema ss -> ElemList schema (new ': ss)
112−-- NewProof :: Known (Sing new) => Sing new -> ElemList schema ss -> ElemList new (new ': ss)
113−
114type family ElemOf (e :: k) (l :: [(a,k)]) :: Constraint where
91type family ElemOf (e :: k) (l :: [(a,k)]) :: Constraint where
115 ElemOf e '[] = 'True ~ 'False
92 ElemOf e '[] = 'True ~ 'False
116 ElemOf e ( '(a, e) ': es) = ()
93 ElemOf e ( '(a, e) ': es) = ()
117 ElemOf e (n ': es) = ElemOf e es
94 ElemOf e (n ': es) = ElemOf e es
118
95
119-- | Extracts revision/schema pairs from @Versioned@ in reverse order.
96-- | Extracts revision/schema pairs from @Versioned@ in reverse order.
120−type family AllVersions (vd :: Versioned) :: Revisions where
97+type family AllVersions (vd :: Versioned) :: [(Revision, Schema)] where
121− AllVersions ('Versioned s ms) = AllVersions' ('Revisions s '[ '("initial", s) ]) ms
98+ AllVersions ('Versioned s ms) = AllVersions' '[ '("initial", s) ] ms
122
99
123−type family AllVersions' (acc :: Revisions) (ms :: [Migration]) :: Revisions where
100+type family AllVersions' (acc :: [(Revision, Schema)]) (ms :: [Migration]) = (r :: [(Revision, Schema)]) where
124− AllVersions' acc '[] = acc
101+ AllVersions' acc '[] = acc
125− AllVersions' ('Revisions tv rs) (m ': ms) =
102+ AllVersions' ( '(rh, sh) ': tl ) (m ': ms) =
126− AllVersions' ('Revisions (Snd (ApplyMigration m tv)) (rs :++ '[(ApplyMigration m tv)])) ms
103+ AllVersions' ( ApplyMigration m sh ': tl ) ms
127
104
128−type family TopVersion (rs :: Revisions) :: Schema where
105+type family TopVersion (rs :: [(Revision, Schema)]) :: Schema where
129− TopVersion ('Revisions s rs) = s
106+ TopVersion ( '(rh, sh) ': tl) = sh
130−
131−type family SchemaPairs (rs :: Revisions) :: [(Revision, Schema)] where
132− SchemaPairs ('Revisions s rs) = rs
133
107
134class MigrateSchema (a :: Schema) (b :: Schema) where
108class MigrateSchema (a :: Schema) (b :: Schema) where
135 migrate :: JsonRepr a -> JsonRepr b
109 migrate :: JsonRepr a -> JsonRepr b
@@ -180,6 +154,14 @@ data instance Sing (v :: Versioned) where
180 -> Sing (ms :: [Migration]) -- a bunch of migrations
154 -> Sing (ms :: [Migration]) -- a bunch of migrations
181 -> Sing ('Versioned s ms)
155 -> Sing ('Versioned s ms)
182
156
157+-- data MList ms where
158+-- MSing :: proxy a -> MList '[a]
159+-- MCons :: Dict (MigrateSchema h a) -> proxy a -> MList (h ': tl) -> MList (a ': h ': tl)
160+
161+-- data MList ms where
162+-- MSing :: proxy a -> MList '[a]
163+-- MCons :: (JsonRepr h -> JsonRepr a) -> proxy a -> MList (h ': tl) -> MList (a ': h ': tl)
164+
183type SchemaExample
165type SchemaExample
184 = 'SchemaObject
166 = 'SchemaObject
185 '[ '("foo", 'SchemaArray '[ 'AEq 1] ( 'SchemaNumber '[ 'NGt 10 ]))
167 '[ '("foo", 'SchemaArray '[ 'AEq 1] ( 'SchemaNumber '[ 'NGt 10 ]))
@@ -195,3 +177,9 @@ jsonExample = ReprObject $
195 FieldRepr (ReprText "foo")
177 FieldRepr (ReprText "foo")
196 :& FieldRepr (ReprOptional (Just (ReprText "bar")))
178 :& FieldRepr (ReprOptional (Just (ReprText "bar")))
197 :& RNil
179 :& RNil
180+
181+
182+-- tail :: [a] -> [a]
183+-- sTail :: Sing s -> Sing (Tail s)
184+-- :: (Head (Tail foo))
185+-- sHead (sTail foo)