cabal-lenses 0.4.5 → 0.4.6
raw patch · 4 files changed
+148/−2 lines, 4 filesdep +eitherdep +strictdep +system-fileio
Dependencies added: either, strict, system-fileio, system-filepath, text, transformers
Files
- CHANGELOG +7/−0
- cabal-lenses.cabal +9/−2
- lib/CabalLenses.hs +2/−0
- lib/CabalLenses/Utils.hs +130/−0
CHANGELOG view
@@ -1,3 +1,10 @@+0.4.6+-----+* Add several helper functions for cabal+ - findCabalFile+ - findPackageDB+ - findDistDir+ 0.4.5 ----- * Support GHC 7.10.1
cabal-lenses.cabal view
@@ -1,5 +1,5 @@ name: cabal-lenses-version: 0.4.5+version: 0.4.6 cabal-version: >=1.9.2 build-type: Simple license: BSD3@@ -25,7 +25,13 @@ base >=3 && <5, lens >=4.0.1 && <4.9, unordered-containers >=0.2.3.3 && <0.3,- Cabal >=1.16.0 && <1.23+ Cabal >=1.16.0 && <1.23,+ either >=4.1.1 && <4.4,+ system-filepath >=0.4.9 && <0.5,+ system-fileio >=0.3.12 && <0.4,+ strict >=0.3.2 && <0.4,+ text >=1.1.0.1 && <1.3,+ transformers >=0.3.0.0 && <0.5 exposed-modules: CabalLenses CabalLenses.PackageDescription@@ -35,6 +41,7 @@ CabalLenses.Section CabalLenses.Traversals.BuildInfo CabalLenses.Traversals.Dependency+ CabalLenses.Utils exposed: True buildable: True cpp-options: -DCABAL
lib/CabalLenses.hs view
@@ -7,6 +7,7 @@ , module CabalLenses.Section , module CabalLenses.Traversals.BuildInfo , module CabalLenses.Traversals.Dependency+ , module CabalLenses.Utils ) where import CabalLenses.CondVars@@ -16,3 +17,4 @@ import CabalLenses.Section import CabalLenses.Traversals.BuildInfo import CabalLenses.Traversals.Dependency+import CabalLenses.Utils
+ lib/CabalLenses/Utils.hs view
@@ -0,0 +1,130 @@+{-# Language CPP #-}++module CabalLenses.Utils+ ( findCabalFile+ , findPackageDB+ , findDistDir+ ) where++import Control.Monad.Trans.Either (EitherT, left, right, runEitherT)+import Control.Monad.IO.Class+import Control.Monad (filterM)+import qualified System.IO.Strict as Strict+import qualified Filesystem.Path.CurrentOS as FP+import Filesystem.Path.CurrentOS ((</>))+import qualified Filesystem as FS+import qualified Data.List as L+import qualified Data.Text as T++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif++type Error = String++io :: MonadIO m => IO a -> m a+io = liftIO++-- | Find a cabal file starting at the given directory, going upwards the directory+-- tree until a cabal file could be found. The returned file path is absolute.+findCabalFile :: FilePath -> EitherT Error IO FilePath+findCabalFile file = do+ cabalFile <- io $ do+ dir <- absoluteDirectory file+ findCabalFile' dir++ if cabalFile == FP.empty+ then left "Couldn't find Cabal file!"+ else right . FP.encodeString $ cabalFile++ where+ findCabalFile' dir = do+ files <- filterM FS.isFile =<< (FS.listDirectory dir)+ case L.find isCabalFile files of+ Just file -> return $ dir </> file+ _ -> do+ let parent = FP.parent dir+ if parent == dir+ then return FP.empty+ else findCabalFile' parent++ isCabalFile file+ | Just ext <- FP.extension file+ = ext == cabalExt++ | otherwise+ = False++ cabalExt = T.pack "cabal"+++-- | Find the package database of the cabal sandbox from the given cabal file.+-- The returned file path is relative to the directory of the cabal file.+findPackageDB :: FilePath -> EitherT Error IO (Maybe FilePath)+findPackageDB cabalFile = do+ cabalDir <- io $ absoluteDirectory cabalFile+ let sandboxConfig = cabalDir </> sandbox_config+ isFile <- io $ FS.isFile sandboxConfig+ if isFile+ then do+ packageDB <- io $ readPackageDB sandboxConfig+ case packageDB of+ Just db -> right . Just $ stripPrefix cabalDir db+ _ -> left $ "Couldn't find field 'package-db: ' in " ++ (show sandboxConfig)+ else+ right Nothing++ where+ -- | reads the 'package-db: ' field from the sandbox config file and returns the value of the field+ readPackageDB :: FP.FilePath -> IO (Maybe FP.FilePath)+ readPackageDB sandboxConfig = do+ lines <- lines <$> Strict.readFile (FP.encodeString sandboxConfig)+ return $ do+ line <- L.find (package_db `L.isPrefixOf`) lines+ packageDB <- L.stripPrefix package_db line+ return $ FP.decodeString packageDB++ sandbox_config = FP.decodeString "cabal.sandbox.config"+ package_db = "package-db: "+++-- | Find the dist directory of the cabal build from the given cabal file. For a non sandboxed+-- build it's just the directory 'dist' in the cabal build directory. For a sandboxed build+-- it's the directory 'dist/dist-sandbox-*'. The returned file path is relative to the+-- directory of the cabal file.+findDistDir :: FilePath -> IO (Maybe FilePath)+findDistDir cabalFile = do+ cabalDir <- absoluteDirectory cabalFile+ let distDir = cabalDir </> FP.decodeString "dist"+ hasDistDir <- FS.isDirectory distDir+ if hasDistDir+ then do+ files <- filterM FS.isDirectory =<< (FS.listDirectory distDir)+ return $ (stripPrefix cabalDir) <$> maybe (Just distDir) Just (L.find isSandboxDistDir files)+ else return Nothing++ where+ isSandboxDistDir file =+ "dist-sandbox-" `L.isPrefixOf` (FP.encodeString . FP.filename $ file)+++stripPrefix :: FP.FilePath -> FP.FilePath -> FilePath+stripPrefix prefix file+ | Just stripped <- FP.stripPrefix prefix file+ = FP.encodeString stripped++ | otherwise+ = FP.encodeString file+++absoluteDirectory :: FilePath -> IO FP.FilePath+absoluteDirectory file = do+ absFile <- absoluteFile file+ isDir <- FS.isDirectory absFile+ if isDir+ then return absFile+ else return . FP.directory $ absFile+++absoluteFile :: FilePath -> IO FP.FilePath+absoluteFile = FS.canonicalizePath . FP.decodeString