-- | 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
import Data.Maybe (catMaybes)
#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)

-- | 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
showList :: [Hyperlink] -> ShowS
$cshowList :: [Hyperlink] -> ShowS
show :: Hyperlink -> String
$cshow :: Hyperlink -> String
showsPrec :: Int -> Hyperlink -> ShowS
$cshowsPrec :: Int -> Hyperlink -> ShowS
Show, Hyperlink -> Hyperlink -> Bool
(Hyperlink -> Hyperlink -> Bool)
-> (Hyperlink -> Hyperlink -> Bool) -> Eq Hyperlink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hyperlink -> Hyperlink -> Bool
$c/= :: Hyperlink -> Hyperlink -> Bool
== :: Hyperlink -> Hyperlink -> Bool
$c== :: 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
TypeRef 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
TypeRef Text
"GError", Text -> Hyperlink
TypeIdentifier Text
"GError"),
                    (Text -> CRef
TypeRef Text
"GType", Text -> Hyperlink
TypeIdentifier Text
"GType"),
                    (Text -> CRef
TypeRef Text
"GVariant", Text -> Hyperlink
TypeIdentifier Text
"GVariant"),
                    (Text -> CRef
ConstantRef Text
"NULL", Text -> Hyperlink
ValueIdentifier Text
"P.Nothing")]

-- | Obtain the absolute location of the module where the given `API`
-- lives.
location :: Name -> API -> ModulePath
location :: Name -> API -> ModulePath
location Name
n API
api = (ModulePath
"GI" ModulePath -> Text -> ModulePath
/. Text -> Text
ucFirst (Name -> Text
namespace Name
n)) ModulePath -> ModulePath -> ModulePath
forall a. Semigroup a => a -> a -> a
<> Name -> API -> ModulePath
submoduleLocation Name
n API
api

-- | 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
location 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
location 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),
                  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),
                 (Text -> CRef
TypeRef (Constant -> Text
constantCType Constant
c),
                  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
FunctionRef (Function -> Text
fnSymbol Function
f),
                 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
TypeRef (Enumeration -> Text
enumCType Enumeration
e),
                    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) (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 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 = [Maybe (CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (CRef, Hyperlink)] -> [(CRef, Hyperlink)])
-> [Maybe (CRef, Hyperlink)] -> [(CRef, Hyperlink)]
forall a b. (a -> b) -> a -> b
$ (Method -> Maybe (CRef, Hyperlink))
-> [Method] -> [Maybe (CRef, Hyperlink)]
forall a b. (a -> b) -> [a] -> [b]
map Method -> Maybe (CRef, Hyperlink)
methodRef [Method]
methods
  where methodRef :: Method -> Maybe (CRef, Hyperlink)
        methodRef :: Method -> Maybe (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}
          in (CRef, Hyperlink) -> Maybe (CRef, Hyperlink)
forall a. a -> Maybe a
Just (Text -> CRef
FunctionRef Text
symbol,
                   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')

-- | 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 Name
n API
api Maybe Text
maybeCName [Signal]
signals = (Signal -> (CRef, Hyperlink)) -> [Signal] -> [(CRef, Hyperlink)]
forall a b. (a -> b) -> [a] -> [b]
map 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
location 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
          in (Text -> Text -> CRef
SignalRef Text
ownerCName Text
sn,
              Maybe Text -> Text -> Text -> Hyperlink
ModuleLinkWithAnchor (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
sn') Text
mod (Text
"g:signal:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sn'))

-- | 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
TypeRef Text
ctype,
                                  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)