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 forall a. [a] -> [a] -> [a]
++ [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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Char]
filePath
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
girFile' Text
name Maybe Text
Nothing [Char]
path =
[Char] -> IO Bool
doesDirectoryExist [Char]
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
[[Char]]
repositories <- forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
takeBaseName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
getDirectoryContents [Char]
path
let version :: Maybe [Char]
version = forall a. Ord a => [a] -> Maybe a
maximumMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix (Text -> [Char]
T.unpack Text
name forall a. [a] -> [a] -> [a]
++ [Char]
"-") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
repositories
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe [Char]
version of
Just [Char]
v -> forall a. a -> Maybe a
Just 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 -> forall a. Maybe a
Nothing
Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
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 = [forall a. [a] -> [a]
reverse [a]
acc]
go (a
y : [a]
ys) [a]
acc = if a
x forall a. Eq a => a -> a -> Bool
== a
y
then forall a. [a] -> [a]
reverse [a]
acc forall a. a -> [a] -> [a]
: [a] -> [a] -> [[a]]
go [a]
ys []
else [a] -> [a] -> [[a]]
go [a]
ys (a
y forall a. a -> [a] -> [a]
: [a]
acc)
girDataDirs :: IO [FilePath]
girDataDirs :: IO [[Char]]
girDataDirs = do
[[Char]]
sys <- [Char] -> IO [[Char]]
getSystemDataDirs [Char]
"gir-1.0"
let macOS :: [[Char]]
macOS = [[Char]
"/opt/homebrew/share/gir-1.0"]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
sys forall a. [a] -> [a] -> [a]
++ [[Char]]
macOS)
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" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe [Char]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just [Char]
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Eq a => a -> [a] -> [[a]]
splitOn Char
searchPathSeparator [Char]
s)
[[Char]]
ps -> forall (m :: * -> *) a. Monad m => a -> m a
return [[Char]]
ps
[[Char]]
dataDirs <- IO [[Char]]
girDataDirs
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
paths forall a. [a] -> [a] -> [a]
++ [[Char]]
dataDirs)
girFile :: Text -> Maybe Text -> [FilePath] -> IO (Maybe FilePath)
girFile :: Text -> Maybe Text -> [[Char]] -> IO (Maybe [Char])
girFile Text
name Maybe Text
version [[Char]]
searchPath =
forall {a}. [Maybe a] -> Maybe a
firstJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Maybe Text -> [Char] -> IO (Maybe [Char])
girFile' Text
name Maybe Text
version) [[Char]]
searchPath)
where firstJust :: [Maybe a] -> Maybe a
firstJust = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
readGiRepository :: Bool
-> Text
-> Maybe Text
-> [FilePath]
-> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just [Char]
path -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Loading GI repository: " forall a. [a] -> [a] -> [a]
++ [Char]
path
ParseSettings -> [Char] -> IO Document
XML.readFile forall a. Default a => a
XML.def [Char]
path
Maybe [Char]
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Did not find a GI repository for "
forall a. [a] -> [a] -> [a]
++ (Text -> [Char]
T.unpack Text
name)
forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char]
"-" forall a. [a] -> [a] -> [a]
++) (Text -> [Char]
T.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
version)
forall a. [a] -> [a] -> [a]
++ [Char]
" in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
searchPath forall a. [a] -> [a] -> [a]
++ [Char]
"."