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 name version path = path </> name ++ "-" ++ version <.> "gir"
girFile' :: Text -> Maybe Text -> FilePath -> IO (Maybe FilePath)
girFile' name (Just version) path =
let filePath = girFilePath (T.unpack name) (T.unpack version) path
in doesFileExist filePath >>= \case
True -> return $ Just filePath
False -> return Nothing
girFile' name Nothing path =
doesDirectoryExist path >>= \case
True -> do
repositories <- map takeBaseName <$> getDirectoryContents path
let version = maximumMay . catMaybes $
List.stripPrefix (T.unpack name ++ "-") <$> repositories
return $ case version of
Just v -> Just $ girFilePath (T.unpack name) v path
Nothing -> Nothing
False -> return Nothing
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn x xs = go xs []
where go [] acc = [reverse acc]
go (y : ys) acc = if x == y
then reverse acc : go ys []
else go ys (y : acc)
girDataDirs :: IO [FilePath]
girDataDirs = getSystemDataDirs "gir-1.0"
buildSearchPath :: [FilePath] -> IO [FilePath]
buildSearchPath extraPaths = do
paths <- case extraPaths of
[] -> lookupEnv "HASKELL_GI_GIR_SEARCH_PATH" >>= \case
Nothing -> return []
Just s -> return (splitOn searchPathSeparator s)
ps -> return ps
dataDirs <- girDataDirs
return (paths ++ dataDirs)
girFile :: Text -> Maybe Text -> [FilePath] -> IO (Maybe FilePath)
girFile name version searchPath =
firstJust <$> (mapM (girFile' name version) searchPath)
where firstJust = listToMaybe . catMaybes
readGiRepository :: Bool
-> Text
-> Maybe Text
-> [FilePath]
-> IO XML.Document
readGiRepository verbose name version extraPaths = do
searchPath <- buildSearchPath extraPaths
girFile name version searchPath >>= \case
Just path -> do
when verbose $ putStrLn $ "Loading GI repository: " ++ path
XML.readFile XML.def path
Nothing -> error $ "Did not find a GI repository for "
++ (T.unpack name)
++ maybe "" ("-" ++) (T.unpack <$> version)
++ " in " ++ show searchPath ++ "."