{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Validity.Aeson where
import Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as K
#endif
import Data.Aeson.Types
import Data.Validity
import Data.Validity.HashMap ()
import Data.Validity.Scientific ()
import Data.Validity.Text ()
import Data.Validity.Vector ()
#if MIN_VERSION_aeson(2,0,0)
instance Validity v => Validity (KeyMap v) where
validate :: KeyMap v -> Validation
validate KeyMap v
m = HashMap Key v -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate (KeyMap v -> HashMap Key v
forall v. KeyMap v -> HashMap Key v
KM.toHashMap KeyMap v
m) String
"KeyMap"
instance Validity Key where
validate :: Key -> Validation
validate Key
k = Text -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate (Key -> Text
K.toText Key
k) String
"Key"
#endif
instance Validity Value where
validate :: Value -> Validation
validate (Object Object
o) = Object -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Object
o String
"Object"
validate (Array Array
a) = Array -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Array
a String
"Array"
validate (String Text
t) = Text -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Text
t String
"String"
validate (Number Scientific
s) = Scientific -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Scientific
s String
"Number"
validate (Bool Bool
b) = Bool -> String -> Validation
forall a. Validity a => a -> String -> Validation
annotate Bool
b String
"Bool"
validate Value
Null = Validation
valid
parseJSONValid :: Validity a => Parser a -> Parser a
parseJSONValid :: Parser a -> Parser a
parseJSONValid Parser a
p = do
a
r <- Parser a
p
case a -> Either String a
forall a. Validity a => a -> Either String a
prettyValidate a
r of
Left String
err -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Parsed value is not valid:", String
err]
Right a
r' -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r'
parseJSONValidWith :: Validity a => (value -> Parser a) -> (value -> Parser a)
parseJSONValidWith :: (value -> Parser a) -> value -> Parser a
parseJSONValidWith value -> Parser a
func value
v = Parser a -> Parser a
forall a. Validity a => Parser a -> Parser a
parseJSONValid (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ value -> Parser a
func value
v