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
            [[Char]]
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 :: Maybe [Char]
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

            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
$ case Maybe [Char]
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
  [[Char]]
sys <- [Char] -> IO [[Char]]
getSystemDataDirs [Char]
"gir-1.0"
  -- See https://github.com/haskell-gi/haskell-gi/issues/390
  let macOS :: [[Char]]
macOS = [[Char]
"/opt/homebrew/share/gir-1.0"]
  [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
sys [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
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
  [[Char]]
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
  [[Char]]
dataDirs <- IO [[Char]]
girDataDirs
  [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
paths [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
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
  [[Char]]
searchPath <- [[Char]] -> IO [[Char]]
buildSearchPath [[Char]]
extraPaths
  Text -> Maybe Text -> [[Char]] -> IO (Maybe [Char])
girFile Text
name Maybe Text
version [[Char]]
searchPath IO (Maybe [Char]) -> (Maybe [Char] -> IO Document) -> IO Document
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \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]
"."