-- | Construct a map from C identifiers to the corresponding Haskell
-- elements in the bindings.
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(..), Property(..))
import Data.GI.CodeGen.ModulePath (dotModulePath)
import Data.GI.CodeGen.SymbolNaming (moduleLocation, lowerName, upperName,
                                     signalHaskellName, haddockSignalAnchor,
                                     haddockAttrAnchor, hyphensToCamelCase)
import Data.GI.CodeGen.Util (ucFirst, lcFirst)

-- | Link to an identifier, module, etc.
data Hyperlink = ValueIdentifier Text
               -- ^ An identifier at the value level: functions, data
               -- constructors, ...
               | TypeIdentifier Text
               -- ^ An identifier at the type level.
               | ModuleLink Text
               -- ^ Link to a module.
               | ModuleLinkWithAnchor (Maybe Text) Text Text
               -- ^ Link to an anchor inside a given module, with an
               -- optional label.
  deriving (Int -> Hyperlink -> ShowS
[Hyperlink] -> ShowS
Hyperlink -> String
(Int -> Hyperlink -> ShowS)
-> (Hyperlink -> String)
-> ([Hyperlink] -> ShowS)
-> Show Hyperlink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hyperlink -> ShowS
showsPrec :: Int -> Hyperlink -> ShowS
$cshow :: Hyperlink -> String
show :: Hyperlink -> String
$cshowList :: [Hyperlink] -> ShowS
showList :: [Hyperlink] -> ShowS
Show, Hyperlink -> Hyperlink -> Bool
(Hyperlink -> Hyperlink -> Bool)
-> (Hyperlink -> Hyperlink -> Bool) -> Eq Hyperlink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hyperlink -> Hyperlink -> Bool
== :: Hyperlink -> Hyperlink -> Bool
$c/= :: Hyperlink -> Hyperlink -> Bool
/= :: Hyperlink -> Hyperlink -> Bool
Eq)

-- | Given a set of APIs, build a `Map` that given a Text
-- corresponding to a certain C identifier returns the corresponding
-- Haskell element in the bindings. For instance, `gtk_widget_show`
-- will get mapped to `GI.Gtk.Objects.Widget.show`.
cToHaskellMap :: [(Name, API)] -> M.Map CRef Hyperlink
cToHaskellMap :: [(Name, API)] -> Map CRef Hyperlink
cToHaskellMap [(Name, API)]
apis = Map CRef Hyperlink -> Map CRef Hyperlink -> Map CRef Hyperlink
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(CRef, Hyperlink)] -> Map CRef Hyperlink
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(CRef, Hyperlink)]
builtins)
                     ([(CRef, Hyperlink)] -> Map CRef Hyperlink
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(CRef, Hyperlink)] -> Map CRef Hyperlink)
-> [(CRef, Hyperlink)] -> Map CRef Hyperlink
forall a b. (a -> b) -> a -> b
$ ((Name, API) -> [(CRef, Hyperlink)])
-> [(Name, API)] -> [(CRef, Hyperlink)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Name, API) -> [(CRef, Hyperlink)]
extractRefs [(Name, API)]
apis)
  where extractRefs :: (Name, API) -> [(CRef, Hyperlink)]
        extractRefs :: (Name, API) -> [(CRef, Hyperlink)]
extractRefs (Name
n, APIConst Constant
c) = Name -> Constant -> [(CRef, Hyperlink)]
constRefs Name
n Constant
c
        extractRefs (Name
n, APIFunction Function
f) = Name -> Function -> [(CRef, Hyperlink)]
funcRefs Name
n Function
f
        extractRefs (Name
n, api :: API
api@(APIEnum Enumeration
e)) = API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs API
api Name
n Enumeration
e
        extractRefs (Name
n, api :: API
api@(APIFlags (Flags Enumeration
e))) = API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs API
api Name
n Enumeration
e
        extractRefs (Name
n, APICallback Callback
c) = Name -> Callback -> [(CRef, Hyperlink)]
callbackRefs Name
n Callback
c
        extractRefs (Name
n, APIStruct Struct
s) = Name -> Struct -> [(CRef, Hyperlink)]
structRefs Name
n Struct
s
        extractRefs (Name
n, APIUnion Union
u) = Name -> Union -> [(CRef, Hyperlink)]
unionRefs Name
n Union
u
        extractRefs (Name
n, APIInterface Interface
i) = Name -> Interface -> [(CRef, Hyperlink)]
ifaceRefs Name
n Interface
i
        extractRefs (Name
n, APIObject Object
o) = Name -> Object -> [(CRef, Hyperlink)]
objectRefs Name
n Object
o

        builtins :: [(CRef, Hyperlink)]
        builtins :: [(CRef, Hyperlink)]
builtins = [(Text -> CRef
CTypeRef Text
"gboolean", Text -> Hyperlink
TypeIdentifier Text
"P.Bool"),
                    (Text -> CRef
ConstantRef Text
"TRUE", Text -> Hyperlink
ValueIdentifier Text
"P.True"),
                    (Text -> CRef
ConstantRef Text
"FALSE", Text -> Hyperlink
ValueIdentifier Text
"P.False"),
                    (Text -> CRef
CTypeRef Text
"GError", Text -> Hyperlink
TypeIdentifier Text
"GError"),
                    (Text -> CRef
CTypeRef Text
"GType", Text -> Hyperlink
TypeIdentifier Text
"GType"),
                    (Text -> CRef
CTypeRef Text
"GVariant", Text -> Hyperlink
TypeIdentifier Text
"GVariant"),
                    (Text -> CRef
ConstantRef Text
"NULL", Text -> Hyperlink
ValueIdentifier Text
"P.Nothing")]

-- | Obtain the fully qualified symbol pointing to a value.
fullyQualifiedValue :: Name -> API -> Text -> Hyperlink
fullyQualifiedValue :: Name -> API -> Text -> Hyperlink
fullyQualifiedValue Name
n API
api Text
symbol =
  Text -> Hyperlink
ValueIdentifier (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ ModulePath -> Text
dotModulePath (Name -> API -> ModulePath
moduleLocation Name
n API
api) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symbol

-- | Obtain the fully qualified symbol pointing to a type.
fullyQualifiedType :: Name -> API -> Text -> Hyperlink
fullyQualifiedType :: Name -> API -> Text -> Hyperlink
fullyQualifiedType Name
n API
api Text
symbol =
  Text -> Hyperlink
TypeIdentifier (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ ModulePath -> Text
dotModulePath (Name -> API -> ModulePath
moduleLocation Name
n API
api) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
symbol

-- | Extract the C name of a constant. These are often referred to as
-- types, so we allow that too.
constRefs :: Name -> Constant -> [(CRef, Hyperlink)]
constRefs :: Name -> Constant -> [(CRef, Hyperlink)]
constRefs Name
n Constant
c = [(Text -> CRef
ConstantRef (Constant -> Text
constantCType Constant
c), Hyperlink
qualified),
                 (Text -> CRef
CTypeRef (Constant -> Text
constantCType Constant
c), Hyperlink
qualified),
                 (Name -> CRef
TypeRef Name
n, Hyperlink
qualified)]
  where qualified :: Hyperlink
qualified = Name -> API -> Text -> Hyperlink
fullyQualifiedValue Name
n (Constant -> API
APIConst Constant
c) (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ Name -> Text
name Name
n

-- | Extract the C name of a function.
funcRefs :: Name -> Function -> [(CRef, Hyperlink)]
funcRefs :: Name -> Function -> [(CRef, Hyperlink)]
funcRefs Name
n Function
f = [(Text -> CRef
OldFunctionRef (Function -> Text
fnSymbol Function
f), Hyperlink
qualified),
                (Name -> CRef
FunctionRef Name
n, Hyperlink
qualified)]
  where qualified :: Hyperlink
qualified = Name -> API -> Text -> Hyperlink
fullyQualifiedValue Name
n (Function -> API
APIFunction Function
f) (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ Name -> Text
lowerName Name
n

-- | Extract the C names of the fields in an enumeration/flags, and
-- the name of the type itself.
enumRefs :: API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs :: API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs API
api Name
n Enumeration
e = (Text -> CRef
CTypeRef (Enumeration -> Text
enumCType Enumeration
e), Hyperlink
qualified)
                   (CRef, Hyperlink) -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. a -> [a] -> [a]
: (Name -> CRef
TypeRef Name
n, Hyperlink
qualified)
                   (CRef, Hyperlink) -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. a -> [a] -> [a]
: (EnumerationMember -> (CRef, Hyperlink))
-> [EnumerationMember] -> [(CRef, Hyperlink)]
forall a b. (a -> b) -> [a] -> [b]
map EnumerationMember -> (CRef, Hyperlink)
memberToRef (Enumeration -> [EnumerationMember]
enumMembers Enumeration
e)
  where qualified :: Hyperlink
qualified = Name -> API -> Text -> Hyperlink
fullyQualifiedType Name
n API
api (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ Name -> Text
upperName Name
n
        memberToRef :: EnumerationMember -> (CRef, Hyperlink)
        memberToRef :: EnumerationMember -> (CRef, Hyperlink)
memberToRef EnumerationMember
em = (Text -> CRef
ConstantRef (EnumerationMember -> Text
enumMemberCId EnumerationMember
em),
                          Name -> API -> Text -> Hyperlink
fullyQualifiedValue Name
n API
api (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ Name -> Text
upperName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$
                          Name
n {name :: Text
name = Name -> Text
name Name
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EnumerationMember -> Text
enumMemberName EnumerationMember
em})

-- | Refs to the methods for a given owner.
methodRefs :: Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs :: Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs Name
n API
api [Method]
methods = (Method -> [(CRef, Hyperlink)]) -> [Method] -> [(CRef, Hyperlink)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Method -> [(CRef, Hyperlink)]
methodRef [Method]
methods
  where methodRef :: Method -> [(CRef, Hyperlink)]
        methodRef :: Method -> [(CRef, Hyperlink)]
methodRef Method{methodSymbol :: Method -> Text
methodSymbol = Text
symbol, methodName :: Method -> Name
methodName = Name
mn} =
          -- Method name namespaced by the owner.
          let mn' :: Name
mn' = Name
mn {name :: Text
name = Name -> Text
name Name
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
name Name
mn}
              qualified :: Hyperlink
qualified = Name -> API -> Text -> Hyperlink
fullyQualifiedValue Name
n API
api (Text -> Hyperlink) -> Text -> Hyperlink
forall a b. (a -> b) -> a -> b
$ Name -> Text
lowerName Name
mn'
          in [(Text -> CRef
OldFunctionRef Text
symbol, Hyperlink
qualified),
              (Name -> Text -> CRef
MethodRef Name
n (Name -> Text
name Name
mn), Hyperlink
qualified)]

-- | Refs to the signals for a given owner.
signalRefs :: Name -> API -> Maybe Text -> [Signal] -> [(CRef, Hyperlink)]
signalRefs :: Name -> API -> Maybe Text -> [Signal] -> [(CRef, Hyperlink)]
signalRefs n :: Name
n@(Name Text
_ Text
owner) API
api Maybe Text
maybeCName [Signal]
signals = (Signal -> [(CRef, Hyperlink)]) -> [Signal] -> [(CRef, Hyperlink)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Signal -> [(CRef, Hyperlink)]
signalRef [Signal]
signals
  where signalRef :: Signal -> [(CRef, Hyperlink)]
        signalRef :: Signal -> [(CRef, Hyperlink)]
signalRef (Signal {sigName :: Signal -> Text
sigName = Text
sn}) =
          let mod :: Text
mod = ModulePath -> Text
dotModulePath (Name -> API -> ModulePath
moduleLocation Name
n API
api)
              sn' :: Text
sn' = Text -> Text
signalHaskellName Text
sn
              ownerCName :: Text
ownerCName = case Maybe Text
maybeCName of
                Just Text
cname -> Text
cname
                Maybe Text
Nothing -> let Name Text
ns Text
owner = Name
n
                           in Text -> Text
ucFirst Text
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
owner
              label :: Maybe Text
label = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sn')
              link :: Hyperlink
link = Maybe Text -> Text -> Text -> Hyperlink
ModuleLinkWithAnchor Maybe Text
label Text
mod (Text
haddockSignalAnchor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sn')
          in [(Text -> Text -> CRef
OldSignalRef Text
ownerCName Text
sn, Hyperlink
link),
              (Name -> Text -> CRef
SignalRef Name
n Text
sn, Hyperlink
link)]

-- | Refs to the properties for a given owner.
propRefs :: Name -> API -> Maybe Text -> [Property] -> [(CRef, Hyperlink)]
propRefs :: Name -> API -> Maybe Text -> [Property] -> [(CRef, Hyperlink)]
propRefs n :: Name
n@(Name Text
_ Text
owner) API
api Maybe Text
maybeCName [Property]
props = (Property -> [(CRef, Hyperlink)])
-> [Property] -> [(CRef, Hyperlink)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Property -> [(CRef, Hyperlink)]
propertyRef [Property]
props
  where propertyRef :: Property -> [(CRef, Hyperlink)]
        propertyRef :: Property -> [(CRef, Hyperlink)]
propertyRef (Property {propName :: Property -> Text
propName = Text
pn}) =
          let mod :: Text
mod = ModulePath -> Text
dotModulePath (Name -> API -> ModulePath
moduleLocation Name
n API
api)
              hn :: Text
hn = Text -> Text
lcFirst (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
hyphensToCamelCase (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
pn
              ownerCName :: Text
ownerCName = case Maybe Text
maybeCName of
                Just Text
cname -> Text
cname
                Maybe Text
Nothing -> let Name Text
ns Text
owner = Name
n
                           in Text -> Text
ucFirst Text
ns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
owner
              label :: Maybe Text
label = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
owner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hn)
              link :: Hyperlink
link = Maybe Text -> Text -> Text -> Hyperlink
ModuleLinkWithAnchor Maybe Text
label Text
mod (Text
haddockAttrAnchor Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hn)
          in [(Text -> Text -> CRef
OldPropertyRef Text
ownerCName Text
pn, Hyperlink
link),
              (Name -> Text -> CRef
PropertyRef Name
n Text
pn, Hyperlink
link)]

-- | Given an optional C type and the API constructor construct the
-- list of associated refs.
maybeCType :: Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType :: Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType Name
_ API
_ Maybe Text
Nothing = []
maybeCType Name
n API
api (Just Text
ctype) = [(Text -> CRef
CTypeRef Text
ctype, Hyperlink
qualified),
                                 (Name -> CRef
TypeRef Name
n, Hyperlink
qualified)]
  where qualified :: Hyperlink
qualified = Name -> API -> Text -> Hyperlink
fullyQualifiedType Name
n API
api (Name -> Text
upperName Name
n)

-- | Extract the C name of a callback.
callbackRefs :: Name -> Callback -> [(CRef, Hyperlink)]
callbackRefs :: Name -> Callback -> [(CRef, Hyperlink)]
callbackRefs Name
n Callback
cb = Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType Name
n (Callback -> API
APICallback Callback
cb) (Callback -> Maybe Text
cbCType Callback
cb)

-- | Extract the C references in a struct.
structRefs :: Name -> Struct -> [(CRef, Hyperlink)]
structRefs :: Name -> Struct -> [(CRef, Hyperlink)]
structRefs Name
n Struct
s = Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType Name
n (Struct -> API
APIStruct Struct
s) (Struct -> Maybe Text
structCType Struct
s)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs Name
n (Struct -> API
APIStruct Struct
s) (Struct -> [Method]
structMethods Struct
s)

-- | Extract the C references in a union.
unionRefs :: Name -> Union -> [(CRef, Hyperlink)]
unionRefs :: Name -> Union -> [(CRef, Hyperlink)]
unionRefs Name
n Union
u = Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType Name
n (Union -> API
APIUnion Union
u) (Union -> Maybe Text
unionCType Union
u)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs Name
n (Union -> API
APIUnion Union
u) (Union -> [Method]
unionMethods Union
u)

-- | Extract the C references in an interface.
ifaceRefs :: Name -> Interface -> [(CRef, Hyperlink)]
ifaceRefs :: Name -> Interface -> [(CRef, Hyperlink)]
ifaceRefs Name
n Interface
i = Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType Name
n (Interface -> API
APIInterface Interface
i) (Interface -> Maybe Text
ifCType Interface
i)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs Name
n (Interface -> API
APIInterface Interface
i) (Interface -> [Method]
ifMethods Interface
i)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> Maybe Text -> [Signal] -> [(CRef, Hyperlink)]
signalRefs Name
n (Interface -> API
APIInterface Interface
i) (Interface -> Maybe Text
ifCType Interface
i) (Interface -> [Signal]
ifSignals Interface
i)

-- | Extract the C references in an object.
objectRefs :: Name -> Object -> [(CRef, Hyperlink)]
objectRefs :: Name -> Object -> [(CRef, Hyperlink)]
objectRefs Name
n Object
o = Name -> API -> Maybe Text -> [(CRef, Hyperlink)]
maybeCType Name
n (Object -> API
APIObject Object
o) (Object -> Maybe Text
objCType Object
o)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> [Method] -> [(CRef, Hyperlink)]
methodRefs Name
n (Object -> API
APIObject Object
o) (Object -> [Method]
objMethods Object
o)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> Maybe Text -> [Signal] -> [(CRef, Hyperlink)]
signalRefs Name
n (Object -> API
APIObject Object
o) (Object -> Maybe Text
objCType Object
o) (Object -> [Signal]
objSignals Object
o)
                 [(CRef, Hyperlink)] -> [(CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. Semigroup a => a -> a -> a
<> Name -> API -> Maybe Text -> [Property] -> [(CRef, Hyperlink)]
propRefs Name
n (Object -> API
APIObject Object
o) (Object -> Maybe Text
objCType Object
o) (Object -> [Property]
objProperties Object
o)