-- | 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 (dotModulePath)
import Data.GI.CodeGen.SymbolNaming (moduleLocation, lowerName, upperName,
                                     signalHaskellName, haddockSignalAnchor)
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 apis :: [(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 (n :: Name
n, APIConst c :: Constant
c) = Name -> Constant -> [(CRef, Hyperlink)]
constRefs Name
n Constant
c
        extractRefs (n :: Name
n, APIFunction f :: Function
f) = Name -> Function -> [(CRef, Hyperlink)]
funcRefs Name
n Function
f
        extractRefs (n :: Name
n, api :: API
api@(APIEnum e :: Enumeration
e)) = API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs API
api Name
n Enumeration
e
        extractRefs (n :: Name
n, api :: API
api@(APIFlags (Flags e :: Enumeration
e))) = API -> Name -> Enumeration -> [(CRef, Hyperlink)]
enumRefs API
api Name
n Enumeration
e
        extractRefs (n :: Name
n, APICallback c :: Callback
c) = Name -> Callback -> [(CRef, Hyperlink)]
callbackRefs Name
n Callback
c
        extractRefs (n :: Name
n, APIStruct s :: Struct
s) = Name -> Struct -> [(CRef, Hyperlink)]
structRefs Name
n Struct
s
        extractRefs (n :: Name
n, APIUnion u :: Union
u) = Name -> Union -> [(CRef, Hyperlink)]
unionRefs Name
n Union
u
        extractRefs (n :: Name
n, APIInterface i :: Interface
i) = Name -> Interface -> [(CRef, Hyperlink)]
ifaceRefs Name
n Interface
i
        extractRefs (n :: Name
n, APIObject o :: Object
o) = Name -> Object -> [(CRef, Hyperlink)]
objectRefs Name
n Object
o

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

-- | Obtain the fully qualified symbol pointing to a value.
fullyQualifiedValue :: Name -> API -> Text -> Hyperlink
fullyQualifiedValue :: Name -> API -> Text -> Hyperlink
fullyQualifiedValue n :: Name
n api :: API
api symbol :: 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
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 n :: Name
n api :: API
api symbol :: 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
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 n :: Name
n c :: 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 n :: Name
n f :: 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
api n :: Name
n e :: 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 em :: 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
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 n :: Name
n api :: API
api methods :: [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
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 n :: Name
n api :: API
api maybeCName :: Maybe Text
maybeCName signals :: [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
moduleLocation Name
n API
api)
              sn' :: Text
sn' = Text -> Text
signalHaskellName Text
sn
              ownerCName :: Text
ownerCName = case Maybe Text
maybeCName of
                Just cname :: Text
cname -> Text
cname
                Nothing -> let Name ns :: Text
ns owner :: 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
haddockSignalAnchor 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 _ _ Nothing = []
maybeCType n :: Name
n api :: API
api (Just ctype :: 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 n :: Name
n cb :: 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 n :: Name
n s :: 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 n :: Name
n u :: 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 n :: Name
n i :: 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 n :: Name
n o :: 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)