git.iko.soy/schematic
on master help sign in
incorrect
1ea9e01Denis Redozubov
src/Data/Schematic/Migration.hs+20−1
compare with master
unifiedsplit
@@ -9,6 +9,8 @@ import Data.Schematic.Schema
9import Data.Schematic.Utils
9import Data.Schematic.Utils
10import Data.Singletons.Prelude hiding (All)
10import Data.Singletons.Prelude hiding (All)
11import Data.Singletons.TypeLits
11import Data.Singletons.TypeLits
12+import Data.Vinyl
13+
12
14
13class MigrateSchema (a :: Schema) (b :: Schema) where
15class MigrateSchema (a :: Schema) (b :: Schema) where
14 migrate :: JsonRepr a -> JsonRepr b
16 migrate :: JsonRepr a -> JsonRepr b
@@ -44,6 +46,7 @@ type family TypedDiffList (s :: Schema) (ds :: [Diff]) :: Constraint where
44 TypedDiffList s '[] = ()
46 TypedDiffList s '[] = ()
45 TypedDiffList s (d ': tl) = (TypedDiff s d, TypedDiffList s tl)
47 TypedDiffList s (d ': tl) = (TypedDiff s d, TypedDiffList s tl)
46
48
49+-- here
47type family TypedDiffListSchema (s :: Schema) (ds :: [Diff]) :: Schema where
50type family TypedDiffListSchema (s :: Schema) (ds :: [Diff]) :: Schema where
48 TypedDiffListSchema s '[] = s
51 TypedDiffListSchema s '[] = s
49 TypedDiffListSchema s (d ': tl) = TypedDiffListSchema (TypedDiffSchema s d) tl
52 TypedDiffListSchema s (d ': tl) = TypedDiffListSchema (TypedDiffSchema s d) tl
@@ -58,8 +61,8 @@ type family TypedSubSchema (s :: Schema) (p :: [PathSegment]) :: Constraint wher
58 TypedSubSchema s '[] = ()
61 TypedSubSchema s '[] = ()
59 TypedSubSchema s (h ': tl) = TypedSubSchema (TraverseStep s h) tl
62 TypedSubSchema s (h ': tl) = TypedSubSchema (TraverseStep s h) tl
60
63
64+-- issue here
61type family TypedSubSchemaSchema (s :: Schema) (p :: [PathSegment]) :: Schema where
65type family TypedSubSchemaSchema (s :: Schema) (p :: [PathSegment]) :: Schema where
62− TypedSubSchemaSchema s '[] = s
63 TypedSubSchemaSchema s (h ': tl) = TypedSubSchemaSchema (TraverseStep s h) tl
66 TypedSubSchemaSchema s (h ': tl) = TypedSubSchemaSchema (TraverseStep s h) tl
64
67
65type family TraverseStep (s :: Schema) (ps :: PathSegment) :: Schema where
68type family TraverseStep (s :: Schema) (ps :: PathSegment) :: Schema where
@@ -112,3 +115,19 @@ type family HeadVersion (vd :: Versioned) :: Schema where
112 HeadVersion ('Versioned s '[]) = s
115 HeadVersion ('Versioned s '[]) = s
113 HeadVersion ('Versioned s (m ': tl)) =
116 HeadVersion ('Versioned s (m ': tl)) =
114 HeadVersion ('Versioned (Snd (TypedMigrationSchema s m)) tl)
117 HeadVersion ('Versioned (Snd (TypedMigrationSchema s m)) tl)
118+
119+type SchemaExample
120+ = 'SchemaObject
121+ '[ '("foo", 'SchemaArray '[ 'AEq 1] ( 'SchemaNumber '[ 'NGt 10 ]))
122+ , '("bar", 'SchemaOptional ( 'SchemaText '[ 'TRegex "\\w+", 'TEnum '["foo", "bar"]]))]
123+
124+type VS =
125+ 'Versioned SchemaExample
126+ '[ 'Migration "test_revision"
127+ '[ 'Diff '[ 'Key "foo" ] ('Update ('SchemaText '[])) ] ]
128+
129+-- jsonExample :: JsonRepr (HeadVersion VS)
130+-- jsonExample = ReprObject $
131+-- FieldRepr (ReprText "foo")
132+-- :& FieldRepr (ReprOptional (Just (ReprText "bar")))
133+-- :& RNil