module Coolbal.FindRoot (
    findCabalSpec,
    FoundCabalSpec(..),
    findDist,
    FoundRootDir(..),
) where

import Data.List (unfoldr)
import System.Directory
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)


data FoundCabalSpec = FoundCabalSpec
    { foundcsRootDir :: FilePath
    , foundcsCabal :: FilePath }
  deriving (Show)

findCabalSpec :: IO FoundCabalSpec
findCabalSpec = do
    cwd <- getCurrentDirectory >>= makeAbsolute
    mfound <- findThingInDirs "cabal file" (`endsWith` ".cabal") doesFileExist FoundCabalSpec (ancestors cwd)
    case mfound of
      Just found -> do
          hPutStrLn stderr ("Found .cabal file: " ++ foundcsCabal found)
          return found
      Nothing -> do
          hPutStrLn stderr (".cabal file not found in ancestors of PWD: " ++ cwd)
          exitFailure

data FoundRootDir = FoundRootDir FilePath
  deriving (Show)

findDist :: IO FoundRootDir
findDist = do
    cwd <- getCurrentDirectory >>= makeAbsolute
    mfound <- findThingInDirs "dist-coolbal directory" (== "dist-coolbal") doesDirectoryExist (\p _ -> FoundRootDir p) (ancestors cwd)
    case mfound of
      Just found -> return found
      Nothing -> do
          hPutStrLn stderr ("dist-coolbal directory not found in ancestors of PWD: " ++ cwd)
          exitFailure

-- | Argument semantics are the same as 'findThingInDir'.
findThingInDirs :: String -> (FilePath -> Bool) -> (FilePath -> IO Bool) -> (FilePath -> FilePath -> a) -> [FilePath] -> IO (Maybe a)
findThingInDirs _ _ _ _ [] = return Nothing
findThingInDirs description namePred typePred constructor (p:ps) =
    findThingInDir description namePred typePred constructor p
        >>= maybe (findThingInDirs description namePred typePred constructor ps)
                  (return . Just)

-- | 'namePred' gets the file name, 'typePred' gets the full path.
-- 'constructor' gets the root dir path and the name of the file found.
findThingInDir :: String -> (FilePath -> Bool) -> (FilePath -> IO Bool) -> (FilePath -> FilePath -> a) -> FilePath -> IO (Maybe a)
findThingInDir description namePred typePred constructor dir = do
    files <- filter namePred <$> listDirectory dir
    case files of
      [fname] -> do
          ok <- typePred (dir </> fname)
          return (if ok then Just (constructor dir (dir </> fname))
                        else Nothing)
      [] -> return Nothing
      _ -> do
          hPutStrLn stderr ("Ambiguity when searching for " ++ description ++ "! Found files:")
          mapM_ (\p -> hPutStrLn stderr ("- " ++ (dir </> p))) files
          exitFailure

parentDir :: FilePath -> Maybe FilePath
parentDir s = case reverse s of
                "/" -> Nothing
                '/' : s' -> Just (reverse (dropWhile (/= '/') s'))
                s' -> case dropWhile (/= '/') s' of
                        "/" -> Just "/"
                        _ : s'' -> Just (reverse s'')
                        "" -> Nothing

-- Includes the path itself as first element
ancestors :: FilePath -> [FilePath]
ancestors p = p : unfoldr (fmap (\x -> (x,x)) . parentDir) p

endsWith :: String -> String -> Bool
s `endsWith` s' = reverse (take (length s') (reverse s)) == s'