git.iko.soy/typeable/schematic
on master help sign in
typeable/schematic/src/Data/Schematic.hs
103 lines 3.2 kB history raw
1{-# OPTIONS -fprint-explicit-kinds #-}
2{-# LANGUAGE AllowAmbiguousTypes #-}
4module Data.Schematic
5 ( module Data.Schematic.JsonSchema
6 , module Data.Schematic.Helpers
7 , module Data.Schematic.Lens
8 , module Data.Schematic.Migration
9 , module Data.Schematic.Schema
10 , decodeAndValidateJson
11 , parseAndValidateJson
12 , parseAndValidateJsonBy
13 , parseAndValidateTopVersionJson
14 , parseAndValidateWithMList
15 , decodeAndValidateVersionedWithMList
16 , decodeAndValidateVersionedWithPureMList
17 , isValid
18 , isDecodingError
19 , isValidationError
20 , ParseResult(..)
21 , withRepr
22 , field
23 ) where
25import Control.Monad.Validation
26import Data.Aeson as J
27import Data.Aeson.Types as J
28import Data.ByteString.Lazy as BL
29import Data.Functor.Identity as F
30import Data.Schematic.DSL
31import Data.Schematic.Helpers
32import Data.Schematic.JsonSchema
33import Data.Schematic.Lens
34import Data.Schematic.Migration
35import Data.Schematic.Schema
36import Data.Schematic.Validation
37import Data.Singletons.Prelude hiding ((:.))
38import Data.Tagged
39import Data.Text as T
42parseAndValidateTopVersionJson
43 :: forall proxy (v :: Versioned)
44 . (SingI (TopVersion (AllVersions v)))
45 => proxy v
46 -> J.Value
47 -> ParseResult (JsonRepr (TopVersion (AllVersions v)))
48parseAndValidateTopVersionJson _ v =
49 case parseEither parseJSON v of
50 Left s -> DecodingError $ T.pack s
51 Right jsonRepr ->
52 let
53 validate =
54 validateJsonRepr (sing :: Sing (TopVersion (AllVersions v))) [] jsonRepr
55 res = runIdentity . runValidationTEither $ validate
56 in case res of
57 Left em -> ValidationError em
58 Right () -> Valid jsonRepr
60parseAndValidateWithMList
61 :: Monad m
62 => MList m revisions
63 -> J.Value
64 -> m (ParseResult (JsonRepr (Head revisions)))
65parseAndValidateWithMList MNil v = pure $ parseAndValidateJson v
66parseAndValidateWithMList (Tagged f :&& tl) v =
67 case parseAndValidateJsonBy Proxy v of
68 Valid a -> pure $ Valid a
69 DecodingError _ -> do
70 pr <- parseAndValidateWithMList tl v
71 let pr' = f <$> pr
72 sequence pr'
73 ValidationError _ -> do
74 pr <- parseAndValidateWithMList tl v
75 let pr' = f <$> pr
76 sequence pr'
78decodeAndValidateJson
79 :: forall schema
80 . (J.FromJSON (JsonRepr schema), TopLevel schema, SingI schema)
81 => BL.ByteString
82 -> ParseResult (JsonRepr schema)
83decodeAndValidateJson bs = case decode bs of
84 Nothing -> DecodingError "malformed json"
85 Just x -> parseAndValidateJson x
87decodeAndValidateVersionedWithMList
88 :: Monad m
89 => proxy versioned
90 -> MList m (MapSnd (AllVersions versioned))
91 -> BL.ByteString
92 -> m (ParseResult (JsonRepr (Head (MapSnd (AllVersions versioned)))))
93decodeAndValidateVersionedWithMList _ mlist bs = case decode bs of
94 Nothing -> pure $ DecodingError "malformed json"
95 Just x -> parseAndValidateWithMList mlist x
97decodeAndValidateVersionedWithPureMList
98 :: proxy versioned
99 -> MList F.Identity (MapSnd (AllVersions versioned))
100 -> BL.ByteString
101 -> ParseResult (JsonRepr (Head (MapSnd (AllVersions versioned))))
102decodeAndValidateVersionedWithPureMList a b c =
103 runIdentity $ decodeAndValidateVersionedWithMList a b c