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)
patchModel ::
(MonadIO m, MonadLogger m, MonadLoggerIO m) =>
LocLayers ->
(N.Note -> N.Note) ->
Stork.IndexVar ->
R.FileType R.SourceExt ->
FilePath ->
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 <- forall (m :: Type -> Type).
MonadLoggerIO m =>
m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO
UTCTime
now <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
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 forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString (forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"[%H:%M:%S] " UTCTime
now) forall a. Semigroup a => a -> a -> a
<> LogStr
s
forall (m :: Type -> Type) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (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
patchModel' ::
(MonadIO m, MonadLogger m) =>
LocLayers ->
(N.Note -> N.Note) ->
Stork.IndexVar ->
R.FileType R.SourceExt ->
FilePath ->
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 ->
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a. a -> a
id
Just LMLRoute
r -> do
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 forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Loc, FilePath)
overlays
currentLayerPath :: FilePath
currentLayerPath = Loc -> FilePath
locPath forall a b. (a -> b) -> a -> b
$ HasCallStack => LocLayers -> Loc
primaryLayer LocLayers
layers
ByteString
s <- forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction FilePath
fpAbs
Note
note <- forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
FilePath -> LMLRoute -> FilePath -> LogSource -> m Note
N.parseNote FilePath
currentLayerPath LMLRoute
r FilePath
fpAbs (forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
s)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). Note -> ModelT f -> ModelT f
M.modelInsertNote forall a b. (a -> b) -> a -> b
$ Note -> Note
noteF Note
note
FileAction (NonEmpty (Loc, FilePath))
UM.Delete -> do
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log forall a b. (a -> b) -> a -> b
$ LogSource
"Removing note: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
fp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). LMLRoute -> ModelT f -> ModelT f
M.modelDeleteNote LMLRoute
r
FileType SourceExt
R.Yaml ->
case forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe (R @a ext)
R.mkRouteFromFilePath FilePath
fp of
Maybe (R @SourceExt 'Yaml)
Nothing ->
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure 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 <- forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. NonEmpty a -> NonEmpty a
NEL.reverse NonEmpty (Loc, FilePath)
overlays) forall a b. (a -> b) -> a -> b
$ \(Loc, FilePath)
overlay -> do
let fpAbs :: FilePath
fpAbs = (Loc, FilePath) -> FilePath
locResolve (Loc, FilePath)
overlay
forall (t :: Type -> Type) a b.
Functor t =>
(a -> t b) -> a -> t (a, b)
traverseToSnd (forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction) FilePath
fpAbs
SData
sData <-
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSource -> BadInput
BadInput) forall (f :: Type -> Type) a. Applicative f => a -> f a
pure 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
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type). SData -> ModelT f -> ModelT f
M.modelInsertData SData
sData
FileAction (NonEmpty (Loc, FilePath))
UM.Delete -> do
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log forall a b. (a -> b) -> a -> b
$ LogSource
"Removing data: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
fp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Loc, FilePath)
overlays
readyOnTemplates :: ModelEma -> ModelEma
readyOnTemplates = forall a. a -> a -> Bool -> a
bool forall a. a -> a
id forall (f :: Type -> Type). ModelT f -> ModelT f
M.modelReadyForView (RefreshAction
refreshAction forall a. Eq a => a -> a -> Bool
== RefreshAction
UM.Existing)
ModelEma -> ModelEma
act <- do
ByteString
s <- forall (m :: Type -> Type).
(MonadLogger m, MonadIO m) =>
RefreshAction -> FilePath -> m ByteString
readRefreshedFile RefreshAction
refreshAction FilePath
fpAbs
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
logD forall a b. (a -> b) -> a -> b
$ LogSource
"Read " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (ByteString -> Int
BS.length ByteString
s) forall a. Semigroup a => a -> a -> a
<> LogSource
" bytes of template"
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (encF :: Type -> Type). Lens' (ModelT encF) TemplateState
M.modelHeistTemplate 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
T.addTemplateFile FilePath
fpAbs FilePath
fp ByteString
s
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ModelEma -> ModelEma
readyOnTemplates 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
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log forall a b. (a -> b) -> a -> b
$ LogSource
"Removing template: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
fp
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (encF :: Type -> Type). Lens' (ModelT encF) TemplateState
M.modelHeistTemplate 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
T.removeTemplateFile FilePath
fp
FileType SourceExt
R.AnyExt -> do
case forall a (ext :: FileType a).
HasExt @a ext =>
FilePath -> Maybe (R @a ext)
R.mkRouteFromFilePath FilePath
fp of
Maybe (R @SourceExt 'AnyExt)
Nothing ->
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure 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 forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty (Loc, FilePath)
overlays
forall (m :: Type -> Type). MonadIO m => FilePath -> m Bool
doesDirectoryExist FilePath
fpAbs forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True ->
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a. a -> a
id
Bool
False -> do
let logF :: LogSource -> m ()
logF = case RefreshAction
refreshAction of
RefreshAction
UM.Existing -> forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
logD forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogSource
"Registering" <>)
RefreshAction
_ -> forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogSource
"Re-registering" <>)
LogSource -> m ()
logF forall a b. (a -> b) -> a -> b
$ LogSource
" file: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
fpAbs forall a. Semigroup a => a -> a -> a
<> LogSource
" " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show R @SourceExt 'AnyExt
r
UTCTime
t <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
logD forall a b. (a -> b) -> a -> b
$ LogSource
"Loading file: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
fp
forall (m :: Type -> Type). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
fp
RefreshAction
_ ->
forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
FilePath -> m ByteString
readFileFollowingFsnotify FilePath
fp
readFileFollowingFsnotify :: (MonadIO m, MonadLogger m) => FilePath -> m ByteString
readFileFollowingFsnotify :: forall (m :: Type -> Type).
(MonadIO m, MonadLogger m) =>
FilePath -> m ByteString
readFileFollowingFsnotify FilePath
fp = do
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log forall a b. (a -> b) -> a -> b
$ LogSource
"Reading file: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
fp
forall (m :: Type -> Type). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
fp forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ByteString
"" ->
forall {m :: Type -> Type}.
(MonadIO m, MonadLogger m) =>
Int -> FilePath -> m ByteString
reReadFileBS Int
100 FilePath
fp forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ByteString
"" ->
forall {m :: Type -> Type}.
(MonadIO m, MonadLogger m) =>
Int -> FilePath -> m ByteString
reReadFileBS Int
300 FilePath
fp
ByteString
s -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
s
ByteString
s -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ByteString
s
where
reReadFileBS :: Int -> FilePath -> m ByteString
reReadFileBS Int
ms FilePath
filePath = do
forall (m :: Type -> Type). MonadIO m => Int -> m ()
threadDelay forall a b. (a -> b) -> a -> b
$ Int
1000 forall a. Num a => a -> a -> a
* Int
ms
forall (m :: Type -> Type). MonadLogger m => LogSource -> m ()
log forall a b. (a -> b) -> a -> b
$ LogSource
"Re-reading (" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
ms forall a. Semigroup a => a -> a -> a
<> LogSource
"ms" forall a. Semigroup a => a -> a -> a
<> LogSource
") file: " forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> LogSource
toText FilePath
filePath
forall (m :: Type -> Type). MonadIO m => FilePath -> m ByteString
readFileBS FilePath
filePath