module Hydra.Ext.Json.Eliminate where

import Hydra.Kernel
import qualified Hydra.Json as Json

import qualified Data.Map as M


expectArray :: Json.Value -> Flow s [Json.Value]
expectArray :: forall s. Value -> Flow s [Value]
expectArray Value
value = case Value
value of
  Json.ValueArray [Value]
els -> [Value] -> Flow s [Value]
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
els
  Value
_ -> String -> String -> Flow s [Value]
forall s x. String -> String -> Flow s x
unexpected String
"JSON array" (String -> Flow s [Value]) -> String -> Flow s [Value]
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
value

expectNumber :: Json.Value -> Flow s Double
expectNumber :: forall s. Value -> Flow s Double
expectNumber Value
value = case Value
value of
  Json.ValueNumber Double
d -> Double -> Flow s Double
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
d
  Value
_ -> String -> String -> Flow s Double
forall s x. String -> String -> Flow s x
unexpected String
"JSON number" (String -> Flow s Double) -> String -> Flow s Double
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
value

expectObject :: Json.Value -> Flow s (M.Map String Json.Value)
expectObject :: forall s. Value -> Flow s (Map String Value)
expectObject Value
value = case Value
value of
  Json.ValueObject Map String Value
m -> Map String Value -> Flow s (Map String Value)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map String Value
m
  Value
_ -> String -> String -> Flow s (Map String Value)
forall s x. String -> String -> Flow s x
unexpected String
"JSON object" (String -> Flow s (Map String Value))
-> String -> Flow s (Map String Value)
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
value

expectString :: Json.Value -> Flow s String
expectString :: forall s. Value -> Flow s String
expectString Value
value = case Value
value of
  Json.ValueString String
s -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
  Value
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"JSON string" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
value

opt :: String -> M.Map String Json.Value -> Maybe Json.Value
opt :: String -> Map String Value -> Maybe Value
opt = String -> Map String Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup

optArray :: String -> M.Map String Json.Value -> Flow s (Maybe [Json.Value])
optArray :: forall s. String -> Map String Value -> Flow s (Maybe [Value])
optArray String
fname Map String Value
m = case String -> Map String Value -> Maybe Value
opt String
fname Map String Value
m of
  Maybe Value
Nothing -> Maybe [Value] -> Flow s (Maybe [Value])
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Value]
forall a. Maybe a
Nothing
  Just Value
a -> [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value])
-> Flow s [Value] -> Flow s (Maybe [Value])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Flow s [Value]
forall s. Value -> Flow s [Value]
expectArray Value
a

optString :: String -> M.Map String Json.Value -> Flow s (Maybe String)
optString :: forall s. String -> Map String Value -> Flow s (Maybe String)
optString String
fname Map String Value
m = case String -> Map String Value -> Maybe Value
opt String
fname Map String Value
m of
  Maybe Value
Nothing -> Maybe String -> Flow s (Maybe String)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
  Just Value
s -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> Flow s String -> Flow s (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Flow s String
forall s. Value -> Flow s String
expectString Value
s

require :: String -> M.Map String Json.Value -> Flow s Json.Value
require :: forall s. String -> Map String Value -> Flow s Value
require String
fname Map String Value
m = case String -> Map String Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
fname Map String Value
m of
  Maybe Value
Nothing -> String -> Flow s Value
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s Value) -> String -> Flow s Value
forall a b. (a -> b) -> a -> b
$ String
"required attribute " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
  Just Value
value -> Value -> Flow s Value
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
value

requireArray :: String -> M.Map String Json.Value -> Flow s [Json.Value]
requireArray :: forall s. String -> Map String Value -> Flow s [Value]
requireArray String
fname Map String Value
m = String -> Map String Value -> Flow s Value
forall s. String -> Map String Value -> Flow s Value
require String
fname Map String Value
m Flow s Value -> (Value -> Flow s [Value]) -> Flow s [Value]
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Flow s [Value]
forall s. Value -> Flow s [Value]
expectArray

requireNumber :: String -> M.Map String Json.Value -> Flow s Double
requireNumber :: forall s. String -> Map String Value -> Flow s Double
requireNumber String
fname Map String Value
m = String -> Map String Value -> Flow s Value
forall s. String -> Map String Value -> Flow s Value
require String
fname Map String Value
m Flow s Value -> (Value -> Flow s Double) -> Flow s Double
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Flow s Double
forall s. Value -> Flow s Double
expectNumber

requireString :: String -> M.Map String Json.Value -> Flow s String
requireString :: forall s. String -> Map String Value -> Flow s String
requireString String
fname Map String Value
m = String -> Map String Value -> Flow s Value
forall s. String -> Map String Value -> Flow s Value
require String
fname Map String Value
m Flow s Value -> (Value -> Flow s String) -> Flow s String
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Flow s String
forall s. Value -> Flow s String
expectString