{-# LANGUAGE TemplateHaskell #-}
module Data.API.Tools.JSON
( jsonTool
, jsonTool'
, toJsonNodeTool
, fromJsonNodeTool
, fromJsonWithErrsNodeTool
) where
import Data.API.JSON
import Data.API.TH
import Data.API.Tools.Combinators
import Data.API.Tools.Datatypes
import Data.API.Tools.Enum
import Data.API.Types
import Data.Aeson hiding (withText, withBool)
import Control.Applicative
import Data.Maybe
import qualified Data.Map as Map
import Data.Monoid
import qualified Data.Text as T
import Language.Haskell.TH
import Prelude
jsonTool :: APITool
jsonTool :: APITool
jsonTool = APINodeTool -> APITool
apiNodeTool (APINodeTool -> APITool) -> APINodeTool -> APITool
forall a b. (a -> b) -> a -> b
$ APINodeTool
toJsonNodeTool APINodeTool -> APINodeTool -> APINodeTool
forall a. Semigroup a => a -> a -> a
<> APINodeTool
fromJsonWithErrsNodeTool
jsonTool' :: APITool
jsonTool' :: APITool
jsonTool' = APINodeTool -> APITool
apiNodeTool (APINodeTool -> APITool) -> APINodeTool -> APITool
forall a b. (a -> b) -> a -> b
$ APINodeTool
toJsonNodeTool APINodeTool -> APINodeTool -> APINodeTool
forall a. Semigroup a => a -> a -> a
<> APINodeTool
fromJsonNodeTool
APINodeTool -> APINodeTool -> APINodeTool
forall a. Semigroup a => a -> a -> a
<> APINodeTool
fromJsonWithErrsNodeTool
toJsonNodeTool :: APINodeTool
toJsonNodeTool :: APINodeTool
toJsonNodeTool = Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> APINodeTool
apiSpecTool Tool (APINode, SpecNewtype)
gen_sn_to Tool (APINode, SpecRecord)
gen_sr_to Tool (APINode, SpecUnion)
gen_su_to Tool (APINode, SpecEnum)
gen_se_to Tool (APINode, APIType)
forall a. Monoid a => a
mempty
APINodeTool -> APINodeTool -> APINodeTool
forall a. Semigroup a => a -> a -> a
<> APINodeTool
gen_pr
fromJsonNodeTool :: APINodeTool
fromJsonNodeTool :: APINodeTool
fromJsonNodeTool = APINodeTool
gen_FromJSON
fromJsonWithErrsNodeTool :: APINodeTool
fromJsonWithErrsNodeTool :: APINodeTool
fromJsonWithErrsNodeTool = Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> APINodeTool
apiSpecTool Tool (APINode, SpecNewtype)
gen_sn_fm Tool (APINode, SpecRecord)
gen_sr_fm Tool (APINode, SpecUnion)
gen_su_fm Tool (APINode, SpecEnum)
gen_se_fm Tool (APINode, APIType)
forall a. Monoid a => a
mempty
APINodeTool -> APINodeTool -> APINodeTool
forall a. Semigroup a => a -> a -> a
<> APINodeTool
gen_in
gen_sn_to :: Tool (APINode, SpecNewtype)
gen_sn_to :: Tool (APINode, SpecNewtype)
gen_sn_to = (ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype))
-> (ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecNewtype
sn) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''ToJSON [APINode -> TypeQ
nodeRepT APINode
an]
[Name -> ExpQ -> DecQ
simpleD 'toJSON (APINode -> SpecNewtype -> ExpQ
bdy APINode
an SpecNewtype
sn)]
where
bdy :: APINode -> SpecNewtype -> ExpQ
bdy APINode
an SpecNewtype
sn = [e| $(SpecNewtype -> ExpQ
forall {m :: * -> *}. Quote m => SpecNewtype -> m Exp
ine SpecNewtype
sn) . $(APINode -> ExpQ
newtypeProjectionE APINode
an) |]
ine :: SpecNewtype -> m Exp
ine SpecNewtype
sn = case SpecNewtype -> BasicType
snType SpecNewtype
sn of
BasicType
BTstring -> [e| String |]
BasicType
BTbinary -> [e| toJSON |]
BasicType
BTbool -> [e| Bool |]
BasicType
BTint -> [e| mkInt |]
BasicType
BTutc -> [e| String . printUTC |]
gen_sn_fm :: Tool (APINode, SpecNewtype)
gen_sn_fm :: Tool (APINode, SpecNewtype)
gen_sn_fm = (ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype))
-> (ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecNewtype
sn) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSONWithErrs [APINode -> TypeQ
nodeRepT APINode
an]
[Name -> ExpQ -> DecQ
simpleD 'parseJSONWithErrs (ToolSettings -> APINode -> SpecNewtype -> ExpQ
bdy ToolSettings
ts APINode
an SpecNewtype
sn)]
where
bdy :: ToolSettings -> APINode -> SpecNewtype -> ExpQ
bdy ToolSettings
ts APINode
an SpecNewtype
sn = [e| $(SpecNewtype -> ExpQ
forall {m :: * -> *}. Quote m => SpecNewtype -> m Exp
wth SpecNewtype
sn) $(TypeName -> ExpQ
typeNameE (APINode -> TypeName
anName APINode
an)) (pure . $(ToolSettings -> APINode -> SpecNewtype -> ExpQ
nodeNewtypeConE ToolSettings
ts APINode
an SpecNewtype
sn)) |]
wth :: SpecNewtype -> m Exp
wth SpecNewtype
sn =
case (SpecNewtype -> BasicType
snType SpecNewtype
sn, SpecNewtype -> Maybe Filter
snFilter SpecNewtype
sn) of
(BasicType
BTstring, Just (FtrStrg RegEx
re)) -> [e| withRegEx re |]
(BasicType
BTstring, Maybe Filter
_ ) -> [e| withText |]
(BasicType
BTbinary, Maybe Filter
_ ) -> [e| withBinary |]
(BasicType
BTbool , Maybe Filter
_ ) -> [e| withBool |]
(BasicType
BTint , Just (FtrIntg IntRange
ir)) -> [e| withIntRange ir |]
(BasicType
BTint , Maybe Filter
_ ) -> [e| withInt |]
(BasicType
BTutc , Just (FtrUTC UTCRange
ur)) -> [e| withUTCRange ur |]
(BasicType
BTutc , Maybe Filter
_ ) -> [e| withUTC |]
gen_sr_to :: Tool (APINode, SpecRecord)
gen_sr_to :: Tool (APINode, SpecRecord)
gen_sr_to = (ToolSettings -> (APINode, SpecRecord) -> Q [Dec])
-> Tool (APINode, SpecRecord)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecRecord) -> Q [Dec])
-> Tool (APINode, SpecRecord))
-> (ToolSettings -> (APINode, SpecRecord) -> Q [Dec])
-> Tool (APINode, SpecRecord)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecRecord
sr) -> do
Name
x <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''ToJSON [APINode -> TypeQ
nodeRepT APINode
an] [Name -> ExpQ -> DecQ
simpleD 'toJSON (APINode -> SpecRecord -> Name -> ExpQ
bdy APINode
an SpecRecord
sr Name
x)]
where
bdy :: APINode -> SpecRecord -> Name -> ExpQ
bdy APINode
an SpecRecord
sr Name
x = [Q Pat] -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x] (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$
Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'object ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE`
[ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE [ [e| $(FieldName -> ExpQ
fieldNameE FieldName
fn) .= $(APINode -> FieldName -> ExpQ
nodeFieldE APINode
an FieldName
fn) $(Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x) |]
| (FieldName
fn, FieldType
_) <- SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr ]
gen_sr_fm :: Tool (APINode, SpecRecord)
gen_sr_fm :: Tool (APINode, SpecRecord)
gen_sr_fm = (ToolSettings -> (APINode, SpecRecord) -> Q [Dec])
-> Tool (APINode, SpecRecord)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecRecord) -> Q [Dec])
-> Tool (APINode, SpecRecord))
-> (ToolSettings -> (APINode, SpecRecord) -> Q [Dec])
-> Tool (APINode, SpecRecord)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecRecord
sr) -> do
Name
x <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSONWithErrs [APINode -> TypeQ
nodeRepT APINode
an]
[Name -> [Q Clause] -> DecQ
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'parseJSONWithErrs [APINode -> SpecRecord -> Name -> Q Clause
cl APINode
an SpecRecord
sr Name
x, Q Clause
clNull, Name -> Q Clause
forall {m :: * -> *}. Quote m => Name -> m Clause
cl' Name
x]]
where
cl :: APINode -> SpecRecord -> Name -> Q Clause
cl APINode
an SpecRecord
sr Name
x = [Q Pat] -> Q Body -> [DecQ] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'Object [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x]] (ExpQ -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB ExpQ
bdy) []
where
bdy :: ExpQ
bdy = ExpQ -> [ExpQ] -> ExpQ
applicativeE (APINode -> ExpQ
nodeConE APINode
an) ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ ((FieldName, FieldType) -> ExpQ)
-> [(FieldName, FieldType)] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, FieldType) -> ExpQ
project (SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr)
project :: (FieldName, FieldType) -> ExpQ
project (FieldName
fn, FieldType
ft) = [e| withDefaultField ro (fmap defaultValueAsJsValue mb_dv) $(FieldName -> ExpQ
fieldNameE FieldName
fn) parseJSONWithErrs $(Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x) |]
where ro :: Bool
ro = FieldType -> Bool
ftReadOnly FieldType
ft
mb_dv :: Maybe DefaultValue
mb_dv = FieldType -> Maybe DefaultValue
ftDefault FieldType
ft
clNull :: Q Clause
clNull = [Q Pat] -> Q Body -> [DecQ] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP 'Null []] (ExpQ -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [e| parseJSONWithErrs (Object mempty) |]) []
cl' :: Name -> m Clause
cl' Name
x = [m Pat] -> m Body -> [m Dec] -> m Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> m Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x] (m Exp -> m Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
bdy' Name
x)) []
bdy' :: Name -> m Exp
bdy' Name
x = [e| failWith (expectedObject $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x)) |]
gen_su_to :: Tool (APINode, SpecUnion)
gen_su_to :: Tool (APINode, SpecUnion)
gen_su_to = (ToolSettings -> (APINode, SpecUnion) -> Q [Dec])
-> Tool (APINode, SpecUnion)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecUnion) -> Q [Dec])
-> Tool (APINode, SpecUnion))
-> (ToolSettings -> (APINode, SpecUnion) -> Q [Dec])
-> Tool (APINode, SpecUnion)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecUnion
su) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''ToJSON [APINode -> TypeQ
nodeRepT APINode
an] [Name -> [Q Clause] -> DecQ
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD 'toJSON (APINode -> SpecUnion -> [Q Clause]
cls APINode
an SpecUnion
su)]
where
cls :: APINode -> SpecUnion -> [Q Clause]
cls APINode
an SpecUnion
su = ((FieldName, (APIType, String)) -> Q Clause)
-> [(FieldName, (APIType, String))] -> [Q Clause]
forall a b. (a -> b) -> [a] -> [b]
map (APINode -> FieldName -> Q Clause
cl APINode
an (FieldName -> Q Clause)
-> ((FieldName, (APIType, String)) -> FieldName)
-> (FieldName, (APIType, String))
-> Q Clause
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName, (APIType, String)) -> FieldName
forall a b. (a, b) -> a
fst) (SpecUnion -> [(FieldName, (APIType, String))]
suFields SpecUnion
su)
cl :: APINode -> FieldName -> Q Clause
cl APINode
an FieldName
fn = do Name
x <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
[Q Pat] -> Q Body -> [DecQ] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [APINode -> FieldName -> [Q Pat] -> Q Pat
nodeAltConP APINode
an FieldName
fn [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x]] (FieldName -> Name -> Q Body
bdy FieldName
fn Name
x) []
bdy :: FieldName -> Name -> Q Body
bdy FieldName
fn Name
x = ExpQ -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [e| object [ $(FieldName -> ExpQ
fieldNameE FieldName
fn) .= $(Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x) ] |]
gen_su_fm :: Tool (APINode, SpecUnion)
gen_su_fm :: Tool (APINode, SpecUnion)
gen_su_fm = (ToolSettings -> (APINode, SpecUnion) -> Q [Dec])
-> Tool (APINode, SpecUnion)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecUnion) -> Q [Dec])
-> Tool (APINode, SpecUnion))
-> (ToolSettings -> (APINode, SpecUnion) -> Q [Dec])
-> Tool (APINode, SpecUnion)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecUnion
su) ->
ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSONWithErrs [APINode -> TypeQ
nodeRepT APINode
an]
[Name -> ExpQ -> DecQ
simpleD 'parseJSONWithErrs (APINode -> SpecUnion -> ExpQ
bdy APINode
an SpecUnion
su)]
where
bdy :: APINode -> SpecUnion -> ExpQ
bdy APINode
an SpecUnion
su = Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'withUnion ExpQ -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` [ExpQ] -> ExpQ
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE (((FieldName, (APIType, String)) -> ExpQ)
-> [(FieldName, (APIType, String))] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map (APINode -> (FieldName, (APIType, String)) -> ExpQ
forall {b}. APINode -> (FieldName, b) -> ExpQ
alt APINode
an) (SpecUnion -> [(FieldName, (APIType, String))]
suFields SpecUnion
su))
alt :: APINode -> (FieldName, b) -> ExpQ
alt APINode
an (FieldName
fn, b
_) = [e| ( $(FieldName -> ExpQ
fieldNameE FieldName
fn) , fmap $(APINode -> FieldName -> ExpQ
nodeAltConE APINode
an FieldName
fn) . parseJSONWithErrs ) |]
gen_se_to :: Tool (APINode, SpecEnum)
gen_se_to :: Tool (APINode, SpecEnum)
gen_se_to = (ToolSettings -> (APINode, SpecEnum) -> Q [Dec])
-> Tool (APINode, SpecEnum)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecEnum) -> Q [Dec])
-> Tool (APINode, SpecEnum))
-> (ToolSettings -> (APINode, SpecEnum) -> Q [Dec])
-> Tool (APINode, SpecEnum)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecEnum
_se) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''ToJSON [APINode -> TypeQ
nodeRepT APINode
an] [Name -> ExpQ -> DecQ
simpleD 'toJSON (APINode -> ExpQ
forall {m :: * -> *}. Quote m => APINode -> m Exp
bdy APINode
an)]
where
bdy :: APINode -> m Exp
bdy APINode
an = [e| String . $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (APINode -> Name
text_enum_nm APINode
an)) |]
gen_se_fm :: Tool (APINode, SpecEnum)
gen_se_fm :: Tool (APINode, SpecEnum)
gen_se_fm = (ToolSettings -> (APINode, SpecEnum) -> Q [Dec])
-> Tool (APINode, SpecEnum)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> (APINode, SpecEnum) -> Q [Dec])
-> Tool (APINode, SpecEnum))
-> (ToolSettings -> (APINode, SpecEnum) -> Q [Dec])
-> Tool (APINode, SpecEnum)
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecEnum
_se) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSONWithErrs [APINode -> TypeQ
nodeRepT APINode
an]
[Name -> ExpQ -> DecQ
simpleD 'parseJSONWithErrs (APINode -> ExpQ
forall {m :: * -> *}. Quote m => APINode -> m Exp
bdy APINode
an)]
where
bdy :: APINode -> m Exp
bdy APINode
an = [e| jsonStrMap_p $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (APINode -> Name
map_enum_nm APINode
an)) |]
gen_in :: Tool APINode
gen_in :: APINodeTool
gen_in = (ToolSettings -> APINode -> Q [Dec]) -> APINodeTool
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> APINode -> Q [Dec]) -> APINodeTool)
-> (ToolSettings -> APINode -> Q [Dec]) -> APINodeTool
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts APINode
an -> case APINode -> Conversion
anConvert APINode
an of
Conversion
Nothing -> [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (FieldName
inj_fn, FieldName
_) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSONWithErrs [APINode -> TypeQ
nodeT APINode
an]
[Name -> ExpQ -> DecQ
simpleD 'parseJSONWithErrs ExpQ
bdy]
where
bdy :: ExpQ
bdy = do Name
x <- String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
[Q Pat] -> ExpQ -> ExpQ
forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x] [e| parseJSONWithErrs $(Name -> ExpQ
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x) >>= $ExpQ
inj |]
inj :: ExpQ
inj = FieldName -> ExpQ
fieldNameVarE FieldName
inj_fn
gen_pr :: Tool APINode
gen_pr :: APINodeTool
gen_pr = (ToolSettings -> APINode -> Q [Dec]) -> APINodeTool
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> APINode -> Q [Dec]) -> APINodeTool)
-> (ToolSettings -> APINode -> Q [Dec]) -> APINodeTool
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts APINode
an -> case APINode -> Conversion
anConvert APINode
an of
Conversion
Nothing -> [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (FieldName
_, FieldName
prj_fn) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''ToJSON [APINode -> TypeQ
nodeT APINode
an] [Name -> ExpQ -> DecQ
simpleD 'toJSON ExpQ
bdy]
where
bdy :: ExpQ
bdy = [e| toJSON . $ExpQ
prj |]
prj :: ExpQ
prj = FieldName -> ExpQ
fieldNameVarE FieldName
prj_fn
gen_FromJSON :: Tool APINode
gen_FromJSON :: APINodeTool
gen_FromJSON = (ToolSettings -> APINode -> Q [Dec]) -> APINodeTool
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> APINode -> Q [Dec]) -> APINodeTool)
-> (ToolSettings -> APINode -> Q [Dec]) -> APINodeTool
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts APINode
an -> do
[Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
(++) ([Dec] -> [Dec] -> [Dec]) -> Q [Dec] -> Q ([Dec] -> [Dec])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ToolSettings -> TypeQ -> Q [Dec]
genIf (Bool -> Bool
not (APINode -> Bool
isSynonym APINode
an)) ToolSettings
ts (APINode -> TypeQ
nodeRepT APINode
an)
Q ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> ToolSettings -> TypeQ -> Q [Dec]
genIf (Conversion -> Bool
forall a. Maybe a -> Bool
isJust (APINode -> Conversion
anConvert APINode
an)) ToolSettings
ts (APINode -> TypeQ
nodeT APINode
an)
where
genIf :: Bool -> ToolSettings -> TypeQ -> Q [Dec]
genIf Bool
b ToolSettings
ts TypeQ
t | Bool
b = ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSON [TypeQ
t] [Name -> ExpQ -> DecQ
simpleD 'parseJSON [e|parseJSONDefault|]]
| Bool
otherwise = [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
isSynonym :: APINode -> Bool
isSynonym APINode
an = case APINode -> Spec
anSpec APINode
an of
SpSynonym APIType
_ -> Bool
True
Spec
_ -> Bool
False
mkInt :: Int -> Value
mkInt :: Int -> Value
mkInt = Scientific -> Value
Number (Scientific -> Value) -> (Int -> Scientific) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> (Int -> Integer) -> Int -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger
jsonStrMap_p :: Ord a => Map.Map T.Text a -> Value -> ParserWithErrs a
jsonStrMap_p :: forall a. Ord a => Map Text a -> Value -> ParserWithErrs a
jsonStrMap_p Map Text a
mp = [Text] -> (Text -> Maybe a) -> Value -> ParserWithErrs a
forall a.
Ord a =>
[Text] -> (Text -> Maybe a) -> Value -> ParserWithErrs a
json_string_p (Map Text a -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text a
mp) ((Text -> Maybe a) -> Value -> ParserWithErrs a)
-> (Text -> Maybe a) -> Value -> ParserWithErrs a
forall a b. (a -> b) -> a -> b
$ (Text -> Map Text a -> Maybe a) -> Map Text a -> Text -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Map Text a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map Text a
mp
json_string_p :: Ord a => [T.Text] -> (T.Text->Maybe a) -> Value -> ParserWithErrs a
json_string_p :: forall a.
Ord a =>
[Text] -> (Text -> Maybe a) -> Value -> ParserWithErrs a
json_string_p [Text]
xs Text -> Maybe a
p (String Text
t) | Just a
val <- Text -> Maybe a
p Text
t = a -> ParserWithErrs a
forall a. a -> ParserWithErrs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
| Bool
otherwise = JSONError -> ParserWithErrs a
forall a. JSONError -> ParserWithErrs a
failWith (JSONError -> ParserWithErrs a) -> JSONError -> ParserWithErrs a
forall a b. (a -> b) -> a -> b
$ [Text] -> Text -> JSONError
UnexpectedEnumVal [Text]
xs Text
t
json_string_p [Text]
_ Text -> Maybe a
_ Value
v = JSONError -> ParserWithErrs a
forall a. JSONError -> ParserWithErrs a
failWith (JSONError -> ParserWithErrs a) -> JSONError -> ParserWithErrs a
forall a b. (a -> b) -> a -> b
$ Value -> JSONError
expectedString Value
v