{-# 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)
findFilesIn :: MonadIO m
=> (AbsDir -> Bool)
-> [RelDir]
-> AbsDir
-> m [AbsFile]
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
'.')