-- | Patch model state depending on file change event.
module Emanote.Source.Patch
  ( patchModel,
    filePatterns,
    ignorePatterns,
  )
where

import Control.Exception (throwIO)
import Control.Monad.Logger (LoggingT (runLoggingT), MonadLogger, MonadLoggerIO (askLoggerIO))
import Data.ByteString qualified as BS
import Data.List.NonEmpty qualified as NEL
import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
import Emanote.Model qualified as M
import Emanote.Model.Note qualified as N
import Emanote.Model.SData qualified as SD
import Emanote.Model.Stork.Index qualified as Stork
import Emanote.Model.Type (ModelEma)
import Emanote.Prelude
  ( BadInput (BadInput),
    log,
    logD,
  )
import Emanote.Route qualified as R
import Emanote.Source.Loc (Loc, LocLayers, locPath, locResolve, primaryLayer)
import Emanote.Source.Pattern (filePatterns, ignorePatterns)
import Heist.Extra.TemplateState qualified as T
import Optics.Operators ((%~))
import Relude
import Relude.Extra (traverseToSnd)
import System.UnionMount qualified as UM
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Directory (doesDirectoryExist)

-- | Map a filesystem change to the corresponding model change.
patchModel ::
  (MonadIO m, MonadLogger m, MonadLoggerIO m) =>
  LocLayers ->
  (N.Note -> N.Note) ->
  Stork.IndexVar ->
  -- | Type of the file being changed
  R.FileType R.SourceExt ->
  -- | Path to the file being changed
  FilePath ->
  -- | Specific change to the file, along with its paths from other "layers"
  UM.FileAction (NonEmpty (Loc, FilePath)) ->
  m (ModelEma -> ModelEma)
patchModel :: forall (m :: Type -> Type).
(MonadIO m, MonadLogger m, MonadLoggerIO m) =>
LocLayers
-> (Note -> Note)
-> IndexVar
-> FileType SourceExt
-> FilePath
-> FileAction (NonEmpty (Loc, FilePath))
-> m (ModelEma -> ModelEma)
patchModel LocLayers
layers Note -> Note
noteF IndexVar
storkIndexTVar FileType SourceExt
fpType FilePath
fp FileAction (NonEmpty (Loc, FilePath))
action = do
  Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger <- m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: Type -> Type).
MonadLoggerIO m =>
m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO
  UTCTime
now <- IO UTCTime -> m UTCTime
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  -- Prefix all patch logging with timestamp.
  let newLogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
newLogger Loc
loc LogSource
src LogLevel
lvl LogStr
s =
        Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger Loc
loc LogSource
src LogLevel
lvl (LogStr -> IO ()) -> LogStr -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> LogStr
forall a. IsString a => FilePath -> a
fromString (TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"[%H:%M:%S] " UTCTime
now) LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
s
  LoggingT m (ModelEma -> ModelEma)
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> m (ModelEma -> ModelEma)
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (LocLayers
-> (Note -> Note)
-> IndexVar
-> FileType SourceExt
-> FilePath
-> FileAction (NonEmpty (Loc, FilePath))
-> LoggingT m (ModelEma -> ModelEma)
forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
LocLayers
-> (Note -> Note)
-> IndexVar
-> FileType SourceExt
-> FilePath
-> FileAction (NonEmpty (Loc, FilePath))
-> m (ModelEma -> ModelEma)
patchModel' LocLayers
layers Note -> Note
noteF IndexVar
storkIndexTVar FileType SourceExt
fpType FilePath
fp FileAction (NonEmpty (Loc, FilePath))
action) Loc -> LogSource -> LogLevel -> LogStr -> IO ()
newLogger

-- | Map a filesystem change to the corresponding model change.
patchModel' ::
  (MonadIO m, MonadLogger m) =>
  LocLayers ->
  (N.Note -> N.Note) ->
  Stork.IndexVar ->
  -- | Type of the file being changed
  R.FileType R.SourceExt ->
  -- | Path to the file being changed
  FilePath ->
  -- | Specific change to the file, along with its paths from other "layers"
  UM.FileAction (NonEmpty (Loc, FilePath)) ->
  m (ModelEma -> ModelEma)
patchModel' :: forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
LocLayers
-> (Note -> Note)
-> IndexVar
-> FileType SourceExt
-> FilePath
-> FileAction (NonEmpty (Loc, FilePath))
-> m (ModelEma -> ModelEma)
patchModel' LocLayers
layers Note -> Note
noteF IndexVar
storkIndexTVar FileType SourceExt
fpType FilePath
fp FileAction (NonEmpty (Loc, FilePath))
action = do
  case FileType SourceExt
fpType of
    R.LMLType LML
lmlType -> do
      case LML -> FilePath -> Maybe LMLRoute
R.mkLMLRouteFromKnownFilePath LML
lmlType FilePath
fp of
        Maybe LMLRoute
Nothing ->
          (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ModelEma -> ModelEma
forall a. a -> a
id -- Impossible
        Just LMLRoute
r -> do
          -- Stork doesn't support incremental building of index, so we must
          -- clear it to pave way for a rebuild later when requested.
          --
          -- From https://github.com/jameslittle230/stork/discussions/112#discussioncomment-252861
          --
          -- > Stork also doesn't support incremental index updates today --
          -- you'd have to re-index everything when users added a new document,
          -- which might be prohibitively long.
          IndexVar -> m ()
forall (m :: Type -> Type). MonadIO m => IndexVar -> m ()
Stork.clearStorkIndex IndexVar
storkIndexTVar

          case FileAction (NonEmpty (Loc, FilePath))
action of
            UM.Refresh RefreshAction
refreshAction NonEmpty (Loc, FilePath)
overlays -> do
              let fpAbs :: FilePath
fpAbs = (Loc, FilePath) -> FilePath
locResolve ((Loc, FilePath) -> FilePath) -> (Loc, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ NonEmpty (Loc, FilePath) -> (Loc, FilePath)
forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Loc, FilePath)
overlays
                  -- TODO: This should automatically be computed, instead of being passed.
                  -- We need access to the model though! With dependency management to boot.
                  -- Until this, `layers` is threaded through as a hack.
                  currentLayerPath :: FilePath
currentLayerPath = Loc -> FilePath
locPath (Loc -> FilePath) -> Loc -> FilePath
forall a b. (a -> b) -> a -> b
$ HasCallStack => LocLayers -> Loc
LocLayers -> Loc
primaryLayer LocLayers
layers
              ByteString
s <- RefreshAction -> FilePath -> m ByteString
forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction FilePath
fpAbs
              Note
note <- FilePath -> LMLRoute -> FilePath -> LogSource -> m Note
forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
FilePath -> LMLRoute -> FilePath -> LogSource -> m Note
N.parseNote FilePath
currentLayerPath LMLRoute
r FilePath
fpAbs (ByteString -> LogSource
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
s)
              (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ Note -> ModelEma -> ModelEma
forall (f :: Type -> Type). Note -> ModelT f -> ModelT f
M.modelInsertNote (Note -> ModelEma -> ModelEma) -> Note -> ModelEma -> ModelEma
forall a b. (a -> b) -> a -> b
$ Note -> Note
noteF Note
note
            FileAction (NonEmpty (Loc, FilePath))
UM.Delete -> do
              LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Removing note: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
fp
              (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ LMLRoute -> ModelEma -> ModelEma
forall (f :: Type -> Type). LMLRoute -> ModelT f -> ModelT f
M.modelDeleteNote LMLRoute
r
    FileType SourceExt
R.Yaml ->
      case FilePath -> Maybe (R @SourceExt 'Yaml)
forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe (R @a ext)
R.mkRouteFromFilePath FilePath
fp of
        Maybe (R @SourceExt 'Yaml)
Nothing ->
          (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ModelEma -> ModelEma
forall a. a -> a
id
        Just R @SourceExt 'Yaml
r -> case FileAction (NonEmpty (Loc, FilePath))
action of
          UM.Refresh RefreshAction
refreshAction NonEmpty (Loc, FilePath)
overlays -> do
            NonEmpty (FilePath, ByteString)
yamlContents <- NonEmpty (Loc, FilePath)
-> ((Loc, FilePath) -> m (FilePath, ByteString))
-> m (NonEmpty (FilePath, ByteString))
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (NonEmpty (Loc, FilePath) -> NonEmpty (Loc, FilePath)
forall a. NonEmpty a -> NonEmpty a
NEL.reverse NonEmpty (Loc, FilePath)
overlays) (((Loc, FilePath) -> m (FilePath, ByteString))
 -> m (NonEmpty (FilePath, ByteString)))
-> ((Loc, FilePath) -> m (FilePath, ByteString))
-> m (NonEmpty (FilePath, ByteString))
forall a b. (a -> b) -> a -> b
$ \(Loc, FilePath)
overlay -> do
              let fpAbs :: FilePath
fpAbs = (Loc, FilePath) -> FilePath
locResolve (Loc, FilePath)
overlay
              (FilePath -> m ByteString) -> FilePath -> m (FilePath, ByteString)
forall (t :: Type -> Type) a b.
Functor t =>
(a -> t b) -> a -> t (a, b)
traverseToSnd (RefreshAction -> FilePath -> m ByteString
forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction) FilePath
fpAbs
            SData
sData <-
              IO SData -> m SData
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO SData -> m SData) -> IO SData -> m SData
forall a b. (a -> b) -> a -> b
$
                (LogSource -> IO SData)
-> (SData -> IO SData) -> Either LogSource SData -> IO SData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (BadInput -> IO SData
forall e a. Exception e => e -> IO a
throwIO (BadInput -> IO SData)
-> (LogSource -> BadInput) -> LogSource -> IO SData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> BadInput
BadInput) SData -> IO SData
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either LogSource SData -> IO SData)
-> Either LogSource SData -> IO SData
forall a b. (a -> b) -> a -> b
$
                  R @SourceExt 'Yaml
-> NonEmpty (FilePath, ByteString) -> Either LogSource SData
SD.parseSDataCascading R @SourceExt 'Yaml
r NonEmpty (FilePath, ByteString)
yamlContents
            (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ SData -> ModelEma -> ModelEma
forall (f :: Type -> Type). SData -> ModelT f -> ModelT f
M.modelInsertData SData
sData
          FileAction (NonEmpty (Loc, FilePath))
UM.Delete -> do
            LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Removing data: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
fp
            (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ R @SourceExt 'Yaml -> ModelEma -> ModelEma
forall (f :: Type -> Type).
R @SourceExt 'Yaml -> ModelT f -> ModelT f
M.modelDeleteData R @SourceExt 'Yaml
r
    FileType SourceExt
R.HeistTpl ->
      case FileAction (NonEmpty (Loc, FilePath))
action of
        UM.Refresh RefreshAction
refreshAction NonEmpty (Loc, FilePath)
overlays -> do
          let fpAbs :: FilePath
fpAbs = (Loc, FilePath) -> FilePath
locResolve ((Loc, FilePath) -> FilePath) -> (Loc, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ NonEmpty (Loc, FilePath) -> (Loc, FilePath)
forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Loc, FilePath)
overlays
              -- Once we start loading HTML templates, mark the model as "ready"
              -- so Ema will begin rendering content in place of "Loading..."
              -- indicator
              readyOnTemplates :: ModelEma -> ModelEma
readyOnTemplates = (ModelEma -> ModelEma)
-> (ModelEma -> ModelEma) -> Bool -> ModelEma -> ModelEma
forall a. a -> a -> Bool -> a
bool ModelEma -> ModelEma
forall a. a -> a
id ModelEma -> ModelEma
forall (f :: Type -> Type). ModelT f -> ModelT f
M.modelReadyForView (RefreshAction
refreshAction RefreshAction -> RefreshAction -> Bool
forall a. Eq a => a -> a -> Bool
== RefreshAction
UM.Existing)
          ModelEma -> ModelEma
act <- do
            ByteString
s <- RefreshAction -> FilePath -> m ByteString
forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction FilePath
fpAbs
            LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
logD (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Read " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> Int -> LogSource
forall b a. (Show a, IsString b) => a -> b
show (ByteString -> Int
BS.length ByteString
s) LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" bytes of template"
            (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ Lens' ModelEma TemplateState
forall (encF :: Type -> Type). Lens' (ModelT encF) TemplateState
M.modelHeistTemplate Lens' ModelEma TemplateState
-> (TemplateState -> TemplateState) -> ModelEma -> ModelEma
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ HasCallStack =>
FilePath
-> FilePath -> ByteString -> TemplateState -> TemplateState
FilePath
-> FilePath -> ByteString -> TemplateState -> TemplateState
T.addTemplateFile FilePath
fpAbs FilePath
fp ByteString
s
          (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ ModelEma -> ModelEma
readyOnTemplates (ModelEma -> ModelEma)
-> (ModelEma -> ModelEma) -> ModelEma -> ModelEma
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> ModelEma -> ModelEma
act
        FileAction (NonEmpty (Loc, FilePath))
UM.Delete -> do
          LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Removing template: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
fp
          (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ Lens' ModelEma TemplateState
forall (encF :: Type -> Type). Lens' (ModelT encF) TemplateState
M.modelHeistTemplate Lens' ModelEma TemplateState
-> (TemplateState -> TemplateState) -> ModelEma -> ModelEma
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ HasCallStack => FilePath -> TemplateState -> TemplateState
FilePath -> TemplateState -> TemplateState
T.removeTemplateFile FilePath
fp
    FileType SourceExt
R.AnyExt -> do
      case FilePath -> Maybe (R @SourceExt 'AnyExt)
forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe (R @a ext)
R.mkRouteFromFilePath FilePath
fp of
        Maybe (R @SourceExt 'AnyExt)
Nothing ->
          (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ModelEma -> ModelEma
forall a. a -> a
id
        Just R @SourceExt 'AnyExt
r -> case FileAction (NonEmpty (Loc, FilePath))
action of
          UM.Refresh RefreshAction
refreshAction NonEmpty (Loc, FilePath)
overlays -> do
            let fpAbs :: FilePath
fpAbs = (Loc, FilePath) -> FilePath
locResolve ((Loc, FilePath) -> FilePath) -> (Loc, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ NonEmpty (Loc, FilePath) -> (Loc, FilePath)
forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Loc, FilePath)
overlays
            FilePath -> m Bool
forall (m :: Type -> Type). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
fpAbs m Bool
-> (Bool -> m (ModelEma -> ModelEma)) -> m (ModelEma -> ModelEma)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Bool
True ->
                -- A directory got added; this is not a static 'file'
                (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ModelEma -> ModelEma
forall a. a -> a
id
              Bool
False -> do
                let logF :: LogSource -> m ()
logF = case RefreshAction
refreshAction of
                      RefreshAction
UM.Existing -> LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
logD (LogSource -> m ())
-> (LogSource -> LogSource) -> LogSource -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogSource
"Registering" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<>)
                      RefreshAction
_ -> LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log (LogSource -> m ())
-> (LogSource -> LogSource) -> LogSource -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogSource
"Re-registering" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<>)
                LogSource -> m ()
logF (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
" file: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
fpAbs LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
" " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> R @SourceExt 'AnyExt -> LogSource
forall b a. (Show a, IsString b) => a -> b
show R @SourceExt 'AnyExt
r
                UTCTime
t <- IO UTCTime -> m UTCTime
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
                (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ UTCTime -> R @SourceExt 'AnyExt -> FilePath -> ModelEma -> ModelEma
forall (f :: Type -> Type).
UTCTime -> R @SourceExt 'AnyExt -> FilePath -> ModelT f -> ModelT f
M.modelInsertStaticFile UTCTime
t R @SourceExt 'AnyExt
r FilePath
fpAbs
          FileAction (NonEmpty (Loc, FilePath))
UM.Delete -> do
            (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((ModelEma -> ModelEma) -> m (ModelEma -> ModelEma))
-> (ModelEma -> ModelEma) -> m (ModelEma -> ModelEma)
forall a b. (a -> b) -> a -> b
$ R @SourceExt 'AnyExt -> ModelEma -> ModelEma
forall (f :: Type -> Type).
R @SourceExt 'AnyExt -> ModelT f -> ModelT f
M.modelDeleteStaticFile R @SourceExt 'AnyExt
r

readRefreshedFile :: (MonadLogger m, MonadIO m) => UM.RefreshAction -> FilePath -> m ByteString
readRefreshedFile :: forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction FilePath
fp =
  case RefreshAction
refreshAction of
    RefreshAction
UM.Existing -> do
      LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
logD (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Loading file: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
fp
      FilePath -> m ByteString
forall (m :: Type -> Type). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
fp
    RefreshAction
_ ->
      FilePath -> m ByteString
forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
FilePath -> m ByteString
readFileFollowingFsnotify FilePath
fp

-- | Like `readFileBS` but accounts for file truncation due to us responding
-- *immediately* to a fsnotify modify event (which is triggered even before the
-- writer *finishes* writing the new contents). We solve this "glitch" by
-- delaying the read retry, expecting (hoping really) that *this time* the new
-- non-empty contents will come through. 'tis a bit of a HACK though.
readFileFollowingFsnotify :: (MonadIO m, MonadLogger m) => FilePath -> m ByteString
readFileFollowingFsnotify :: forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
FilePath -> m ByteString
readFileFollowingFsnotify FilePath
fp = do
  LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Reading file: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
fp
  FilePath -> m ByteString
forall (m :: Type -> Type). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
fp m ByteString -> (ByteString -> m ByteString) -> m ByteString
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ByteString
"" ->
      Int -> FilePath -> m ByteString
forall {m :: Type -> Type}.
(MonadIO m, MonadLogger m) =>
Int -> FilePath -> m ByteString
reReadFileBS Int
100 FilePath
fp m ByteString -> (ByteString -> m ByteString) -> m ByteString
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ByteString
"" ->
          -- Sometimes 100ms is not enough (eg: on WSL), so wait a bit more and
          -- give it another try.
          Int -> FilePath -> m ByteString
forall {m :: Type -> Type}.
(MonadIO m, MonadLogger m) =>
Int -> FilePath -> m ByteString
reReadFileBS Int
300 FilePath
fp
        ByteString
s -> ByteString -> m ByteString
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
s
    ByteString
s -> ByteString -> m ByteString
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
s
  where
    -- Wait before reading, logging the given delay.
    reReadFileBS :: Int -> FilePath -> m ByteString
reReadFileBS Int
ms FilePath
filePath = do
      Int -> m ()
forall (m :: Type -> Type). MonadIO m => Int -> m ()
threadDelay (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ms
      LogSource -> m ()
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log (LogSource -> m ()) -> LogSource -> m ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Re-reading (" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> Int -> LogSource
forall b a. (Show a, IsString b) => a -> b
show Int
ms LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
"ms" LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource
") file: " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> LogSource
forall a. ToText a => a -> LogSource
toText FilePath
filePath
      FilePath -> m ByteString
forall (m :: Type -> Type). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
filePath