{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeApplications #-}
module System.UnionMount
(
mount,
unionMount,
unionMount',
FileAction (..),
RefreshAction (..),
Change,
)
where
import Control.Concurrent (threadDelay)
import Control.Monad.Logger
( LogLevel (LevelDebug, LevelError, LevelInfo, LevelWarn),
MonadLogger,
logWithoutLoc,
)
import Data.LVar qualified as LVar
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import System.Directory (canonicalizePath)
import System.FSNotify
( ActionPredicate,
Event (..),
EventIsDirectory (IsDirectory),
StopListening,
WatchManager,
defaultConfig,
eventIsDirectory,
eventPath,
watchTree,
withManagerConf,
)
import System.FilePath (isRelative, makeRelative)
import System.FilePattern (FilePattern, (?==))
import System.FilePattern.Directory (getDirectoryFilesIgnore)
import UnliftIO (MonadUnliftIO, finally, race, try, withRunInIO)
mount ::
forall model m b.
( MonadIO m,
MonadUnliftIO m,
MonadLogger m,
Show b,
Ord b
) =>
FilePath ->
[(b, FilePattern)] ->
[FilePattern] ->
model ->
(b -> FilePath -> FileAction () -> m (model -> model)) ->
m (model, (model -> m ()) -> m ())
mount :: forall model (m :: * -> *) b.
(MonadIO m, MonadUnliftIO m, MonadLogger m, Show b, Ord b) =>
FilePath
-> [(b, FilePath)]
-> [FilePath]
-> model
-> (b -> FilePath -> FileAction () -> m (model -> model))
-> m (model, (model -> m ()) -> m ())
mount FilePath
folder [(b, FilePath)]
pats [FilePath]
ignore model
var0 b -> FilePath -> FileAction () -> m (model -> model)
toAction' =
let tag0 :: ()
tag0 = ()
sources :: Set ((), FilePath)
sources = forall x. One x => OneItem x -> x
one (()
tag0, FilePath
folder)
in forall source tag model (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadLogger m, Ord source, Ord tag) =>
Set (source, FilePath)
-> [(tag, FilePath)]
-> [FilePath]
-> model
-> (Change source tag -> m (model -> model))
-> m (model, (model -> m ()) -> m ())
unionMount Set ((), FilePath)
sources [(b, FilePath)]
pats [FilePath]
ignore model
var0 forall a b. (a -> b) -> a -> b
$ \Change () b
ch -> do
let fsSet :: [(b, [(FilePath, FileAction ())])]
fsSet = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Change () b
ch
(\(b
tag, [(FilePath, FileAction ())]
xs) -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (b -> FilePath -> FileAction () -> m (model -> model)
toAction' b
tag) forall x a. Monad m => (x -> m (a -> a)) -> [x] -> m (a -> a)
`chainM` [(FilePath, FileAction ())]
xs) forall x a. Monad m => (x -> m (a -> a)) -> [x] -> m (a -> a)
`chainM` [(b, [(FilePath, FileAction ())])]
fsSet
where
chainM :: (Monad m) => (x -> m (a -> a)) -> [x] -> m (a -> a)
chainM :: forall x a. Monad m => (x -> m (a -> a)) -> [x] -> m (a -> a)
chainM x -> m (a -> a)
f =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a -> a] -> a -> a
chain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM x -> m (a -> a)
f
where
chain :: [a -> a] -> a -> a
chain :: forall a. [a -> a] -> a -> a
chain = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)
unionMount ::
forall source tag model m.
( MonadIO m,
MonadUnliftIO m,
MonadLogger m,
Ord source,
Ord tag
) =>
Set (source, FilePath) ->
[(tag, FilePattern)] ->
[FilePattern] ->
model ->
(Change source tag -> m (model -> model)) ->
m (model, (model -> m ()) -> m ())
unionMount :: forall source tag model (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadLogger m, Ord source, Ord tag) =>
Set (source, FilePath)
-> [(tag, FilePath)]
-> [FilePath]
-> model
-> (Change source tag -> m (model -> model))
-> m (model, (model -> m ()) -> m ())
unionMount Set (source, FilePath)
sources [(tag, FilePath)]
pats [FilePath]
ignore model
model0 Change source tag -> m (model -> model)
handleAction = do
(Change source tag
x0, (Change source tag -> m ()) -> m Cmd
xf) <- forall source tag (m :: * -> *) (m1 :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadLogger m, MonadLogger m1,
MonadIO m1, Ord source, Ord tag) =>
Set (source, FilePath)
-> [(tag, FilePath)]
-> [FilePath]
-> m1 (Change source tag, (Change source tag -> m ()) -> m Cmd)
unionMount' Set (source, FilePath)
sources [(tag, FilePath)]
pats [FilePath]
ignore
model -> model
x0' <- forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadLogger m) =>
a -> m a -> m a
interceptExceptions forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Change source tag -> m (model -> model)
handleAction Change source tag
x0
let initial :: model
initial = model -> model
x0' model
model0
LVar model
lvar <- forall a (m :: * -> *). MonadIO m => a -> m (LVar a)
LVar.new model
initial
let sender :: (model -> m ()) -> m ()
sender model -> m ()
send = do
Cmd
Cmd_Remount <- (Change source tag -> m ()) -> m Cmd
xf forall a b. (a -> b) -> a -> b
$ \Change source tag
change -> do
model -> model
change' <- forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadLogger m) =>
a -> m a -> m a
interceptExceptions forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ Change source tag -> m (model -> model)
handleAction Change source tag
change
forall (m :: * -> *) a. MonadIO m => LVar a -> (a -> a) -> m ()
LVar.modify LVar model
lvar model -> model
change'
model
x <- forall (m :: * -> *) a. MonadIO m => LVar a -> m a
LVar.get LVar model
lvar
model -> m ()
send model
x
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelInfo Text
"Remounting..."
(model
a, (model -> m ()) -> m ()
b) <- forall source tag model (m :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadLogger m, Ord source, Ord tag) =>
Set (source, FilePath)
-> [(tag, FilePath)]
-> [FilePath]
-> model
-> (Change source tag -> m (model -> model))
-> m (model, (model -> m ()) -> m ())
unionMount Set (source, FilePath)
sources [(tag, FilePath)]
pats [FilePath]
ignore model
model0 Change source tag -> m (model -> model)
handleAction
model -> m ()
send model
a
(model -> m ()) -> m ()
b model -> m ()
send
forall (f :: * -> *) a. Applicative f => a -> f a
pure (model -> model
x0' model
model0, (model -> m ()) -> m ()
sender)
interceptExceptions :: (MonadIO m, MonadUnliftIO m, MonadLogger m) => a -> m a -> m a
interceptExceptions :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m, MonadLogger m) =>
a -> m a -> m a
interceptExceptions a
default_ m a
f = do
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (SomeException
ex :: SomeException) -> do
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelError forall a b. (a -> b) -> a -> b
$ Text
"Change handler exception: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SomeException
ex
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
default_
Right a
v ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
data Evt source tag
= Evt_Change (Change source tag)
| Evt_Unhandled
deriving (Evt source tag -> Evt source tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall source tag.
(Eq tag, Eq source) =>
Evt source tag -> Evt source tag -> Bool
/= :: Evt source tag -> Evt source tag -> Bool
$c/= :: forall source tag.
(Eq tag, Eq source) =>
Evt source tag -> Evt source tag -> Bool
== :: Evt source tag -> Evt source tag -> Bool
$c== :: forall source tag.
(Eq tag, Eq source) =>
Evt source tag -> Evt source tag -> Bool
Eq, Int -> Evt source tag -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
forall source tag.
(Show tag, Show source) =>
Int -> Evt source tag -> ShowS
forall source tag.
(Show tag, Show source) =>
[Evt source tag] -> ShowS
forall source tag.
(Show tag, Show source) =>
Evt source tag -> FilePath
showList :: [Evt source tag] -> ShowS
$cshowList :: forall source tag.
(Show tag, Show source) =>
[Evt source tag] -> ShowS
show :: Evt source tag -> FilePath
$cshow :: forall source tag.
(Show tag, Show source) =>
Evt source tag -> FilePath
showsPrec :: Int -> Evt source tag -> ShowS
$cshowsPrec :: forall source tag.
(Show tag, Show source) =>
Int -> Evt source tag -> ShowS
Show)
data Cmd
= Cmd_Remount
deriving (Cmd -> Cmd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cmd -> Cmd -> Bool
$c/= :: Cmd -> Cmd -> Bool
== :: Cmd -> Cmd -> Bool
$c== :: Cmd -> Cmd -> Bool
Eq, Int -> Cmd -> ShowS
[Cmd] -> ShowS
Cmd -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Cmd] -> ShowS
$cshowList :: [Cmd] -> ShowS
show :: Cmd -> FilePath
$cshow :: Cmd -> FilePath
showsPrec :: Int -> Cmd -> ShowS
$cshowsPrec :: Int -> Cmd -> ShowS
Show)
unionMount' ::
forall source tag m m1.
( MonadIO m,
MonadUnliftIO m,
MonadLogger m,
MonadLogger m1,
MonadIO m1,
Ord source,
Ord tag
) =>
Set (source, FilePath) ->
[(tag, FilePattern)] ->
[FilePattern] ->
m1
( Change source tag,
(Change source tag -> m ()) ->
m Cmd
)
unionMount' :: forall source tag (m :: * -> *) (m1 :: * -> *).
(MonadIO m, MonadUnliftIO m, MonadLogger m, MonadLogger m1,
MonadIO m1, Ord source, Ord tag) =>
Set (source, FilePath)
-> [(tag, FilePath)]
-> [FilePath]
-> m1 (Change source tag, (Change source tag -> m ()) -> m Cmd)
unionMount' Set (source, FilePath)
sources [(tag, FilePath)]
pats [FilePath]
ignore = do
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall source. Ord source => OverlayFs source
emptyOverlayFs @source) forall a b. (a -> b) -> a -> b
$ do
Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
changes0 :: Change source tag <-
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (source, FilePath)
sources forall a b. (a -> b) -> a -> b
$ \(source
src, FilePath
folder) -> do
[(tag, [FilePath])]
taggedFiles <- forall (m :: * -> *) b.
(MonadIO m, MonadLogger m, Ord b) =>
FilePath -> [(b, FilePath)] -> [FilePath] -> m [(b, [FilePath])]
filesMatchingWithTag FilePath
folder [(tag, FilePath)]
pats [FilePath]
ignore
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(tag, [FilePath])]
taggedFiles forall a b. (a -> b) -> a -> b
$ \(tag
tag, [FilePath]
fs) -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
fs forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source tag (m :: * -> *).
(Ord source, Ord tag, MonadState (OverlayFs source) m) =>
source
-> tag
-> FilePath
-> FileAction ()
-> Change source tag
-> m (Change source tag)
changeInsert source
src tag
tag FilePath
fp (forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
Existing ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
OverlayFs source
ofs <- forall s (m :: * -> *). MonadState s m => m s
get
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
changes0,
\Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
-> m ()
reportChange -> do
TMVar (source, FilePath, Either (FolderAction ()) (FileAction ()))
q :: TMVar (x, FilePath, Either (FolderAction ()) (FileAction ())) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race (forall x (m :: * -> *).
(Eq x, MonadIO m, MonadLogger m, MonadUnliftIO m) =>
TMVar (x, FilePath, Either (FolderAction ()) (FileAction ()))
-> [(x, FilePath)] -> m Cmd
onChange TMVar (source, FilePath, Either (FolderAction ()) (FileAction ()))
q (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (source, FilePath)
sources)) forall a b. (a -> b) -> a -> b
$
let readDebounced :: StateT
(OverlayFs source)
m
(source, FilePath, Either (FolderAction ()) (FileAction ()))
readDebounced = do
(source, FilePath, Either (FolderAction ()) (FileAction ()))
_ <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> STM a
readTMVar TMVar (source, FilePath, Either (FolderAction ()) (FileAction ()))
q
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
100000
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT
(OverlayFs source)
m
(source, FilePath, Either (FolderAction ()) (FileAction ()))
readDebounced forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (forall a. TMVar a -> STM (Maybe a)
tryTakeTMVar TMVar (source, FilePath, Either (FolderAction ()) (FileAction ()))
q)
loop :: StateT (OverlayFs source) m Cmd
loop = do
(source
src, FilePath
fp, Either (FolderAction ()) (FileAction ())
actE) <- StateT
(OverlayFs source)
m
(source, FilePath, Either (FolderAction ()) (FileAction ()))
readDebounced
let shouldIgnore :: Bool
shouldIgnore = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FilePath -> FilePath -> Bool
?== FilePath
fp) [FilePath]
ignore
case Either (FolderAction ()) (FileAction ())
actE of
Left FolderAction ()
_ -> do
let reason :: Text
reason = Text
"Unhandled folder event on '" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText FilePath
fp forall a. Semigroup a => a -> a -> a
<> Text
"'"
if Bool
shouldIgnore
then do
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelWarn forall a b. (a -> b) -> a -> b
$ Text
reason forall a. Semigroup a => a -> a -> a
<> Text
" on an ignored path"
StateT (OverlayFs source) m Cmd
loop
else do
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelWarn forall a b. (a -> b) -> a -> b
$ Text
reason forall a. Semigroup a => a -> a -> a
<> Text
"; suggesting a re-mount"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
Cmd_Remount
Right FileAction ()
act -> do
case forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
shouldIgnore) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. [(b, FilePath)] -> FilePath -> Maybe b
getTag [(tag, FilePath)]
pats FilePath
fp of
Maybe tag
Nothing -> StateT (OverlayFs source) m Cmd
loop
Just tag
tag -> do
Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
changes <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall source tag (m :: * -> *).
(Ord source, Ord tag, MonadState (OverlayFs source) m) =>
source
-> tag
-> FilePath
-> FileAction ()
-> Change source tag
-> m (Change source tag)
changeInsert source
src tag
tag FilePath
fp FileAction ()
act forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
-> m ()
reportChange Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
changes
StateT (OverlayFs source) m Cmd
loop
in forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (OverlayFs source) m Cmd
loop OverlayFs source
ofs
)
filesMatching :: (MonadIO m, MonadLogger m) => FilePath -> [FilePattern] -> [FilePattern] -> m [FilePath]
filesMatching :: forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
FilePath -> [FilePath] -> [FilePath] -> m [FilePath]
filesMatching FilePath
parent' [FilePath]
pats [FilePath]
ignore = do
FilePath
parent <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
parent'
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelInfo forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ FilePath
"Traversing " forall a. Semigroup a => a -> a -> a
<> FilePath
parent forall a. Semigroup a => a -> a -> a
<> FilePath
" for files matching " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [FilePath]
pats forall a. Semigroup a => a -> a -> a
<> FilePath
", ignoring " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [FilePath]
ignore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> [FilePath] -> IO [FilePath]
getDirectoryFilesIgnore FilePath
parent [FilePath]
pats [FilePath]
ignore
filesMatchingWithTag :: (MonadIO m, MonadLogger m, Ord b) => FilePath -> [(b, FilePattern)] -> [FilePattern] -> m [(b, [FilePath])]
filesMatchingWithTag :: forall (m :: * -> *) b.
(MonadIO m, MonadLogger m, Ord b) =>
FilePath -> [(b, FilePath)] -> [FilePath] -> m [(b, [FilePath])]
filesMatchingWithTag FilePath
parent' [(b, FilePath)]
pats [FilePath]
ignore = do
[FilePath]
fs <- forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
FilePath -> [FilePath] -> [FilePath] -> m [FilePath]
filesMatching FilePath
parent' (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, FilePath)]
pats) [FilePath]
ignore
let m :: Map b [FilePath]
m = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [FilePath]
fs forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
b
tag <- forall b. [(b, FilePath)] -> FilePath -> Maybe b
getTag [(b, FilePath)]
pats FilePath
fp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
tag, forall x. One x => OneItem x -> x
one FilePath
fp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map b [FilePath]
m
getTag :: [(b, FilePattern)] -> FilePath -> Maybe b
getTag :: forall b. [(b, FilePath)] -> FilePath -> Maybe b
getTag [(b, FilePath)]
pats FilePath
fp =
let pull :: [(a, FilePath)] -> Maybe a
pull [(a, FilePath)]
patterns =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(a, FilePath)]
patterns forall a b. (a -> b) -> a -> b
$ \(a
tag, FilePath
pat) -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ FilePath
pat FilePath -> FilePath -> Bool
?== FilePath
fp
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
tag
in if FilePath -> Bool
isRelative FilePath
fp
then forall {a}. [(a, FilePath)] -> Maybe a
pull [(b, FilePath)]
pats
else
forall {a}. [(a, FilePath)] -> Maybe a
pull forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (FilePath
"**/" forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(b, FilePath)]
pats
data RefreshAction
=
Existing
|
New
|
Update
deriving (RefreshAction -> RefreshAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefreshAction -> RefreshAction -> Bool
$c/= :: RefreshAction -> RefreshAction -> Bool
== :: RefreshAction -> RefreshAction -> Bool
$c== :: RefreshAction -> RefreshAction -> Bool
Eq, Int -> RefreshAction -> ShowS
[RefreshAction] -> ShowS
RefreshAction -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RefreshAction] -> ShowS
$cshowList :: [RefreshAction] -> ShowS
show :: RefreshAction -> FilePath
$cshow :: RefreshAction -> FilePath
showsPrec :: Int -> RefreshAction -> ShowS
$cshowsPrec :: Int -> RefreshAction -> ShowS
Show)
data FileAction a
=
Refresh RefreshAction a
|
Delete
deriving (FileAction a -> FileAction a -> Bool
forall a. Eq a => FileAction a -> FileAction a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileAction a -> FileAction a -> Bool
$c/= :: forall a. Eq a => FileAction a -> FileAction a -> Bool
== :: FileAction a -> FileAction a -> Bool
$c== :: forall a. Eq a => FileAction a -> FileAction a -> Bool
Eq, Int -> FileAction a -> ShowS
forall a. Show a => Int -> FileAction a -> ShowS
forall a. Show a => [FileAction a] -> ShowS
forall a. Show a => FileAction a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileAction a] -> ShowS
$cshowList :: forall a. Show a => [FileAction a] -> ShowS
show :: FileAction a -> FilePath
$cshow :: forall a. Show a => FileAction a -> FilePath
showsPrec :: Int -> FileAction a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FileAction a -> ShowS
Show, forall a b. a -> FileAction b -> FileAction a
forall a b. (a -> b) -> FileAction a -> FileAction 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 -> FileAction b -> FileAction a
$c<$ :: forall a b. a -> FileAction b -> FileAction a
fmap :: forall a b. (a -> b) -> FileAction a -> FileAction b
$cfmap :: forall a b. (a -> b) -> FileAction a -> FileAction b
Functor)
newtype FolderAction a = FolderAction a
deriving (FolderAction a -> FolderAction a -> Bool
forall a. Eq a => FolderAction a -> FolderAction a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FolderAction a -> FolderAction a -> Bool
$c/= :: forall a. Eq a => FolderAction a -> FolderAction a -> Bool
== :: FolderAction a -> FolderAction a -> Bool
$c== :: forall a. Eq a => FolderAction a -> FolderAction a -> Bool
Eq, Int -> FolderAction a -> ShowS
forall a. Show a => Int -> FolderAction a -> ShowS
forall a. Show a => [FolderAction a] -> ShowS
forall a. Show a => FolderAction a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FolderAction a] -> ShowS
$cshowList :: forall a. Show a => [FolderAction a] -> ShowS
show :: FolderAction a -> FilePath
$cshow :: forall a. Show a => FolderAction a -> FilePath
showsPrec :: Int -> FolderAction a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FolderAction a -> ShowS
Show, forall a b. a -> FolderAction b -> FolderAction a
forall a b. (a -> b) -> FolderAction a -> FolderAction 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 -> FolderAction b -> FolderAction a
$c<$ :: forall a b. a -> FolderAction b -> FolderAction a
fmap :: forall a b. (a -> b) -> FolderAction a -> FolderAction b
$cfmap :: forall a b. (a -> b) -> FolderAction a -> FolderAction b
Functor)
refreshAction :: FileAction a -> Maybe RefreshAction
refreshAction :: forall a. FileAction a -> Maybe RefreshAction
refreshAction = \case
Refresh RefreshAction
act a
_ -> forall a. a -> Maybe a
Just RefreshAction
act
FileAction a
_ -> forall a. Maybe a
Nothing
onChange ::
forall x m.
(Eq x, MonadIO m, MonadLogger m, MonadUnliftIO m) =>
TMVar (x, FilePath, Either (FolderAction ()) (FileAction ())) ->
[(x, FilePath)] ->
m Cmd
onChange :: forall x (m :: * -> *).
(Eq x, MonadIO m, MonadLogger m, MonadUnliftIO m) =>
TMVar (x, FilePath, Either (FolderAction ()) (FileAction ()))
-> [(x, FilePath)] -> m Cmd
onChange TMVar (x, FilePath, Either (FolderAction ()) (FileAction ()))
q [(x, FilePath)]
roots = do
forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m) =>
(WatchManager -> m a) -> m a
withManagerM forall a b. (a -> b) -> a -> b
$ \WatchManager
mgr -> do
[IO ()]
stops <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(x, FilePath)]
roots forall a b. (a -> b) -> a -> b
$ \(x
x, FilePath
rootRel) -> do
FilePath
root <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
rootRel
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelInfo forall a b. (a -> b) -> a -> b
$ forall a. ToText a => a -> Text
toText forall a b. (a -> b) -> a -> b
$ FilePath
"Monitoring " forall a. Semigroup a => a -> a -> a
<> FilePath
root forall a. Semigroup a => a -> a -> a
<> FilePath
" for changes"
forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m) =>
WatchManager
-> FilePath -> ActionPredicate -> (Event -> m ()) -> m (IO ())
watchTreeM WatchManager
mgr FilePath
root (forall a b. a -> b -> a
const Bool
True) forall a b. (a -> b) -> a -> b
$ \Event
event -> do
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelDebug forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show Event
event
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
Maybe (x, FilePath, Either (FolderAction ()) (FileAction ()))
lastQ <- forall a. TMVar a -> STM (Maybe a)
tryTakeTMVar TMVar (x, FilePath, Either (FolderAction ()) (FileAction ()))
q
let fp :: FilePath
fp = FilePath -> ShowS
makeRelative FilePath
root forall a b. (a -> b) -> a -> b
$ Event -> FilePath
eventPath Event
event
f :: Either (FolderAction ()) (FileAction ()) -> STM ()
f Either (FolderAction ()) (FileAction ())
act = forall a. TMVar a -> a -> STM ()
putTMVar TMVar (x, FilePath, Either (FolderAction ()) (FileAction ()))
q (x
x, FilePath
fp, Either (FolderAction ()) (FileAction ())
act)
reAddQ :: STM ()
reAddQ = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (x, FilePath, Either (FolderAction ()) (FileAction ()))
lastQ (forall a. TMVar a -> a -> STM ()
putTMVar TMVar (x, FilePath, Either (FolderAction ()) (FileAction ()))
q)
if Event -> EventIsDirectory
eventIsDirectory Event
event forall a. Eq a => a -> a -> Bool
== EventIsDirectory
IsDirectory
then Either (FolderAction ()) (FileAction ()) -> STM ()
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. a -> FolderAction a
FolderAction ()
else do
let newAction :: Maybe (FileAction ())
newAction = case Event
event of
Added {} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
New ()
Modified {} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
Update ()
ModifiedAttributes {} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
Update ()
Removed {} -> forall a. a -> Maybe a
Just forall a. FileAction a
Delete
Event
_ -> forall a. Maybe a
Nothing
case (Maybe (x, FilePath, Either (FolderAction ()) (FileAction ()))
lastQ, Maybe (FileAction ())
newAction) of
(Maybe (x, FilePath, Either (FolderAction ()) (FileAction ()))
_, Maybe (FileAction ())
Nothing) -> STM ()
reAddQ
(Just (x
lastTag, FilePath
lastFp, Right FileAction ()
lastAction), Just FileAction ()
a)
| x
lastTag forall a. Eq a => a -> a -> Bool
== x
x Bool -> Bool -> Bool
&& FilePath
lastFp forall a. Eq a => a -> a -> Bool
== FilePath
fp ->
case (FileAction ()
lastAction, FileAction ()
a) of
(FileAction ()
Delete, Refresh RefreshAction
New ()) -> Either (FolderAction ()) (FileAction ()) -> STM ()
f forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
Update ()
(Refresh RefreshAction
New (), Refresh RefreshAction
Update ()) -> Either (FolderAction ()) (FileAction ()) -> STM ()
f forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
New ()
(Refresh RefreshAction
New (), FileAction ()
Delete) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(FileAction (), FileAction ())
_ -> Either (FolderAction ()) (FileAction ()) -> STM ()
f forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right FileAction ()
a
(Maybe (x, FilePath, Either (FolderAction ()) (FileAction ()))
_, Just FileAction ()
a) -> STM ()
reAddQ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (FolderAction ()) (FileAction ()) -> STM ()
f (forall a b. b -> Either a b
Right FileAction ()
a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> IO ()
threadDelay forall a. Bounded a => a
maxBound)
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` do
forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log LogLevel
LevelInfo Text
"Stopping fsnotify monitor."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IO ()]
stops forall a. a -> a
id
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
Cmd_Remount
withManagerM ::
(MonadIO m, MonadUnliftIO m) =>
(WatchManager -> m a) ->
m a
withManagerM :: forall (m :: * -> *) a.
(MonadIO m, MonadUnliftIO m) =>
(WatchManager -> m a) -> m a
withManagerM WatchManager -> m a
f = do
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
withManagerConf WatchConfig
defaultConfig forall a b. (a -> b) -> a -> b
$ \WatchManager
mgr -> forall a. m a -> IO a
run (WatchManager -> m a
f WatchManager
mgr)
watchTreeM ::
forall m.
(MonadIO m, MonadUnliftIO m) =>
WatchManager ->
FilePath ->
ActionPredicate ->
(Event -> m ()) ->
m StopListening
watchTreeM :: forall (m :: * -> *).
(MonadIO m, MonadUnliftIO m) =>
WatchManager
-> FilePath -> ActionPredicate -> (Event -> m ()) -> m (IO ())
watchTreeM WatchManager
wm FilePath
fp ActionPredicate
pr Event -> m ()
f =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchTree WatchManager
wm FilePath
fp ActionPredicate
pr forall a b. (a -> b) -> a -> b
$ \Event
evt -> forall a. m a -> IO a
run (Event -> m ()
f Event
evt)
log :: MonadLogger m => LogLevel -> Text -> m ()
log :: forall (m :: * -> *). MonadLogger m => LogLevel -> Text -> m ()
log = forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc Text
"System.UnionMount"
newtype OverlayFs source = OverlayFs (Map FilePath (Set source))
emptyOverlayFs :: Ord source => OverlayFs source
emptyOverlayFs :: forall source. Ord source => OverlayFs source
emptyOverlayFs = forall source. Map FilePath (Set source) -> OverlayFs source
OverlayFs forall a. Monoid a => a
mempty
overlayFsModify :: FilePath -> (Set src -> Set src) -> OverlayFs src -> OverlayFs src
overlayFsModify :: forall src.
FilePath -> (Set src -> Set src) -> OverlayFs src -> OverlayFs src
overlayFsModify FilePath
k Set src -> Set src
f (OverlayFs Map FilePath (Set src)
m) =
forall source. Map FilePath (Set source) -> OverlayFs source
OverlayFs forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
k (Set src -> Set src
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Set a
Set.empty forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
k Map FilePath (Set src)
m) Map FilePath (Set src)
m
overlayFsAdd :: Ord src => FilePath -> src -> OverlayFs src -> OverlayFs src
overlayFsAdd :: forall src.
Ord src =>
FilePath -> src -> OverlayFs src -> OverlayFs src
overlayFsAdd FilePath
fp src
src =
forall src.
FilePath -> (Set src -> Set src) -> OverlayFs src -> OverlayFs src
overlayFsModify FilePath
fp forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.insert src
src
overlayFsRemove :: Ord src => FilePath -> src -> OverlayFs src -> OverlayFs src
overlayFsRemove :: forall src.
Ord src =>
FilePath -> src -> OverlayFs src -> OverlayFs src
overlayFsRemove FilePath
fp src
src =
forall src.
FilePath -> (Set src -> Set src) -> OverlayFs src -> OverlayFs src
overlayFsModify FilePath
fp forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.delete src
src
overlayFsLookup :: FilePath -> OverlayFs source -> Maybe (NonEmpty (source, FilePath))
overlayFsLookup :: forall source.
FilePath -> OverlayFs source -> Maybe (NonEmpty (source, FilePath))
overlayFsLookup FilePath
fp (OverlayFs Map FilePath (Set source)
m) = do
NonEmpty source
sources <- forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
fp Map FilePath (Set source)
m
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NonEmpty source
sources forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,FilePath
fp)
type Change source tag = Map tag (Map FilePath (FileAction (NonEmpty (source, FilePath))))
changeInsert ::
(Ord source, Ord tag, MonadState (OverlayFs source) m) =>
source ->
tag ->
FilePath ->
FileAction () ->
Change source tag ->
m (Change source tag)
changeInsert :: forall source tag (m :: * -> *).
(Ord source, Ord tag, MonadState (OverlayFs source) m) =>
source
-> tag
-> FilePath
-> FileAction ()
-> Change source tag
-> m (Change source tag)
changeInsert source
src tag
tag FilePath
fp FileAction ()
act Change source tag
ch = do
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Change source tag
ch forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$
(if FileAction ()
act forall a. Eq a => a -> a -> Bool
== forall a. FileAction a
Delete then forall src.
Ord src =>
FilePath -> src -> OverlayFs src -> OverlayFs src
overlayFsRemove else forall src.
Ord src =>
FilePath -> src -> OverlayFs src -> OverlayFs src
overlayFsAdd)
FilePath
fp
source
src
FileAction (NonEmpty (source, FilePath))
overlays <-
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall source.
FilePath -> OverlayFs source -> Maybe (NonEmpty (source, FilePath))
overlayFsLookup FilePath
fp) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Maybe (NonEmpty (source, FilePath))
Nothing -> forall a. FileAction a
Delete
Just NonEmpty (source, FilePath)
fs ->
let combinedAction :: RefreshAction
combinedAction = forall a. a -> Maybe a -> a
fromMaybe RefreshAction
Existing forall a b. (a -> b) -> a -> b
$ forall a. FileAction a -> Maybe RefreshAction
refreshAction FileAction ()
act
in forall a. RefreshAction -> a -> FileAction a
Refresh RefreshAction
combinedAction NonEmpty (source, FilePath)
fs
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup tag
tag) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Map FilePath (FileAction (NonEmpty (source, FilePath))))
Nothing ->
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert tag
tag forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton FilePath
fp FileAction (NonEmpty (source, FilePath))
overlays
Just Map FilePath (FileAction (NonEmpty (source, FilePath)))
files ->
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert tag
tag forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
fp FileAction (NonEmpty (source, FilePath))
overlays Map FilePath (FileAction (NonEmpty (source, FilePath)))
files