{-# 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

-- | 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 -> 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"


-- | Find the package database of the cabal sandbox from the given cabal file.
--   The returned file path is absolute.
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
      -- | reads the 'package-db: ' field from the sandbox config file and returns the value of the field
      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: "


-- | 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 absolute.
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)


-- | Find the new style dist directory of the cabal build from the given cabal file.
--   The returned file path is absolute.
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