49e8aef · typeable/schematic

git.iko.soy/typeable/schematic

Simplify MList construction

commit49e8aef0c33dfaa345993b9b7ebdeb2973c73b4d authorDenis Redozubov <denis.redozubov@gmail.com> dateThu 12 Oct 2017, 21:03 (9 years ago) parentb1b8d40

4 files changed+23−21

compare with master

unifiedsplit

src/Data/Schematic.hs+17−15 src/Data/Schematic/DSL.hs−1 src/Data/Schematic/Migration.hs+4−2 test/SchemaSpec.hs+2−3

src/Data/Schematic.hs+17−15

@@ -22,20 +22,21 @@ module Data.Schematic

2222 , field

2323 ) where

2424

25−import Control.Monad.Validation

26−import Data.Aeson as J

27−import Data.Aeson.Types as J

28−import Data.ByteString.Lazy as BL

29−import Data.Functor.Identity as F

30−import Data.Schematic.DSL

31−import Data.Schematic.Helpers

32−import Data.Schematic.JsonSchema

33−import Data.Schematic.Lens

34−import Data.Schematic.Migration

35−import Data.Schematic.Schema

36−import Data.Schematic.Validation

37−import Data.Singletons.Prelude hiding ((:.))

38−import Data.Text as T

25+import Control.Monad.Validation

26+import Data.Aeson as J

27+import Data.Aeson.Types as J

28+import Data.ByteString.Lazy as BL

29+import Data.Functor.Identity as F

30+import Data.Schematic.DSL

31+import Data.Schematic.Helpers

32+import Data.Schematic.JsonSchema

33+import Data.Schematic.Lens

34+import Data.Schematic.Migration

35+import Data.Schematic.Schema

36+import Data.Schematic.Validation

37+import Data.Singletons.Prelude hiding ((:.))

38+import Data.Tagged

39+import Data.Text as T

3940

4041

4142parseAndValidateJson

@@ -85,7 +86,8 @@ parseAndValidateWithMList

8586 -> J.Value

8687 -> m (ParseResult (JsonRepr (Head revisions)))

8788parseAndValidateWithMList MNil v = pure $ parseAndValidateJson v

88−parseAndValidateWithMList ((:&&) p f tl) v = case parseAndValidateJsonBy p v of

89+parseAndValidateWithMList (Tagged f :&& tl) v =

90+ case parseAndValidateJsonBy Proxy v of

8991 Valid a -> pure $ Valid a

9092 DecodingError _ -> do

9193 pr <- parseAndValidateWithMList tl v

src/Data/Schematic/DSL.hs−1

@@ -18,7 +18,6 @@ import Data.Vinyl

1818import Data.Vinyl.Functor

1919

2020

21−

2221type Constructor a

2322 = forall b. FSubset (FieldsOf a) b (FImage (FieldsOf a) b)

2423 => Rec (Tagged (FieldsOf a) :. FieldRepr) b

src/Data/Schematic/Migration.hs+4−2

@@ -4,6 +4,7 @@

44module Data.Schematic.Migration where

66import Data.Kind

7+import Data.Tagged

78import Data.Schematic.Path

89import Data.Schematic.Schema

910import Data.Singletons.Prelude hiding (All)

@@ -138,12 +139,13 @@ data instance Sing (v :: Versioned) where

138139 -> Sing (ms :: [Migration]) -- a bunch of migrations

139140 -> Sing ('Versioned s ms)

140141

142+type DataMigration s m h = Tagged s (JsonRepr h -> m (JsonRepr s))

143+

141144data MList :: (* -> *) -> [Schema] -> Type where

142145 MNil :: (Monad m, SingI s, TopLevel s) => MList m '[s]

143146 (:&&)

144147 :: (TopLevel s, SingI s)

145− => proxy s

146− -> (JsonRepr h -> m (JsonRepr s))

148+ => DataMigration s m h

147149 -> MList m (h ': tl)

148150 -> MList m (s ': h ': tl)

149151

test/SchemaSpec.hs+2−3

@@ -7,6 +7,7 @@ import Data.ByteString.Lazy

77import Data.Functor.Identity

88import Data.Proxy

99import Data.Schematic

10+import Data.Tagged

1011import Data.Vinyl

1112import Test.Hspec

1213

@@ -65,9 +66,7 @@ spec = do

6566 it "validates versioned json with a migration list" $ do

6667 decodeAndValidateVersionedWithPureMList

6768 (Proxy @VS)

68− ((:&&)

69− (Proxy @(SchemaByRevision "test_revision" VS))

70− (const $ Identity topObject) MNil)

69+ (Tagged (const $ Identity topObject) :&& MNil)

7170 schemaJson

7271 `shouldSatisfy` isValid

7372