module Data.GI.CodeGen.OverloadedSignals
    ( genObjectSignals
    , genInterfaceSignals
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (when)

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import qualified Data.Text as T

import Data.GI.CodeGen.API
import Data.GI.CodeGen.Code
import Data.GI.CodeGen.Inheritance (fullObjectSignalList, fullInterfaceSignalList)
import Data.GI.CodeGen.GObject (apiIsGObject)
import Data.GI.CodeGen.SymbolNaming (upperName, hyphensToCamelCase,
                                     signalInfoName)
import Data.GI.CodeGen.Util (lcFirst)

-- | Signal instances for (GObject-derived) objects.
genObjectSignals :: Name -> Object -> CodeGen e ()
genObjectSignals :: forall e. Name -> Object -> CodeGen e ()
genObjectSignals Name
n Object
o = do
  let name :: Text
name = Name -> Text
upperName Name
n
  isGO <- Name -> API -> CodeGen e Bool
forall e. Name -> API -> CodeGen e Bool
apiIsGObject Name
n (Object -> API
APIObject Object
o)
  when isGO $ do
       infos <- fullObjectSignalList n o >>=
                mapM (\(Name
owner, Signal
signal) -> do
                      si <- Name
-> Signal
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall e. Name -> Signal -> CodeGen e Text
signalInfoName Name
owner Signal
signal
                      return $ "'(\"" <> (lcFirst . hyphensToCamelCase . sigName) signal
                                 <> "\", " <> si <> ")")
       group $ do
         let signalListType = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"SignalList"
         line $ "type instance O.SignalList " <> name <> " = " <> signalListType
         line $ "type " <> signalListType <> " = ('[ "
                  <> T.intercalate ", " infos <> "] :: [(Symbol, DK.Type)])"

-- | Signal instances for interfaces.
genInterfaceSignals :: Name -> Interface -> CodeGen e ()
genInterfaceSignals :: forall e. Name -> Interface -> CodeGen e ()
genInterfaceSignals Name
n Interface
iface = do
  let name :: Text
name = Name -> Text
upperName Name
n
  infos <- Name -> Interface -> CodeGen e [(Name, Signal)]
forall e. Name -> Interface -> CodeGen e [(Name, Signal)]
fullInterfaceSignalList Name
n Interface
iface CodeGen e [(Name, Signal)]
-> ([(Name, Signal)]
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text])
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text]
forall a b.
ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) a
-> (a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b)
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           ((Name, Signal)
 -> ReaderT
      CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text)
-> [(Name, Signal)]
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Name
owner, Signal
signal) -> do
                   si <- Name
-> Signal
-> ReaderT
     CodeGenConfig (StateT (CGState, ModuleInfo) (Except e)) Text
forall e. Name -> Signal -> CodeGen e Text
signalInfoName Name
owner Signal
signal
                   return $ "'(\"" <> (lcFirst . hyphensToCamelCase . sigName) signal
                              <> "\", " <> si <> ")")
  group $ do
    let signalListType = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"SignalList"
    line $ "type instance O.SignalList " <> name <> " = " <> signalListType
    line $ "type " <> signalListType <> " = ('[ "
             <> T.intercalate ", " infos <> "] :: [(Symbol, DK.Type)])"