srid/ema
1
1
Fork 0
mirror of https://github.com/srid/ema.git synced 2024-12-01 15:13:36 +03:00
Code Issues Projects Releases Wiki Activity

Allow passing initial value to mount

Browse Source
This commit is contained in:
Sridhar Ratnakumar 2021-05-17 19:20:40 -04:00
parent 2c33a83733
commit 5c0763be32
1 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Ema/Helper/FileSystem.hs
View File

@ -48,7 +48,6 @@ mountOnLVar ::
( MonadIO m, ( MonadIO m,
MonadUnliftIO m, MonadUnliftIO m,
MonadLogger m, MonadLogger m,
Default model,
Show b, Show b,
Ord b Ord b
) => ) =>
@ -57,7 +56,12 @@ mountOnLVar ::
-- | Only include these files (exclude everything else) -- | Only include these files (exclude everything else)
[(b, FilePattern)] -> [(b, FilePattern)] ->
-- | The `LVar` onto which to mount. -- | The `LVar` onto which to mount.
--
-- NOTE: It must not be set already. Otherwise, the value will be overriden
-- with the initial value argument (next).
LVar model -> LVar model ->
-- | Initial value of model, onto which to apply updates.
model ->
-- | How to update the model given a file action. -- | How to update the model given a file action.
-- --
-- `b` is the tag associated with the `FilePattern` that selected this -- `b` is the tag associated with the `FilePattern` that selected this
@ -68,13 +72,13 @@ mountOnLVar ::
-- If the action throws an exception, it will be logged and ignored. -- If the action throws an exception, it will be logged and ignored.
([(b, [FilePath])] -> FileAction -> m (model -> model)) -> ([(b, [FilePath])] -> FileAction -> m (model -> model)) ->
m () m ()
mountOnLVar folder pats var toAction' = do mountOnLVar folder pats var var0 toAction' = do
let toAction x = interceptExceptions id . toAction' x let toAction x = interceptExceptions id . toAction' x
log LevelInfo $ "Mounting path " <> toText folder <> " (filter: " <> show pats <> ") onto LVar" log LevelInfo $ "Mounting path " <> toText folder <> " (filter: " <> show pats <> ") onto LVar"
LVar.set var =<< do LVar.set var =<< do
fs <- filesMatchingWithTag folder pats fs <- filesMatchingWithTag folder pats
initialAction <- toAction fs Update initialAction <- toAction fs Update
pure $ initialAction def pure $ initialAction var0
onChange folder $ \fp change -> do onChange folder $ \fp change -> do
whenJust (getTag pats fp) $ \tag -> do whenJust (getTag pats fp) $ \tag -> do
-- TODO: We should probably debounce and group frequently-firing events -- TODO: We should probably debounce and group frequently-firing events