on master help sign in
incorrect
commit1ea9e01dd8be3cfeddc9965a3469b4a6a11e7b13 authorDenis Redozubov <denis.redozubov@gmail.com> dateThu 25 May 2017, 20:00 (9 years ago) parent07015be
1 file changed+20−1
src/Data/Schematic/Migration.hs+20−1
src/Data/Schematic/Migration.hs+20−1
@@ -9,6 +9,8 @@ import Data.Schematic.Schema
99import Data.Schematic.Utils
1010import Data.Singletons.Prelude hiding (All)
1111import Data.Singletons.TypeLits
12+import Data.Vinyl
13+
1214
1315class MigrateSchema (a :: Schema) (b :: Schema) where
1416 migrate :: JsonRepr a -> JsonRepr b
@@ -44,6 +46,7 @@ type family TypedDiffList (s :: Schema) (ds :: [Diff]) :: Constraint where
4446 TypedDiffList s '[] = ()
4547 TypedDiffList s (d ': tl) = (TypedDiff s d, TypedDiffList s tl)
4648
49+-- here
4750type family TypedDiffListSchema (s :: Schema) (ds :: [Diff]) :: Schema where
4851 TypedDiffListSchema s '[] = s
4952 TypedDiffListSchema s (d ': tl) = TypedDiffListSchema (TypedDiffSchema s d) tl
@@ -58,8 +61,8 @@ type family TypedSubSchema (s :: Schema) (p :: [PathSegment]) :: Constraint wher
5861 TypedSubSchema s '[] = ()
5962 TypedSubSchema s (h ': tl) = TypedSubSchema (TraverseStep s h) tl
6063
64+-- issue here
6165type family TypedSubSchemaSchema (s :: Schema) (p :: [PathSegment]) :: Schema where
62− TypedSubSchemaSchema s '[] = s
6366 TypedSubSchemaSchema s (h ': tl) = TypedSubSchemaSchema (TraverseStep s h) tl
6467
6568type family TraverseStep (s :: Schema) (ps :: PathSegment) :: Schema where
@@ -112,3 +115,19 @@ type family HeadVersion (vd :: Versioned) :: Schema where
112115 HeadVersion ('Versioned s '[]) = s
113116 HeadVersion ('Versioned s (m ': tl)) =
114117 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