{-# Language CPP, PatternGuards #-}
module CabalLenses.Utils
( findCabalFile
, findPackageDB
, findDistDir
, findNewDistDir
) where
import Control.Monad.Trans.Except (ExceptT, throwE)
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 :: forall (m :: * -> *) a. MonadIO m => IO a -> m a
io = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
findCabalFile :: FilePath -> ExceptT Error IO FilePath
findCabalFile :: Error -> ExceptT Error IO Error
findCabalFile Error
file = do
FilePath
cabalFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
FilePath
dir <- Error -> IO FilePath
absoluteDirectory Error
file
FilePath -> IO FilePath
findCabalFile' FilePath
dir
if FilePath
cabalFile forall a. Eq a => a -> a -> Bool
== FilePath
FP.empty
then forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Error
"Couldn't find Cabal file!"
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Error
FP.encodeString FilePath
cabalFile
where
findCabalFile' :: FilePath -> IO FilePath
findCabalFile' FilePath
dir = do
[FilePath]
files <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
FS.isFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (FilePath -> IO [FilePath]
FS.listDirectory FilePath
dir)
case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find FilePath -> Bool
isCabalFile [FilePath]
files of
Just FilePath
file -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file
Maybe FilePath
_ -> do
let parent :: FilePath
parent = FilePath -> FilePath
FP.parent FilePath
dir
if FilePath
parent forall a. Eq a => a -> a -> Bool
== FilePath
dir
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
FP.empty
else FilePath -> IO FilePath
findCabalFile' FilePath
parent
isCabalFile :: FilePath -> Bool
isCabalFile FilePath
file
| Just Text
ext <- FilePath -> Maybe Text
FP.extension FilePath
file
= Text
ext forall a. Eq a => a -> a -> Bool
== Text
cabalExt
| Bool
otherwise
= Bool
False
cabalExt :: Text
cabalExt = Error -> Text
T.pack Error
"cabal"
findPackageDB :: FilePath -> ExceptT Error IO (Maybe FilePath)
findPackageDB :: Error -> ExceptT Error IO (Maybe Error)
findPackageDB Error
cabalFile = do
FilePath
cabalDir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Error -> IO FilePath
absoluteDirectory Error
cabalFile
let sandboxConfig :: FilePath
sandboxConfig = FilePath
cabalDir FilePath -> FilePath -> FilePath
</> FilePath
sandbox_config
Bool
isFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
FS.isFile FilePath
sandboxConfig
if Bool
isFile
then do
Maybe Error
packageDB <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe Error)
readPackageDB FilePath
sandboxConfig
case Maybe Error
packageDB of
Just Error
db -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Error
db
Maybe Error
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall a b. (a -> b) -> a -> b
$ Error
"Couldn't find field 'package-db: ' in " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> Error
show FilePath
sandboxConfig)
else
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where
readPackageDB :: FP.FilePath -> IO (Maybe FilePath)
readPackageDB :: FilePath -> IO (Maybe Error)
readPackageDB FilePath
sandboxConfig = do
[Error]
lines <- Error -> [Error]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Error -> IO Error
Strict.readFile (FilePath -> Error
FP.encodeString FilePath
sandboxConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
Error
line <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Error
package_db forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) [Error]
lines
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix Error
package_db Error
line
sandbox_config :: FilePath
sandbox_config = Error -> FilePath
FP.decodeString Error
"cabal.sandbox.config"
package_db :: Error
package_db = Error
"package-db: "
findDistDir :: FilePath -> IO (Maybe FilePath)
findDistDir :: Error -> IO (Maybe Error)
findDistDir Error
cabalFile = do
FilePath
cabalDir <- Error -> IO FilePath
absoluteDirectory Error
cabalFile
let distDir :: FilePath
distDir = FilePath
cabalDir FilePath -> FilePath -> FilePath
</> Error -> FilePath
FP.decodeString Error
"dist"
Bool
hasDistDir <- FilePath -> IO Bool
FS.isDirectory FilePath
distDir
if Bool
hasDistDir
then do
[FilePath]
files <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
FS.isDirectory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (FilePath -> IO [FilePath]
FS.listDirectory FilePath
distDir)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Error
FP.encodeString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just FilePath
distDir) forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find FilePath -> Bool
isSandboxDistDir [FilePath]
files)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where
isSandboxDistDir :: FilePath -> Bool
isSandboxDistDir FilePath
file =
Error
"dist-sandbox-" forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` (FilePath -> Error
FP.encodeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.filename forall a b. (a -> b) -> a -> b
$ FilePath
file)
findNewDistDir :: FilePath -> IO (Maybe FilePath)
findNewDistDir :: Error -> IO (Maybe Error)
findNewDistDir Error
cabalFile = do
FilePath
cabalDir <- Error -> IO FilePath
absoluteDirectory Error
cabalFile
let distDir :: FilePath
distDir = FilePath
cabalDir FilePath -> FilePath -> FilePath
</> Error -> FilePath
FP.decodeString Error
"dist-newstyle"
Bool
hasDistDir <- FilePath -> IO Bool
FS.isDirectory FilePath
distDir
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
hasDistDir then forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Error
FP.encodeString forall a b. (a -> b) -> a -> b
$ FilePath
distDir else forall a. Maybe a
Nothing
absoluteDirectory :: FilePath -> IO FP.FilePath
absoluteDirectory :: Error -> IO FilePath
absoluteDirectory Error
file = do
FilePath
absFile <- Error -> IO FilePath
absoluteFile Error
file
Bool
isDir <- FilePath -> IO Bool
FS.isDirectory FilePath
absFile
if Bool
isDir
then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
absFile
else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.directory forall a b. (a -> b) -> a -> b
$ FilePath
absFile
absoluteFile :: FilePath -> IO FP.FilePath
absoluteFile :: Error -> IO FilePath
absoluteFile = FilePath -> IO FilePath
FS.canonicalizePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> FilePath
FP.decodeString