-- | 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(..))
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 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 absolute location of the module where the given `API`
-- lives.
location :: Name -> API -> ModulePath
location :: Name -> API -> ModulePath
location n :: Name
n api :: API
api = ("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 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
location 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
location 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 = (Method -> (CRef, Hyperlink)) -> [Method] -> [(CRef, Hyperlink)]
forall a b. (a -> b) -> [a] -> [b]
map Method -> (CRef, Hyperlink)
methodRef [Method]
methods
  where methodRef :: Method -> (CRef, Hyperlink)
        methodRef :: Method -> (CRef, Hyperlink)
methodRef m :: Method
m@(Method {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 (Text -> CRef
FunctionRef (Method -> Text
methodSymbol Method
m),
              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
location 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 ("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 _ _ 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)