{-# LANGUAGE BangPatterns #-}

module Distribution.Cab.Sandbox (
    getSandbox
  , getSandboxOpts
  , getSandboxOpts2
  ) where

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 :: FilePath
configFile = FilePath
"cabal.sandbox.config"

pkgDbKey :: String
pkgDbKey :: FilePath
pkgDbKey = FilePath
"package-db:"

pkgDbKeyLen :: Int
pkgDbKeyLen :: Int
pkgDbKeyLen = forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pkgDbKey

-- | Find a sandbox config file by tracing ancestor directories,
--   parse it and return the package db path
getSandbox :: IO (Maybe FilePath)
getSandbox :: IO (Maybe FilePath)
getSandbox = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getPkgDb) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` SomeException -> IO (Maybe FilePath)
handler
  where
    getPkgDb :: IO FilePath
getPkgDb = IO FilePath
getCurrentDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO FilePath
getSandboxConfigFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO FilePath
getPackageDbDir
    handler :: SomeException -> IO (Maybe String)
    handler :: SomeException -> IO (Maybe FilePath)
handler SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Find a sandbox config file by tracing ancestor directories.
--   Exception is thrown if not found
getSandboxConfigFile :: FilePath -> IO FilePath
getSandboxConfigFile :: FilePath -> IO FilePath
getSandboxConfigFile FilePath
dir = do
    let cfile :: FilePath
cfile = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
configFile
    Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
cfile
    if Bool
exist then
        forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
cfile
      else do
        let dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir
        if FilePath
dir forall a. Eq a => a -> a -> Bool
== FilePath
dir' then
            forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
"sandbox config file not found"
          else
            FilePath -> IO FilePath
getSandboxConfigFile FilePath
dir'

-- | Extract a package db directory from the sandbox config file.
--   Exception is thrown if the sandbox config file is broken.
getPackageDbDir :: FilePath -> IO FilePath
getPackageDbDir :: FilePath -> IO FilePath
getPackageDbDir FilePath
sconf = do
    -- Be strict to ensure that an error can be caught.
    !FilePath
path <- FilePath -> FilePath
extractValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
parse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
sconf
    forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
  where
    parse :: FilePath -> FilePath
parse = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
"package-db:" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
    extractValue :: FilePath -> FilePath
extractValue = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
pkgDbKeyLen

----------------------------------------------------------------

-- | Generate GHC options for package db according to GHC version.
--
-- >>> getSandboxOpts Nothing
-- ""
-- >>> getSandboxOpts (Just "/path/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
-- "-package-db /path/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
-- >>> getSandboxOpts (Just "/path/.cabal-sandbox/i386-osx-ghc-7.4.1-packages.conf.d")
-- "-package-conf /path/.cabal-sandbox/i386-osx-ghc-7.4.1-packages.conf.d"
getSandboxOpts :: Maybe FilePath -> String
getSandboxOpts :: Maybe FilePath -> FilePath
getSandboxOpts Maybe FilePath
Nothing     = FilePath
""
getSandboxOpts (Just FilePath
path) = FilePath
pkgOpt forall a. [a] -> [a] -> [a]
++ FilePath
path
  where
    ghcver :: Int
ghcver = FilePath -> Int
extractGhcVer FilePath
path
    pkgOpt :: FilePath
pkgOpt | Int
ghcver forall a. Ord a => a -> a -> Bool
>= Int
706 = FilePath
"-package-db "
           | Bool
otherwise     = FilePath
"-package-conf "

getSandboxOpts2 :: Maybe FilePath -> String
getSandboxOpts2 :: Maybe FilePath -> FilePath
getSandboxOpts2 Maybe FilePath
Nothing     = FilePath
""
getSandboxOpts2 (Just FilePath
path) = FilePath
pkgOpt forall a. [a] -> [a] -> [a]
++ FilePath
"=" forall a. [a] -> [a] -> [a]
++ FilePath
path
  where
    ghcver :: Int
ghcver = FilePath -> Int
extractGhcVer FilePath
path
    pkgOpt :: FilePath
pkgOpt | Int
ghcver forall a. Ord a => a -> a -> Bool
>= Int
706 = FilePath
"--package-db"
           | Bool
otherwise     = FilePath
"--package-conf"

-- | Extracting GHC version from the path of package db.
--   Exception is thrown if the string argument is incorrect.
--
-- >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"
-- 706
extractGhcVer :: String -> Int
extractGhcVer :: FilePath -> Int
extractGhcVer FilePath
dir = Int
ver
  where
    file :: FilePath
file = FilePath -> FilePath
takeFileName FilePath
dir
    findVer :: FilePath -> FilePath
findVer = forall a. Int -> [a] -> [a]
drop Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
"ghc-" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails
    (FilePath
verStr1,FilePath
left) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'.') forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
findVer FilePath
file
    (FilePath
verStr2,FilePath
_)    = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'.') forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail FilePath
left
    ver :: Int
ver = forall a. Read a => FilePath -> a
read FilePath
verStr1 forall a. Num a => a -> a -> a
* Int
100 forall a. Num a => a -> a -> a
+ forall a. Read a => FilePath -> a
read FilePath
verStr2