{-# LANGUAGE CPP, BangPatterns #-}
module Sandbox
( getSandboxArguments
, getPackageDbDir
, getSandboxConfigFile
) where
#if __GLASGOW_HASKELL__ < 710
import Data.Functor ((<$>))
#endif
import Control.Exception as E (catch, SomeException, throwIO)
import Data.Char (isSpace)
import Data.List (isPrefixOf, tails)
import System.Directory (getCurrentDirectory, doesFileExist)
import System.FilePath ((</>), takeDirectory, takeFileName)
configFile :: String
configFile = "cabal.sandbox.config"
pkgDbKey :: String
pkgDbKey = "package-db:"
pkgDbKeyLen :: Int
pkgDbKeyLen = length pkgDbKey
getSandboxArguments :: IO [String]
getSandboxArguments = (sandboxArguments <$> getPkgDb) `E.catch` handler
where
getPkgDb = getCurrentDirectory >>= getSandboxConfigFile >>= getPackageDbDir
handler :: SomeException -> IO [String]
handler _ = return []
getSandboxConfigFile :: FilePath -> IO FilePath
getSandboxConfigFile dir = do
let cfile = dir </> configFile
exist <- doesFileExist cfile
if exist then
return cfile
else do
let dir' = takeDirectory dir
if dir == dir' then
throwIO $ userError "sandbox config file not found"
else
getSandboxConfigFile dir'
getPackageDbDir :: FilePath -> IO FilePath
getPackageDbDir sconf = do
!path <- extractValue . parse <$> readFile sconf
return path
where
parse = head . filter ("package-db:" `isPrefixOf`) . lines
extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen
sandboxArguments :: FilePath -> [String]
sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb]
where
ver = extractGhcVer pkgDb
(pkgDbOpt,noUserPkgDbOpt)
| ver < 706 = ("-package-conf","-no-user-package-conf")
| otherwise = ("-package-db", "-no-user-package-db")
extractGhcVer :: String -> Int
extractGhcVer dir = ver
where
file = takeFileName dir
findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails
(verStr1,_:left) = break (== '.') $ findVer file
(verStr2,_) = break (== '.') left
ver = read verStr1 * 100 + read verStr2