@@ -10,16 +10,13 @@ module Data.Schematic
1010 , decodeAndValidateJson
1111 , parseAndValidateJson
1212 , parseAndValidateJsonBy
13− , parseAndValidateVersionedJson
1413 , parseAndValidateTopVersionJson
15− , decodeAndValidateVersionedJson
1614 , parseAndValidateWithMList
1715 , decodeAndValidateVersionedWithMList
1816 , isValid
1917 , isDecodingError
2018 , isValidationError
2119 , ParseResult(..)
22− , Migratable
2320 ) where
2421
2522import Control.Monad.Validation
@@ -78,44 +75,22 @@ parseAndValidateTopVersionJson _ v =
7875 Left em -> ValidationError em
7976 Right () -> Valid jsonRepr
8077
81−class Migratable (revisions :: [(Revision, Schema)]) where
82− mparse
83− :: Sing revisions
84− -> J.Value
85− -> ParseResult (JsonRepr (Snd (Head revisions)))
86−
87−instance
88− {-# OVERLAPPING #-}
89− ( TopLevel (Snd rev), SingI (Snd rev) )
90− => Migratable '[rev] where
91− mparse _ = parseAndValidateJson
92−
93−instance {-# OVERLAPPABLE #-}
94− ( Migratable (Tail revisions)
95− , MigrateSchema (Snd (Head (Tail revisions))) (Snd (Head revisions))
96− , SingI (Snd (Head revisions)))
97− => Migratable revisions where
98− mparse s v = case parseEither parseJSON v of
99− Left _ ->
100− migrate <$> (mparse (sTail s) v :: ParseResult (JsonRepr (Snd (Head (Tail revisions)))))
101− Right x -> Valid x
102−
103−parseAndValidateVersionedJson
104− :: forall proxy v. (SingI (AllVersions v), Migratable (AllVersions v))
105− => proxy v
106− -> J.Value
107− -> ParseResult (JsonRepr (Snd (Head (AllVersions v))))
108−parseAndValidateVersionedJson _ v = mparse (sing :: Sing (AllVersions v)) v
109−
11078parseAndValidateWithMList
111− :: MList revisions
79+ :: Monad m
80+ => MList m revisions
11281 -> J.Value
113− -> ParseResult (JsonRepr (Head revisions))
114−parseAndValidateWithMList MNil v = parseAndValidateJson v
82+ -> m (ParseResult (JsonRepr (Head revisions)))
83+parseAndValidateWithMList MNil v = pure $ parseAndValidateJson v
11584parseAndValidateWithMList ((:&&) p f tl) v = case parseAndValidateJsonBy p v of
116− Valid a -> Valid a
117− DecodingError _ -> f <$> parseAndValidateWithMList tl v
118− ValidationError _ -> f <$> parseAndValidateWithMList tl v
85+ Valid a -> pure $ Valid a
86+ DecodingError _ -> do
87+ pr <- parseAndValidateWithMList tl v
88+ let pr' = f <$> pr
89+ sequence pr'
90+ ValidationError _ -> do
91+ pr <- parseAndValidateWithMList tl v
92+ let pr' = f <$> pr
93+ sequence pr'
11994
12095decodeAndValidateJson
12196 :: forall schema
@@ -126,24 +101,16 @@ decodeAndValidateJson bs = case decode bs of
126101 Nothing -> DecodingError "malformed json"
127102 Just x -> parseAndValidateJson x
128103
129−decodeAndValidateVersionedJson
130− :: (Migratable (AllVersions versioned), SingI (AllVersions versioned))
131− => proxy versioned
132− -> BL.ByteString
133− -> ParseResult (JsonRepr (Snd (Head (AllVersions versioned))))
134−decodeAndValidateVersionedJson vp bs = case decode bs of
135− Nothing -> DecodingError "malformed json"
136− Just x -> parseAndValidateVersionedJson vp x
137−
138104type family MapSnd (l :: [(a,k)]) = (r :: [k]) where
139105 MapSnd '[] = '[]
140106 MapSnd ( '(a, b) ': tl) = b ': MapSnd tl
141107
142108decodeAndValidateVersionedWithMList
143− :: proxy versioned
144− -> MList (MapSnd (AllVersions versioned))
109+ :: Monad m
110+ => proxy versioned
111+ -> MList m (MapSnd (AllVersions versioned))
145112 -> BL.ByteString
146− -> ParseResult (JsonRepr (Head (MapSnd (AllVersions versioned))))
113+ -> m (ParseResult (JsonRepr (Head (MapSnd (AllVersions versioned)))))
147114decodeAndValidateVersionedWithMList _ mlist bs = case decode bs of
148− Nothing -> DecodingError "malformed json"
115+ Nothing -> pure $ DecodingError "malformed json"
149116 Just x -> parseAndValidateWithMList mlist x