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

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

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

    getSandboxArguments :: IO [String]
    getSandboxArguments :: IO [String]
    getSandboxArguments = (String -> [String]
    sandboxArguments (String -> [String]) -> IO String -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO String
    getPkgDb) IO [String] -> (SomeException -> IO [String]) -> IO [String]
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` SomeException -> IO [String]
    handler
      where
        getPkgDb :: IO String
    getPkgDb = IO String
    getCurrentDirectory IO String -> (String -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> IO String
    getSandboxConfigFile IO String -> (String -> IO String) -> IO String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> IO String
    getPackageDbDir
        handler :: SomeException -> IO [String]
        handler :: SomeException -> IO [String]
    handler _ = [String] -> IO [String]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    -- | Find a sandbox config file by tracing ancestor directories.
    --   Exception is thrown if not found
    getSandboxConfigFile :: FilePath -> IO FilePath
    getSandboxConfigFile :: String -> IO String
    getSandboxConfigFile dir :: String
    dir = do
        let cfile :: String
    cfile = String
    dir String -> String -> String
    </> String
    configFile
        Bool
    exist <- String -> IO Bool
    doesFileExist String
    cfile
        if Bool
    exist then
            String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    cfile
          else do
            let dir' :: String
    dir' = String -> String
    takeDirectory String
    dir
            if String
    dir String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    dir' then
                IOError -> IO String
    forall e a. Exception e => e -> IO a
    throwIO (IOError -> IO String) -> IOError -> IO String
    forall a b. (a -> b) -> a -> b
    $ String -> IOError
    userError "sandbox config file not found"
              else
                String -> IO String
    getSandboxConfigFile String
    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 :: String -> IO String
    getPackageDbDir sconf :: String
    sconf = do
        -- Be strict to ensure that an error can be caught.
        !String
    path <- String -> String
    extractValue (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    parse (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO String
    readFile String
    sconf
        String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    path
      where
        parse :: String -> String
    parse = [String] -> String
    forall a. [a] -> a
    head ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("package-db:" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
        extractValue :: String -> String
    extractValue = (String, String) -> String
    forall a b. (a, b) -> a
    fst ((String, String) -> String)
    -> (String -> (String, String)) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Char -> Bool
    isSpace (String -> (String, String))
    -> (String -> String) -> String -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    pkgDbKeyLen

    -- | Adding necessary GHC options to the package db.
    --   Exception is thrown if the string argument is incorrect.
    --
    -- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"
    -- ["-no-user-package-db","-package-db","/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"]
    -- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"
    -- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"]
    sandboxArguments :: FilePath -> [String]
    sandboxArguments :: String -> [String]
    sandboxArguments pkgDb :: String
    pkgDb = [String
    noUserPkgDbOpt, String
    pkgDbOpt, String
    pkgDb]
      where
        ver :: Int
    ver = String -> Int
    extractGhcVer String
    pkgDb
        (pkgDbOpt :: String
    pkgDbOpt,noUserPkgDbOpt :: String
    noUserPkgDbOpt)
          | Int
    ver Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 706 = ("-package-conf","-no-user-package-conf")
          | Bool
    otherwise = ("-package-db",  "-no-user-package-db")

    -- | 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 :: String -> Int
    extractGhcVer dir :: String
    dir = Int
    ver
      where
        file :: String
    file = String -> String
    takeFileName String
    dir
        findVer :: String -> String
    findVer = Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 4 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall a. [a] -> a
    head ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("ghc-" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    forall a. [a] -> [[a]]
    tails
        (verStr1 :: String
    verStr1,_:left :: String
    left) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '.') (String -> (String, String)) -> String -> (String, String)
    forall a b. (a -> b) -> a -> b
    $ String -> String
    findVer String
    file
        (verStr2 :: String
    verStr2,_)      = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '.') String
    left
        ver :: Int
    ver = String -> Int
    forall a. Read a => String -> a
    read String
    verStr1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 100 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. Read a => String -> a
    read String
    verStr2