module Data.GI.CodeGen.CtoHaskellMap
( cToHaskellMap
, Hyperlink(..)
) where
import qualified Data.Map as M
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import Data.GI.CodeGen.GtkDoc (CRef(..))
import Data.GI.CodeGen.API (API(..), Name(..), Callback(..),
Constant(..), Flags(..),
Enumeration(..), EnumerationMember(..),
Interface(..), Object(..),
Function(..), Method(..), Struct(..), Union(..),
Signal(..))
import Data.GI.CodeGen.ModulePath (ModulePath, dotModulePath, (/.))
import Data.GI.CodeGen.SymbolNaming (submoduleLocation, lowerName, upperName,
signalHaskellName)
import Data.GI.CodeGen.Util (ucFirst)
data Hyperlink = ValueIdentifier Text
| TypeIdentifier Text
| ModuleLink Text
| ModuleLinkWithAnchor (Maybe Text) Text Text
deriving (Show, Eq)
cToHaskellMap :: [(Name, API)] -> M.Map CRef Hyperlink
cToHaskellMap apis = M.union (M.fromList builtins)
(M.fromList $ concatMap extractRefs apis)
where extractRefs :: (Name, API) -> [(CRef, Hyperlink)]
extractRefs (n, APIConst c) = constRefs n c
extractRefs (n, APIFunction f) = funcRefs n f
extractRefs (n, api@(APIEnum e)) = enumRefs api n e
extractRefs (n, api@(APIFlags (Flags e))) = enumRefs api n e
extractRefs (n, APICallback c) = callbackRefs n c
extractRefs (n, APIStruct s) = structRefs n s
extractRefs (n, APIUnion u) = unionRefs n u
extractRefs (n, APIInterface i) = ifaceRefs n i
extractRefs (n, APIObject o) = objectRefs n o
builtins :: [(CRef, Hyperlink)]
builtins = [(TypeRef "gboolean", TypeIdentifier "P.Bool"),
(ConstantRef "TRUE", ValueIdentifier "P.True"),
(ConstantRef "FALSE", ValueIdentifier "P.False"),
(TypeRef "GError", TypeIdentifier "GError"),
(TypeRef "GType", TypeIdentifier "GType"),
(TypeRef "GVariant", TypeIdentifier "GVariant"),
(ConstantRef "NULL", ValueIdentifier "P.Nothing")]
location :: Name -> API -> ModulePath
location n api = ("GI" /. ucFirst (namespace n)) <> submoduleLocation n api
fullyQualifiedValue :: Name -> API -> Text -> Hyperlink
fullyQualifiedValue n api symbol =
ValueIdentifier $ dotModulePath (location n api) <> "." <> symbol
fullyQualifiedType :: Name -> API -> Text -> Hyperlink
fullyQualifiedType n api symbol =
TypeIdentifier $ dotModulePath (location n api) <> "." <> symbol
constRefs :: Name -> Constant -> [(CRef, Hyperlink)]
constRefs n c = [(ConstantRef (constantCType c),
fullyQualifiedValue n (APIConst c) $ name n),
(TypeRef (constantCType c),
fullyQualifiedValue n (APIConst c) $ name n)]
funcRefs :: Name -> Function -> [(CRef, Hyperlink)]
funcRefs n f = [(FunctionRef (fnSymbol f),
fullyQualifiedValue n (APIFunction f) $ lowerName n)]
enumRefs :: API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs api n e = (TypeRef (enumCType e),
fullyQualifiedType n api $ upperName n) :
map memberToRef (enumMembers e)
where memberToRef :: EnumerationMember -> (CRef, Hyperlink)
memberToRef em = (ConstantRef (enumMemberCId em),
fullyQualifiedValue n api $ upperName $
n {name = name n <> "_" <> enumMemberName em})
methodRefs :: Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs n api methods = map methodRef methods
where methodRef :: Method -> (CRef, Hyperlink)
methodRef m@(Method {methodName = mn}) =
let mn' = mn {name = name n <> "_" <> name mn}
in (FunctionRef (methodSymbol m),
fullyQualifiedValue n api $ lowerName mn')
signalRefs :: Name -> API -> Maybe Text -> [Signal] -> [(CRef, Hyperlink)]
signalRefs n api maybeCName signals = map signalRef signals
where signalRef :: Signal -> (CRef, Hyperlink)
signalRef (Signal {sigName = sn}) =
let mod = dotModulePath (location n api)
sn' = signalHaskellName sn
ownerCName = case maybeCName of
Just cname -> cname
Nothing -> let Name ns owner = n
in ucFirst ns <> owner
in (SignalRef ownerCName sn,
ModuleLinkWithAnchor (Just sn') mod ("signal:" <> sn'))
maybeCType :: Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType _ _ Nothing = []
maybeCType n api (Just ctype) = [(TypeRef ctype,
fullyQualifiedType n api (upperName n))]
callbackRefs :: Name -> Callback -> [(CRef, Hyperlink)]
callbackRefs n cb = maybeCType n (APICallback cb) (cbCType cb)
structRefs :: Name -> Struct -> [(CRef, Hyperlink)]
structRefs n s = maybeCType n (APIStruct s) (structCType s)
<> methodRefs n (APIStruct s) (structMethods s)
unionRefs :: Name -> Union -> [(CRef, Hyperlink)]
unionRefs n u = maybeCType n (APIUnion u) (unionCType u)
<> methodRefs n (APIUnion u) (unionMethods u)
ifaceRefs :: Name -> Interface -> [(CRef, Hyperlink)]
ifaceRefs n i = maybeCType n (APIInterface i) (ifCType i)
<> methodRefs n (APIInterface i) (ifMethods i)
<> signalRefs n (APIInterface i) (ifCType i) (ifSignals i)
objectRefs :: Name -> Object -> [(CRef, Hyperlink)]
objectRefs n o = maybeCType n (APIObject o) (objCType o)
<> methodRefs n (APIObject o) (objMethods o)
<> signalRefs n (APIObject o) (objCType o) (objSignals o)