    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies, DataKinds #-}
    -- | A minimal wrapper for libgirepository.
    module Data.GI.CodeGen.LibGIRepository
        ( girRequire
        , Typelib
        , setupTypelibSearchPath
        , FieldInfo(..)
        , girStructFieldInfo
        , girUnionFieldInfo
        , girLoadGType
        , girIsSymbolResolvable
        ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    #endif
    #if !MIN_VERSION_base(4,13,0)
    import Data.Monoid ((<>))
    #endif

    import Control.Monad (forM, (>=>))
    import qualified Data.Map as M
    import Data.Maybe (isJust)
    import Data.Text (Text)
    import qualified Data.Text as T

    import Foreign.C.Types (CInt(..), CSize(..))
    import Foreign.C.String (CString, withCString)
    import Foreign (nullPtr, Ptr, FunPtr, peek)

    import System.Environment (lookupEnv)
    import System.FilePath (searchPathSeparator)

    import Data.GI.Base.BasicConversions (withTextCString, cstringToText)
    import Data.GI.Base.BasicTypes (TypedObject(..), GBoxed,
                                    GType(..), CGType, ManagedPtr)
    import Data.GI.Base.GError (GError, checkGError)
    import Data.GI.Base.ManagedPtr (wrapBoxed, withManagedPtr)
    import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
    import Data.GI.Base.Utils (allocMem, freeMem)
    import Data.GI.CodeGen.Util (splitOn)

    -- | Wrapper for 'GIBaseInfo'
    newtype BaseInfo = BaseInfo (ManagedPtr BaseInfo)

    -- | Wrapper for 'GITypelib', remembering the originating namespace
    -- and version.
    data Typelib = Typelib { Typelib -> Text
    typelibNamespace       :: Text
                           , Typelib -> Text
    typelibVersion         :: Text
                           , Typelib -> Ptr Typelib
    _typelibPtr            :: Ptr Typelib
                           }

    instance Show Typelib where
      show :: Typelib -> [Char]
    show Typelib
    t = Text -> [Char]
    T.unpack (Typelib -> Text
    typelibNamespace Typelib
    t) [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack (Typelib -> Text
    typelibVersion Typelib
    t)

    -- | Extra info about a field in a struct or union which is not easily
    -- determined from the GIR file. (And which we determine by using
    -- libgirepository.)
    data FieldInfo = FieldInfo {
          FieldInfo -> Int
    fieldInfoOffset    :: Int
        }

    -- | The (empty) set of parent types for `BaseInfo` visible to the
    -- Haskell type system.
    instance HasParentTypes BaseInfo
    type instance ParentTypes BaseInfo = '[]

    foreign import ccall "g_base_info_gtype_get_type" c_g_base_info_gtype_get_type :: IO GType

    instance TypedObject BaseInfo where
      glibType :: IO GType
    glibType = IO GType
    c_g_base_info_gtype_get_type

    -- | `BaseInfo`s are registered as boxed in the GLib type system.
    instance GBoxed BaseInfo

    foreign import ccall "g_irepository_prepend_search_path" g_irepository_prepend_search_path :: CString -> IO ()

    -- | Add the given directory to the typelib search path, this is a
    -- thin wrapper over `g_irepository_prepend_search_path`.
    girPrependSearchPath :: FilePath -> IO ()
    girPrependSearchPath :: [Char] -> IO ()
    girPrependSearchPath [Char]
    fp = [Char] -> (CString -> IO ()) -> IO ()
    forall a. [Char] -> (CString -> IO a) -> IO a
    withCString [Char]
    fp CString -> IO ()
    g_irepository_prepend_search_path

    foreign import ccall "g_irepository_require" g_irepository_require ::
        Ptr () -> CString -> CString -> CInt -> Ptr (Ptr GError)
        -> IO (Ptr Typelib)

    -- | A convenience function for setting up the typelib search path
    -- from the environment. Note that for efficiency reasons this should
    -- only be called once per program run. If the list of paths passed in
    -- is empty, the environment variable @HASKELL_GI_TYPELIB_SEARCH_PATH@
    -- will be checked. In either case the system directories will be
    -- searched after the passed in directories.
    setupTypelibSearchPath :: [FilePath] -> IO ()
    setupTypelibSearchPath :: [[Char]] -> IO ()
    setupTypelibSearchPath [] = do
      env <- [Char] -> IO (Maybe [Char])
    lookupEnv [Char]
    "HASKELL_GI_TYPELIB_SEARCH_PATH"
      case env of
        Maybe [Char]
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just [Char]
    paths -> ([Char] -> IO ()) -> [[Char]] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ [Char] -> IO ()
    girPrependSearchPath (Char -> [Char] -> [[Char]]
    forall a. Eq a => a -> [a] -> [[a]]
    splitOn Char
    searchPathSeparator [Char]
    paths)
    setupTypelibSearchPath [[Char]]
    paths = ([Char] -> IO ()) -> [[Char]] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ [Char] -> IO ()
    girPrependSearchPath [[Char]]
    paths

    -- | Ensure that the given version of the namespace is loaded. If that
    -- is not possible we error out.
    girRequire :: Text -> Text -> IO Typelib
    girRequire :: Text -> Text -> IO Typelib
    girRequire Text
    ns Text
    version =
        Text -> (CString -> IO Typelib) -> IO Typelib
    forall a. Text -> (CString -> IO a) -> IO a
    withTextCString Text
    ns ((CString -> IO Typelib) -> IO Typelib)
    -> (CString -> IO Typelib) -> IO Typelib
    forall a b. (a -> b) -> a -> b
    $ \CString
    cns ->
        Text -> (CString -> IO Typelib) -> IO Typelib
    forall a. Text -> (CString -> IO a) -> IO a
    withTextCString Text
    version ((CString -> IO Typelib) -> IO Typelib)
    -> (CString -> IO Typelib) -> IO Typelib
    forall a b. (a -> b) -> a -> b
    $ \CString
    cversion -> do
            typelib <- (Ptr (Ptr GError) -> IO (Ptr Typelib))
    -> (GError -> IO (Ptr Typelib)) -> IO (Ptr Typelib)
    forall a. (Ptr (Ptr GError) -> IO a) -> (GError -> IO a) -> IO a
    checkGError (Ptr ()
    -> CString
    -> CString
    -> CInt
    -> Ptr (Ptr GError)
    -> IO (Ptr Typelib)
    g_irepository_require Ptr ()
    forall a. Ptr a
    nullPtr CString
    cns CString
    cversion CInt
    0)
                                   (\GError
    gerror -> [Char] -> IO (Ptr Typelib)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO (Ptr Typelib)) -> [Char] -> IO (Ptr Typelib)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Could not load typelib for "
                                               [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    ns [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " version "
                                               [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    version [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ".\n"
                                               [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "Error was: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ GError -> [Char]
    forall a. Show a => a -> [Char]
    show GError
    gerror)
            return (Typelib ns version typelib)

    foreign import ccall "g_irepository_find_by_name" g_irepository_find_by_name ::
        Ptr () -> CString -> CString -> IO (Ptr BaseInfo)

    -- | Find a given baseinfo by name, or give an error if it cannot be
    -- found.
    girFindByName :: Text -> Text -> IO BaseInfo
    girFindByName :: Text -> Text -> IO BaseInfo
    girFindByName Text
    ns Text
    name =
        Text -> (CString -> IO BaseInfo) -> IO BaseInfo
    forall a. Text -> (CString -> IO a) -> IO a
    withTextCString Text
    ns ((CString -> IO BaseInfo) -> IO BaseInfo)
    -> (CString -> IO BaseInfo) -> IO BaseInfo
    forall a b. (a -> b) -> a -> b
    $ \CString
    cns ->
        Text -> (CString -> IO BaseInfo) -> IO BaseInfo
    forall a. Text -> (CString -> IO a) -> IO a
    withTextCString Text
    name ((CString -> IO BaseInfo) -> IO BaseInfo)
    -> (CString -> IO BaseInfo) -> IO BaseInfo
    forall a b. (a -> b) -> a -> b
    $ \CString
    cname -> do
          ptr <- Ptr () -> CString -> CString -> IO (Ptr BaseInfo)
    g_irepository_find_by_name Ptr ()
    forall a. Ptr a
    nullPtr CString
    cns CString
    cname
          if ptr == nullPtr
          then error ("Could not find " ++ T.unpack ns ++ "::" ++ T.unpack name)
          else wrapBoxed BaseInfo ptr

    foreign import ccall "g_field_info_get_offset" g_field_info_get_offset ::
        Ptr BaseInfo -> IO CInt
    foreign import ccall "g_base_info_get_name" g_base_info_get_name ::
        Ptr BaseInfo -> IO CString

    -- | Get the extra information for the given field.
    getFieldInfo :: BaseInfo -> IO (Text, FieldInfo)
    getFieldInfo :: BaseInfo -> IO (Text, FieldInfo)
    getFieldInfo BaseInfo
    field = BaseInfo
    -> (Ptr BaseInfo -> IO (Text, FieldInfo)) -> IO (Text, FieldInfo)
    forall a c.
    (HasCallStack, ManagedPtrNewtype a) =>
    a -> (Ptr a -> IO c) -> IO c
    withManagedPtr BaseInfo
    field ((Ptr BaseInfo -> IO (Text, FieldInfo)) -> IO (Text, FieldInfo))
    -> (Ptr BaseInfo -> IO (Text, FieldInfo)) -> IO (Text, FieldInfo)
    forall a b. (a -> b) -> a -> b
    $ \Ptr BaseInfo
    fi -> do
         fname <- (Ptr BaseInfo -> IO CString
    g_base_info_get_name Ptr BaseInfo
    fi IO CString -> (CString -> IO Text) -> IO Text
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= HasCallStack => CString -> IO Text
    CString -> IO Text
    cstringToText)
         fOffset <- g_field_info_get_offset fi
         return (fname, FieldInfo { fieldInfoOffset = fromIntegral fOffset })

    foreign import ccall "g_struct_info_get_size" g_struct_info_get_size ::
        Ptr BaseInfo -> IO CSize
    foreign import ccall "g_struct_info_get_n_fields" g_struct_info_get_n_fields ::
        Ptr BaseInfo -> IO CInt
    foreign import ccall "g_struct_info_get_field" g_struct_info_get_field ::
        Ptr BaseInfo -> CInt -> IO (Ptr BaseInfo)

    -- | Find out the size of a struct, and the map from field names to
    -- offsets inside the struct.
    girStructFieldInfo :: Text -> Text -> IO (Int, M.Map Text FieldInfo)
    girStructFieldInfo :: Text -> Text -> IO (Int, Map Text FieldInfo)
    girStructFieldInfo Text
    ns Text
    name = do
      baseinfo <- Text -> Text -> IO BaseInfo
    girFindByName Text
    ns Text
    name
      withManagedPtr baseinfo $ \Ptr BaseInfo
    si -> do
         size <- Ptr BaseInfo -> IO CSize
    g_struct_info_get_size Ptr BaseInfo
    si
         nfields <- g_struct_info_get_n_fields si
         fieldInfos <- forM [0..(nfields-1)]
               (g_struct_info_get_field si >=> wrapBoxed BaseInfo >=> getFieldInfo)
         return (fromIntegral size, M.fromList fieldInfos)

    foreign import ccall "g_union_info_get_size" g_union_info_get_size ::
        Ptr BaseInfo -> IO CSize
    foreign import ccall "g_union_info_get_n_fields" g_union_info_get_n_fields ::
        Ptr BaseInfo -> IO CInt
    foreign import ccall "g_union_info_get_field" g_union_info_get_field ::
        Ptr BaseInfo -> CInt -> IO (Ptr BaseInfo)

    -- | Find out the size of a union, and the map from field names to
    -- offsets inside the union.
    girUnionFieldInfo :: Text -> Text -> IO (Int, M.Map Text FieldInfo)
    girUnionFieldInfo :: Text -> Text -> IO (Int, Map Text FieldInfo)
    girUnionFieldInfo Text
    ns Text
    name = do
      baseinfo <- Text -> Text -> IO BaseInfo
    girFindByName Text
    ns Text
    name
      withManagedPtr baseinfo $ \Ptr BaseInfo
    ui -> do
         size <- Ptr BaseInfo -> IO CSize
    g_union_info_get_size Ptr BaseInfo
    ui
         nfields <- g_union_info_get_n_fields ui
         fieldInfos <- forM [0..(nfields-1)] (
               g_union_info_get_field ui >=> wrapBoxed BaseInfo >=> getFieldInfo)
         return (fromIntegral size, M.fromList fieldInfos)

    foreign import ccall "g_typelib_symbol" g_typelib_symbol ::
        Ptr Typelib -> CString -> Ptr (FunPtr a) -> IO CInt

    -- | Try to load a symbol from the dynamic library associated to the
    -- given typelib.
    girLookupSymbol :: forall a. Typelib -> Text -> IO (Maybe (FunPtr a))
    girLookupSymbol :: forall a. Typelib -> Text -> IO (Maybe (FunPtr a))
    girLookupSymbol (Typelib Text
    _ Text
    _ Ptr Typelib
    typelib) Text
    symbol = do
      funPtrPtr <- IO (Ptr (FunPtr a))
    forall a. Storable a => IO (Ptr a)
    allocMem :: IO (Ptr (FunPtr a))
      result <- withTextCString symbol $ \CString
    csymbol ->
                          Ptr Typelib -> CString -> Ptr (FunPtr a) -> IO CInt
    forall a. Ptr Typelib -> CString -> Ptr (FunPtr a) -> IO CInt
    g_typelib_symbol Ptr Typelib
    typelib CString
    csymbol Ptr (FunPtr a)
    funPtrPtr
      funPtr <- peek funPtrPtr
      freeMem funPtrPtr
      if result /= 1
        then return Nothing
        else return (Just funPtr)

    -- | Load a symbol from the dynamic library associated to the given
    -- typelib. If the symbol does not exist this will raise an error.
    girSymbol :: Typelib -> Text -> IO (FunPtr a)
    girSymbol :: forall a. Typelib -> Text -> IO (FunPtr a)
    girSymbol typelib :: Typelib
    typelib@(Typelib Text
    ns Text
    version Ptr Typelib
    _) Text
    symbol = do
      maybeSymbol <- Typelib -> Text -> IO (Maybe (FunPtr a))
    forall a. Typelib -> Text -> IO (Maybe (FunPtr a))
    girLookupSymbol Typelib
    typelib Text
    symbol
      case maybeSymbol of
        Just FunPtr a
    funPtr -> FunPtr a -> IO (FunPtr a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FunPtr a
    funPtr
        Maybe (FunPtr a)
    Nothing -> [Char] -> IO (FunPtr a)
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Could not resolve symbol " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    symbol [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " in namespace "
                  [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show (Text
    ns Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    version))

    type GTypeInit = IO CGType
    foreign import ccall "dynamic" gtypeInit :: FunPtr GTypeInit -> GTypeInit

    -- | Load a GType given the `Typelib` where it lives and the type init
    -- function.
    girLoadGType :: Typelib -> Text -> IO GType
    girLoadGType :: Typelib -> Text -> IO GType
    girLoadGType Typelib
    typelib Text
    typeInit =
      CGType -> GType
    GType (CGType -> GType) -> IO CGType -> IO GType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Typelib -> Text -> IO (FunPtr (IO CGType))
    forall a. Typelib -> Text -> IO (FunPtr a)
    girSymbol Typelib
    typelib Text
    typeInit IO (FunPtr (IO CGType))
    -> (FunPtr (IO CGType) -> IO CGType) -> IO CGType
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FunPtr (IO CGType) -> IO CGType
    gtypeInit)

    -- | Check whether a symbol is present in the dynamical liberary.
    girIsSymbolResolvable :: Typelib -> Text -> IO Bool
    girIsSymbolResolvable :: Typelib -> Text -> IO Bool
    girIsSymbolResolvable Typelib
    typelib Text
    symbol = do
      maybeSymbol <- Typelib -> Text -> IO (Maybe (FunPtr (ZonkAny 0)))
    forall a. Typelib -> Text -> IO (Maybe (FunPtr a))
    girLookupSymbol Typelib
    typelib Text
    symbol
      return (isJust maybeSymbol)