module CabalHelper.Compiletime.Sandbox where
import Control.Applicative
import Data.Char
import Data.Maybe
import Data.List
import System.FilePath
import Prelude
import qualified Data.Traversable as T
import CabalHelper.Shared.Common
import CabalHelper.Compiletime.Program.GHC
( GhcVersion (..), showGhcVersion )
getSandboxPkgDb :: String
-> GhcVersion
-> FilePath
-> IO (Maybe FilePath)
getSandboxPkgDb :: String -> GhcVersion -> String -> IO (Maybe String)
getSandboxPkgDb String
platform GhcVersion
ghcVer String
projdir = do
Maybe String
mConf <-
(String -> IO String) -> Maybe String -> IO (Maybe String)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse String -> IO String
readFile (Maybe String -> IO (Maybe String))
-> IO (Maybe String) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe String)
mightExist (String
projdir String -> String -> String
</> String
"cabal.sandbox.config")
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> String
fixPkgDbVer (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe String
extractSandboxDbDir (String -> Maybe String) -> Maybe String -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String
mConf)
where
fixPkgDbVer :: String -> String
fixPkgDbVer String
dir =
case String -> String
takeFileName String
dir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> GhcVersion -> String
ghcSandboxPkgDbDir String
platform GhcVersion
ghcVer of
Bool
True -> String
dir
Bool
False -> String -> String
takeDirectory String
dir String -> String -> String
</> String -> GhcVersion -> String
ghcSandboxPkgDbDir String
platform GhcVersion
ghcVer
ghcSandboxPkgDbDir :: String -> GhcVersion -> String
ghcSandboxPkgDbDir :: String -> GhcVersion -> String
ghcSandboxPkgDbDir String
platform GhcVersion
ghcVer =
String
platform String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-ghc-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GhcVersion -> String
showGhcVersion GhcVersion
ghcVer String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-packages.conf.d"
extractSandboxDbDir :: String -> Maybe FilePath
extractSandboxDbDir :: String -> Maybe String
extractSandboxDbDir String
conf = String -> String
extractValue (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
parse String
conf
where
key :: String
key = String
"package-db:"
keyLen :: Int
keyLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
key
parse :: String -> Maybe String
parse = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String)
-> (String -> [String]) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
key 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 = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
CabalHelper.Compiletime.Sandbox.dropWhileEnd Char -> Bool
isSpace (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
keyLen
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd a -> Bool
p = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x [a]
xs -> if a -> Bool
p a
x Bool -> Bool -> Bool
&& [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs then [] else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) []