{-# 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 qualified Data.HashMap.Strict            as HMap
import           Data.Maybe
import qualified Data.Map                       as Map
import           Data.Monoid
import qualified Data.Text                      as T
import           Language.Haskell.TH
import           Prelude


-- | Tool to generate 'ToJSON' and 'FromJSONWithErrs' instances for
-- types generated by 'datatypesTool'.  This depends on 'enumTool'.
-- For historical reasons this does not generate 'FromJSON' instances;
-- you probably want to use 'jsonTool'' instead.
jsonTool :: APITool
jsonTool :: APITool
jsonTool = Tool APINode -> APITool
apiNodeTool (Tool APINode -> APITool) -> Tool APINode -> APITool
forall a b. (a -> b) -> a -> b
$ Tool APINode
toJsonNodeTool Tool APINode -> Tool APINode -> Tool APINode
forall a. Semigroup a => a -> a -> a
<> Tool APINode
fromJsonWithErrsNodeTool

-- | Tool to generate 'ToJSON', 'FromJSON' and 'FromJSONWithErrs'
-- instances for types generated by 'datatypesTool'.  This depends on
-- 'enumTool'.  Note that generated 'FromJSON' and 'FromJSONWithErrs'
-- instances will always agree on the decoding of a value, but that
-- the 'FromJSONWithErrs' instances for basic types are more liberal
-- than 'FromJSON'.
jsonTool' :: APITool
jsonTool' :: APITool
jsonTool' = Tool APINode -> APITool
apiNodeTool (Tool APINode -> APITool) -> Tool APINode -> APITool
forall a b. (a -> b) -> a -> b
$ Tool APINode
toJsonNodeTool Tool APINode -> Tool APINode -> Tool APINode
forall a. Semigroup a => a -> a -> a
<> Tool APINode
fromJsonNodeTool
                                         Tool APINode -> Tool APINode -> Tool APINode
forall a. Semigroup a => a -> a -> a
<> Tool APINode
fromJsonWithErrsNodeTool


-- | Tool to generate 'ToJSON' instance for an API node
toJsonNodeTool :: APINodeTool
toJsonNodeTool :: Tool APINode
toJsonNodeTool = Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> Tool APINode
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
                 Tool APINode -> Tool APINode -> Tool APINode
forall a. Semigroup a => a -> a -> a
<> Tool APINode
gen_pr

-- | Tool to generate 'FromJSON' instance for an API node, which
-- relies on the 'FromJSONWithErrs' instance.
fromJsonNodeTool :: APINodeTool
fromJsonNodeTool :: Tool APINode
fromJsonNodeTool = Tool APINode
gen_FromJSON

-- | Tool to generate 'FromJSONWithErrs' instance for an API node
fromJsonWithErrsNodeTool :: APINodeTool
fromJsonWithErrsNodeTool :: Tool APINode
fromJsonWithErrsNodeTool = Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> Tool APINode
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
                           Tool APINode -> Tool APINode -> Tool APINode
forall a. Semigroup a => a -> a -> a
<> Tool APINode
gen_in


{-
instance ToJSON JobId where
    toJSON = String . _JobId
-}

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| $(ine sn) . $(newtypeProjectionE an) |]

    ine :: SpecNewtype -> ExpQ
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  |]


{-
instance FromJSONWithErrs JobId where
    parseJSONWithErrs = withText "JobId" (pure . JobId)
-}

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| $(wth sn) $(typeNameE (anName an)) (pure . $(nodeNewtypeConE ts an sn)) |]

    wth :: SpecNewtype -> ExpQ
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         |]



{-
instance ToJSON JobSpecId where
     toJSON = \ x ->
        object
            [ "Id"         .= jsiId         x
            , "Input"      .= jsiInput      x
            , "Output"     .= jsiOutput     x
            , "PipelineId" .= jsiPipelineId x
            ]
-}

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
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 = [PatQ] -> ExpQ -> ExpQ
lamE [Name -> PatQ
varP Name
x] (ExpQ -> ExpQ) -> ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$
            Name -> ExpQ
varE 'object ExpQ -> ExpQ -> ExpQ
`appE`
            [ExpQ] -> ExpQ
listE [ [e| $(fieldNameE fn) .= $(nodeFieldE an fn) $(varE x) |]
                  | (FieldName
fn, FieldType
_) <- SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr ]


{-
instance FromJSONWithErrs JobSpecId where
     parseJSONWithErrs (Object v) =
        JobSpecId <$>
            v .: "Id"                               <*>
            v .: "Input"                            <*>
            v .: "Output"                           <*>
            v .: "PipelineId"
     parseJSONWithErrs Null       = parseJSONWithErrs (Object HMap.empty)
     parseJSONWithErrs v          = failWith $ expectedObject val
-}

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
newName String
"x"
    ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''FromJSONWithErrs [APINode -> TypeQ
nodeRepT APINode
an]
                      [Name -> [ClauseQ] -> DecQ
funD 'parseJSONWithErrs [APINode -> SpecRecord -> Name -> ClauseQ
cl APINode
an SpecRecord
sr Name
x, ClauseQ
clNull, Name -> ClauseQ
cl' Name
x]]
  where
    cl :: APINode -> SpecRecord -> Name -> ClauseQ
cl APINode
an SpecRecord
sr Name
x  = [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
clause [Name -> [PatQ] -> PatQ
conP 'Object [Name -> PatQ
varP Name
x]] (ExpQ -> BodyQ
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) $(fieldNameE fn) parseJSONWithErrs $(varE x) |]
          where ro :: Bool
ro    = FieldType -> Bool
ftReadOnly FieldType
ft
                mb_dv :: Maybe DefaultValue
mb_dv = FieldType -> Maybe DefaultValue
ftDefault FieldType
ft

    clNull :: ClauseQ
clNull = [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
clause [Name -> [PatQ] -> PatQ
conP 'Null []] (ExpQ -> BodyQ
normalB [e| parseJSONWithErrs (Object HMap.empty) |]) []

    cl' :: Name -> ClauseQ
cl'  Name
x = [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
clause [Name -> PatQ
varP Name
x] (ExpQ -> BodyQ
normalB (Name -> ExpQ
bdy' Name
x)) []
    bdy' :: Name -> ExpQ
bdy' Name
x = [e| failWith (expectedObject $(varE x)) |]


{-
instance ToJSON Foo where
    toJSON (Bar x) = object [ "x" .= x ]
    toJSON (Baz x) = object [ "y" .= 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 -> [ClauseQ] -> DecQ
funD 'toJSON (APINode -> SpecUnion -> [ClauseQ]
cls APINode
an SpecUnion
su)]
  where
    cls :: APINode -> SpecUnion -> [ClauseQ]
cls APINode
an SpecUnion
su = ((FieldName, (APIType, String)) -> ClauseQ)
-> [(FieldName, (APIType, String))] -> [ClauseQ]
forall a b. (a -> b) -> [a] -> [b]
map (APINode -> FieldName -> ClauseQ
cl APINode
an (FieldName -> ClauseQ)
-> ((FieldName, (APIType, String)) -> FieldName)
-> (FieldName, (APIType, String))
-> ClauseQ
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 -> ClauseQ
cl APINode
an FieldName
fn = do Name
x <- String -> Q Name
newName String
"x"
                  [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
clause [APINode -> FieldName -> [PatQ] -> PatQ
nodeAltConP APINode
an FieldName
fn [Name -> PatQ
varP Name
x]] (FieldName -> Name -> BodyQ
bdy FieldName
fn Name
x) []

    bdy :: FieldName -> Name -> BodyQ
bdy FieldName
fn Name
x = ExpQ -> BodyQ
normalB [e| object [ $(fieldNameE fn) .= $(varE x) ] |]


{-
instance FromJSONWithErrs Foo where
    parseJSONWithErrs = withUnion [ ("x", fmap Bar . parseJSONWithErrs)
                                  , ("y", fmap Baz . parseJSONWithErrs) ]
-}

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
varE 'withUnion ExpQ -> ExpQ -> ExpQ
`appE` [ExpQ] -> ExpQ
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| ( $(fieldNameE fn) , fmap $(nodeAltConE an fn) . parseJSONWithErrs ) |]


{-
instance ToJSON FrameRate where
    toJSON    = String . _text_FrameRate
-}

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
bdy APINode
an)]
  where
    bdy :: APINode -> ExpQ
bdy APINode
an = [e| String . $(varE (text_enum_nm an)) |]


{-
instance FromJSONWithErrs FrameRate where
    parseJSONWithErrs = jsonStrMap_p _map_FrameRate
-}

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
bdy APINode
an)]
  where
    bdy :: APINode -> ExpQ
bdy APINode
an = [e| jsonStrMap_p $(varE (map_enum_nm an)) |]


gen_in :: Tool APINode
gen_in :: Tool APINode
gen_in = (ToolSettings -> APINode -> Q [Dec]) -> Tool APINode
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> APINode -> Q [Dec]) -> Tool APINode)
-> (ToolSettings -> APINode -> Q [Dec]) -> Tool APINode
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts APINode
an -> case APINode -> Conversion
anConvert APINode
an of
  Conversion
Nothing          -> [Dec] -> Q [Dec]
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
newName String
"x"
             [PatQ] -> ExpQ -> ExpQ
lamE [Name -> PatQ
varP Name
x] [e| parseJSONWithErrs $(varE x) >>= $inj |]
    inj :: ExpQ
inj = FieldName -> ExpQ
fieldNameVarE FieldName
inj_fn


gen_pr :: Tool APINode
gen_pr :: Tool APINode
gen_pr = (ToolSettings -> APINode -> Q [Dec]) -> Tool APINode
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> APINode -> Q [Dec]) -> Tool APINode)
-> (ToolSettings -> APINode -> Q [Dec]) -> Tool APINode
forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts APINode
an -> case APINode -> Conversion
anConvert APINode
an of
  Conversion
Nothing          -> [Dec] -> Q [Dec]
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 . $prj |]
    prj :: ExpQ
prj = FieldName -> ExpQ
fieldNameVarE FieldName
prj_fn


-- | Generate 'FromJSON' instances like this:
--
-- > instance FromJSON T where
-- >   parseJSON = parseJSONDefault
gen_FromJSON :: Tool APINode
gen_FromJSON :: Tool APINode
gen_FromJSON = (ToolSettings -> APINode -> Q [Dec]) -> Tool APINode
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool ((ToolSettings -> APINode -> Q [Dec]) -> Tool APINode)
-> (ToolSettings -> APINode -> Q [Dec]) -> Tool APINode
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 (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 (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 :: 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 :: [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 (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