{-# LANGUAGE TemplateHaskell            #-}
module Data.API.Tools.Datatypes
    ( datatypesTool
    , datatypesTool'
    , defaultDerivedClasses
    , type_nm
    , rep_type_nm
    , nodeT
    , nodeRepT
    , nodeConE
    , nodeNewtypeConE
    , nodeFieldE
    , nodeFieldP
    , nodeAltConE
    , nodeAltConP
    , newtypeProjectionE
    ) where

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

import           Control.Applicative
import           Data.Aeson
import qualified Data.CaseInsensitive           as CI
import           Data.Char
import           Data.Maybe
import           Data.String
import qualified Data.Text                      as T
import           Data.Time
import           Data.Typeable
import           Language.Haskell.TH
import           Text.Regex
import           Prelude


-- | Tool to generate datatypes and type synonyms corresponding to an API
datatypesTool :: APITool
datatypesTool :: APITool
datatypesTool = (APINode -> [Name]) -> APITool
datatypesTool' APINode -> [Name]
defaultDerivedClasses

-- | Tool to generate datatypes and type synonyms corresponding to an
-- API, where the function specifies the derived classes for each datatype.
datatypesTool' :: (APINode -> [Name]) -> APITool
datatypesTool' :: (APINode -> [Name]) -> APITool
datatypesTool' APINode -> [Name]
deriv = Tool APINode -> APITool
apiNodeTool (Tool APINode -> APITool) -> Tool APINode -> APITool
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 ((ToolSettings -> (APINode, SpecNewtype) -> Q [Dec])
-> Tool (APINode, SpecNewtype)
forall a. (ToolSettings -> a -> Q [Dec]) -> Tool a
mkTool     ((APINode -> [Name])
-> ToolSettings -> (APINode, SpecNewtype) -> Q [Dec]
gen_sn_dt APINode -> [Name]
deriv))
                                                 (((APINode, SpecRecord) -> Q [Dec]) -> Tool (APINode, SpecRecord)
forall a. (a -> Q [Dec]) -> Tool a
simpleTool ((APINode -> [Name]) -> (APINode, SpecRecord) -> Q [Dec]
gen_sr_dt APINode -> [Name]
deriv))
                                                 (((APINode, SpecUnion) -> Q [Dec]) -> Tool (APINode, SpecUnion)
forall a. (a -> Q [Dec]) -> Tool a
simpleTool ((APINode -> [Name]) -> (APINode, SpecUnion) -> Q [Dec]
gen_su_dt APINode -> [Name]
deriv))
                                                 (((APINode, SpecEnum) -> Q [Dec]) -> Tool (APINode, SpecEnum)
forall a. (a -> Q [Dec]) -> Tool a
simpleTool ((APINode -> [Name]) -> (APINode, SpecEnum) -> Q [Dec]
gen_se_dt APINode -> [Name]
deriv))
                                                 (((APINode, APIType) -> Q [Dec]) -> Tool (APINode, APIType)
forall a. (a -> Q [Dec]) -> Tool a
simpleTool (APINode, APIType) -> Q [Dec]
gen_sy)


-- | Generate a type synonym definition
gen_sy :: (APINode, APIType) -> Q [Dec]
gen_sy :: (APINode, APIType) -> Q [Dec]
gen_sy (APINode
as, APIType
ty) = [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name -> [TyVarBndr] -> Type -> Dec
TySynD (APINode -> Name
type_nm APINode
as) [] (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$ APIType -> Type
mk_type APIType
ty]


-- | Generate a newtype definition, like this:
--
-- > newtype JobId = JobId { _JobId :: T.Text }
-- >     deriving (Show,IsString,Eq,Typeable)
--
-- If a filter has been applied, and smart constructors are enabled,
-- instead generate this:
--
-- > newtype EmailAddress = UnsafeMkEmailAddress { _EmailAddress :: T.Text }
-- >     deriving (Show,Eq,Typeable)
-- > mkEmailAddress :: T.Text -> Maybe EmailAddress
-- > mkEmailAddress t = ... -- check filter

gen_sn_dt :: (APINode -> [Name]) -> ToolSettings -> (APINode, SpecNewtype) -> Q [Dec]
gen_sn_dt :: (APINode -> [Name])
-> ToolSettings -> (APINode, SpecNewtype) -> Q [Dec]
gen_sn_dt APINode -> [Name]
deriv ToolSettings
ts (APINode
as, SpecNewtype
sn) = (Dec
nd Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
:) ([Dec] -> [Dec]) -> Q [Dec] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Bool
smart then Q [Dec]
sc else [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    nd :: Dec
nd  = Cxt -> Name -> [TyVarBndr] -> Con -> [Name] -> Dec
mkNewtypeD [] Name
nm [] Con
c (APINode -> [Name]
deriv APINode
as)
    c :: Con
c   = Name -> [VarBangType] -> Con
RecC (Bool -> APINode -> Name
newtype_con_nm Bool
smart APINode
as) [(APINode -> Name
newtype_prj_nm APINode
as,Strictness
annNotStrict,Type
wrapped_ty)]
    wrapped_ty :: Type
wrapped_ty = APIType -> Type
mk_type (APIType -> Type) -> APIType -> Type
forall a b. (a -> b) -> a -> b
$ BasicType -> APIType
TyBasic (SpecNewtype -> BasicType
snType SpecNewtype
sn)

    nm :: Name
nm  = APINode -> Name
rep_type_nm APINode
as

    smart :: Bool
smart = ToolSettings -> Bool
newtypeSmartConstructors ToolSettings
ts Bool -> Bool -> Bool
&& Maybe Filter -> Bool
forall a. Maybe a -> Bool
isJust (SpecNewtype -> Maybe Filter
snFilter SpecNewtype
sn)

    sc :: Q [Dec]
sc  = Name -> TypeQ -> ExpQ -> Q [Dec]
simpleSigD (APINode -> Name
newtype_smart_con_nm APINode
as) [t| $(return wrapped_ty) -> Maybe $(nodeRepT as) |] (ExpQ -> Q [Dec]) -> ExpQ -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
             case SpecNewtype -> Maybe Filter
snFilter SpecNewtype
sn of
               Just (FtrStrg RegEx
re) -> [| \ s -> if isJust (matchRegex (re_regex re) (T.unpack s))
                                                                   then Just ($nt_con s) else Nothing |]
               Just (FtrIntg IntRange
ir) -> [| \ i -> if i `inIntRange` ir then Just ($nt_con i) else Nothing |]
               Just (FtrUTC  UTCRange
ur) -> [| \ u -> if u `inUTCRange` ur then Just ($nt_con u) else Nothing |]
               Maybe Filter
Nothing           -> [| Just . $nt_con |]

    nt_con :: ExpQ
nt_con = ToolSettings -> APINode -> SpecNewtype -> ExpQ
nodeNewtypeConE ToolSettings
ts APINode
as SpecNewtype
sn



-- | Generate a record type definition, like this:
--
-- > data JobSpecId
-- >     = JobSpecId
-- >         { _jsi_id         :: JobId
-- >         , _jsi_input      :: JSInput
-- >         , _jsi_output     :: JSOutputStatus
-- >         , _jsi_pipelineId :: PipelineId
-- >         }
-- >     deriving (Show,Eq,Typeable)

gen_sr_dt :: (APINode -> [Name]) -> (APINode, SpecRecord) -> Q [Dec]
gen_sr_dt :: (APINode -> [Name]) -> (APINode, SpecRecord) -> Q [Dec]
gen_sr_dt APINode -> [Name]
deriv (APINode
as, SpecRecord
sr) = [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec
mkDataD [] Name
nm [] [Con]
cs (APINode -> [Name]
deriv APINode
as)]
  where
    cs :: [Con]
cs = [Name -> [VarBangType] -> Con
RecC Name
nm [(APINode -> FieldName -> Name
pref_field_nm APINode
as FieldName
fnm,Strictness
annIsStrict,APIType -> Type
mk_type (FieldType -> APIType
ftType FieldType
fty)) |
                                                (FieldName
fnm,FieldType
fty)<-SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr]]
    nm :: Name
nm = APINode -> Name
rep_type_nm APINode
as


-- | Generate a union type definition, like this:
--
-- > data Foo = F_Bar Int | F_Baz Bool
-- >     deriving (Show,Typeable)

gen_su_dt :: (APINode -> [Name]) -> (APINode, SpecUnion) -> Q [Dec]
gen_su_dt :: (APINode -> [Name]) -> (APINode, SpecUnion) -> Q [Dec]
gen_su_dt APINode -> [Name]
deriv (APINode
as, SpecUnion
su) = [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec
mkDataD [] Name
nm [] [Con]
cs (APINode -> [Name]
deriv APINode
as)]
  where
    cs :: [Con]
cs = [Name -> [BangType] -> Con
NormalC (APINode -> FieldName -> Name
pref_con_nm APINode
as FieldName
fnm) [(Strictness
annIsStrict,APIType -> Type
mk_type APIType
ty)] |
                                            (FieldName
fnm,(APIType
ty,MDComment
_))<-SpecUnion -> [(FieldName, (APIType, MDComment))]
suFields SpecUnion
su]
    nm :: Name
nm = APINode -> Name
rep_type_nm APINode
as


-- | Generate an enum type definition, like this:
--
-- > data FrameRate
-- >     = FR_auto
-- >     | FR_10
-- >     | FR_15
-- >     | FR_23_97
-- >     | FR_24
-- >     | FR_25
-- >     | FR_29_97
-- >     | FR_30
-- >     | FR_60
-- >     deriving (Show,Eq,Ord,Bounded,Enum,Typeable)

gen_se_dt :: (APINode -> [Name]) -> (APINode, SpecEnum) -> Q [Dec]
gen_se_dt :: (APINode -> [Name]) -> (APINode, SpecEnum) -> Q [Dec]
gen_se_dt APINode -> [Name]
deriv (APINode
as, SpecEnum
se) = [Dec] -> Q [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return [Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec
mkDataD [] Name
nm [] [Con]
cs (APINode -> [Name]
deriv APINode
as)]
  where
    cs :: [Con]
cs = [Name -> [BangType] -> Con
NormalC (APINode -> FieldName -> Name
pref_con_nm APINode
as FieldName
fnm) [] | (FieldName
fnm,MDComment
_) <- SpecEnum -> [(FieldName, MDComment)]
seAlts SpecEnum
se ]
    nm :: Name
nm = APINode -> Name
rep_type_nm APINode
as


mk_type :: APIType -> Type
mk_type :: APIType -> Type
mk_type APIType
ty =
    case APIType
ty of
      TyList  APIType
ty'  -> Type -> Type -> Type
AppT Type
ListT  (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ APIType -> Type
mk_type APIType
ty'
      TyMaybe APIType
ty'  -> Type -> Type -> Type
AppT (Name -> Type
ConT ''Maybe) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ APIType -> Type
mk_type APIType
ty'
      TyName  TypeName
nm   -> Name -> Type
ConT  (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ Text -> Name
mkNameText (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ TypeName -> Text
_TypeName TypeName
nm
      TyBasic BasicType
bt   -> BasicType -> Type
basic_type BasicType
bt
      APIType
TyJSON       -> Name -> Type
ConT ''Value

basic_type :: BasicType -> Type
basic_type :: BasicType -> Type
basic_type BasicType
bt =
    case BasicType
bt of
      BasicType
BTstring -> Name -> Type
ConT ''T.Text
      BasicType
BTbinary -> Name -> Type
ConT ''Binary
      BasicType
BTbool   -> Name -> Type
ConT ''Bool
      BasicType
BTint    -> Name -> Type
ConT ''Int
      BasicType
BTutc    -> Name -> Type
ConT ''UTCTime


-- | Default names of classes for which to derive instances, depending
-- on the type of API node.
defaultDerivedClasses :: APINode -> [Name]
defaultDerivedClasses :: APINode -> [Name]
defaultDerivedClasses APINode
an = case APINode -> Spec
anSpec APINode
an of
    SpNewtype SpecNewtype
sn -> case SpecNewtype -> BasicType
snType SpecNewtype
sn of
                      BasicType
BTstring -> ''IsString Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
derive_leaf_nms
                      BasicType
BTbinary -> [Name]
derive_leaf_nms
                      BasicType
BTbool   -> [Name]
derive_leaf_nms
                      BasicType
BTint    -> [Name]
derive_leaf_nms
                      BasicType
BTutc    -> [Name]
derive_leaf_nms
    SpRecord  SpecRecord
_  -> [Name]
derive_node_nms
    SpUnion   SpecUnion
_  -> [Name]
derive_node_nms
    SpEnum    SpecEnum
_  -> [Name]
derive_leaf_nms [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [''Bounded, ''Enum]
    SpSynonym APIType
_  -> []

derive_leaf_nms :: [Name]
derive_leaf_nms :: [Name]
derive_leaf_nms = [''Show,''Eq,''Ord,''Typeable]

derive_node_nms :: [Name]
derive_node_nms :: [Name]
derive_node_nms = [''Show,''Eq,''Typeable]


-- | Name of the type corresponding to the API node, e.g. @JobId@
type_nm :: APINode -> Name
type_nm :: APINode -> Name
type_nm APINode
an = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ Text -> MDComment
T.unpack (Text -> MDComment) -> Text -> MDComment
forall a b. (a -> b) -> a -> b
$ TypeName -> Text
_TypeName (TypeName -> Text) -> TypeName -> Text
forall a b. (a -> b) -> a -> b
$ APINode -> TypeName
anName APINode
an

-- | Name of the representation type corresponding to the API node,
-- which differs from the 'type_nm' only if custom conversion
-- functions are specified.  This is also the name of the sole
-- constructor for newtypes and records.
rep_type_nm :: APINode -> Name
rep_type_nm :: APINode -> Name
rep_type_nm APINode
an = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ APINode -> MDComment
rep_type_s APINode
an

-- | Name of the single field in a newtype, prefixed by an underscore,
-- e.g. @_JobId@
newtype_prj_nm :: APINode -> Name
newtype_prj_nm :: APINode -> Name
newtype_prj_nm APINode
an = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ MDComment
"_" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ APINode -> MDComment
rep_type_s APINode
an

-- | Name of the constructor of a newtype, which will be same as the
-- representation type unless a smart constructor is requested, in
-- which case we just prefix it with "UnsafeMk".
newtype_con_nm :: Bool -> APINode -> Name
newtype_con_nm :: Bool -> APINode -> Name
newtype_con_nm Bool
smart APINode
an | Bool
smart     = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ MDComment
"UnsafeMk" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ APINode -> MDComment
rep_type_s APINode
an
                        | Bool
otherwise = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$               APINode -> MDComment
rep_type_s APINode
an

-- | Name of the smart constructor of a newtype, prefixed with "mk".
newtype_smart_con_nm :: APINode -> Name
newtype_smart_con_nm :: APINode -> Name
newtype_smart_con_nm APINode
an = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ MDComment
"mk" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ APINode -> MDComment
rep_type_s APINode
an

rep_type_s :: APINode -> String
rep_type_s :: APINode -> MDComment
rep_type_s APINode
an = MDComment -> MDComment
f (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ Text -> MDComment
T.unpack (Text -> MDComment) -> Text -> MDComment
forall a b. (a -> b) -> a -> b
$ TypeName -> Text
_TypeName (TypeName -> Text) -> TypeName -> Text
forall a b. (a -> b) -> a -> b
$ APINode -> TypeName
anName APINode
an
  where
    f :: MDComment -> MDComment
f MDComment
s = MDComment
-> ((FieldName, FieldName) -> MDComment)
-> Maybe (FieldName, FieldName)
-> MDComment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MDComment
s (MDComment -> (FieldName, FieldName) -> MDComment
forall a b. a -> b -> a
const (MDComment
"REP__"MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++MDComment
s)) (Maybe (FieldName, FieldName) -> MDComment)
-> Maybe (FieldName, FieldName) -> MDComment
forall a b. (a -> b) -> a -> b
$ APINode -> Maybe (FieldName, FieldName)
anConvert APINode
an

-- | Construct the name of a record field by attaching the
-- type-specific prefix, in lowercase, e.g. @_jsi_id@
pref_field_nm :: APINode -> FieldName -> Name
pref_field_nm :: APINode -> FieldName -> Name
pref_field_nm APINode
as FieldName
fnm = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ MDComment
pre MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Text -> MDComment
T.unpack (FieldName -> Text
_FieldName FieldName
fnm)
  where
    pre :: MDComment
pre = MDComment
"_" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> MDComment -> MDComment
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (CI MDComment -> MDComment
forall s. CI s -> s
CI.original (CI MDComment -> MDComment) -> CI MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ APINode -> CI MDComment
anPrefix APINode
as) MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
"_"

-- | Construct the name of a union or enum constructor by attaching
-- the type-specific prefix, in uppercase, e.g. @FR_auto@
pref_con_nm :: APINode -> FieldName -> Name
pref_con_nm :: APINode -> FieldName -> Name
pref_con_nm APINode
as FieldName
fnm = MDComment -> Name
mkName (MDComment -> Name) -> MDComment -> Name
forall a b. (a -> b) -> a -> b
$ MDComment
pre MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Text -> MDComment
T.unpack (FieldName -> Text
_FieldName FieldName
fnm)
  where
    pre :: MDComment
pre = (Char -> Char) -> MDComment -> MDComment
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (CI MDComment -> MDComment
forall s. CI s -> s
CI.original (CI MDComment -> MDComment) -> CI MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ APINode -> CI MDComment
anPrefix APINode
as) MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
"_"


-- | The type corresponding to an API node
nodeT :: APINode -> TypeQ
nodeT :: APINode -> TypeQ
nodeT = Name -> TypeQ
conT (Name -> TypeQ) -> (APINode -> Name) -> APINode -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> Name
type_nm

-- | The representation type corresponding to an API node
nodeRepT :: APINode -> TypeQ
nodeRepT :: APINode -> TypeQ
nodeRepT = Name -> TypeQ
conT (Name -> TypeQ) -> (APINode -> Name) -> APINode -> TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> Name
rep_type_nm

-- | The constructor for a record API node
nodeConE :: APINode -> ExpQ
nodeConE :: APINode -> ExpQ
nodeConE = Name -> ExpQ
conE (Name -> ExpQ) -> (APINode -> Name) -> APINode -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> Name
rep_type_nm

-- | The constructor for a newtype, which might be renamed
nodeNewtypeConE :: ToolSettings -> APINode -> SpecNewtype -> ExpQ
nodeNewtypeConE :: ToolSettings -> APINode -> SpecNewtype -> ExpQ
nodeNewtypeConE ToolSettings
ts APINode
an SpecNewtype
sn = Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ Bool -> APINode -> Name
newtype_con_nm (ToolSettings -> Bool
newtypeSmartConstructors ToolSettings
ts Bool -> Bool -> Bool
&& Maybe Filter -> Bool
forall a. Maybe a -> Bool
isJust (SpecNewtype -> Maybe Filter
snFilter SpecNewtype
sn)) APINode
an

-- | A record field in an API node, as an expression
nodeFieldE :: APINode -> FieldName -> ExpQ
nodeFieldE :: APINode -> FieldName -> ExpQ
nodeFieldE APINode
an FieldName
fnm = Name -> ExpQ
varE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ APINode -> FieldName -> Name
pref_field_nm APINode
an FieldName
fnm

-- | A record field in an API node, as a pattern
nodeFieldP :: APINode -> FieldName -> PatQ
nodeFieldP :: APINode -> FieldName -> PatQ
nodeFieldP APINode
an FieldName
fnm = Name -> PatQ
varP (Name -> PatQ) -> Name -> PatQ
forall a b. (a -> b) -> a -> b
$ APINode -> FieldName -> Name
pref_field_nm APINode
an FieldName
fnm

-- | A prefixed constructor for a union or enum, as an expression
nodeAltConE :: APINode -> FieldName -> ExpQ
nodeAltConE :: APINode -> FieldName -> ExpQ
nodeAltConE APINode
an FieldName
fn = Name -> ExpQ
conE (Name -> ExpQ) -> Name -> ExpQ
forall a b. (a -> b) -> a -> b
$ APINode -> FieldName -> Name
pref_con_nm APINode
an FieldName
fn

-- | A prefixed constructor for a union or enum, as a pattern
nodeAltConP :: APINode -> FieldName -> [PatQ] -> PatQ
nodeAltConP :: APINode -> FieldName -> [PatQ] -> PatQ
nodeAltConP APINode
an FieldName
fn = Name -> [PatQ] -> PatQ
conP (APINode -> FieldName -> Name
pref_con_nm APINode
an FieldName
fn)

-- | The projection function from a newtype API node, as an epxression
newtypeProjectionE :: APINode -> ExpQ
newtypeProjectionE :: APINode -> ExpQ
newtypeProjectionE = Name -> ExpQ
varE (Name -> ExpQ) -> (APINode -> Name) -> APINode -> ExpQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> Name
newtype_prj_nm