module GHCup.PlanJson where

import Control.Monad (unless)
import System.FilePath
import System.Directory

findPlanJson
    :: FilePath
    -> IO FilePath
findPlanJson :: String -> IO String
findPlanJson String
fp = do
    String
planJsonFn <- do
            Maybe String
mRoot <- String -> IO (Maybe String)
findProjectRoot String
fp
            case Maybe String
mRoot of
                Maybe String
Nothing  -> String -> IO String
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"missing project root relative to: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fp)
                Just String
dir -> String -> IO String
fromBuilddir (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"dist-newstyle"

    Bool
havePlanJson <- String -> IO Bool
doesFileExist String
planJsonFn

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
havePlanJson (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing 'plan.json' file; do you need to run 'cabal new-build'?"

    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
planJsonFn
  where
    fromBuilddir :: String -> IO String
fromBuilddir String
distFolder = do
        Bool
haveDistFolder <- String -> IO Bool
doesDirectoryExist String
distFolder

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
haveDistFolder (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"missing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
distFolder String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" folder; do you need to run 'cabal new-build'?")

        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
distFolder String -> String -> String
</> String
"cache" String -> String -> String
</> String
"plan.json"


-- | Find project root relative to a directory, this emulates cabal's current
-- heuristic, but is slightly more liberal. If no cabal.project is found,
-- cabal-install looks for *.cabal files in the specified directory only. This
-- function also considers *.cabal files in directories higher up in the
-- hierarchy.
findProjectRoot :: FilePath -> IO (Maybe FilePath)
findProjectRoot :: String -> IO (Maybe String)
findProjectRoot String
dir = do
    String
normalisedPath <- String -> IO String
canonicalizePath String
dir
    let checkCabalProject :: String -> IO (Maybe String)
checkCabalProject String
d = do
            Bool
ex <- String -> IO Bool
doesFileExist String
fn
            Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
ex then String -> Maybe String
forall a. a -> Maybe a
Just String
d else Maybe String
forall a. Maybe a
Nothing
          where
            fn :: String
fn = String
d String -> String -> String
</> String
"cabal.project"

        checkCabal :: String -> IO (Maybe String)
checkCabal String
d = do
            [String]
files <- String -> IO [String]
listDirectory' String
d
            Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
isExtensionOf' String
".cabal") [String]
files
                        then String -> Maybe String
forall a. a -> Maybe a
Just String
d
                        else Maybe String
forall a. Maybe a
Nothing

    Maybe String
result <- (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a. (String -> IO (Maybe a)) -> String -> IO (Maybe a)
walkUpFolders String -> IO (Maybe String)
checkCabalProject String
normalisedPath
    case Maybe String
result of
        Just String
rootDir -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
rootDir
        Maybe String
Nothing      -> (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a. (String -> IO (Maybe a)) -> String -> IO (Maybe a)
walkUpFolders String -> IO (Maybe String)
checkCabal String
normalisedPath
  where
    isExtensionOf' :: String -> FilePath -> Bool
    isExtensionOf' :: String -> String -> Bool
isExtensionOf' String
ext String
fp = String
ext String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> String
takeExtension String
fp

    listDirectory' :: FilePath -> IO [FilePath]
    listDirectory' :: String -> IO [String]
listDirectory' String
fp = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isSpecialDir ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getDirectoryContents String
fp
      where
        isSpecialDir :: String -> Bool
isSpecialDir String
f = String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"." Bool -> Bool -> Bool
&& String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
".."

walkUpFolders :: (FilePath -> IO (Maybe a)) -> FilePath -> IO (Maybe a)
walkUpFolders :: forall a. (String -> IO (Maybe a)) -> String -> IO (Maybe a)
walkUpFolders String -> IO (Maybe a)
dtest String
d0 = do
    String
home <- IO String
getHomeDirectory

    let go :: String -> IO (Maybe a)
go String
d | String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
home  = Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
             | String -> Bool
isDrive String
d  = Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
             | Bool
otherwise  = do
                   Maybe a
t <- String -> IO (Maybe a)
dtest String
d
                   case Maybe a
t of
                     Maybe a
Nothing  -> String -> IO (Maybe a)
go (String -> IO (Maybe a)) -> String -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
d
                     x :: Maybe a
x@Just{} -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x

    String -> IO (Maybe a)
go String
d0