{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | A directory forest of files associated with values
--
-- This module is meant to be imported like this:
--
-- > import Data.DirForest (DirForest)
-- > import qualified Data.DirForest as DF
module Data.DirForest
  ( -- * Dirforest types
    DirTree (..),
    DirForest (..),
    InsertionError (..),
    FOD (..),

    -- * Comparisons
    eq1DirTree,
    ord1DirTree,
    eq1DirForest,
    ord1DirForest,

    -- * Query
    null,
    nullFiles,
    lookup,

    -- * Construction
    empty,
    singletonFile,
    singletonDir,
    insertFile,
    insertDir,

    -- * Traversal
    mapWithPath,
    traverseWithPath,
    traverseWithPath_,

    -- * Pruning
    pruneEmptyDirs,
    anyEmptyDir,

    -- * Conversion

    -- ** Map
    fromFileMap,
    toFileMap,
    fromMap,
    toMap,

    -- ** List
    fromFileList,
    toFileList,

    -- * IO

    -- ** Read
    read,
    readNonHidden,
    readFiltered,
    readNonHiddenFiltered,
    readOneLevel,
    readOneLevelNonHidden,
    readOneLevelFiltered,
    readOneLevelNonHiddenFiltered,
    hiddenRel,

    -- ** Write
    write,

    -- * Combinations

    -- ** Union
    InsertValidation (..),
    unpackInsertValidation,
    union,
    unionWith,
    unionWithKey,
    unions,

    -- ** Intersection
    intersection,
    intersectionWith,
    intersectionWithKey,
    intersections,

    -- ** Difference
    difference,
    differenceWith,
    differenceWithKey,

    -- * Filter
    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, -- We need this for equality with the files.
                          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

-- | File or Dir
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)

-- | The empty forest
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

-- | True iff the forest is entirely 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

-- | True iff there are only empty directories in the directory forest
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

-- | Remove all empty directories from a 'DirForest'
--
-- This will return 'Nothing' if the root was also empty.
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 -- Should not happen, but just insert nothing if it does.
        [FilePath
f] ->
          -- The last piece
          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 -- If it's already there, nothing changes

        -- Not the last piece, must be a dir
        (FilePath
d : [FilePath]
ds) ->
          -- Check if this piece is already in the forest
          case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
d Map FilePath (DirTree a)
ts of
            -- If it isn't, then we need to make it and try again
            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)
            -- If it is, then we can recurse down there.
            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

-- Left-biased
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

-- Left-biased
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)

-- Left-biased
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
"" -- Because "" FP.</> "anything" = "anything"
  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
"" -- Because "" FP.</> "anything" = "anything"
  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 -- TODO is this what we want?
      (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
"" -- Because "" FP.</> "anything" = "anything"
  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) -- Nothing means it will be removed
    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
"" -- Because "" </> "anything" = "anything"
  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 -- TODO not sure what the semantics are here
      (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 -- TODO not sure what the semantics are here
      (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) -- Cannot fail if the original dirforest is valid
           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) -- Cannot fail if the original dirforest is valid
           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 -- Whatever
      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 -- Whatever
      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 -- Technically not possible, but fine
hiddenHere (Char
'.' : FilePath
_) = Bool
True
hiddenHere FilePath
_ = Bool
False