module Data.GI.CodeGen.CtoHaskellMap
( cToHaskellMap
, Hyperlink(..)
) where
import qualified Data.Map as M
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.String (IsString(..))
import Data.GI.CodeGen.GtkDoc (CRef(..))
import Data.GI.CodeGen.API (API(..), Name(..), Callback(..),
Constant(..), Flags(..),
Enumeration(..), EnumerationMember(..),
Interface(..), Object(..),
Function(..), Method(..), Struct(..), Union(..))
import Data.GI.CodeGen.ModulePath (ModulePath, dotModulePath, (/.))
import Data.GI.CodeGen.SymbolNaming (submoduleLocation, lowerName, upperName)
import Data.GI.CodeGen.Util (ucFirst)
data Hyperlink = IdentifierLink Text
| ModuleLink Text
| ModuleLinkWithAnchor Text Text
deriving (Show, Eq)
instance IsString Hyperlink where
fromString = IdentifierLink . T.pack
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", "Bool"),
(ConstantRef "TRUE", "True"),
(ConstantRef "FALSE", "False"),
(TypeRef "GError", "GError"),
(TypeRef "GType", "GType"),
(TypeRef "GVariant", "GVariant"),
(ConstantRef "NULL", "Nothing")]
location :: Name -> API -> ModulePath
location n api = ("GI" /. ucFirst (namespace n)) <> submoduleLocation n api
fullyQualified :: Name -> API -> Text -> Hyperlink
fullyQualified n api symbol =
IdentifierLink $ dotModulePath (location n api) <> "." <> symbol
constRefs :: Name -> Constant -> [(CRef, Hyperlink)]
constRefs n c = [(ConstantRef (constantCType c),
fullyQualified n (APIConst c) $ name n),
(TypeRef (constantCType c),
fullyQualified n (APIConst c) $ name n)]
funcRefs :: Name -> Function -> [(CRef, Hyperlink)]
funcRefs n f = [(FunctionRef (fnSymbol f),
fullyQualified n (APIFunction f) $ lowerName n)]
enumRefs :: API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs api n e = (TypeRef (enumCType e), fullyQualified n api $ upperName n) :
map memberToRef (enumMembers e)
where memberToRef :: EnumerationMember -> (CRef, Hyperlink)
memberToRef em = (ConstantRef (enumMemberCId em),
fullyQualified n api $ upperName $
n {name = name n <> "_" <> enumMemberName em})
maybeCType :: Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType _ _ Nothing = []
maybeCType n api (Just ctype) = [(TypeRef ctype,
fullyQualified n api (upperName n))]
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),
fullyQualified n api $ lowerName mn')
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)
objectRefs :: Name -> Object -> [(CRef, Hyperlink)]
objectRefs n o = maybeCType n (APIObject o) (objCType o)
<> methodRefs n (APIObject o) (objMethods o)