aboutsummaryrefslogtreecommitdiff
path: root/CabalHelper/Shared
diff options
context:
space:
mode:
authorDaniel Gröber <dxld@darkboxed.org>2017-09-28 21:33:24 +0200
committerDaniel Gröber <dxld@darkboxed.org>2017-09-28 21:33:24 +0200
commit4b7b646c4fddb1c368aead0315a1f6ce0784b230 (patch)
tree4726bfeba0074d3db6899466d276aadef5c2ed37 /CabalHelper/Shared
parent7e79dacef6fbeb1ae7805072f6a04b36d99eab7b (diff)
Move split source into src/ and lib/
Diffstat (limited to 'CabalHelper/Shared')
-rw-r--r--CabalHelper/Shared/Common.hs128
-rw-r--r--CabalHelper/Shared/InterfaceTypes.hs75
-rw-r--r--CabalHelper/Shared/Sandbox.hs77
3 files changed, 0 insertions, 280 deletions
diff --git a/CabalHelper/Shared/Common.hs b/CabalHelper/Shared/Common.hs
deleted file mode 100644
index 239fe3c..0000000
--- a/CabalHelper/Shared/Common.hs
+++ /dev/null
@@ -1,128 +0,0 @@
--- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU Affero 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 Affero General Public License for more details.
---
--- You should have received a copy of the GNU Affero General Public License
--- along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-{-|
-Module : CabalHelper.Shared.Common
-Description : Shared utility functions
-License : AGPL-3
--}
-
-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
-module CabalHelper.Shared.Common where
-
-import Control.Applicative
-import Control.Exception as E
-import Control.Monad
-import Data.List
-import Data.Maybe
-import Data.Version
-import Data.Typeable
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS8
-import System.Environment
-import System.IO
-import qualified System.Info
-import System.Exit
-import System.Directory
-import System.FilePath
-import Text.ParserCombinators.ReadP
-import Prelude
-
-data Panic = Panic String deriving (Typeable, Show)
-instance Exception Panic
-
-panic :: String -> a
-panic msg = throw $ Panic msg
-
-panicIO :: String -> IO a
-panicIO msg = throwIO $ Panic msg
-
-handlePanic :: IO a -> IO a
-handlePanic action =
- action `E.catch` \(Panic msg) -> errMsg msg >> exitFailure
-
-errMsg :: String -> IO ()
-errMsg str = do
- prog <- getProgName
- hPutStrLn stderr $ prog ++ ": " ++ str
-
--- | @getCabalConfigHeader "dist/setup-config"@ returns the cabal version and
--- compiler version
-getCabalConfigHeader :: FilePath -> IO (Maybe (Version, (ByteString, Version)))
-getCabalConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do
- parseHeader <$> BS.hGetLine h
-
-parseHeader :: ByteString -> Maybe (Version, (ByteString, Version))
-parseHeader header = case BS8.words header of
- ["Saved", "package", "config", "for", _pkgId ,
- "written", "by", cabalId,
- "using", compId]
- -> liftM2 (,) (snd <$> parsePkgId cabalId) (parsePkgId compId)
- _ -> Nothing
-
-parsePkgId :: ByteString -> Maybe (ByteString, Version)
-parsePkgId bs =
- case BS8.split '-' bs of
- [pkg, vers] -> Just (pkg, parseVer $ BS8.unpack vers)
- _ -> Nothing
-
-parseVer :: String -> Version
-parseVer vers = runReadP parseVersion vers
-
-majorVer :: Version -> Version
-majorVer (Version b _) = Version (take 2 b) []
-
-sameMajorVersionAs :: Version -> Version -> Bool
-sameMajorVersionAs a b = majorVer a == majorVer b
-
-runReadP :: ReadP t -> String -> t
-runReadP p i = case filter ((=="") . snd) $ readP_to_S p i of
- (a,""):[] -> a
- _ -> error $ "Error parsing: " ++ show i
-
-appCacheDir :: IO FilePath
-appCacheDir =
- (</> "cabal-helper") <$> getEnvDefault "XDG_CACHE_HOME" (homeRel cache)
- where
- -- for GHC 7.4
- lookupEnv' var = do env <- getEnvironment; return (lookup var env)
- getEnvDefault var def = lookupEnv' var >>= \m -> case m of Nothing -> def; Just x -> return x
- homeRel path = (</> path) <$> getHomeDirectory
- cache =
- case System.Info.os of
- "mingw32" -> windowsCache
- _ -> unixCache
-
- windowsCache = "Local Settings" </> "Cache"
- unixCache = ".cache"
-
-isCabalFile :: FilePath -> Bool
-isCabalFile f = takeExtension' f == ".cabal"
-
-takeExtension' :: FilePath -> String
-takeExtension' p =
- if takeFileName p == takeExtension p
- then "" -- just ".cabal" is not a valid cabal file
- else takeExtension p
-
-replace :: String -> String -> String -> String
-replace n r hs' = go "" hs'
- where
- go acc h
- | take (length n) h == n =
- reverse acc ++ r ++ drop (length n) h
- go acc (h:hs) = go (h:acc) hs
- go acc [] = reverse acc
diff --git a/CabalHelper/Shared/InterfaceTypes.hs b/CabalHelper/Shared/InterfaceTypes.hs
deleted file mode 100644
index 5f4972f..0000000
--- a/CabalHelper/Shared/InterfaceTypes.hs
+++ /dev/null
@@ -1,75 +0,0 @@
--- Copyright (C) 2015,2017 Daniel Gröber <dxld ÄT darkboxed DOT org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU Affero 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 Affero General Public License for more details.
---
--- You should have received a copy of the GNU Affero General Public License
--- along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures #-}
-
-{-|
-Module : CabalHelper.Shared.InterfaceTypes
-Description : Types which are used by c-h library and executable to communicate
-License : AGPL-3
-
-These types are used to communicate between the cabal-helper library and main
-executable, using Show/Read. If any types in this module change the major
-version must be bumped since this will be exposed in the @Distribution.Helper@
-module.
-
-The cached executables in @$XDG_CACHE_DIR/cabal-helper@ use the cabal-helper
-version (among other things) as a cache key so we don't need to worry about
-talking to an old executable.
--}
-module CabalHelper.Shared.InterfaceTypes where
-
-import GHC.Generics
-import Data.Version
-
-data ChResponse
- = ChResponseCompList [(ChComponentName, [String])]
- | ChResponseEntrypoints [(ChComponentName, ChEntrypoint)]
- | ChResponseList [String]
- | ChResponsePkgDbs [ChPkgDb]
- | ChResponseLbi String
- | ChResponseVersion String Version
- | ChResponseLicenses [(String, [(String, Version)])]
- | ChResponseFlags [(String, Bool)]
- deriving (Eq, Ord, Read, Show, Generic)
-
-data ChComponentName = ChSetupHsName
- | ChLibName
- | ChSubLibName String
- | ChFLibName String
- | ChExeName String
- | ChTestName String
- | ChBenchName String
- deriving (Eq, Ord, Read, Show, Generic)
-
-newtype ChModuleName = ChModuleName String
- deriving (Eq, Ord, Read, Show, Generic)
-
-data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but
- -- @main-is@ could either be @"Setup.hs"@
- -- or @"Setup.lhs"@. Since we don't know
- -- where the source directory is you have
- -- to find these files.
- | ChLibEntrypoint { chExposedModules :: [ChModuleName]
- , chOtherModules :: [ChModuleName]
- }
- | ChExeEntrypoint { chMainIs :: FilePath
- , chOtherModules :: [ChModuleName]
- } deriving (Eq, Ord, Read, Show, Generic)
-
-data ChPkgDb = ChPkgGlobal
- | ChPkgUser
- | ChPkgSpecific FilePath
- deriving (Eq, Ord, Read, Show, Generic)
diff --git a/CabalHelper/Shared/Sandbox.hs b/CabalHelper/Shared/Sandbox.hs
deleted file mode 100644
index 4dd9705..0000000
--- a/CabalHelper/Shared/Sandbox.hs
+++ /dev/null
@@ -1,77 +0,0 @@
--- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU Affero 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 Affero General Public License for more details.
---
--- You should have received a copy of the GNU Affero 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 : AGPL-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 System.Directory
-import Prelude
-
-import qualified Data.Traversable as T
-
--- | Get the path to the sandbox package-db in a project
-getSandboxPkgDb :: FilePath
- -- ^ Path to the cabal package root directory (containing the
- -- @cabal.sandbox.config@ file)
- -> String
- -- ^ Cabal build platform, i.e. @buildPlatform@
- -> Version
- -- ^ GHC version (@cProjectVersion@ is your friend)
- -> IO (Maybe FilePath)
-getSandboxPkgDb d platform ghcVer = do
- mConf <- T.traverse readFile =<< mightExist (d </> "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
-
-
-mightExist :: FilePath -> IO (Maybe FilePath)
-mightExist f = do
- exists <- doesFileExist f
- return $ if exists then (Just f) else (Nothing)
-
--- 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) []