{-# LANGUAGE BangPatterns #-}
module Distribution.Cab.Sandbox (
getSandbox
, getSandboxOpts
, getSandboxOpts2
) where
import Control.Applicative ((<$>))
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
getSandbox :: IO (Maybe FilePath)
getSandbox = (Just <$> getPkgDb) `E.catch` handler
where
getPkgDb = getCurrentDirectory >>= getSandboxConfigFile >>= getPackageDbDir
handler :: SomeException -> IO (Maybe String)
handler _ = return Nothing
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
getSandboxOpts :: Maybe FilePath -> String
getSandboxOpts Nothing = ""
getSandboxOpts (Just path) = pkgOpt ++ path
where
ghcver = extractGhcVer path
pkgOpt | ghcver >= 706 = "-package-db "
| otherwise = "-package-conf "
getSandboxOpts2 :: Maybe FilePath -> String
getSandboxOpts2 Nothing = ""
getSandboxOpts2 (Just path) = pkgOpt ++ "=" ++ path
where
ghcver = extractGhcVer path
pkgOpt | ghcver >= 706 = "--package-db"
| otherwise = "--package-conf"
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