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 :: String -> String -> String -> String
girFilePath name :: String
name version :: String
version path :: String
path = String
path String -> String -> String
</> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version String -> String -> String
<.> "gir"

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

            Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ case Maybe String
version of
                Just v :: String
v  -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
girFilePath (Text -> String
T.unpack Text
name) String
v String
path
                Nothing -> Maybe String
forall a. Maybe a
Nothing

        False -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing

-- | Split a list into sublists delimited by the given element.
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn :: a -> [a] -> [[a]]
splitOn x :: a
x xs :: [a]
xs = [a] -> [a] -> [[a]]
go [a]
xs []
    where go :: [a] -> [a] -> [[a]]
go [] acc :: [a]
acc = [[a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc]
          go (y :: a
y : ys :: [a]
ys) acc :: [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)

girDataDirs :: IO [FilePath]
girDataDirs :: IO [String]
girDataDirs = String -> IO [String]
getSystemDataDirs "gir-1.0"

-- | 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 :: [String] -> IO [String]
buildSearchPath extraPaths :: [String]
extraPaths = do
  [String]
paths <- case [String]
extraPaths of
             [] -> String -> IO (Maybe String)
lookupEnv "HASKELL_GI_GIR_SEARCH_PATH" IO (Maybe String) -> (Maybe String -> IO [String]) -> IO [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
               Nothing -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
               Just s :: String
s -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> String -> [String]
forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
searchPathSeparator String
s)
             ps :: [String]
ps -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
ps
  [String]
dataDirs <- IO [String]
girDataDirs
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
paths [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
dataDirs)

-- | Search for an appropriate @.gir@ file in the search path.
girFile :: Text -> Maybe Text -> [FilePath] -> IO (Maybe FilePath)
girFile :: Text -> Maybe Text -> [String] -> IO (Maybe String)
girFile name :: Text
name version :: Maybe Text
version searchPath :: [String]
searchPath =
  [Maybe String] -> Maybe String
forall a. [Maybe a] -> Maybe a
firstJust ([Maybe String] -> Maybe String)
-> IO [Maybe String] -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Maybe Text -> String -> IO (Maybe String)
girFile' Text
name Maybe Text
version) [String]
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 -> [String] -> IO Document
readGiRepository verbose :: Bool
verbose name :: Text
name version :: Maybe Text
version extraPaths :: [String]
extraPaths = do
  [String]
searchPath <- [String] -> IO [String]
buildSearchPath [String]
extraPaths
  Text -> Maybe Text -> [String] -> IO (Maybe String)
girFile Text
name Maybe Text
version [String]
searchPath IO (Maybe String) -> (Maybe String -> IO Document) -> IO Document
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just path :: String
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
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Loading GI repository: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path
            ParseSettings -> String -> IO Document
XML.readFile ParseSettings
forall a. Default a => a
XML.def String
path
        Nothing -> String -> IO Document
forall a. HasCallStack => String -> a
error (String -> IO Document) -> String -> IO Document
forall a b. (a -> b) -> a -> b
$ "Did not find a GI repository for "
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack Text
name)
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ("-" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
version)
                   String -> String -> String
forall a. [a] -> [a] -> [a]
++ " in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
searchPath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "."