    module Data.GI.GIR.Repository (readGiRepository) where

    import Prelude hiding (readFile)

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

    import Control.Monad (when)
    import Data.Maybe
    import qualified Data.List as List
    import qualified Data.Text as T
    import Data.Text (Text)
    import Safe (maximumMay)
    import qualified Text.XML as XML

    import System.Directory
    import System.Environment (lookupEnv)
    import System.Environment.XDG.BaseDir (getSystemDataDirs)
    import System.FilePath (searchPathSeparator, takeBaseName, (</>), (<.>))

    girFilePath :: String -> String -> FilePath -> FilePath
    girFilePath :: [Char] -> [Char] -> [Char] -> [Char]
    girFilePath [Char]
    name [Char]
    version [Char]
    path = [Char]
    path [Char] -> [Char] -> [Char]
    </> [Char]
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    version [Char] -> [Char] -> [Char]
    <.> [Char]
    "gir"

    girFile' :: Text -> Maybe Text -> FilePath -> IO (Maybe FilePath)
    girFile' :: Text -> Maybe Text -> [Char] -> IO (Maybe [Char])
    girFile' Text
    name (Just Text
    version) [Char]
    path =
        let filePath :: [Char]
    filePath = [Char] -> [Char] -> [Char] -> [Char]
    girFilePath (Text -> [Char]
    T.unpack Text
    name) (Text -> [Char]
    T.unpack Text
    version) [Char]
    path
        in  [Char] -> IO Bool
    doesFileExist [Char]
    filePath IO Bool -> (Bool -> IO (Maybe [Char])) -> IO (Maybe [Char])
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Bool
    True  -> Maybe [Char] -> IO (Maybe [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Char] -> IO (Maybe [Char]))
    -> Maybe [Char] -> IO (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    filePath
            Bool
    False -> Maybe [Char] -> IO (Maybe [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    forall a. Maybe a
    Nothing
    girFile' Text
    name Maybe Text
    Nothing [Char]
    path =
        [Char] -> IO Bool
    doesDirectoryExist [Char]
    path IO Bool -> (Bool -> IO (Maybe [Char])) -> IO (Maybe [Char])
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Bool
    True -> do
                repositories <- ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    takeBaseName ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO [[Char]]
    getDirectoryContents [Char]
    path
                let version = [[Char]] -> Maybe [Char]
    forall a. Ord a => [a] -> Maybe a
    maximumMay ([[Char]] -> Maybe [Char])
    -> ([Maybe [Char]] -> [[Char]]) -> [Maybe [Char]] -> Maybe [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe [Char]] -> [[Char]]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe [Char]] -> Maybe [Char]) -> [Maybe [Char]] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $
                        [Char] -> [Char] -> Maybe [Char]
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    List.stripPrefix (Text -> [Char]
    T.unpack Text
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "-") ([Char] -> Maybe [Char]) -> [[Char]] -> [Maybe [Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[Char]]
    repositories

                return $ case version of
                    Just [Char]
    v  -> [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [Char] -> [Char]
    girFilePath (Text -> [Char]
    T.unpack Text
    name) [Char]
    v [Char]
    path
                    Maybe [Char]
    Nothing -> Maybe [Char]
    forall a. Maybe a
    Nothing

            Bool
    False -> Maybe [Char] -> IO (Maybe [Char])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    forall a. Maybe a
    Nothing

    -- | Split a list into sublists delimited by the given element.
    splitOn :: Eq a => a -> [a] -> [[a]]
    splitOn :: forall a. Eq a => a -> [a] -> [[a]]
    splitOn a
    x [a]
    xs = [a] -> [a] -> [[a]]
    go [a]
    xs []
        where go :: [a] -> [a] -> [[a]]
    go [] [a]
    acc = [[a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    acc]
              go (a
    y : [a]
    ys) [a]
    acc = if a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    y
                                then [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    acc [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [a] -> [[a]]
    go [a]
    ys []
                                else [a] -> [a] -> [[a]]
    go [a]
    ys (a
    y a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    acc)

    -- | Return the paths where to look for gir files.
    girDataDirs :: IO [FilePath]
    girDataDirs :: IO [[Char]]
    girDataDirs = do
      sys <- [Char] -> IO [[Char]]
    getSystemDataDirs [Char]
    "gir-1.0"
      -- See https://github.com/haskell-gi/haskell-gi/issues/390
      let macOS = [[Char]
    "/opt/homebrew/share/gir-1.0"]
      return (sys ++ macOS)

    -- | Construct the GIR search path, possibly looking into the
    -- @HASKELL_GI_GIR_SEARCH_PATH@ environment variable if no explicit
    -- list of extra paths is given. In either case
    -- the system data dirs are also searched if nothing can be found in
    -- the explicitly passed paths, or in the contents of
    -- @HASKELL_GI_GIR_SEARCH_PATH@.
    buildSearchPath :: [FilePath] -> IO [FilePath]
    buildSearchPath :: [[Char]] -> IO [[Char]]
    buildSearchPath [[Char]]
    extraPaths = do
      paths <- case [[Char]]
    extraPaths of
                 [] -> [Char] -> IO (Maybe [Char])
    lookupEnv [Char]
    "HASKELL_GI_GIR_SEARCH_PATH" IO (Maybe [Char]) -> (Maybe [Char] -> IO [[Char]]) -> IO [[Char]]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                   Maybe [Char]
    Nothing -> [[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                   Just [Char]
    s -> [[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Char -> [Char] -> [[Char]]
    forall a. Eq a => a -> [a] -> [[a]]
    splitOn Char
    searchPathSeparator [Char]
    s)
                 [[Char]]
    ps -> [[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Char]]
    ps
      dataDirs <- girDataDirs
      return (paths ++ dataDirs)

    -- | Search for an appropriate @.gir@ file in the search path.
    girFile :: Text -> Maybe Text -> [FilePath] -> IO (Maybe FilePath)
    girFile :: Text -> Maybe Text -> [[Char]] -> IO (Maybe [Char])
    girFile Text
    name Maybe Text
    version [[Char]]
    searchPath =
      [Maybe [Char]] -> Maybe [Char]
    forall {a}. [Maybe a] -> Maybe a
    firstJust ([Maybe [Char]] -> Maybe [Char])
    -> IO [Maybe [Char]] -> IO (Maybe [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO [Maybe [Char]]
    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 (Text -> Maybe Text -> [Char] -> IO (Maybe [Char])
    girFile' Text
    name Maybe Text
    version) [[Char]]
    searchPath)
        where firstJust :: [Maybe a] -> Maybe a
    firstJust = [a] -> Maybe a
    forall a. [a] -> Maybe a
    listToMaybe ([a] -> Maybe a) -> ([Maybe a] -> [a]) -> [Maybe a] -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes

    -- | Try to load the `.gir` file corresponding to the given repository
    readGiRepository :: Bool        -- ^ verbose
                     -> Text        -- ^ name
                     -> Maybe Text  -- ^ version
                     -> [FilePath]  -- ^ searchPath
                     -> IO XML.Document
    readGiRepository :: Bool -> Text -> Maybe Text -> [[Char]] -> IO Document
    readGiRepository Bool
    verbose Text
    name Maybe Text
    version [[Char]]
    extraPaths = do
      searchPath <- [[Char]] -> IO [[Char]]
    buildSearchPath [[Char]]
    extraPaths
      girFile name version searchPath >>= \case
            Just [Char]
    path -> do
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    verbose (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Loading GI repository: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    path
                ParseSettings -> [Char] -> IO Document
    XML.readFile ParseSettings
    forall a. Default a => a
    XML.def [Char]
    path
            Maybe [Char]
    Nothing -> [Char] -> IO Document
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO Document) -> [Char] -> IO Document
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Did not find a GI repository for "
                       [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Text -> [Char]
    T.unpack Text
    name)
                       [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [Char]
    "" ([Char]
    "-" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++) (Text -> [Char]
    T.unpack (Text -> [Char]) -> Maybe Text -> Maybe [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe Text
    version)
                       [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " in " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show [[Char]]
    searchPath [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "."