{-# LANGUAGE OverloadedStrings #-}

module Hledger.Flow.PathHelpers where

import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO)
import qualified Data.Text as T
import Hledger.Flow.DocHelpers (docURL)
import Path ((</>))
import qualified Path
import qualified Path.IO as Path
import qualified Turtle

type TurtlePath = Turtle.FilePath

type AbsFile = Path.Path Path.Abs Path.File

type RelFile = Path.Path Path.Rel Path.File

type AbsDir = Path.Path Path.Abs Path.Dir

type RelDir = Path.Path Path.Rel Path.Dir

data PathException = MissingBaseDir AbsDir | InvalidTurtleDir TurtlePath
  deriving (PathException -> PathException -> Bool
(PathException -> PathException -> Bool)
-> (PathException -> PathException -> Bool) -> Eq PathException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathException -> PathException -> Bool
== :: PathException -> PathException -> Bool
$c/= :: PathException -> PathException -> Bool
/= :: PathException -> PathException -> Bool
Eq)

instance Show PathException where
  show :: PathException -> TurtlePath
show (MissingBaseDir AbsDir
d) =
    TurtlePath
"Unable to find an import directory at "
      TurtlePath -> ShowS
forall a. [a] -> [a] -> [a]
++ AbsDir -> TurtlePath
forall a. Show a => a -> TurtlePath
show AbsDir
d
      TurtlePath -> ShowS
forall a. [a] -> [a] -> [a]
++ TurtlePath
" (or in any of its parent directories).\n\n"
      TurtlePath -> ShowS
forall a. [a] -> [a] -> [a]
++ TurtlePath
"Have a look at the documentation for more information:\n"
      TurtlePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> TurtlePath
T.unpack (Line -> Text
docURL Line
"getting-started")
  show (InvalidTurtleDir TurtlePath
d) = TurtlePath
"Expected a directory but got this instead: " TurtlePath -> ShowS
forall a. [a] -> [a] -> [a]
++ TurtlePath
d

instance Exception PathException

fromTurtleAbsFile :: (MonadThrow m) => TurtlePath -> m AbsFile
fromTurtleAbsFile :: forall (m :: * -> *). MonadThrow m => TurtlePath -> m AbsFile
fromTurtleAbsFile TurtlePath
turtlePath = TurtlePath -> m AbsFile
forall (m :: * -> *). MonadThrow m => TurtlePath -> m AbsFile
Path.parseAbsFile TurtlePath
turtlePath

fromTurtleRelFile :: (MonadThrow m) => TurtlePath -> m RelFile
fromTurtleRelFile :: forall (m :: * -> *). MonadThrow m => TurtlePath -> m RelFile
fromTurtleRelFile TurtlePath
turtlePath = TurtlePath -> m RelFile
forall (m :: * -> *). MonadThrow m => TurtlePath -> m RelFile
Path.parseRelFile TurtlePath
turtlePath

fromTurtleAbsDir :: (MonadThrow m) => TurtlePath -> m AbsDir
fromTurtleAbsDir :: forall (m :: * -> *). MonadThrow m => TurtlePath -> m AbsDir
fromTurtleAbsDir TurtlePath
turtlePath = TurtlePath -> m AbsDir
forall (m :: * -> *). MonadThrow m => TurtlePath -> m AbsDir
Path.parseAbsDir TurtlePath
turtlePath

fromTurtleRelDir :: (MonadThrow m) => TurtlePath -> m RelDir
fromTurtleRelDir :: forall (m :: * -> *). MonadThrow m => TurtlePath -> m RelDir
fromTurtleRelDir TurtlePath
turtlePath = TurtlePath -> m RelDir
forall (m :: * -> *). MonadThrow m => TurtlePath -> m RelDir
Path.parseRelDir TurtlePath
turtlePath

turtleToAbsDir :: (MonadIO m, MonadThrow m) => AbsDir -> TurtlePath -> m AbsDir
turtleToAbsDir :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
AbsDir -> TurtlePath -> m AbsDir
turtleToAbsDir AbsDir
baseDir TurtlePath
p = do
  Bool
isDir <- TurtlePath -> m Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testdir TurtlePath
p
  if Bool
isDir
    then AbsDir -> TurtlePath -> m AbsDir
forall (m :: * -> *). MonadIO m => AbsDir -> TurtlePath -> m AbsDir
Path.resolveDir AbsDir
baseDir TurtlePath
p
    else PathException -> m AbsDir
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (PathException -> m AbsDir) -> PathException -> m AbsDir
forall a b. (a -> b) -> a -> b
$ TurtlePath -> PathException
InvalidTurtleDir TurtlePath
p

pathToTurtle :: Path.Path b t -> TurtlePath
pathToTurtle :: forall b t. Path b t -> TurtlePath
pathToTurtle = Path b t -> TurtlePath
forall b t. Path b t -> TurtlePath
Path.toFilePath

forceTrailingSlash :: TurtlePath -> TurtlePath
forceTrailingSlash :: ShowS
forceTrailingSlash TurtlePath
p = ShowS
Turtle.directory (TurtlePath
p TurtlePath -> ShowS
Turtle.</> TurtlePath
"temp")

pathSize :: Path.Path b Path.Dir -> Int
pathSize :: forall b. Path b Dir -> Int
pathSize Path b Dir
p = Path b Dir -> Int -> Int
forall b. Path b Dir -> Int -> Int
pathSize' Path b Dir
p Int
0

pathSize' :: Path.Path b Path.Dir -> Int -> Int
pathSize' :: forall b. Path b Dir -> Int -> Int
pathSize' Path b Dir
p Int
count = if Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
Path.parent Path b Dir
p Path b Dir -> Path b Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path b Dir
p then Int
count else Path b Dir -> Int -> Int
forall b. Path b Dir -> Int -> Int
pathSize' (Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
Path.parent Path b Dir
p) (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Do a recursive search starting from the given directory.
-- Return all files contained in each directory which matches the given predicate.
findFilesIn ::
  (MonadIO m) =>
  -- | Do we want the files in this directory?
  (AbsDir -> Bool) ->
  -- | Exclude these directory names
  [RelDir] ->
  -- | Top of the search tree
  AbsDir ->
  -- | Absolute paths to all files in the directories which match the predicate
  m [AbsFile]
findFilesIn :: forall (m :: * -> *).
MonadIO m =>
(AbsDir -> Bool) -> [RelDir] -> AbsDir -> m [AbsFile]
findFilesIn AbsDir -> Bool
includePred [RelDir]
excludeDirs = Maybe (AbsDir -> [AbsDir] -> [AbsFile] -> m (WalkAction Abs))
-> (AbsDir -> [AbsDir] -> [AbsFile] -> m [AbsFile])
-> AbsDir
-> m [AbsFile]
forall (m :: * -> *) o b.
(MonadIO m, Monoid o) =>
Maybe (AbsDir -> [AbsDir] -> [AbsFile] -> m (WalkAction Abs))
-> (AbsDir -> [AbsDir] -> [AbsFile] -> m o) -> Path b Dir -> m o
Path.walkDirAccum ((AbsDir -> [AbsDir] -> [AbsFile] -> m (WalkAction Abs))
-> Maybe (AbsDir -> [AbsDir] -> [AbsFile] -> m (WalkAction Abs))
forall a. a -> Maybe a
Just AbsDir -> [AbsDir] -> [AbsFile] -> m (WalkAction Abs)
forall {m :: * -> *} {b} {p} {p}.
Monad m =>
Path b Dir -> p -> p -> m (WalkAction b)
excludeHandler) AbsDir -> [AbsDir] -> [AbsFile] -> m [AbsFile]
forall {m :: * -> *} {p}.
Monad m =>
AbsDir -> p -> [AbsFile] -> m [AbsFile]
accumulator
  where
    excludeHandler :: Path b Dir -> p -> p -> m (WalkAction b)
excludeHandler Path b Dir
currentDir p
_ p
_ = WalkAction b -> m (WalkAction b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WalkAction b -> m (WalkAction b))
-> WalkAction b -> m (WalkAction b)
forall a b. (a -> b) -> a -> b
$ [Path b Dir] -> WalkAction b
forall b. [Path b Dir] -> WalkAction b
Path.WalkExclude ((RelDir -> Path b Dir) -> [RelDir] -> [Path b Dir]
forall a b. (a -> b) -> [a] -> [b]
map (Path b Dir
currentDir Path b Dir -> RelDir -> Path b Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) [RelDir]
excludeDirs)
    accumulator :: AbsDir -> p -> [AbsFile] -> m [AbsFile]
accumulator AbsDir
currentDir p
_ [AbsFile]
files =
      if AbsDir -> Bool
includePred AbsDir
currentDir
        then [AbsFile] -> m [AbsFile]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([AbsFile] -> m [AbsFile]) -> [AbsFile] -> m [AbsFile]
forall a b. (a -> b) -> a -> b
$ [AbsFile] -> [AbsFile]
excludeHiddenFiles [AbsFile]
files
        else [AbsFile] -> m [AbsFile]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

excludeHiddenFiles :: [AbsFile] -> [AbsFile]
excludeHiddenFiles :: [AbsFile] -> [AbsFile]
excludeHiddenFiles = (AbsFile -> Bool) -> [AbsFile] -> [AbsFile]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (AbsFile -> Bool) -> AbsFile -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsFile -> Bool
forall {b}. Path b File -> Bool
isHiddenFile)
  where
    isHiddenFile :: Path b File -> Bool
isHiddenFile Path b File
f = case RelFile -> TurtlePath
forall b t. Path b t -> TurtlePath
Path.toFilePath (Path b File -> RelFile
forall b. Path b File -> RelFile
Path.filename Path b File
f) of
      Char
'.':TurtlePath
_ -> Bool
True
      TurtlePath
_ -> Bool
False