{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
module Data.API.Tools.DeepSeq
    ( deepSeqTool
    ) where

import           Data.API.TH
import           Data.API.Tools.Combinators
import           Data.API.Tools.Datatypes
import           Data.API.Types

import           Control.DeepSeq
import           Data.Monoid
import           Language.Haskell.TH
import           Prelude


-- | Tool to generate 'NFData' instances for generated types.
deepSeqTool :: APITool
deepSeqTool :: APITool
deepSeqTool = Tool APINode -> APITool
apiNodeTool forall a b. (a -> b) -> a -> b
$ Tool (APINode, SpecNewtype)
-> Tool (APINode, SpecRecord)
-> Tool (APINode, SpecUnion)
-> Tool (APINode, SpecEnum)
-> Tool (APINode, APIType)
-> Tool APINode
apiSpecTool Tool (APINode, SpecNewtype)
gen_sn Tool (APINode, SpecRecord)
gen_sr Tool (APINode, SpecUnion)
gen_su Tool (APINode, SpecEnum)
gen_se forall a. Monoid a => a
mempty


gen_sn :: Tool (APINode, SpecNewtype)
gen_sn :: Tool (APINode, SpecNewtype)
gen_sn = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecNewtype
_) -> ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''NFData [APINode -> TypeQ
nodeRepT APINode
an]
                                     [Name -> ExpQ -> DecQ
simpleD 'rnf (APINode -> ExpQ
bdy APINode
an)]
  where
    bdy :: APINode -> ExpQ
bdy APINode
an = [e| \ x -> rnf ($(newtypeProjectionE an) x) |]

gen_sr :: Tool (APINode, SpecRecord)
gen_sr :: Tool (APINode, SpecRecord)
gen_sr = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecRecord
sr) -> do
    Name
x <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
    ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''NFData [APINode -> TypeQ
nodeRepT APINode
an] [Name -> ExpQ -> DecQ
simpleD 'rnf (APINode -> SpecRecord -> Name -> ExpQ
bdy APINode
an SpecRecord
sr Name
x)]
  where
    bdy :: APINode -> SpecRecord -> Name -> ExpQ
bdy APINode
an SpecRecord
sr Name
x = forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}. (FieldName, b) -> ExpQ -> ExpQ
f [e|()|] (SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr)
      where
        f :: (FieldName, b) -> ExpQ -> ExpQ
f (FieldName
fn,b
_) ExpQ
r = [e| rnf ($(nodeFieldE an fn) $(varE x)) `seq` $r |]

gen_su :: Tool (APINode, SpecUnion)
gen_su :: Tool (APINode, SpecUnion)
gen_su = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecUnion
su) -> do
    Name
x <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"x"
    Name
y <- forall (m :: * -> *). Quote m => String -> m Name
newName String
"y"
    ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''NFData [APINode -> TypeQ
nodeRepT APINode
an] [Name -> ExpQ -> DecQ
simpleD 'rnf (APINode -> SpecUnion -> Name -> Name -> ExpQ
bdy APINode
an SpecUnion
su Name
x Name
y)]
  where
    bdy :: APINode -> SpecUnion -> Name -> Name -> ExpQ
bdy APINode
an SpecUnion
su Name
x Name
y = forall (m :: * -> *). Quote m => [m Pat] -> m Exp -> m Exp
lamE [forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
x] forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
caseE (forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
x) [Q Match]
cs
      where
        cs :: [Q Match]
cs = forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (FieldName, b) -> Q Match
f (SpecUnion -> [(FieldName, (APIType, String))]
suFields SpecUnion
su)
        f :: (FieldName, b) -> Q Match
f (FieldName
fn,b
_) = forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match (APINode -> FieldName -> [Q Pat] -> Q Pat
nodeAltConP APINode
an FieldName
fn [forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
y]) (forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [e|rnf $(varE y)|]) []

gen_se :: Tool (APINode, SpecEnum)
gen_se :: Tool (APINode, SpecEnum)
gen_se = forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool forall a b. (a -> b) -> a -> b
$ \ ToolSettings
ts (APINode
an, SpecEnum
_) ->
    ToolSettings -> Name -> [TypeQ] -> [DecQ] -> Q [Dec]
optionalInstanceD ToolSettings
ts ''NFData [APINode -> TypeQ
nodeRepT APINode
an]
        [Name -> ExpQ -> DecQ
simpleD 'rnf [e| \ x -> seq x () |] ]