From 66ff20ada55558ab1fda09f22f4f6f6de0736136 Mon Sep 17 00:00:00 2001 From: Daniel Gröber Date: Sat, 15 Dec 2018 23:02:29 +0100 Subject: Move Shared.Sandbox module to Compiletime. --- src/CabalHelper/Compiletime/Compile.hs | 3 +- src/CabalHelper/Compiletime/Data.hs | 1 - src/CabalHelper/Compiletime/Sandbox.hs | 74 ++++++++++++++++++++++++++++++++++ src/CabalHelper/Runtime/Compat.hs | 1 - src/CabalHelper/Runtime/Main.hs | 1 - src/CabalHelper/Shared/Sandbox.hs | 74 ---------------------------------- 6 files changed, 76 insertions(+), 78 deletions(-) create mode 100644 src/CabalHelper/Compiletime/Sandbox.hs delete mode 100644 src/CabalHelper/Shared/Sandbox.hs (limited to 'src/CabalHelper') 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 +-- +-- 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 . + +{-| +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) [] diff --git a/src/CabalHelper/Runtime/Compat.hs b/src/CabalHelper/Runtime/Compat.hs index 8c32adf..eb87163 100644 --- a/src/CabalHelper/Runtime/Compat.hs +++ b/src/CabalHelper/Runtime/Compat.hs @@ -134,7 +134,6 @@ import Distribution.Types.GenericPackageDescription #endif -import CabalHelper.Shared.Sandbox import CabalHelper.Shared.Common import CabalHelper.Shared.InterfaceTypes diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs index 2a72f37..775f6b0 100644 --- a/src/CabalHelper/Runtime/Main.hs +++ b/src/CabalHelper/Runtime/Main.hs @@ -226,7 +226,6 @@ import System.IO import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) import Text.Printf -import CabalHelper.Shared.Sandbox import CabalHelper.Shared.Common import CabalHelper.Shared.InterfaceTypes import CabalHelper.Runtime.Compat diff --git a/src/CabalHelper/Shared/Sandbox.hs b/src/CabalHelper/Shared/Sandbox.hs deleted file mode 100644 index d2172a2..0000000 --- a/src/CabalHelper/Shared/Sandbox.hs +++ /dev/null @@ -1,74 +0,0 @@ --- cabal-helper: Simple interface to Cabal's configuration state --- Copyright (C) 2015-2017 Daniel Gröber --- --- 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 . - -{-| -Module : CabalHelper.Shared.Sandbox -Description : Extracting information from @cabal.sandbox.config@ files -License : GPL-3 --} - -module CabalHelper.Shared.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.Shared.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) [] -- cgit v1.2.3