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 (
    doesFileExist,
    getCurrentDirectory,
    getDirectoryContents,
 )
import System.FilePath (takeDirectory, (</>))

import Hhp.GhcPkg
import Hhp.Types

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

-- | 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 IO Cradle -> IO Cradle -> IO Cradle
forall a. IO a -> IO a -> IO a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> IO Cradle
sandboxCradle FilePath
wdir IO Cradle -> IO Cradle -> IO Cradle
forall a. IO a -> IO a -> IO a
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
    Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        Cradle
            { cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
            , cradleRootDir :: FilePath
cradleRootDir = FilePath
rdir
            , cradleCabalFile :: Maybe FilePath
cradleCabalFile = FilePath -> Maybe FilePath
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
    Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        Cradle
            { cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
            , cradleRootDir :: FilePath
cradleRootDir = FilePath
rdir
            , cradleCabalFile :: Maybe FilePath
cradleCabalFile = Maybe FilePath
forall a. Maybe a
Nothing
            , cradlePkgDbStack :: [GhcPkgDb]
cradlePkgDbStack = [GhcPkgDb]
pkgDbStack
            }

plainCradle :: FilePath -> IO Cradle
plainCradle :: FilePath -> IO Cradle
plainCradle FilePath
wdir =
    Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        Cradle
            { cradleCurrentDir :: FilePath
cradleCurrentDir = FilePath
wdir
            , cradleRootDir :: FilePath
cradleRootDir = FilePath
wdir
            , cradleCabalFile :: Maybe FilePath
cradleCabalFile = Maybe FilePath
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
    Cradle -> IO Cradle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Cradle
cradle{cradlePkgDbStack = [GlobalDb]}

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

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

cabalSuffixLength :: Int
cabalSuffixLength :: Int
cabalSuffixLength = FilePath -> Int
forall a. [a] -> Int
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' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir -> IOError -> IO (FilePath, FilePath)
forall e a. Exception e => e -> IO a
E.throwIO (IOError -> IO (FilePath, FilePath))
-> IOError -> IO (FilePath, FilePath)
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]
_ -> (FilePath, FilePath) -> IO (FilePath, FilePath)
forall a. a -> IO a
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 IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
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 FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
name
            Bool -> Bool -> Bool
&& FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
name Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cabalSuffixLength
    getFiles :: IO [FilePath]
getFiles = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isCabal ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 (FilePath -> IO Bool) -> FilePath -> IO Bool
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 FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
dir
        else
            if FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
dir'
                then IOError -> IO FilePath
forall e a. Exception e => e -> IO a
E.throwIO (IOError -> IO FilePath) -> IOError -> IO FilePath
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