diff options
Diffstat (limited to 'src/CabalHelper/Compiletime')
-rw-r--r-- | src/CabalHelper/Compiletime/Compile.hs | 3 | ||||
-rw-r--r-- | src/CabalHelper/Compiletime/Data.hs | 1 | ||||
-rw-r--r-- | src/CabalHelper/Compiletime/Sandbox.hs | 74 |
3 files changed, 76 insertions, 2 deletions
diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs index c1c3bc4..2f4b0a9 100644 --- a/src/CabalHelper/Compiletime/Compile.hs +++ b/src/CabalHelper/Compiletime/Compile.hs @@ -58,10 +58,11 @@ import CabalHelper.Compiletime.Data import CabalHelper.Compiletime.Log import CabalHelper.Compiletime.Program.GHC import CabalHelper.Compiletime.Program.CabalInstall +import CabalHelper.Compiletime.Sandbox + ( getSandboxPkgDb ) import CabalHelper.Compiletime.Types import CabalHelper.Shared.Common -import CabalHelper.Shared.Sandbox (getSandboxPkgDb) data Compile = CompileWithCabalSource diff --git a/src/CabalHelper/Compiletime/Data.hs b/src/CabalHelper/Compiletime/Data.hs index 9fb5a53..07cf2d2 100644 --- a/src/CabalHelper/Compiletime/Data.hs +++ b/src/CabalHelper/Compiletime/Data.hs @@ -87,7 +87,6 @@ runtimeSources = $( [ ("Runtime/Main.hs") , ("Runtime/Compat.hs") , ("Shared/Common.hs") - , ("Shared/Sandbox.hs") , ("Shared/InterfaceTypes.hs") ] in do diff --git a/src/CabalHelper/Compiletime/Sandbox.hs b/src/CabalHelper/Compiletime/Sandbox.hs new file mode 100644 index 0000000..5af226a --- /dev/null +++ b/src/CabalHelper/Compiletime/Sandbox.hs @@ -0,0 +1,74 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015-2017 Daniel Gröber <cabal-helper@dxld.at> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +{-| +Module : CabalHelper.Shared.Sandbox +Description : Extracting information from @cabal.sandbox.config@ files +License : GPL-3 +-} + +module CabalHelper.Compiletime.Sandbox where + +import Control.Applicative +import Data.Char +import Data.Maybe +import Data.List +import Data.Version +import System.FilePath +import Prelude + +import qualified Data.Traversable as T + +import CabalHelper.Shared.Common + +-- | Get the path to the sandbox package-db in a project +getSandboxPkgDb :: String + -- ^ Cabal build platform, i.e. @buildPlatform@ + -> Version + -- ^ GHC version (@cProjectVersion@ is your friend) + -> FilePath + -- ^ Path to the cabal package root directory (containing the + -- @cabal.sandbox.config@ file) + -> IO (Maybe FilePath) +getSandboxPkgDb platform ghcVer projdir = do + mConf <- + T.traverse readFile =<< mightExist (projdir </> "cabal.sandbox.config") + return $ fixPkgDbVer <$> (extractSandboxDbDir =<< mConf) + + where + fixPkgDbVer dir = + case takeFileName dir == ghcSandboxPkgDbDir platform ghcVer of + True -> dir + False -> takeDirectory dir </> ghcSandboxPkgDbDir platform ghcVer + +ghcSandboxPkgDbDir :: String -> Version -> String +ghcSandboxPkgDbDir platform ghcVer = + platform ++ "-ghc-" ++ showVersion ghcVer ++ "-packages.conf.d" + +-- | Extract the sandbox package db directory from the cabal.sandbox.config +-- file. Exception is thrown if the sandbox config file is broken. +extractSandboxDbDir :: String -> Maybe FilePath +extractSandboxDbDir conf = extractValue <$> parse conf + where + key = "package-db:" + keyLen = length key + + parse = listToMaybe . filter (key `isPrefixOf`) . lines + extractValue = CabalHelper.Compiletime.Sandbox.dropWhileEnd isSpace . dropWhile isSpace . drop keyLen + +-- dropWhileEnd is not provided prior to base 4.5.0.0. +dropWhileEnd :: (a -> Bool) -> [a] -> [a] +dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] |