content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes #-}
  
  module Hledger.Flow.BaseDir
    ( determineBaseDir,
      relativeToBase,
      relativeToBase',
      turtleBaseDir,
      effectiveRunDir,
    )
  where
  
  import Control.Monad (when)
  import Control.Monad.Catch (MonadThrow, throwM)
  import Control.Monad.IO.Class (MonadIO)
  import Data.Maybe
  import qualified Data.Text as T
  import qualified Data.Text.IO as T
  import Hledger.Flow.PathHelpers
  import Hledger.Flow.Types (BaseDir, HasBaseDir, RunDir, baseDir)
  import Path
  import Path.IO
  import qualified Turtle (liftIO, repr, stripPrefix)
  
  determineBaseDir :: Maybe TurtlePath -> IO (BaseDir, RunDir)
  determineBaseDir suppliedDir = do
    pwd <- getCurrentDir
    determineBaseDir' pwd suppliedDir
  
  determineBaseDir' :: AbsDir -> Maybe TurtlePath -> IO (BaseDir, RunDir)
  determineBaseDir' pwd (Just suppliedDir) = do
    absDir <- turtleToAbsDir pwd suppliedDir
    determineBaseDirFromStartDir absDir
  determineBaseDir' pwd Nothing = determineBaseDirFromStartDir pwd
  
  determineBaseDirFromStartDir :: AbsDir -> IO (BaseDir, RunDir)
  determineBaseDirFromStartDir startDir = determineBaseDirFromStartDir' startDir startDir
  
  determineBaseDirFromStartDir' :: (MonadIO m, MonadThrow m) => AbsDir -> AbsDir -> m (BaseDir, RunDir)
  determineBaseDirFromStartDir' startDir possibleBaseDir = do
    Control.Monad.when (parent possibleBaseDir == possibleBaseDir) $ throwM (MissingBaseDir startDir)
    foundBaseDir <- doesDirExist $ possibleBaseDir </> [reldir|import|]
    if foundBaseDir
      then do
        runDir <- limitRunDir possibleBaseDir startDir
        return (possibleBaseDir, runDir)
      else determineBaseDirFromStartDir' startDir $ parent possibleBaseDir
  
  -- | We have unexpected behaviour when the runDir is deeper than the account directory,
  -- e.g. "1-in" or the year directory. Specifically, include files are generated incorrectly
  -- and some journals are written entirely outside of the baseDir.
  -- limitRunDir can possibly removed if the above is fixed.
  limitRunDir :: (MonadIO m, MonadThrow m) => BaseDir -> AbsDir -> m RunDir
  limitRunDir bd absRunDir = do
    rel <- makeRelative bd absRunDir
    let runDirDepth = pathSize rel
    let fun = composeN (runDirDepth - 4) parent
    let newRunDir = fun rel
    when (runDirDepth > 4) $ do
      let msg = T.pack $ "Changing runDir from " ++ Turtle.repr rel ++ " to " ++ Turtle.repr newRunDir :: T.Text
      Turtle.liftIO $ T.putStrLn msg
    return newRunDir
  
  composeN :: Int -> (a -> a) -> (a -> a)
  composeN n f
    | n < 1 = id
    | n == 1 = f
    | otherwise = composeN (n - 1) (f . f)
  
  relativeToBase :: (HasBaseDir o) => o -> TurtlePath -> TurtlePath
  relativeToBase opts = relativeToBase' $ pathToTurtle (baseDir opts)
  
  relativeToBase' :: TurtlePath -> TurtlePath -> TurtlePath
  relativeToBase' bd p =
    if forceTrailingSlash bd == forceTrailingSlash p
      then "./"
      else
        fromMaybe p $ Turtle.stripPrefix (forceTrailingSlash bd) p
  
  turtleBaseDir :: (HasBaseDir o) => o -> TurtlePath
  turtleBaseDir opts = pathToTurtle $ baseDir opts
  
  effectiveRunDir :: BaseDir -> RunDir -> AbsDir
  effectiveRunDir bd rd = do
    let baseImportDir = bd </> [Path.reldir|import|]
    let absRunDir = bd </> rd
    if absRunDir == bd then baseImportDir else absRunDir
  