{-# LANGUAGE OverloadedStrings #-}

module Hledger.Flow.PathHelpers where

import Control.Monad.Catch (MonadThrow, Exception, throwM)
import Control.Monad.IO.Class (MonadIO)

import qualified Data.Text as T

import Path ((</>))
import qualified Path
import qualified Path.IO as Path
import qualified Turtle

import Hledger.Flow.DocHelpers (docURL)

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
/= :: PathException -> PathException -> Bool
$c/= :: PathException -> PathException -> Bool
== :: PathException -> PathException -> Bool
$c== :: PathException -> PathException -> Bool
Eq)

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

instance Exception PathException

fromTurtleAbsFile :: MonadThrow m => TurtlePath -> m AbsFile
fromTurtleAbsFile :: TurtlePath -> m AbsFile
fromTurtleAbsFile TurtlePath
turtlePath = String -> m AbsFile
forall (m :: * -> *). MonadThrow m => String -> m AbsFile
Path.parseAbsFile (String -> m AbsFile) -> String -> m AbsFile
forall a b. (a -> b) -> a -> b
$ TurtlePath -> String
Turtle.encodeString TurtlePath
turtlePath

fromTurtleRelFile :: MonadThrow m => TurtlePath -> m RelFile
fromTurtleRelFile :: TurtlePath -> m RelFile
fromTurtleRelFile TurtlePath
turtlePath = String -> m RelFile
forall (m :: * -> *). MonadThrow m => String -> m RelFile
Path.parseRelFile (String -> m RelFile) -> String -> m RelFile
forall a b. (a -> b) -> a -> b
$ TurtlePath -> String
Turtle.encodeString TurtlePath
turtlePath

fromTurtleAbsDir :: MonadThrow m => TurtlePath -> m AbsDir
fromTurtleAbsDir :: TurtlePath -> m AbsDir
fromTurtleAbsDir TurtlePath
turtlePath = String -> m AbsDir
forall (m :: * -> *). MonadThrow m => String -> m AbsDir
Path.parseAbsDir (String -> m AbsDir) -> String -> m AbsDir
forall a b. (a -> b) -> a -> b
$ TurtlePath -> String
Turtle.encodeString TurtlePath
turtlePath

fromTurtleRelDir :: MonadThrow m => TurtlePath -> m RelDir
fromTurtleRelDir :: TurtlePath -> m RelDir
fromTurtleRelDir TurtlePath
turtlePath = String -> m RelDir
forall (m :: * -> *). MonadThrow m => String -> m RelDir
Path.parseRelDir (String -> m RelDir) -> String -> m RelDir
forall a b. (a -> b) -> a -> b
$ TurtlePath -> String
Turtle.encodeString TurtlePath
turtlePath

turtleToAbsDir :: (MonadIO m, MonadThrow m) => AbsDir -> TurtlePath -> m AbsDir
turtleToAbsDir :: 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 -> String -> m AbsDir
forall (m :: * -> *). MonadIO m => AbsDir -> String -> m AbsDir
Path.resolveDir AbsDir
baseDir (String -> m AbsDir) -> String -> m AbsDir
forall a b. (a -> b) -> a -> b
$ TurtlePath -> String
Turtle.encodeString TurtlePath
p
    else PathException -> m AbsDir
forall (m :: * -> *) e a. (MonadThrow m, 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 :: Path b t -> TurtlePath
pathToTurtle = String -> TurtlePath
Turtle.decodeString (String -> TurtlePath)
-> (Path b t -> String) -> Path b t -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> String
forall b t. Path b t -> String
Path.toFilePath

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

pathSize :: Path.Path b Path.Dir -> Int
pathSize :: 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' :: 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
countInt -> 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
  => (AbsDir -> Bool) -- ^ Do we want the files in this directory?
  -> [RelDir]         -- ^ Exclude these directory names
  -> AbsDir           -- ^ Top of the search tree
  -> m [AbsFile]      -- ^ Absolute paths to all files in the directories which match the predicate
findFilesIn :: (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 (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 (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 (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 (\ AbsFile
f -> String -> Char
forall a. [a] -> a
head (RelFile -> String
forall b t. Path b t -> String
Path.toFilePath (AbsFile -> RelFile
forall b. Path b File -> RelFile
Path.filename AbsFile
f)) Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.')