module Hhp.Cradle (
    findCradle
  , findCradleWithoutSandbox
  ) where

import Control.Applicative ((<|>))
import qualified Control.Exception as E
import Control.Monad (filterM)
import Data.List (isSuffixOf)
import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
import System.FilePath ((</>), takeDirectory)

import Hhp.Types
import Hhp.GhcPkg

----------------------------------------------------------------

-- | Finding 'Cradle'.
--   Find a cabal file by tracing ancestor directories.
--   Find a sandbox according to a cabal sandbox config
--   in a cabal directory.
findCradle :: IO Cradle
findCradle :: IO Cradle
findCradle = do
    FilePath
wdir <- IO FilePath
getCurrentDirectory
    FilePath -> IO Cradle
cabalCradle FilePath
wdir forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> IO Cradle
sandboxCradle FilePath
wdir forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> IO Cradle
plainCradle FilePath
wdir

cabalCradle :: FilePath -> IO Cradle
cabalCradle :: FilePath -> IO Cradle
cabalCradle FilePath
wdir = do
    (FilePath
rdir,FilePath
cfile) <- FilePath -> IO (FilePath, FilePath)
cabalDir FilePath
wdir
    [GhcPkgDb]
pkgDbStack <- FilePath -> IO [GhcPkgDb]
getPackageDbStack FilePath
rdir
    forall (m :: * -> *) a. Monad m => a -> m a
return Cradle {
        cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
      , cradleRootDir :: FilePath
cradleRootDir    = FilePath
rdir
      , cradleCabalFile :: Maybe FilePath
cradleCabalFile  = forall a. a -> Maybe a
Just FilePath
cfile
      , cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb]
pkgDbStack
      }

sandboxCradle :: FilePath -> IO Cradle
sandboxCradle :: FilePath -> IO Cradle
sandboxCradle FilePath
wdir = do
    FilePath
rdir <- FilePath -> IO FilePath
getSandboxDir FilePath
wdir
    [GhcPkgDb]
pkgDbStack <- FilePath -> IO [GhcPkgDb]
getPackageDbStack FilePath
rdir
    forall (m :: * -> *) a. Monad m => a -> m a
return Cradle {
        cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
      , cradleRootDir :: FilePath
cradleRootDir    = FilePath
rdir
      , cradleCabalFile :: Maybe FilePath
cradleCabalFile  = forall a. Maybe a
Nothing
      , cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb]
pkgDbStack
      }

plainCradle :: FilePath -> IO Cradle
plainCradle :: FilePath -> IO Cradle
plainCradle FilePath
wdir = forall (m :: * -> *) a. Monad m => a -> m a
return Cradle {
        cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
      , cradleRootDir :: FilePath
cradleRootDir    = FilePath
wdir
      , cradleCabalFile :: Maybe FilePath
cradleCabalFile  = forall a. Maybe a
Nothing
      , cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb
GlobalDb]
      }

-- Just for testing
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox = do
    Cradle
cradle <- IO Cradle
findCradle
    forall (m :: * -> *) a. Monad m => a -> m a
return Cradle
cradle { cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb
GlobalDb]}

----------------------------------------------------------------

cabalSuffix :: String
cabalSuffix :: FilePath
cabalSuffix = FilePath
".cabal"

cabalSuffixLength :: Int
cabalSuffixLength :: Int
cabalSuffixLength = forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
cabalSuffix

-- Finding a Cabal file up to the root directory
-- Input: a directly to investigate
-- Output: (the path to the directory containing a Cabal file
--         ,the path to the Cabal file)
cabalDir :: FilePath -> IO (FilePath,FilePath)
cabalDir :: FilePath -> IO (FilePath, FilePath)
cabalDir FilePath
dir = do
    [FilePath]
cnts <- FilePath -> IO [FilePath]
getCabalFiles FilePath
dir
    case [FilePath]
cnts of
        [] | FilePath
dir' forall a. Eq a => a -> a -> Bool
== FilePath
dir -> forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
"cabal files not found"
           | Bool
otherwise   -> FilePath -> IO (FilePath, FilePath)
cabalDir FilePath
dir'
        FilePath
cfile:[FilePath]
_          -> forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
dir,FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
cfile)
  where
    dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir

getCabalFiles :: FilePath -> IO [FilePath]
getCabalFiles :: FilePath -> IO [FilePath]
getCabalFiles FilePath
dir = IO [FilePath]
getFiles forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesCabalFileExist
  where
    isCabal :: FilePath -> Bool
isCabal FilePath
name = FilePath
cabalSuffix forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
name
                Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
name forall a. Ord a => a -> a -> Bool
> Int
cabalSuffixLength
    getFiles :: IO [FilePath]
getFiles = forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isCabal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
    doesCabalFileExist :: FilePath -> IO Bool
doesCabalFileExist FilePath
file = FilePath -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
file

----------------------------------------------------------------

getSandboxDir :: FilePath -> IO FilePath
getSandboxDir :: FilePath -> IO FilePath
getSandboxDir FilePath
dir = do
    Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
sfile
    if Bool
exist then
        forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
      else if FilePath
dir forall a. Eq a => a -> a -> Bool
== FilePath
dir' then
        forall e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOError
userError FilePath
"sandbox not found"
      else
        FilePath -> IO FilePath
getSandboxDir FilePath
dir'
  where
    sfile :: FilePath
sfile = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cabal.sandbox.config"
    dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
dir