{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.DirForest
(
DirTree (..),
DirForest (..),
InsertionError (..),
FOD (..),
eq1DirTree,
ord1DirTree,
eq1DirForest,
ord1DirForest,
null,
nullFiles,
lookup,
empty,
singletonFile,
singletonDir,
insertFile,
insertDir,
mapWithPath,
traverseWithPath,
traverseWithPath_,
pruneEmptyDirs,
anyEmptyDir,
fromFileMap,
toFileMap,
fromMap,
toMap,
fromFileList,
toFileList,
read,
readNonHidden,
readFiltered,
readNonHiddenFiltered,
readOneLevel,
readOneLevelNonHidden,
readOneLevelFiltered,
readOneLevelNonHiddenFiltered,
hiddenRel,
write,
InsertValidation (..),
unpackInsertValidation,
union,
unionWith,
unionWithKey,
unions,
intersection,
intersectionWith,
intersectionWithKey,
intersections,
difference,
differenceWith,
differenceWithKey,
filter,
filterWithKey,
filterHidden,
)
where
import Autodocodec
import Control.Arrow (left)
import Control.DeepSeq
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson (FromJSON, ToJSON)
import Data.Functor.Classes
import Data.Functor.Identity
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Validity
import Data.Validity.Containers ()
import Data.Validity.Map
import Data.Validity.Path ()
import GHC.Generics (Generic)
import Path
import Path.IO
import Path.Internal
import qualified System.FilePath as FP
import Prelude hiding (filter, lookup, null, read)
import qualified Prelude
data DirTree a
= NodeFile a
| NodeDir (DirForest a)
deriving stock (Int -> DirTree a -> ShowS
forall a. Show a => Int -> DirTree a -> ShowS
forall a. Show a => [DirTree a] -> ShowS
forall a. Show a => DirTree a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DirTree a] -> ShowS
$cshowList :: forall a. Show a => [DirTree a] -> ShowS
show :: DirTree a -> FilePath
$cshow :: forall a. Show a => DirTree a -> FilePath
showsPrec :: Int -> DirTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DirTree a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DirTree a) x -> DirTree a
forall a x. DirTree a -> Rep (DirTree a) x
$cto :: forall a x. Rep (DirTree a) x -> DirTree a
$cfrom :: forall a x. DirTree a -> Rep (DirTree a) x
Generic, forall a b. a -> DirTree b -> DirTree a
forall a b. (a -> b) -> DirTree a -> DirTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DirTree b -> DirTree a
$c<$ :: forall a b. a -> DirTree b -> DirTree a
fmap :: forall a b. (a -> b) -> DirTree a -> DirTree b
$cfmap :: forall a b. (a -> b) -> DirTree a -> DirTree b
Functor)
deriving (Value -> Parser [DirTree a]
Value -> Parser (DirTree a)
forall a. HasCodec a => Value -> Parser [DirTree a]
forall a. HasCodec a => Value -> Parser (DirTree a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DirTree a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [DirTree a]
parseJSON :: Value -> Parser (DirTree a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (DirTree a)
FromJSON, [DirTree a] -> Encoding
[DirTree a] -> Value
DirTree a -> Encoding
DirTree a -> Value
forall a. HasCodec a => [DirTree a] -> Encoding
forall a. HasCodec a => [DirTree a] -> Value
forall a. HasCodec a => DirTree a -> Encoding
forall a. HasCodec a => DirTree a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DirTree a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [DirTree a] -> Encoding
toJSONList :: [DirTree a] -> Value
$ctoJSONList :: forall a. HasCodec a => [DirTree a] -> Value
toEncoding :: DirTree a -> Encoding
$ctoEncoding :: forall a. HasCodec a => DirTree a -> Encoding
toJSON :: DirTree a -> Value
$ctoJSON :: forall a. HasCodec a => DirTree a -> Value
ToJSON) via (Autodocodec (DirTree a))
instance (Validity a) => Validity (DirTree a)
instance Eq a => Eq (DirTree a) where
== :: DirTree a -> DirTree a -> Bool
(==) = forall a b. (a -> b -> Bool) -> DirTree a -> DirTree b -> Bool
eq1DirTree forall a. Eq a => a -> a -> Bool
(==)
instance Ord a => Ord (DirTree a) where
compare :: DirTree a -> DirTree a -> Ordering
compare = forall a b.
(a -> b -> Ordering) -> DirTree a -> DirTree b -> Ordering
ord1DirTree forall a. Ord a => a -> a -> Ordering
compare
instance Eq1 DirTree where
liftEq :: forall a b. (a -> b -> Bool) -> DirTree a -> DirTree b -> Bool
liftEq = forall a b. (a -> b -> Bool) -> DirTree a -> DirTree b -> Bool
eq1DirTree
instance Ord1 DirTree where
liftCompare :: forall a b.
(a -> b -> Ordering) -> DirTree a -> DirTree b -> Ordering
liftCompare = forall a b.
(a -> b -> Ordering) -> DirTree a -> DirTree b -> Ordering
ord1DirTree
instance NFData a => NFData (DirTree a)
instance Foldable DirTree where
foldMap :: forall m a. Monoid m => (a -> m) -> DirTree a -> m
foldMap a -> m
func =
\case
NodeFile a
v -> a -> m
func a
v
NodeDir DirForest a
df -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
func DirForest a
df
instance Traversable DirTree where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirTree a -> f (DirTree b)
traverse a -> f b
func =
\case
NodeFile a
v -> forall a. a -> DirTree a
NodeFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
func a
v
NodeDir DirForest a
df -> forall a. DirForest a -> DirTree a
NodeDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
func DirForest a
df
instance HasCodec a => HasCodec (DirTree a) where
codec :: JSONCodec (DirTree a)
codec =
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"DirTree" forall a b. (a -> b) -> a -> b
$
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec forall {a}. Either a (DirForest a) -> DirTree a
f forall {a}. DirTree a -> Either a (DirForest a)
g forall a b. (a -> b) -> a -> b
$
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
(forall value. HasCodec value => JSONCodec value
codec :: JSONCodec a)
(forall value. HasCodec value => JSONCodec value
codec :: JSONCodec (DirForest a))
where
f :: Either a (DirForest a) -> DirTree a
f = \case
Left a
a -> forall a. a -> DirTree a
NodeFile a
a
Right DirForest a
b -> forall a. DirForest a -> DirTree a
NodeDir DirForest a
b
g :: DirTree a -> Either a (DirForest a)
g = \case
NodeFile a
a -> forall a b. a -> Either a b
Left a
a
NodeDir DirForest a
b -> forall a b. b -> Either a b
Right DirForest a
b
eq1DirTree :: (a -> b -> Bool) -> DirTree a -> DirTree b -> Bool
eq1DirTree :: forall a b. (a -> b -> Bool) -> DirTree a -> DirTree b -> Bool
eq1DirTree a -> b -> Bool
eq DirTree a
dt1 DirTree b
dt2 = case (DirTree a
dt1, DirTree b
dt2) of
(NodeFile a
a1, NodeFile b
a2) -> a -> b -> Bool
eq a
a1 b
a2
(NodeDir DirForest a
df1, NodeDir DirForest b
df2) -> forall a b. (a -> b -> Bool) -> DirForest a -> DirForest b -> Bool
eq1DirForest a -> b -> Bool
eq DirForest a
df1 DirForest b
df2
(DirTree a, DirTree b)
_ -> Bool
False
ord1DirTree :: (a -> b -> Ordering) -> DirTree a -> DirTree b -> Ordering
ord1DirTree :: forall a b.
(a -> b -> Ordering) -> DirTree a -> DirTree b -> Ordering
ord1DirTree a -> b -> Ordering
cmp DirTree a
dt1 DirTree b
dt2 = case (DirTree a
dt1, DirTree b
dt2) of
(NodeFile a
a1, NodeFile b
a2) -> a -> b -> Ordering
cmp a
a1 b
a2
(NodeDir DirForest a
df1, NodeDir DirForest b
df2) -> forall a b.
(a -> b -> Ordering) -> DirForest a -> DirForest b -> Ordering
ord1DirForest a -> b -> Ordering
cmp DirForest a
df1 DirForest b
df2
(NodeFile a
_, NodeDir DirForest b
_) -> Ordering
LT
(NodeDir DirForest a
_, NodeFile b
_) -> Ordering
GT
newtype DirForest a = DirForest
{ forall a. DirForest a -> Map FilePath (DirTree a)
unDirForest :: Map FilePath (DirTree a)
}
deriving stock (Int -> DirForest a -> ShowS
forall a. Show a => Int -> DirForest a -> ShowS
forall a. Show a => [DirForest a] -> ShowS
forall a. Show a => DirForest a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DirForest a] -> ShowS
$cshowList :: forall a. Show a => [DirForest a] -> ShowS
show :: DirForest a -> FilePath
$cshow :: forall a. Show a => DirForest a -> FilePath
showsPrec :: Int -> DirForest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DirForest a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DirForest a) x -> DirForest a
forall a x. DirForest a -> Rep (DirForest a) x
$cto :: forall a x. Rep (DirForest a) x -> DirForest a
$cfrom :: forall a x. DirForest a -> Rep (DirForest a) x
Generic, forall a b. a -> DirForest b -> DirForest a
forall a b. (a -> b) -> DirForest a -> DirForest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> DirForest b -> DirForest a
$c<$ :: forall a b. a -> DirForest b -> DirForest a
fmap :: forall a b. (a -> b) -> DirForest a -> DirForest b
$cfmap :: forall a b. (a -> b) -> DirForest a -> DirForest b
Functor)
deriving (Value -> Parser [DirForest a]
Value -> Parser (DirForest a)
forall a. HasCodec a => Value -> Parser [DirForest a]
forall a. HasCodec a => Value -> Parser (DirForest a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DirForest a]
$cparseJSONList :: forall a. HasCodec a => Value -> Parser [DirForest a]
parseJSON :: Value -> Parser (DirForest a)
$cparseJSON :: forall a. HasCodec a => Value -> Parser (DirForest a)
FromJSON, [DirForest a] -> Encoding
[DirForest a] -> Value
DirForest a -> Encoding
DirForest a -> Value
forall a. HasCodec a => [DirForest a] -> Encoding
forall a. HasCodec a => [DirForest a] -> Value
forall a. HasCodec a => DirForest a -> Encoding
forall a. HasCodec a => DirForest a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DirForest a] -> Encoding
$ctoEncodingList :: forall a. HasCodec a => [DirForest a] -> Encoding
toJSONList :: [DirForest a] -> Value
$ctoJSONList :: forall a. HasCodec a => [DirForest a] -> Value
toEncoding :: DirForest a -> Encoding
$ctoEncoding :: forall a. HasCodec a => DirForest a -> Encoding
toJSON :: DirForest a -> Value
$ctoJSON :: forall a. HasCodec a => DirForest a -> Value
ToJSON) via (Autodocodec (DirForest a))
instance (Validity a) => Validity (DirForest a) where
validate :: DirForest a -> Validation
validate df :: DirForest a
df@(DirForest Map FilePath (DirTree a)
m) =
forall a. Monoid a => [a] -> a
mconcat
[ forall a. (Generic a, GValidity (Rep a)) => a -> Validation
genericValidate DirForest a
df,
forall k v.
Show k =>
Map k v -> (k -> v -> Validation) -> Validation
decorateMap Map FilePath (DirTree a)
m forall a b. (a -> b) -> a -> b
$ \FilePath
p DirTree a
dt ->
let isTopLevel :: Path Rel t -> Bool
isTopLevel Path Rel t
p_ = forall b t. Path b t -> Path b Dir
parent Path Rel t
p_ forall a. Eq a => a -> a -> Bool
== [reldir|./|]
in case DirTree a
dt of
NodeFile a
_ ->
let rf :: Path Rel File
rf = forall b t. FilePath -> Path b t
Path FilePath
p :: Path Rel File
in forall a. Monoid a => [a] -> a
mconcat
[ FilePath -> Bool -> Validation
declare FilePath
"There are no separators on this level" forall a b. (a -> b) -> a -> b
$ forall {t}. Path Rel t -> Bool
isTopLevel Path Rel File
rf,
forall a. Validity a => a -> Validation
validate (forall b t. FilePath -> Path b t
Path FilePath
p :: Path Rel File)
]
NodeDir (DirForest Map FilePath (DirTree a)
_) ->
let rd :: Path Rel Dir
rd = forall b t. FilePath -> Path b t
Path (ShowS
FP.addTrailingPathSeparator FilePath
p) :: Path Rel Dir
in forall a. Monoid a => [a] -> a
mconcat
[ FilePath -> Bool -> Validation
declare FilePath
"the path has no trailing path separator" forall a b. (a -> b) -> a -> b
$
Bool -> Bool
not forall a b. (a -> b) -> a -> b
$
FilePath -> Bool
FP.hasTrailingPathSeparator FilePath
p,
FilePath -> Bool -> Validation
declare FilePath
"There are no separators on this level" forall a b. (a -> b) -> a -> b
$ forall {t}. Path Rel t -> Bool
isTopLevel Path Rel Dir
rd,
forall a. Validity a => a -> Validation
validate Path Rel Dir
rd
]
]
instance Eq a => Eq (DirForest a) where
== :: DirForest a -> DirForest a -> Bool
(==) = forall a b. (a -> b -> Bool) -> DirForest a -> DirForest b -> Bool
eq1DirForest forall a. Eq a => a -> a -> Bool
(==)
instance Ord a => Ord (DirForest a) where
compare :: DirForest a -> DirForest a -> Ordering
compare = forall a b.
(a -> b -> Ordering) -> DirForest a -> DirForest b -> Ordering
ord1DirForest forall a. Ord a => a -> a -> Ordering
compare
instance Eq1 DirForest where
liftEq :: forall a b. (a -> b -> Bool) -> DirForest a -> DirForest b -> Bool
liftEq = forall a b. (a -> b -> Bool) -> DirForest a -> DirForest b -> Bool
eq1DirForest
instance Ord1 DirForest where
liftCompare :: forall a b.
(a -> b -> Ordering) -> DirForest a -> DirForest b -> Ordering
liftCompare = forall a b.
(a -> b -> Ordering) -> DirForest a -> DirForest b -> Ordering
ord1DirForest
instance NFData a => NFData (DirForest a)
instance Foldable DirForest where
foldMap :: forall m a. Monoid m => (a -> m) -> DirForest a -> m
foldMap a -> m
func (DirForest Map FilePath (DirTree a)
dtm) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
func) Map FilePath (DirTree a)
dtm
instance Traversable DirForest where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> DirForest a -> f (DirForest b)
traverse a -> f b
func (DirForest Map FilePath (DirTree a)
dtm) = forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
func) Map FilePath (DirTree a)
dtm
instance HasCodec a => HasCodec (DirForest a) where
codec :: JSONCodec (DirForest a)
codec =
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"DirForest" forall a b. (a -> b) -> a -> b
$
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec
forall a. Map FilePath (DirTree a) -> DirForest a
DirForest
forall a. DirForest a -> Map FilePath (DirTree a)
unDirForest
(forall value. HasCodec value => JSONCodec value
codec :: JSONCodec (Map FilePath (DirTree a)))
eq1DirForest :: (a -> b -> Bool) -> DirForest a -> DirForest b -> Bool
eq1DirForest :: forall a b. (a -> b -> Bool) -> DirForest a -> DirForest b -> Bool
eq1DirForest a -> b -> Bool
eq (DirForest Map FilePath (DirTree a)
m1) (DirForest Map FilePath (DirTree b)
m2) =
let l1 :: [(FilePath, DirTree a)]
l1 = forall k a. Map k a -> [(k, a)]
M.toAscList Map FilePath (DirTree a)
m1
l2 :: [(FilePath, DirTree b)]
l2 = forall k a. Map k a -> [(k, a)]
M.toAscList Map FilePath (DirTree b)
m2
in forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, DirTree a)]
l1 forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, DirTree b)]
l2 Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (\(FilePath
p1, DirTree a
a1) (FilePath
p2, DirTree b
a2) -> FilePath
p1 forall a. Eq a => a -> a -> Bool
== FilePath
p2 Bool -> Bool -> Bool
&& forall a b. (a -> b -> Bool) -> DirTree a -> DirTree b -> Bool
eq1DirTree a -> b -> Bool
eq DirTree a
a1 DirTree b
a2) [(FilePath, DirTree a)]
l1 [(FilePath, DirTree b)]
l2
ord1DirForest :: (a -> b -> Ordering) -> DirForest a -> DirForest b -> Ordering
ord1DirForest :: forall a b.
(a -> b -> Ordering) -> DirForest a -> DirForest b -> Ordering
ord1DirForest a -> b -> Ordering
cmp (DirForest Map FilePath (DirTree a)
m1) (DirForest Map FilePath (DirTree b)
m2) =
let l1 :: [(FilePath, DirTree a)]
l1 = forall k a. Map k a -> [(k, a)]
M.toAscList Map FilePath (DirTree a)
m1
l2 :: [(FilePath, DirTree b)]
l2 = forall k a. Map k a -> [(k, a)]
M.toAscList Map FilePath (DirTree b)
m2
in forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (\(FilePath
p1, DirTree a
a1) (FilePath
p2, DirTree b
a2) -> forall a. Ord a => a -> a -> Ordering
compare FilePath
p1 FilePath
p2 forall a. Semigroup a => a -> a -> a
<> forall a b.
(a -> b -> Ordering) -> DirTree a -> DirTree b -> Ordering
ord1DirTree a -> b -> Ordering
cmp DirTree a
a1 DirTree b
a2) [(FilePath, DirTree a)]
l1 [(FilePath, DirTree b)]
l2
data FOD a
= F a
| D
deriving (Int -> FOD a -> ShowS
forall a. Show a => Int -> FOD a -> ShowS
forall a. Show a => [FOD a] -> ShowS
forall a. Show a => FOD a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FOD a] -> ShowS
$cshowList :: forall a. Show a => [FOD a] -> ShowS
show :: FOD a -> FilePath
$cshow :: forall a. Show a => FOD a -> FilePath
showsPrec :: Int -> FOD a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FOD a -> ShowS
Show, FOD a -> FOD a -> Bool
forall a. Eq a => FOD a -> FOD a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FOD a -> FOD a -> Bool
$c/= :: forall a. Eq a => FOD a -> FOD a -> Bool
== :: FOD a -> FOD a -> Bool
$c== :: forall a. Eq a => FOD a -> FOD a -> Bool
Eq, FOD a -> FOD a -> Bool
FOD a -> FOD a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (FOD a)
forall a. Ord a => FOD a -> FOD a -> Bool
forall a. Ord a => FOD a -> FOD a -> Ordering
forall a. Ord a => FOD a -> FOD a -> FOD a
min :: FOD a -> FOD a -> FOD a
$cmin :: forall a. Ord a => FOD a -> FOD a -> FOD a
max :: FOD a -> FOD a -> FOD a
$cmax :: forall a. Ord a => FOD a -> FOD a -> FOD a
>= :: FOD a -> FOD a -> Bool
$c>= :: forall a. Ord a => FOD a -> FOD a -> Bool
> :: FOD a -> FOD a -> Bool
$c> :: forall a. Ord a => FOD a -> FOD a -> Bool
<= :: FOD a -> FOD a -> Bool
$c<= :: forall a. Ord a => FOD a -> FOD a -> Bool
< :: FOD a -> FOD a -> Bool
$c< :: forall a. Ord a => FOD a -> FOD a -> Bool
compare :: FOD a -> FOD a -> Ordering
$ccompare :: forall a. Ord a => FOD a -> FOD a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FOD a) x -> FOD a
forall a x. FOD a -> Rep (FOD a) x
$cto :: forall a x. Rep (FOD a) x -> FOD a
$cfrom :: forall a x. FOD a -> Rep (FOD a) x
Generic, forall a b. a -> FOD b -> FOD a
forall a b. (a -> b) -> FOD a -> FOD b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FOD b -> FOD a
$c<$ :: forall a b. a -> FOD b -> FOD a
fmap :: forall a b. (a -> b) -> FOD a -> FOD b
$cfmap :: forall a b. (a -> b) -> FOD a -> FOD b
Functor)
instance Validity a => Validity (FOD a)
empty :: DirForest a
empty :: forall a. DirForest a
empty = forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall k a. Map k a
M.empty
null :: DirForest a -> Bool
null :: forall a. DirForest a -> Bool
null (DirForest Map FilePath (DirTree a)
dtm) = forall k a. Map k a -> Bool
M.null Map FilePath (DirTree a)
dtm
nullFiles :: DirForest a -> Bool
nullFiles :: forall a. DirForest a -> Bool
nullFiles (DirForest Map FilePath (DirTree a)
df) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. DirTree a -> Bool
goTree Map FilePath (DirTree a)
df
where
goTree :: DirTree a -> Bool
goTree = \case
NodeFile a
_ -> Bool
False
NodeDir DirForest a
df' -> forall a. DirForest a -> Bool
nullFiles DirForest a
df'
singletonFile :: Path Rel File -> a -> DirForest a
singletonFile :: forall a. Path Rel File -> a -> DirForest a
singletonFile Path Rel File
rp a
a =
case forall a.
Path Rel File
-> a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFile Path Rel File
rp a
a forall a. DirForest a
empty of
Right DirForest a
df -> DirForest a
df
Either (InsertionError a) (DirForest a)
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"There can't have been anything in the way in an empty dir forest."
singletonDir :: Path Rel Dir -> DirForest a
singletonDir :: forall a. Path Rel Dir -> DirForest a
singletonDir Path Rel Dir
rp =
case forall a.
Path Rel Dir
-> DirForest a -> Either (InsertionError a) (DirForest a)
insertDir Path Rel Dir
rp forall a. DirForest a
empty of
Right DirForest a
df -> DirForest a
df
Either (InsertionError a) (DirForest a)
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"There can't have been anything in the way in an empty dir forest."
mapWithPath :: (Path Rel File -> a -> b) -> DirForest a -> DirForest b
mapWithPath :: forall a b. (Path Rel File -> a -> b) -> DirForest a -> DirForest b
mapWithPath Path Rel File -> a -> b
func DirForest a
df = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall a b (f :: * -> *).
Applicative f =>
(Path Rel File -> a -> f b) -> DirForest a -> f (DirForest b)
traverseWithPath (\Path Rel File
a a
b -> forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ Path Rel File -> a -> b
func Path Rel File
a a
b) DirForest a
df
traverseWithPath :: forall a b f. Applicative f => (Path Rel File -> a -> f b) -> DirForest a -> f (DirForest b)
traverseWithPath :: forall a b (f :: * -> *).
Applicative f =>
(Path Rel File -> a -> f b) -> DirForest a -> f (DirForest b)
traverseWithPath Path Rel File -> a -> f b
func = Path Rel Dir -> DirForest a -> f (DirForest b)
goF [reldir|./|]
where
goF :: Path Rel Dir -> DirForest a -> f (DirForest b)
goF :: Path Rel Dir -> DirForest a -> f (DirForest b)
goF Path Rel Dir
cur (DirForest Map FilePath (DirTree a)
ts) = forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey (Path Rel Dir -> FilePath -> DirTree a -> f (DirTree b)
goT Path Rel Dir
cur) Map FilePath (DirTree a)
ts
goT :: Path Rel Dir -> FilePath -> DirTree a -> f (DirTree b)
goT :: Path Rel Dir -> FilePath -> DirTree a -> f (DirTree b)
goT Path Rel Dir
cur FilePath
fp = \case
NodeFile a
v ->
let rf :: Path Rel File
rf = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
fp)
in forall a. a -> DirTree a
NodeFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Rel File -> a -> f b
func Path Rel File
rf a
v
NodeDir DirForest a
df ->
let rd :: Path Rel Dir
rd = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
fp)
in forall a. DirForest a -> DirTree a
NodeDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Rel Dir -> DirForest a -> f (DirForest b)
goF Path Rel Dir
rd DirForest a
df
traverseWithPath_ :: forall a b f. Applicative f => (Path Rel File -> a -> f b) -> DirForest a -> f ()
traverseWithPath_ :: forall a b (f :: * -> *).
Applicative f =>
(Path Rel File -> a -> f b) -> DirForest a -> f ()
traverseWithPath_ Path Rel File -> a -> f b
func = Path Rel Dir -> DirForest a -> f ()
goF [reldir|./|]
where
goF :: Path Rel Dir -> DirForest a -> f ()
goF :: Path Rel Dir -> DirForest a -> f ()
goF Path Rel Dir
cur (DirForest Map FilePath (DirTree a)
ts) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey (Path Rel Dir -> FilePath -> DirTree a -> f ()
goT Path Rel Dir
cur) Map FilePath (DirTree a)
ts
goT :: Path Rel Dir -> FilePath -> DirTree a -> f ()
goT :: Path Rel Dir -> FilePath -> DirTree a -> f ()
goT Path Rel Dir
cur FilePath
fp = \case
NodeFile a
v ->
let rf :: Path Rel File
rf = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
fp)
in forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Path Rel File -> a -> f b
func Path Rel File
rf a
v
NodeDir DirForest a
df ->
let rd :: Path Rel Dir
rd = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
fp)
in Path Rel Dir -> DirForest a -> f ()
goF Path Rel Dir
rd DirForest a
df
pruneEmptyDirs :: DirForest a -> Maybe (DirForest a)
pruneEmptyDirs :: forall a. DirForest a -> Maybe (DirForest a)
pruneEmptyDirs (DirForest Map FilePath (DirTree a)
m) =
let m' :: Map FilePath (DirTree a)
m' = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe forall a. DirTree a -> Maybe (DirTree a)
goTree Map FilePath (DirTree a)
m
in if forall k a. Map k a -> Bool
M.null Map FilePath (DirTree a)
m' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Map FilePath (DirTree a) -> DirForest a
DirForest Map FilePath (DirTree a)
m')
where
goTree :: DirTree a -> Maybe (DirTree a)
goTree :: forall a. DirTree a -> Maybe (DirTree a)
goTree DirTree a
dt = case DirTree a
dt of
NodeFile a
_ -> forall a. a -> Maybe a
Just DirTree a
dt
NodeDir DirForest a
df -> forall a. DirForest a -> DirTree a
NodeDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. DirForest a -> Maybe (DirForest a)
pruneEmptyDirs DirForest a
df
anyEmptyDir :: DirForest a -> Bool
anyEmptyDir :: forall a. DirForest a -> Bool
anyEmptyDir (DirForest Map FilePath (DirTree a)
m) = forall k a. Map k a -> Bool
M.null Map FilePath (DirTree a)
m Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. DirTree a -> Bool
goTree Map FilePath (DirTree a)
m
where
goTree :: DirTree a -> Bool
goTree :: forall a. DirTree a -> Bool
goTree = \case
NodeFile a
_ -> Bool
False
NodeDir DirForest a
df -> forall a. DirForest a -> Bool
anyEmptyDir DirForest a
df
lookup ::
forall a.
Path Rel File ->
DirForest a ->
Maybe a
lookup :: forall a. Path Rel File -> DirForest a -> Maybe a
lookup Path Rel File
rp DirForest a
df = DirForest a -> [FilePath] -> Maybe a
go DirForest a
df (FilePath -> [FilePath]
FP.splitDirectories forall a b. (a -> b) -> a -> b
$ Path Rel File -> FilePath
fromRelFile Path Rel File
rp)
where
go :: DirForest a -> [FilePath] -> Maybe a
go :: DirForest a -> [FilePath] -> Maybe a
go (DirForest Map FilePath (DirTree a)
ts) =
\case
[] -> forall a. Maybe a
Nothing
[FilePath
f] -> do
DirTree a
dt <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
f Map FilePath (DirTree a)
ts
case DirTree a
dt of
NodeFile a
contents -> forall a. a -> Maybe a
Just a
contents
DirTree a
_ -> forall a. Maybe a
Nothing
(FilePath
d : [FilePath]
ds) -> do
DirTree a
dt <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
d Map FilePath (DirTree a)
ts
case DirTree a
dt of
NodeDir DirForest a
dt_ -> DirForest a -> [FilePath] -> Maybe a
go DirForest a
dt_ [FilePath]
ds
DirTree a
_ -> forall a. Maybe a
Nothing
insertFOD ::
forall a.
FilePath ->
FOD a ->
DirForest a ->
Either (InsertionError a) (DirForest a)
insertFOD :: forall a.
FilePath
-> FOD a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFOD FilePath
fp FOD a
fod DirForest a
dirForest = Path Rel Dir
-> DirForest a
-> [FilePath]
-> Either (InsertionError a) (DirForest a)
go [reldir|./|] DirForest a
dirForest (FilePath -> [FilePath]
FP.splitDirectories FilePath
fp)
where
node :: DirTree a
node = case FOD a
fod of
F a
a -> forall a. a -> DirTree a
NodeFile a
a
FOD a
D -> forall a. DirForest a -> DirTree a
NodeDir forall a. DirForest a
empty
go ::
Path Rel Dir ->
DirForest a ->
[FilePath] ->
Either (InsertionError a) (DirForest a)
go :: Path Rel Dir
-> DirForest a
-> [FilePath]
-> Either (InsertionError a) (DirForest a)
go Path Rel Dir
cur df :: DirForest a
df@(DirForest Map FilePath (DirTree a)
ts) =
\case
[] -> forall a b. b -> Either a b
Right DirForest a
df
[FilePath
f] ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
f Map FilePath (DirTree a)
ts of
Maybe (DirTree a)
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
f DirTree a
node Map FilePath (DirTree a)
ts
Just DirTree a
dt ->
case DirTree a
dt of
NodeFile a
contents -> do
let rf :: Path Rel File
rf = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
f)
forall a b. a -> Either a b
Left (forall a. Path Rel File -> a -> InsertionError a
FileInTheWay Path Rel File
rf a
contents)
NodeDir DirForest a
df' -> case FOD a
fod of
F a
_ -> do
let rd :: Path Rel Dir
rd = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
f)
forall a b. a -> Either a b
Left (forall a. Path Rel Dir -> DirForest a -> InsertionError a
DirInTheWay Path Rel Dir
rd DirForest a
df')
FOD a
D -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df
(FilePath
d : [FilePath]
ds) ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
d Map FilePath (DirTree a)
ts of
Maybe (DirTree a)
Nothing -> do
let df' :: DirForest a
df' = forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
d (forall a. DirForest a -> DirTree a
NodeDir forall a. DirForest a
empty) Map FilePath (DirTree a)
ts
Path Rel Dir
-> DirForest a
-> [FilePath]
-> Either (InsertionError a) (DirForest a)
go Path Rel Dir
cur DirForest a
df' (FilePath
d forall a. a -> [a] -> [a]
: [FilePath]
ds)
Just DirTree a
dt ->
case DirTree a
dt of
NodeFile a
contents -> do
let rf :: Path Rel File
rf = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
d)
forall a b. a -> Either a b
Left (forall a. Path Rel File -> a -> InsertionError a
FileInTheWay Path Rel File
rf a
contents)
NodeDir DirForest a
df' -> do
let newCur :: Path Rel Dir
newCur = Path Rel Dir
cur forall b t. Path b Dir -> Path Rel t -> Path b t
</> forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
d)
DirForest a
df'' <- Path Rel Dir
-> DirForest a
-> [FilePath]
-> Either (InsertionError a) (DirForest a)
go Path Rel Dir
newCur DirForest a
df' [FilePath]
ds
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
d (forall a. DirForest a -> DirTree a
NodeDir DirForest a
df'') Map FilePath (DirTree a)
ts
insertFile ::
forall a.
Path Rel File ->
a ->
DirForest a ->
Either (InsertionError a) (DirForest a)
insertFile :: forall a.
Path Rel File
-> a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFile Path Rel File
rp a
a = forall a.
FilePath
-> FOD a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFOD (Path Rel File -> FilePath
fromRelFile Path Rel File
rp) (forall a. a -> FOD a
F a
a)
insertDir ::
forall a.
Path Rel Dir ->
DirForest a ->
Either (InsertionError a) (DirForest a)
insertDir :: forall a.
Path Rel Dir
-> DirForest a -> Either (InsertionError a) (DirForest a)
insertDir Path Rel Dir
rp = forall a.
FilePath
-> FOD a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFOD (ShowS
FP.dropTrailingPathSeparator forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> FilePath
fromRelDir Path Rel Dir
rp) forall a. FOD a
D
fromFileList :: [(Path Rel File, a)] -> Either (InsertionError a) (DirForest a)
fromFileList :: forall a.
[(Path Rel File, a)] -> Either (InsertionError a) (DirForest a)
fromFileList = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a.
Path Rel File
-> a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFile) forall a. DirForest a
empty
toFileList :: DirForest a -> [(Path Rel File, a)]
toFileList :: forall a. DirForest a -> [(Path Rel File, a)]
toFileList = forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DirForest a -> Map (Path Rel File) a
toFileMap
data InsertValidation e a = InsertionErrors (NonEmpty (InsertionError e)) | NoInsertionErrors a
deriving (Int -> InsertValidation e a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall e a.
(Show e, Show a) =>
Int -> InsertValidation e a -> ShowS
forall e a. (Show e, Show a) => [InsertValidation e a] -> ShowS
forall e a. (Show e, Show a) => InsertValidation e a -> FilePath
showList :: [InsertValidation e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [InsertValidation e a] -> ShowS
show :: InsertValidation e a -> FilePath
$cshow :: forall e a. (Show e, Show a) => InsertValidation e a -> FilePath
showsPrec :: Int -> InsertValidation e a -> ShowS
$cshowsPrec :: forall e a.
(Show e, Show a) =>
Int -> InsertValidation e a -> ShowS
Show, InsertValidation e a -> InsertValidation e a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a.
(Eq e, Eq a) =>
InsertValidation e a -> InsertValidation e a -> Bool
/= :: InsertValidation e a -> InsertValidation e a -> Bool
$c/= :: forall e a.
(Eq e, Eq a) =>
InsertValidation e a -> InsertValidation e a -> Bool
== :: InsertValidation e a -> InsertValidation e a -> Bool
$c== :: forall e a.
(Eq e, Eq a) =>
InsertValidation e a -> InsertValidation e a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (InsertValidation e a) x -> InsertValidation e a
forall e a x. InsertValidation e a -> Rep (InsertValidation e a) x
$cto :: forall e a x. Rep (InsertValidation e a) x -> InsertValidation e a
$cfrom :: forall e a x. InsertValidation e a -> Rep (InsertValidation e a) x
Generic, forall a b. a -> InsertValidation e b -> InsertValidation e a
forall a b.
(a -> b) -> InsertValidation e a -> InsertValidation e b
forall e a b. a -> InsertValidation e b -> InsertValidation e a
forall e a b.
(a -> b) -> InsertValidation e a -> InsertValidation e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> InsertValidation e b -> InsertValidation e a
$c<$ :: forall e a b. a -> InsertValidation e b -> InsertValidation e a
fmap :: forall a b.
(a -> b) -> InsertValidation e a -> InsertValidation e b
$cfmap :: forall e a b.
(a -> b) -> InsertValidation e a -> InsertValidation e b
Functor)
instance (Validity e, Validity a) => Validity (InsertValidation e a)
instance Applicative (InsertValidation e) where
pure :: forall a. a -> InsertValidation e a
pure = forall e a. a -> InsertValidation e a
NoInsertionErrors
InsertionErrors NonEmpty (InsertionError e)
es1 <*> :: forall a b.
InsertValidation e (a -> b)
-> InsertValidation e a -> InsertValidation e b
<*> InsertionErrors NonEmpty (InsertionError e)
es2 = forall e a. NonEmpty (InsertionError e) -> InsertValidation e a
InsertionErrors forall a b. (a -> b) -> a -> b
$ NonEmpty (InsertionError e)
es1 forall a. Semigroup a => a -> a -> a
<> NonEmpty (InsertionError e)
es2
InsertionErrors NonEmpty (InsertionError e)
es <*> NoInsertionErrors a
_ = forall e a. NonEmpty (InsertionError e) -> InsertValidation e a
InsertionErrors NonEmpty (InsertionError e)
es
NoInsertionErrors a -> b
_ <*> InsertionErrors NonEmpty (InsertionError e)
es = forall e a. NonEmpty (InsertionError e) -> InsertValidation e a
InsertionErrors NonEmpty (InsertionError e)
es
NoInsertionErrors a -> b
f <*> NoInsertionErrors a
a = forall e a. a -> InsertValidation e a
NoInsertionErrors forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
unpackInsertValidation :: InsertValidation e a -> Either (NonEmpty (InsertionError e)) a
unpackInsertValidation :: forall e a.
InsertValidation e a -> Either (NonEmpty (InsertionError e)) a
unpackInsertValidation = \case
InsertionErrors NonEmpty (InsertionError e)
es -> forall a b. a -> Either a b
Left NonEmpty (InsertionError e)
es
NoInsertionErrors a
r -> forall a b. b -> Either a b
Right a
r
union :: DirForest a -> DirForest a -> InsertValidation a (DirForest a)
union :: forall a.
DirForest a -> DirForest a -> InsertValidation a (DirForest a)
union = forall a.
(a -> a -> a)
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
unionWith forall a b. a -> b -> a
const
unionWith :: (a -> a -> a) -> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
unionWith :: forall a.
(a -> a -> a)
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
unionWith a -> a -> a
func = forall a.
(Path Rel File -> a -> a -> a)
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
unionWithKey (\Path Rel File
_ a
a a
b -> a -> a -> a
func a
a a
b)
unionWithKey :: forall a. (Path Rel File -> a -> a -> a) -> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
unionWithKey :: forall a.
(Path Rel File -> a -> a -> a)
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
unionWithKey Path Rel File -> a -> a -> a
func = FilePath
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
goForest FilePath
""
where
goForest :: FilePath -> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
goForest :: FilePath
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
goForest FilePath
base (DirForest Map FilePath (DirTree a)
dtm1) (DirForest Map FilePath (DirTree a)
dtm2) =
forall a. Map FilePath (DirTree a) -> DirForest a
DirForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
( forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWithKey
( \FilePath
p InsertValidation a (DirTree a)
e1 InsertValidation a (DirTree a)
e2 -> case (InsertValidation a (DirTree a)
e1, InsertValidation a (DirTree a)
e2) of
(NoInsertionErrors DirTree a
m1, NoInsertionErrors DirTree a
m2) -> FilePath
-> DirTree a -> DirTree a -> InsertValidation a (DirTree a)
goTree (FilePath
base FilePath -> ShowS
FP.</> FilePath
p) DirTree a
m1 DirTree a
m2
(InsertValidation a (DirTree a), InsertValidation a (DirTree a))
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"Should not happen because we just M.map-ed only NoInsertionErrors, but it did"
)
(forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall e a. a -> InsertValidation e a
NoInsertionErrors Map FilePath (DirTree a)
dtm1)
(forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall e a. a -> InsertValidation e a
NoInsertionErrors Map FilePath (DirTree a)
dtm2)
)
goTree :: FilePath -> DirTree a -> DirTree a -> InsertValidation a (DirTree a)
goTree :: FilePath
-> DirTree a -> DirTree a -> InsertValidation a (DirTree a)
goTree FilePath
base DirTree a
dt1 DirTree a
dt2 = case (DirTree a
dt1, DirTree a
dt2) of
(NodeDir DirForest a
df1, NodeDir DirForest a
df2) -> forall a. DirForest a -> DirTree a
NodeDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> DirForest a -> DirForest a -> InsertValidation a (DirForest a)
goForest FilePath
base DirForest a
df1 DirForest a
df2
(NodeFile a
a1, NodeFile a
a2) -> forall e a. a -> InsertValidation e a
NoInsertionErrors forall a b. (a -> b) -> a -> b
$ forall a. a -> DirTree a
NodeFile forall a b. (a -> b) -> a -> b
$ Path Rel File -> a -> a -> a
func (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
base) a
a1 a
a2
(NodeFile a
a, NodeDir DirForest a
_) -> forall e a. NonEmpty (InsertionError e) -> InsertValidation e a
InsertionErrors forall a b. (a -> b) -> a -> b
$ forall a. Path Rel File -> a -> InsertionError a
FileInTheWay (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
base) a
a forall a. a -> [a] -> NonEmpty a
:| []
(NodeDir DirForest a
df, NodeFile a
_) -> forall e a. NonEmpty (InsertionError e) -> InsertValidation e a
InsertionErrors forall a b. (a -> b) -> a -> b
$ forall a. Path Rel Dir -> DirForest a -> InsertionError a
DirInTheWay (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
base) DirForest a
df forall a. a -> [a] -> NonEmpty a
:| []
unions :: [DirForest a] -> Either (InsertionError a) (DirForest a)
unions :: forall a. [DirForest a] -> Either (InsertionError a) (DirForest a)
unions = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\DirForest a
df1 DirForest a
df2 -> forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ forall e a.
InsertValidation e a -> Either (NonEmpty (InsertionError e)) a
unpackInsertValidation forall a b. (a -> b) -> a -> b
$ forall a.
DirForest a -> DirForest a -> InsertValidation a (DirForest a)
union DirForest a
df1 DirForest a
df2) forall a. DirForest a
empty
intersection :: DirForest a -> DirForest b -> DirForest a
intersection :: forall a b. DirForest a -> DirForest b -> DirForest a
intersection = forall a b c.
(a -> b -> c) -> DirForest a -> DirForest b -> DirForest c
intersectionWith forall a b. a -> b -> a
const
intersectionWith :: (a -> b -> c) -> DirForest a -> DirForest b -> DirForest c
intersectionWith :: forall a b c.
(a -> b -> c) -> DirForest a -> DirForest b -> DirForest c
intersectionWith a -> b -> c
func = forall a b c.
(Path Rel File -> a -> b -> c)
-> DirForest a -> DirForest b -> DirForest c
intersectionWithKey (\Path Rel File
_ a
a b
b -> a -> b -> c
func a
a b
b)
intersectionWithKey :: forall a b c. (Path Rel File -> a -> b -> c) -> DirForest a -> DirForest b -> DirForest c
intersectionWithKey :: forall a b c.
(Path Rel File -> a -> b -> c)
-> DirForest a -> DirForest b -> DirForest c
intersectionWithKey Path Rel File -> a -> b -> c
func = FilePath -> DirForest a -> DirForest b -> DirForest c
goForest FilePath
""
where
goForest :: FilePath -> DirForest a -> DirForest b -> DirForest c
goForest :: FilePath -> DirForest a -> DirForest b -> DirForest c
goForest FilePath
base (DirForest Map FilePath (DirTree a)
dtm1) (DirForest Map FilePath (DirTree b)
dtm2) =
forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
M.intersectionWithKey (\FilePath
p DirTree a
m1 DirTree b
m2 -> FilePath -> DirTree a -> DirTree b -> Maybe (DirTree c)
goTree (FilePath
base FilePath -> ShowS
FP.</> FilePath
p) DirTree a
m1 DirTree b
m2) Map FilePath (DirTree a)
dtm1 Map FilePath (DirTree b)
dtm2
goTree :: FilePath -> DirTree a -> DirTree b -> Maybe (DirTree c)
goTree :: FilePath -> DirTree a -> DirTree b -> Maybe (DirTree c)
goTree FilePath
base DirTree a
dt1 DirTree b
dt2 = case (DirTree a
dt1, DirTree b
dt2) of
(NodeDir DirForest a
df1_, NodeDir DirForest b
df2_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DirForest a -> DirTree a
NodeDir forall a b. (a -> b) -> a -> b
$ FilePath -> DirForest a -> DirForest b -> DirForest c
goForest FilePath
base DirForest a
df1_ DirForest b
df2_
(NodeFile a
f1, NodeFile b
f2) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> DirTree a
NodeFile forall a b. (a -> b) -> a -> b
$ Path Rel File -> a -> b -> c
func (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
base) a
f1 b
f2
(DirTree a, DirTree b)
_ -> forall a. Maybe a
Nothing
intersections :: [DirForest a] -> DirForest a
intersections :: forall a. [DirForest a] -> DirForest a
intersections = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. DirForest a -> DirForest b -> DirForest a
intersection forall a. DirForest a
empty
filter :: (a -> Bool) -> DirForest a -> DirForest a
filter :: forall a. (a -> Bool) -> DirForest a -> DirForest a
filter a -> Bool
func = forall a.
(Path Rel File -> a -> Bool) -> DirForest a -> DirForest a
filterWithKey (forall a b. a -> b -> a
const a -> Bool
func)
filterWithKey :: forall a. (Path Rel File -> a -> Bool) -> DirForest a -> DirForest a
filterWithKey :: forall a.
(Path Rel File -> a -> Bool) -> DirForest a -> DirForest a
filterWithKey Path Rel File -> a -> Bool
filePred = FilePath -> DirForest a -> DirForest a
goForest FilePath
""
where
goForest :: FilePath -> DirForest a -> DirForest a
goForest :: FilePath -> DirForest a -> DirForest a
goForest FilePath
base (DirForest Map FilePath (DirTree a)
df) =
forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey
(\FilePath
p DirTree a
dt -> FilePath -> DirTree a -> Maybe (DirTree a)
goTree (FilePath
base FilePath -> ShowS
FP.</> FilePath
p) DirTree a
dt)
Map FilePath (DirTree a)
df
goTree :: FilePath -> DirTree a -> Maybe (DirTree a)
goTree :: FilePath -> DirTree a -> Maybe (DirTree a)
goTree FilePath
base DirTree a
dt = case DirTree a
dt of
NodeFile a
cts -> do
Path Rel File
rf <- forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
base
if Path Rel File -> a -> Bool
filePred Path Rel File
rf a
cts then forall a. a -> Maybe a
Just DirTree a
dt else forall a. Maybe a
Nothing
NodeDir DirForest a
df -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DirForest a -> DirTree a
NodeDir forall a b. (a -> b) -> a -> b
$ FilePath -> DirForest a -> DirForest a
goForest FilePath
base DirForest a
df
filterHidden :: forall a. DirForest a -> DirForest a
filterHidden :: forall a. DirForest a -> DirForest a
filterHidden = DirForest a -> DirForest a
goForest
where
goPair :: FilePath -> DirTree a -> Maybe (DirTree a)
goPair :: FilePath -> DirTree a -> Maybe (DirTree a)
goPair FilePath
fp DirTree a
dt = if FilePath -> Bool
hiddenHere FilePath
fp then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DirTree a -> DirTree a
goTree DirTree a
dt
goForest :: DirForest a -> DirForest a
goForest :: DirForest a -> DirForest a
goForest (DirForest Map FilePath (DirTree a)
m) =
forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey FilePath -> DirTree a -> Maybe (DirTree a)
goPair Map FilePath (DirTree a)
m
goTree :: DirTree a -> DirTree a
goTree :: DirTree a -> DirTree a
goTree DirTree a
dt = case DirTree a
dt of
NodeFile a
_ -> DirTree a
dt
NodeDir DirForest a
df -> forall a. DirForest a -> DirTree a
NodeDir forall a b. (a -> b) -> a -> b
$ DirForest a -> DirForest a
goForest DirForest a
df
difference :: DirForest a -> DirForest b -> DirForest a
difference :: forall a b. DirForest a -> DirForest b -> DirForest a
difference = forall a b.
(a -> b -> Maybe a) -> DirForest a -> DirForest b -> DirForest a
differenceWith forall a b. (a -> b) -> a -> b
$ \a
_ b
_ -> forall a. Maybe a
Nothing
differenceWith :: (a -> b -> Maybe a) -> DirForest a -> DirForest b -> DirForest a
differenceWith :: forall a b.
(a -> b -> Maybe a) -> DirForest a -> DirForest b -> DirForest a
differenceWith a -> b -> Maybe a
func = forall a b.
(Path Rel File -> a -> b -> Maybe a)
-> DirForest a -> DirForest b -> DirForest a
differenceWithKey forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const a -> b -> Maybe a
func
differenceWithKey :: forall a b. (Path Rel File -> a -> b -> Maybe a) -> DirForest a -> DirForest b -> DirForest a
differenceWithKey :: forall a b.
(Path Rel File -> a -> b -> Maybe a)
-> DirForest a -> DirForest b -> DirForest a
differenceWithKey Path Rel File -> a -> b -> Maybe a
func = FilePath -> DirForest a -> DirForest b -> DirForest a
goForest FilePath
""
where
goForest :: FilePath -> DirForest a -> DirForest b -> DirForest a
goForest :: FilePath -> DirForest a -> DirForest b -> DirForest a
goForest FilePath
base (DirForest Map FilePath (DirTree a)
df1_) (DirForest Map FilePath (DirTree b)
df2_) =
forall a. Map FilePath (DirTree a) -> DirForest a
DirForest forall a b. (a -> b) -> a -> b
$ forall k a b.
Ord k =>
(k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
M.differenceWithKey (\FilePath
p DirTree a
dt1 DirTree b
dt2 -> FilePath -> DirTree a -> DirTree b -> Maybe (DirTree a)
goTree (FilePath
base FilePath -> ShowS
FP.</> FilePath
p) DirTree a
dt1 DirTree b
dt2) Map FilePath (DirTree a)
df1_ Map FilePath (DirTree b)
df2_
goTree :: FilePath -> DirTree a -> DirTree b -> Maybe (DirTree a)
goTree :: FilePath -> DirTree a -> DirTree b -> Maybe (DirTree a)
goTree FilePath
base DirTree a
dt1 DirTree b
dt2 = case (DirTree a
dt1, DirTree b
dt2) of
(NodeFile a
v1, NodeFile b
v2) -> forall a. a -> DirTree a
NodeFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Rel File -> a -> b -> Maybe a
func (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
base) a
v1 b
v2
(NodeFile a
v, NodeDir DirForest b
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> DirTree a
NodeFile a
v
(NodeDir DirForest a
df, NodeFile b
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DirForest a -> DirTree a
NodeDir DirForest a
df
(NodeDir DirForest a
df1_, NodeDir DirForest b
df2_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. DirForest a -> DirTree a
NodeDir forall a b. (a -> b) -> a -> b
$ FilePath -> DirForest a -> DirForest b -> DirForest a
goForest FilePath
base DirForest a
df1_ DirForest b
df2_
data InsertionError a
= FileInTheWay (Path Rel File) a
| DirInTheWay (Path Rel Dir) (DirForest a)
deriving (Int -> InsertionError a -> ShowS
forall a. Show a => Int -> InsertionError a -> ShowS
forall a. Show a => [InsertionError a] -> ShowS
forall a. Show a => InsertionError a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InsertionError a] -> ShowS
$cshowList :: forall a. Show a => [InsertionError a] -> ShowS
show :: InsertionError a -> FilePath
$cshow :: forall a. Show a => InsertionError a -> FilePath
showsPrec :: Int -> InsertionError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> InsertionError a -> ShowS
Show, InsertionError a -> InsertionError a -> Bool
forall a. Eq a => InsertionError a -> InsertionError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertionError a -> InsertionError a -> Bool
$c/= :: forall a. Eq a => InsertionError a -> InsertionError a -> Bool
== :: InsertionError a -> InsertionError a -> Bool
$c== :: forall a. Eq a => InsertionError a -> InsertionError a -> Bool
Eq, InsertionError a -> InsertionError a -> Bool
InsertionError a -> InsertionError a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (InsertionError a)
forall a. Ord a => InsertionError a -> InsertionError a -> Bool
forall a. Ord a => InsertionError a -> InsertionError a -> Ordering
forall a.
Ord a =>
InsertionError a -> InsertionError a -> InsertionError a
min :: InsertionError a -> InsertionError a -> InsertionError a
$cmin :: forall a.
Ord a =>
InsertionError a -> InsertionError a -> InsertionError a
max :: InsertionError a -> InsertionError a -> InsertionError a
$cmax :: forall a.
Ord a =>
InsertionError a -> InsertionError a -> InsertionError a
>= :: InsertionError a -> InsertionError a -> Bool
$c>= :: forall a. Ord a => InsertionError a -> InsertionError a -> Bool
> :: InsertionError a -> InsertionError a -> Bool
$c> :: forall a. Ord a => InsertionError a -> InsertionError a -> Bool
<= :: InsertionError a -> InsertionError a -> Bool
$c<= :: forall a. Ord a => InsertionError a -> InsertionError a -> Bool
< :: InsertionError a -> InsertionError a -> Bool
$c< :: forall a. Ord a => InsertionError a -> InsertionError a -> Bool
compare :: InsertionError a -> InsertionError a -> Ordering
$ccompare :: forall a. Ord a => InsertionError a -> InsertionError a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InsertionError a) x -> InsertionError a
forall a x. InsertionError a -> Rep (InsertionError a) x
$cto :: forall a x. Rep (InsertionError a) x -> InsertionError a
$cfrom :: forall a x. InsertionError a -> Rep (InsertionError a) x
Generic)
instance (Validity a) => Validity (InsertionError a)
fromFileMap :: Map (Path Rel File) a -> Either (InsertionError a) (DirForest a)
fromFileMap :: forall a.
Map (Path Rel File) a -> Either (InsertionError a) (DirForest a)
fromFileMap = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\DirForest a
df (Path Rel File
rf, a
cts) -> forall a.
Path Rel File
-> a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFile Path Rel File
rf a
cts DirForest a
df) forall a. DirForest a
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
toFileMap :: DirForest a -> Map (Path Rel File) a
toFileMap :: forall a. DirForest a -> Map (Path Rel File) a
toFileMap = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey forall a.
Map (Path Rel File) a
-> FilePath -> DirTree a -> Map (Path Rel File) a
go forall k a. Map k a
M.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DirForest a -> Map FilePath (DirTree a)
unDirForest
where
go :: Map (Path Rel File) a -> FilePath -> DirTree a -> Map (Path Rel File) a
go :: forall a.
Map (Path Rel File) a
-> FilePath -> DirTree a -> Map (Path Rel File) a
go Map (Path Rel File) a
m FilePath
path =
\case
NodeFile a
contents ->
let rf :: Path Rel File
rf = forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
path)
in forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Path Rel File
rf a
contents Map (Path Rel File) a
m
NodeDir DirForest a
df ->
let rd :: Path Rel Dir
rd = forall a. HasCallStack => Maybe a -> a
fromJust (forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
path)
in forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map (Path Rel File) a
m forall a b. (a -> b) -> a -> b
$ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (Path Rel Dir
rd forall b t. Path b Dir -> Path Rel t -> Path b t
</>) (forall a. DirForest a -> Map (Path Rel File) a
toFileMap DirForest a
df)
fromMap :: Map FilePath (FOD a) -> Either (InsertionError a) (DirForest a)
fromMap :: forall a.
Map FilePath (FOD a) -> Either (InsertionError a) (DirForest a)
fromMap = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\DirForest a
df (FilePath
rf, FOD a
fod) -> forall a.
FilePath
-> FOD a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFOD FilePath
rf FOD a
fod DirForest a
df) forall a. DirForest a
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList
toMap :: DirForest a -> Map FilePath (FOD a)
toMap :: forall a. DirForest a -> Map FilePath (FOD a)
toMap = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey forall a.
Map FilePath (FOD a)
-> FilePath -> DirTree a -> Map FilePath (FOD a)
go forall k a. Map k a
M.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DirForest a -> Map FilePath (DirTree a)
unDirForest
where
go :: Map FilePath (FOD a) -> FilePath -> DirTree a -> Map FilePath (FOD a)
go :: forall a.
Map FilePath (FOD a)
-> FilePath -> DirTree a -> Map FilePath (FOD a)
go Map FilePath (FOD a)
m FilePath
path =
\case
NodeFile a
contents ->
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
path (forall a. a -> FOD a
F a
contents) Map FilePath (FOD a)
m
NodeDir DirForest a
df ->
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
path forall a. FOD a
D forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map FilePath (FOD a)
m forall a b. (a -> b) -> a -> b
$ forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys (FilePath
path FilePath -> ShowS
FP.</>) (forall a. DirForest a -> Map FilePath (FOD a)
toMap DirForest a
df)
read ::
forall a b m.
(MonadIO m) =>
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
read :: forall a b (m :: * -> *).
MonadIO m =>
Path b Dir -> (Path b File -> m a) -> m (DirForest a)
read = forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readFiltered (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
True)
readNonHidden ::
forall a b m.
(MonadIO m) =>
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readNonHidden :: forall a b (m :: * -> *).
MonadIO m =>
Path b Dir -> (Path b File -> m a) -> m (DirForest a)
readNonHidden = forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readNonHiddenFiltered (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
True)
readNonHiddenFiltered ::
forall a b m.
(MonadIO m) =>
(Path b File -> Bool) ->
(Path b Dir -> Bool) ->
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readNonHiddenFiltered :: forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readNonHiddenFiltered Path b File -> Bool
filePred Path b Dir -> Bool
dirPred Path b Dir
root = forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readFiltered (\Path b File
f -> forall {t}. Path b t -> Bool
go Path b File
f Bool -> Bool -> Bool
&& Path b File -> Bool
filePred Path b File
f) (\Path b Dir
d -> forall {t}. Path b t -> Bool
go Path b Dir
d Bool -> Bool -> Bool
&& Path b Dir -> Bool
dirPred Path b Dir
d) Path b Dir
root
where
go :: Path b t -> Bool
go Path b t
af = case forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path b Dir
root Path b t
af of
Maybe (Path Rel t)
Nothing -> Bool
True
Just Path Rel t
rf -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall {t}. Path Rel t -> Bool
hiddenRel Path Rel t
rf
readFiltered ::
forall a b m.
(MonadIO m) =>
(Path b File -> Bool) ->
(Path b Dir -> Bool) ->
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readFiltered :: forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readFiltered Path b File -> Bool
filePred Path b Dir -> Bool
dirPred Path b Dir
root Path b File -> m a
readFunc = do
Bool
e <- forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path b Dir
root
if Bool
e
then do
[DirForest a]
fs <- forall (m :: * -> *) o b.
(MonadIO m, Monoid o) =>
Maybe
(Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel))
-> (Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m o)
-> Path b Dir
-> m o
walkDirAccumRel (forall a. a -> Maybe a
Just Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)
decendHandler) Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m [DirForest a]
outputWriter Path b Dir
root
case forall a. [DirForest a] -> Either (InsertionError a) (DirForest a)
unions [DirForest a]
fs of
Left InsertionError a
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"There can't have been any intra-dir collisions, but there were."
Right DirForest a
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
r
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. DirForest a
empty
where
decendHandler :: Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)
decendHandler :: Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)
decendHandler Path Rel Dir
subdir [Path Rel Dir]
dirs [Path Rel File]
_ = do
let toExclude :: [Path Rel Dir]
toExclude = forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b Dir -> Bool
dirPred forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
subdir) forall b t. Path b Dir -> Path Rel t -> Path b t
</>)) [Path Rel Dir]
dirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b. [Path b Dir] -> WalkAction b
WalkExclude [Path Rel Dir]
toExclude
outputWriter :: Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m [DirForest a]
outputWriter :: Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m [DirForest a]
outputWriter Path Rel Dir
subdir [Path Rel Dir]
dirs [Path Rel File]
files = do
DirForest a
df1 <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM DirForest a -> Path Rel Dir -> m (DirForest a)
goDir forall a. DirForest a
empty [Path Rel Dir]
dirs
(forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM DirForest a -> Path Rel File -> m (DirForest a)
goFile DirForest a
df1 [Path Rel File]
files
where
goDir :: DirForest a -> Path Rel Dir -> m (DirForest a)
goDir :: DirForest a -> Path Rel Dir -> m (DirForest a)
goDir DirForest a
df Path Rel Dir
p =
let path :: Path b Dir
path = Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
subdir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
p
in if Path b Dir -> Bool
dirPred Path b Dir
path
then case forall a.
Path Rel Dir
-> DirForest a -> Either (InsertionError a) (DirForest a)
insertDir (Path Rel Dir
subdir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
p) DirForest a
df of
Left InsertionError a
_ ->
forall a. HasCallStack => FilePath -> a
error
FilePath
"There can't have been anything in the way while reading a dirforest, but there was."
Right DirForest a
df' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df'
else forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df
goFile :: DirForest a -> Path Rel File -> m (DirForest a)
goFile :: DirForest a -> Path Rel File -> m (DirForest a)
goFile DirForest a
df Path Rel File
p =
let path :: Path b File
path = Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
subdir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
p
in if Path b File -> Bool
filePred Path b File
path
then do
a
contents <- Path b File -> m a
readFunc Path b File
path
case forall a.
Path Rel File
-> a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFile (Path Rel Dir
subdir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
p) a
contents DirForest a
df of
Left InsertionError a
_ ->
forall a. HasCallStack => FilePath -> a
error
FilePath
"There can't have been anything in the way while reading a dirforest, but there was."
Right DirForest a
df' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df'
else forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df
readOneLevel ::
forall a b m.
(MonadIO m) =>
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readOneLevel :: forall a b (m :: * -> *).
MonadIO m =>
Path b Dir -> (Path b File -> m a) -> m (DirForest a)
readOneLevel = forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readOneLevelFiltered (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
True)
readOneLevelNonHidden ::
forall a b m.
(MonadIO m) =>
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readOneLevelNonHidden :: forall a b (m :: * -> *).
MonadIO m =>
Path b Dir -> (Path b File -> m a) -> m (DirForest a)
readOneLevelNonHidden = forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readOneLevelNonHiddenFiltered (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
True)
readOneLevelNonHiddenFiltered ::
forall a b m.
(MonadIO m) =>
(Path b File -> Bool) ->
(Path b Dir -> Bool) ->
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readOneLevelNonHiddenFiltered :: forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readOneLevelNonHiddenFiltered Path b File -> Bool
filePred Path b Dir -> Bool
dirPred Path b Dir
root = forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readOneLevelFiltered (\Path b File
f -> forall {t}. Path b t -> Bool
go Path b File
f Bool -> Bool -> Bool
&& Path b File -> Bool
filePred Path b File
f) (\Path b Dir
d -> forall {t}. Path b t -> Bool
go Path b Dir
d Bool -> Bool -> Bool
&& Path b Dir -> Bool
dirPred Path b Dir
d) Path b Dir
root
where
go :: Path b t -> Bool
go Path b t
af = case forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path b Dir
root Path b t
af of
Maybe (Path Rel t)
Nothing -> Bool
True
Just Path Rel t
rf -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall {t}. Path Rel t -> Bool
hiddenRel Path Rel t
rf
readOneLevelFiltered ::
forall a b m.
(MonadIO m) =>
(Path b File -> Bool) ->
(Path b Dir -> Bool) ->
Path b Dir ->
(Path b File -> m a) ->
m (DirForest a)
readOneLevelFiltered :: forall a b (m :: * -> *).
MonadIO m =>
(Path b File -> Bool)
-> (Path b Dir -> Bool)
-> Path b Dir
-> (Path b File -> m a)
-> m (DirForest a)
readOneLevelFiltered Path b File -> Bool
filePred Path b Dir -> Bool
dirPred Path b Dir
root Path b File -> m a
readFunc = do
([Path Rel Dir]
dirs, [Path Rel File]
files) <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe ([], [])) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Rel Dir], [Path Rel File])
listDirRel Path b Dir
root
DirForest a
df1 <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM DirForest a -> Path Rel Dir -> m (DirForest a)
goDir forall a. DirForest a
empty [Path Rel Dir]
dirs
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM DirForest a -> Path Rel File -> m (DirForest a)
goFile DirForest a
df1 [Path Rel File]
files
where
goDir :: DirForest a -> Path Rel Dir -> m (DirForest a)
goDir :: DirForest a -> Path Rel Dir -> m (DirForest a)
goDir DirForest a
df Path Rel Dir
p =
let path :: Path b Dir
path = Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
p
in if Path b Dir -> Bool
dirPred Path b Dir
path
then case forall a.
Path Rel Dir
-> DirForest a -> Either (InsertionError a) (DirForest a)
insertDir Path Rel Dir
p DirForest a
df of
Left InsertionError a
_ ->
forall a. HasCallStack => FilePath -> a
error
FilePath
"There can't have been anything in the way while reading a dirforest, but there was."
Right DirForest a
df' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df'
else forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df
goFile :: DirForest a -> Path Rel File -> m (DirForest a)
goFile :: DirForest a -> Path Rel File -> m (DirForest a)
goFile DirForest a
df Path Rel File
p =
let path :: Path b File
path = Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
p
in if Path b File -> Bool
filePred Path b File
path
then do
a
contents <- Path b File -> m a
readFunc Path b File
path
case forall a.
Path Rel File
-> a -> DirForest a -> Either (InsertionError a) (DirForest a)
insertFile Path Rel File
p a
contents DirForest a
df of
Left InsertionError a
_ ->
forall a. HasCallStack => FilePath -> a
error
FilePath
"There can't have been anything in the way while reading a dirforest, but there was."
Right DirForest a
df' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df'
else forall (f :: * -> *) a. Applicative f => a -> f a
pure DirForest a
df
write ::
forall a b.
(Show a, Ord a) =>
Path b Dir ->
DirForest a ->
(Path b File -> a -> IO ()) ->
IO ()
write :: forall a b.
(Show a, Ord a) =>
Path b Dir -> DirForest a -> (Path b File -> a -> IO ()) -> IO ()
write Path b Dir
root DirForest a
dirForest Path b File -> a -> IO ()
writeFunc = do
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path b Dir
root
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall a. DirForest a -> Map FilePath (DirTree a)
unDirForest DirForest a
dirForest) forall a b. (a -> b) -> a -> b
$ \(FilePath
path, DirTree a
dt) ->
case DirTree a
dt of
NodeFile a
contents -> do
Path Rel File
f <- forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
path
let af :: Path b File
af = Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
f
Path b File -> a -> IO ()
writeFunc Path b File
af a
contents
NodeDir DirForest a
df' -> do
Path Rel Dir
d <- forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
path
let ad :: Path b Dir
ad = Path b Dir
root forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d
forall a b.
(Show a, Ord a) =>
Path b Dir -> DirForest a -> (Path b File -> a -> IO ()) -> IO ()
write Path b Dir
ad DirForest a
df' Path b File -> a -> IO ()
writeFunc
hiddenRel :: Path Rel t -> Bool
hiddenRel :: forall {t}. Path Rel t -> Bool
hiddenRel = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
hiddenHere forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
FP.splitDirectories forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath
hiddenHere :: FilePath -> Bool
hiddenHere :: FilePath -> Bool
hiddenHere [] = Bool
False
hiddenHere (Char
'.' : FilePath
_) = Bool
True
hiddenHere FilePath
_ = Bool
False