{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
module Data.Aeson.TypeScript.Util where
import Control.Monad
import Data.Aeson as A
import Data.Aeson.TypeScript.Instances ()
import Data.Aeson.TypeScript.Types
import qualified Data.List as L
import Data.Proxy
import Data.String.Interpolate
import qualified Data.Text as T
import Language.Haskell.TH hiding (stringE)
import Language.Haskell.TH.Datatype
import qualified Language.Haskell.TH.Lib as TH
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
type Suffix = String
type Var = String
getDataTypeVars :: DatatypeInfo -> [Type]
#if MIN_VERSION_th_abstraction(0,3,0)
getDataTypeVars :: DatatypeInfo -> [Type]
getDataTypeVars (DatatypeInfo {[Type]
datatypeInstTypes :: DatatypeInfo -> [Type]
datatypeInstTypes :: [Type]
datatypeInstTypes}) = [Type]
datatypeInstTypes
#else
getDataTypeVars (DatatypeInfo {datatypeVars}) = datatypeVars
#endif
coveredByDataTypeVars :: [Type] -> Type -> Bool
coveredByDataTypeVars :: [Type] -> Type -> Bool
coveredByDataTypeVars [Type]
dataTypeVars Type
candidate | Type
candidate forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Type]
dataTypeVars = Bool
True
coveredByDataTypeVars [Type]
dataTypeVars Type
candidate | (Type -> Type -> Type
SigT Type
candidate Type
StarT) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Type]
dataTypeVars = Bool
True
coveredByDataTypeVars [Type]
_ Type
_ = Bool
False
setDataTypeVars :: DatatypeInfo -> [Type] -> DatatypeInfo
#if MIN_VERSION_th_abstraction(0,3,0)
setDataTypeVars :: DatatypeInfo -> [Type] -> DatatypeInfo
setDataTypeVars dti :: DatatypeInfo
dti@(DatatypeInfo {}) [Type]
vars = DatatypeInfo
dti { datatypeInstTypes :: [Type]
datatypeInstTypes = [Type]
vars }
#else
setDataTypeVars dti@(DatatypeInfo {}) vars = dti { datatypeVars = vars }
#endif
dropLeadingIFromInterfaceName :: TSDeclaration -> TSDeclaration
dropLeadingIFromInterfaceName :: TSDeclaration -> TSDeclaration
dropLeadingIFromInterfaceName decl :: TSDeclaration
decl@(TSInterfaceDeclaration {interfaceName :: TSDeclaration -> Var
interfaceName=(Char
'I':Var
xs)}) = TSDeclaration
decl { interfaceName :: Var
interfaceName = Var
xs }
dropLeadingIFromInterfaceName decl :: TSDeclaration
decl@(TSTypeAlternatives {typeName :: TSDeclaration -> Var
typeName=(Char
'I':Var
xs)}) = TSDeclaration
decl { typeName :: Var
typeName = Var
xs }
dropLeadingIFromInterfaceName TSDeclaration
x = TSDeclaration
x
lastNameComponent :: String -> String
lastNameComponent :: Var -> Var
lastNameComponent Var
x = Text -> Var
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"." (Var -> Text
T.pack Var
x)
lastNameComponent' :: Name -> String
lastNameComponent' :: Name -> Var
lastNameComponent' = Var -> Var
lastNameComponent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Var
show
getTypeName :: Name -> String
getTypeName :: Name -> Var
getTypeName Name
x = Var -> Var
lastNameComponent forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Var
show Name
x
allConstructorsAreNullary :: [ConstructorInfo] -> Bool
allConstructorsAreNullary :: [ConstructorInfo] -> Bool
allConstructorsAreNullary [ConstructorInfo]
constructors = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConstructorInfo -> Bool
isConstructorNullary [ConstructorInfo]
constructors
isConstructorNullary :: ConstructorInfo -> Bool
isConstructorNullary :: ConstructorInfo -> Bool
isConstructorNullary (ConstructorInfo {ConstructorVariant
constructorVariant :: ConstructorInfo -> ConstructorVariant
constructorVariant :: ConstructorVariant
constructorVariant, [Type]
constructorFields :: ConstructorInfo -> [Type]
constructorFields :: [Type]
constructorFields}) = (ConstructorVariant
constructorVariant forall a. Eq a => a -> a -> Bool
== ConstructorVariant
NormalConstructor) Bool -> Bool -> Bool
&& ([Type]
constructorFields forall a. Eq a => a -> a -> Bool
== [])
getDatatypePredicate :: Type -> Pred
#if MIN_VERSION_template_haskell(2,10,0)
getDatatypePredicate :: Type -> Type
getDatatypePredicate = Type -> Type -> Type
AppT (Name -> Type
ConT ''TypeScript)
#else
getDatatypePredicate typ = ClassP ''TypeScript [typ]
#endif
getTypeAsStringExp :: Type -> Q Exp
getTypeAsStringExp :: Type -> Q Exp
getTypeAsStringExp Type
typ = [|getTypeScriptType (Proxy :: Proxy $(return typ))|]
getOptionalAsBoolExp :: Type -> Q Exp
getOptionalAsBoolExp :: Type -> Q Exp
getOptionalAsBoolExp Type
typ = [|getTypeScriptOptional (Proxy :: Proxy $(return typ))|]
applyToArgsT :: Type -> [Type] -> Type
applyToArgsT :: Type -> [Type] -> Type
applyToArgsT Type
constructor [] = Type
constructor
applyToArgsT Type
constructor (Type
x:[Type]
xs) = Type -> [Type] -> Type
applyToArgsT (Type -> Type -> Type
AppT Type
constructor Type
x) [Type]
xs
applyToArgsE :: Exp -> [Exp] -> Exp
applyToArgsE :: Exp -> [Exp] -> Exp
applyToArgsE Exp
f [] = Exp
f
applyToArgsE Exp
f (Exp
x:[Exp]
xs) = Exp -> [Exp] -> Exp
applyToArgsE (Exp -> Exp -> Exp
AppE Exp
f Exp
x) [Exp]
xs
getTagSingleConstructors :: Options -> Bool
#if MIN_VERSION_aeson(1,2,0)
getTagSingleConstructors :: Options -> Bool
getTagSingleConstructors = Options -> Bool
tagSingleConstructors
#else
getTagSingleConstructors _ = False
#endif
assertExtensionsTurnedOn :: DatatypeInfo -> Q ()
#if MIN_VERSION_template_haskell(2,11,0)
assertExtensionsTurnedOn :: DatatypeInfo -> Q ()
assertExtensionsTurnedOn (DatatypeInfo {[Type]
[TyVarBndrUnit]
[ConstructorInfo]
Name
DatatypeVariant
datatypeContext :: DatatypeInfo -> [Type]
datatypeName :: DatatypeInfo -> Name
datatypeVars :: DatatypeInfo -> [TyVarBndrUnit]
datatypeVariant :: DatatypeInfo -> DatatypeVariant
datatypeCons :: DatatypeInfo -> [ConstructorInfo]
datatypeCons :: [ConstructorInfo]
datatypeVariant :: DatatypeVariant
datatypeInstTypes :: [Type]
datatypeVars :: [TyVarBndrUnit]
datatypeName :: Name
datatypeContext :: [Type]
datatypeInstTypes :: DatatypeInfo -> [Type]
..}) = do
Bool
scopedTypeVariablesEnabled <- Extension -> Q Bool
isExtEnabled Extension
ScopedTypeVariables
Bool
kindSignaturesEnabled <- Extension -> Q Bool
isExtEnabled Extension
KindSignatures
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
scopedTypeVariablesEnabled forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => Var -> a
error [i|The ScopedTypeVariables extension is required; please enable it before calling deriveTypeScript. (For example: put {-\# LANGUAGE ScopedTypeVariables \#-} at the top of the file.)|]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
kindSignaturesEnabled Bool -> Bool -> Bool
|| (forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [TyVarBndrUnit]
datatypeVars)) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => Var -> a
error [i|The KindSignatures extension is required since type #{datatypeName} is a higher order type; please enable it before calling deriveTypeScript. (For example: put {-\# LANGUAGE KindSignatures \#-} at the top of the file.)|]
#else
assertExtensionsTurnedOn _ = return ()
#endif
isObjectWithSingleField :: SumEncoding -> Bool
isObjectWithSingleField :: SumEncoding -> Bool
isObjectWithSingleField SumEncoding
ObjectWithSingleField = Bool
True
isObjectWithSingleField SumEncoding
_ = Bool
False
isTwoElemArray :: SumEncoding -> Bool
isTwoElemArray :: SumEncoding -> Bool
isTwoElemArray SumEncoding
TwoElemArray = Bool
True
isTwoElemArray SumEncoding
_ = Bool
False
isUntaggedValue :: SumEncoding -> Bool
#if MIN_VERSION_aeson(1,0,0)
isUntaggedValue :: SumEncoding -> Bool
isUntaggedValue SumEncoding
UntaggedValue = Bool
True
#endif
isUntaggedValue SumEncoding
_ = Bool
False
mkInstance :: Cxt -> Type -> [Dec] -> Dec
#if MIN_VERSION_template_haskell(2,11,0)
mkInstance :: [Type] -> Type -> [Dec] -> Dec
mkInstance = Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
InstanceD forall a. Maybe a
Nothing
#else
mkInstance = InstanceD
#endif
namesAndTypes :: Options -> [(Name, (Suffix, Var))] -> ConstructorInfo -> [(Name, String, Type)]
namesAndTypes :: Options
-> [(Name, (Var, Var))] -> ConstructorInfo -> [(Name, Var, Type)]
namesAndTypes Options
options [(Name, (Var, Var))]
genericVariables ConstructorInfo
ci = case ConstructorInfo -> ConstructorVariant
constructorVariant ConstructorInfo
ci of
RecordConstructor [Name]
names -> forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Name]
names (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Options -> Var -> Var
fieldLabelModifier Options
options) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Var
lastNameComponent') [Name]
names) (ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci)
ConstructorVariant
_ -> case Options -> SumEncoding
sumEncoding Options
options of
TaggedObject Var
_ Var
contentsFieldName
| ConstructorInfo -> Bool
isConstructorNullary ConstructorInfo
ci -> []
| Bool
otherwise -> [(Var -> Name
mkName Var
"", Var
contentsFieldName, [(Name, (Var, Var))] -> ConstructorInfo -> Type
contentsTupleTypeSubstituted [(Name, (Var, Var))]
genericVariables ConstructorInfo
ci)]
SumEncoding
_ -> [(ConstructorInfo -> Name
constructorName ConstructorInfo
ci, Options -> ConstructorInfo -> Var
constructorNameToUse Options
options ConstructorInfo
ci, [(Name, (Var, Var))] -> ConstructorInfo -> Type
contentsTupleTypeSubstituted [(Name, (Var, Var))]
genericVariables ConstructorInfo
ci)]
constructorNameToUse :: Options -> ConstructorInfo -> String
constructorNameToUse :: Options -> ConstructorInfo -> Var
constructorNameToUse Options
options ConstructorInfo
ci = (Options -> Var -> Var
constructorTagModifier Options
options) forall a b. (a -> b) -> a -> b
$ Name -> Var
lastNameComponent' (ConstructorInfo -> Name
constructorName ConstructorInfo
ci)
contentsTupleType :: ConstructorInfo -> Type
contentsTupleType :: ConstructorInfo -> Type
contentsTupleType ConstructorInfo
ci = let fields :: [Type]
fields = ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci in
case [Type]
fields of
[] -> Type -> Type -> Type
AppT Type
ListT (Name -> Type
ConT ''())
[Type
x] -> Type
x
[Type]
xs-> Type -> [Type] -> Type
applyToArgsT (Name -> Type
ConT forall a b. (a -> b) -> a -> b
$ Int -> Name
tupleTypeName (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Type]
xs)) [Type]
fields
contentsTupleTypeSubstituted :: [(Name, (Suffix, Var))] -> ConstructorInfo -> Type
contentsTupleTypeSubstituted :: [(Name, (Var, Var))] -> ConstructorInfo -> Type
contentsTupleTypeSubstituted [(Name, (Var, Var))]
genericVariables ConstructorInfo
ci = let fields :: [Type]
fields = ConstructorInfo -> [Type]
constructorFields ConstructorInfo
ci in
case [Type]
fields of
[] -> Type -> Type -> Type
AppT Type
ListT (Name -> Type
ConT ''())
[Type
x] -> [(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
genericVariables Type
x
[Type]
xs -> Type -> [Type] -> Type
applyToArgsT (Name -> Type
ConT forall a b. (a -> b) -> a -> b
$ Int -> Name
tupleTypeName (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Type]
xs)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
genericVariables) [Type]
xs)
mapType :: [(Name, (Suffix, Var))] -> Type -> Type
mapType :: [(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g x :: Type
x@(VarT Name
name) = forall {a} {a} {a}.
(Eq a, Eq a, IsString a) =>
Type -> [(a, (a, a))] -> a -> Type
tryPromote Type
x [(Name, (Var, Var))]
g Name
name
mapType [(Name, (Var, Var))]
g x :: Type
x@(ConT Name
name) = forall {a} {a} {a}.
(Eq a, Eq a, IsString a) =>
Type -> [(a, (a, a))] -> a -> Type
tryPromote Type
x [(Name, (Var, Var))]
g Name
name
mapType [(Name, (Var, Var))]
g x :: Type
x@(PromotedT Name
name) = forall {a} {a} {a}.
(Eq a, Eq a, IsString a) =>
Type -> [(a, (a, a))] -> a -> Type
tryPromote Type
x [(Name, (Var, Var))]
g Name
name
mapType [(Name, (Var, Var))]
g (AppT Type
typ1 Type
typ2) = Type -> Type -> Type
AppT ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ1) ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ2)
mapType [(Name, (Var, Var))]
g (SigT Type
typ Type
x) = Type -> Type -> Type
SigT ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ) Type
x
mapType [(Name, (Var, Var))]
g (InfixT Type
typ1 Name
x Type
typ2) = Type -> Name -> Type -> Type
InfixT ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ1) Name
x ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ2)
mapType [(Name, (Var, Var))]
g (UInfixT Type
typ1 Name
x Type
typ2) = Type -> Name -> Type -> Type
UInfixT ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ1) Name
x ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ2)
mapType [(Name, (Var, Var))]
g (ParensT Type
typ) = Type -> Type
ParensT ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ)
#if MIN_VERSION_template_haskell(2,15,0)
mapType [(Name, (Var, Var))]
g (AppKindT Type
typ Type
x) = Type -> Type -> Type
AppKindT ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ) Type
x
mapType [(Name, (Var, Var))]
g (ImplicitParamT Var
x Type
typ) = Var -> Type -> Type
ImplicitParamT Var
x ([(Name, (Var, Var))] -> Type -> Type
mapType [(Name, (Var, Var))]
g Type
typ)
#endif
mapType [(Name, (Var, Var))]
_ Type
x = Type
x
tryPromote :: Type -> [(a, (a, a))] -> a -> Type
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"")) = Name -> Type
ConT ''T
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T")) = Name -> Type
ConT ''T
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T1")) = Name -> Type
ConT ''T1
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T2")) = Name -> Type
ConT ''T2
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T3")) = Name -> Type
ConT ''T3
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T4")) = Name -> Type
ConT ''T4
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T5")) = Name -> Type
ConT ''T5
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T6")) = Name -> Type
ConT ''T6
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T7")) = Name -> Type
ConT ''T7
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T8")) = Name -> Type
ConT ''T8
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T9")) = Name -> Type
ConT ''T9
tryPromote Type
_ [(a, (a, a))]
genericVariables (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup [(a, (a, a))]
genericVariables -> Just (a
_, a
"T10")) = Name -> Type
ConT ''T10
tryPromote Type
x [(a, (a, a))]
_ a
_ = Type
x
getBracketsExpression :: Bool -> [(Name, (Suffix, Var))] -> Q Exp
getBracketsExpression :: Bool -> [(Name, (Var, Var))] -> Q Exp
getBracketsExpression Bool
_ [] = [|""|]
getBracketsExpression Bool
includeSuffix [(Name, (Var, Var))]
names =
[|let vars = $(genericVariablesListExpr includeSuffix names) in "<" <> L.intercalate ", " vars <> ">"|]
getBracketsExpressionAllTypesNoSuffix :: [(Name, (Suffix, Var))] -> Q Exp
getBracketsExpressionAllTypesNoSuffix :: [(Name, (Var, Var))] -> Q Exp
getBracketsExpressionAllTypesNoSuffix [] = [|""|]
getBracketsExpressionAllTypesNoSuffix [(Name, (Var, Var))]
names = [|"<" <> L.intercalate ", " $(listE [ [|(getTypeScriptType (Proxy :: Proxy $(varT x)))|] | (x, (_suffix, _)) <- names]) <> ">"|]
genericVariablesListExpr :: Bool -> [(Name, (Suffix, Var))] -> Q Exp
genericVariablesListExpr :: Bool -> [(Name, (Var, Var))] -> Q Exp
genericVariablesListExpr Bool
includeSuffix [(Name, (Var, Var))]
genericVariables = forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((Name
_, (Var
suffix, Var
_)), Type
correspondingGeneric) ->
[|(getTypeScriptType (Proxy :: Proxy $(return correspondingGeneric))) <> $(TH.stringE (if includeSuffix then suffix else ""))|])
(case [(Name, (Var, Var))]
genericVariables of
[(Name, (Var, Var))
x] -> [((Name, (Var, Var))
x, Name -> Type
ConT ''T)]
[(Name, (Var, Var))]
xs -> forall a b. [a] -> [b] -> [(a, b)]
zip [(Name, (Var, Var))]
xs [Type]
allStarConstructors)
)
isStarType :: Type -> Maybe Name
isStarType :: Type -> Maybe Name
isStarType (SigT (VarT Name
n) Type
StarT) = forall a. a -> Maybe a
Just Name
n
isStarType Type
_ = forall a. Maybe a
Nothing
nothingOnFail :: Q a -> Q (Maybe a)
nothingOnFail :: forall a. Q a -> Q (Maybe a)
nothingOnFail Q a
action = forall a. Q a -> Q a -> Q a
recover (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q a
action)
tryGetDoc :: (String -> String) -> Name -> Q Exp
tryGetDoc :: (Var -> Var) -> Name -> Q Exp
tryGetDoc Var -> Var
haddockModifier Name
n = do
#if MIN_VERSION_template_haskell(2,18,0)
Maybe (Maybe Var)
maybeDoc <- forall a. Q a -> Q (Maybe a)
nothingOnFail (DocLoc -> Q (Maybe Var)
getDoc (Name -> DocLoc
DeclDoc Name
n)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (Just Var
doc) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Var -> Var
haddockModifier Var
doc
Maybe (Maybe Var)
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe Var)
x
#else
let maybeDoc = Nothing
#endif
case Maybe (Maybe Var)
maybeDoc of
Just (Just Var
doc) -> [|Just $(TH.stringE doc)|]
Maybe (Maybe Var)
_ -> [|Nothing|]