{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Emanote.Source.Dynamic (
  emanoteSiteInput,
  EmanoteConfig (..),
  emanoteCompileTailwind,
  emanoteConfigCli,
  emanoteConfigNoteFn,
  emanoteConfigPandocRenderers,
) where

import Control.Monad.Logger (MonadLogger, MonadLoggerIO)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Some (Some)
import Data.UUID.V4 qualified as UUID
import Ema (Dynamic (..))
import Ema.CLI qualified
import Emanote.CLI qualified as CLI
import Emanote.Model.Note (Note)
import Emanote.Model.Stork.Index qualified as Stork
import Emanote.Model.Type qualified as Model
import Emanote.Pandoc.Renderer (EmanotePandocRenderers)
import Emanote.Prelude (chainM)
import Emanote.Route (LMLRoute)
import Emanote.Source.Loc (Loc)
import Emanote.Source.Loc qualified as Loc
import Emanote.Source.Patch qualified as Patch
import Emanote.Source.Pattern qualified as Pattern
import Optics.TH (makeLenses)
import Paths_emanote qualified
import Relude
import System.UnionMount qualified as UM
import UnliftIO (MonadUnliftIO)

-- | Everything that's required to run an Emanote site.
data EmanoteConfig = EmanoteConfig
  { EmanoteConfig -> Cli
_emanoteConfigCli :: CLI.Cli
  -- ^ CLI arguments (includes layers)
  , EmanoteConfig -> Note -> Note
_emanoteConfigNoteFn :: Note -> Note
  -- ^ A function to filter the `Note` before it gets added to the model.
  , EmanoteConfig -> EmanotePandocRenderers Model LMLRoute
_emanoteConfigPandocRenderers :: EmanotePandocRenderers Model.Model LMLRoute
  -- ^ How to render Pandoc to Heist HTML.
  , EmanoteConfig -> Bool
_emanoteCompileTailwind :: Bool
  -- ^ Whether to replace Tailwind2 CDN with a minimized Tailwind3 CSS file.
  }

{- | Make an Ema `Dynamic` for the Emanote model.

 The bulk of logic for building the Dynamic is in `Patch.hs`.
-}
emanoteSiteInput :: (MonadUnliftIO m, MonadLoggerIO m) => Some Ema.CLI.Action -> EmanoteConfig -> m (Dynamic m Model.ModelEma)
emanoteSiteInput :: forall (m :: Type -> Type).
(MonadUnliftIO m, MonadLoggerIO m) =>
Some @Type Action -> EmanoteConfig -> m (Dynamic m ModelEma)
emanoteSiteInput Some @Type Action
cliAct EmanoteConfig {Bool
EmanotePandocRenderers Model LMLRoute
Cli
Note -> Note
_emanoteCompileTailwind :: Bool
_emanoteConfigPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_emanoteConfigNoteFn :: Note -> Note
_emanoteConfigCli :: Cli
_emanoteCompileTailwind :: EmanoteConfig -> Bool
_emanoteConfigPandocRenderers :: EmanoteConfig -> EmanotePandocRenderers Model LMLRoute
_emanoteConfigNoteFn :: EmanoteConfig -> Note -> Note
_emanoteConfigCli :: EmanoteConfig -> Cli
..} = do
  Loc
defaultLayer <- FilePath -> Loc
Loc.defaultLayer forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO FilePath
Paths_emanote.getDataDir
  UUID
instanceId <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UUID
UUID.nextRandom
  IndexVar
storkIndex <- forall (m :: Type -> Type). MonadIO m => m IndexVar
Stork.newIndex
  let layers :: Set Loc
layers = NonEmpty FilePath -> Set Loc
Loc.userLayers (Cli -> NonEmpty FilePath
CLI.layers Cli
_emanoteConfigCli) forall a. Semigroup a => a -> a -> a
<> forall x. One x => OneItem x -> x
one Loc
defaultLayer
      initialModel :: ModelEma
initialModel = Set Loc
-> Some @Type Action
-> EmanotePandocRenderers Model LMLRoute
-> Bool
-> UUID
-> IndexVar
-> ModelEma
Model.emptyModel Set Loc
layers Some @Type Action
cliAct EmanotePandocRenderers Model LMLRoute
_emanoteConfigPandocRenderers Bool
_emanoteCompileTailwind UUID
instanceId IndexVar
storkIndex
  forall (m :: Type -> Type) a.
(a, (a -> m ()) -> m ()) -> Dynamic m a
Dynamic
    forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall source tag model (m :: Type -> Type).
(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 ())
UM.unionMount
      (Set Loc
layers forall a b. a -> (a -> b) -> b
& forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall a. a -> a
id forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Loc -> FilePath
Loc.locPath))
      [(FileType SourceExt, FilePath)]
Pattern.filePatterns
      [FilePath]
Pattern.ignorePatterns
      ModelEma
initialModel
      (forall (m :: Type -> Type) tag model.
(MonadIO m, MonadLogger m) =>
ChangeHandler tag model m -> Change Loc tag -> m (model -> model)
mapFsChanges forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
(MonadIO m, MonadLogger m, MonadLoggerIO m) =>
Set Loc
-> (Note -> Note)
-> IndexVar
-> FileType SourceExt
-> FilePath
-> FileAction (NonEmpty (Loc, FilePath))
-> m (ModelEma -> ModelEma)
Patch.patchModel Set Loc
layers Note -> Note
_emanoteConfigNoteFn IndexVar
storkIndex)

type ChangeHandler tag model m =
  tag ->
  FilePath ->
  UM.FileAction (NonEmpty (Loc, FilePath)) ->
  m (model -> model)

mapFsChanges :: (MonadIO m, MonadLogger m) => ChangeHandler tag model m -> UM.Change Loc tag -> m (model -> model)
mapFsChanges :: forall (m :: Type -> Type) tag model.
(MonadIO m, MonadLogger m) =>
ChangeHandler tag model m -> Change Loc tag -> m (model -> model)
mapFsChanges ChangeHandler tag model m
h Change Loc tag
ch = do
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (m :: Type -> Type) tag model.
(MonadIO m, MonadLogger m) =>
ChangeHandler tag model m
-> tag
-> Map FilePath (FileAction (NonEmpty (Loc, FilePath)))
-> m (model -> model)
mapFsChangesOnExt ChangeHandler tag model m
h) forall (m :: Type -> Type) b a.
Monad m =>
(b -> m (a -> a)) -> [b] -> m (a -> a)
`chainM` forall k a. Map k a -> [(k, a)]
Map.toList Change Loc tag
ch
  where
    -- Temporarily use block buffering before calling an IO action that is
    -- known ahead to log rapidly, so as to not hamper serial processing speed.
    -- FIXME: This buffers warnings and errors (when parsing .md file) without
    -- dumping them to console. So disabling for now. But we need a proper fix.
    _withBlockBuffering :: f a -> f a
_withBlockBuffering f a
f =
      (forall (m :: Type -> Type).
MonadIO m =>
Handle -> BufferMode -> m ()
hSetBuffering Handle
stdout (Maybe Int -> BufferMode
BlockBuffering forall a. Maybe a
Nothing) forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type).
MonadIO m =>
Handle -> BufferMode -> m ()
hSetBuffering Handle
stderr BufferMode
LineBuffering)
        forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> f a
f
        forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* (forall (m :: Type -> Type). MonadIO m => Handle -> m ()
hFlush Handle
stdout forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type). MonadIO m => Handle -> m ()
hFlush Handle
stderr forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type).
MonadIO m =>
Handle -> BufferMode -> m ()
hSetBuffering Handle
stdout BufferMode
LineBuffering)

mapFsChangesOnExt ::
  (MonadIO m, MonadLogger m) =>
  ChangeHandler tag model m ->
  tag ->
  Map FilePath (UM.FileAction (NonEmpty (Loc, FilePath))) ->
  m (model -> model)
mapFsChangesOnExt :: forall (m :: Type -> Type) tag model.
(MonadIO m, MonadLogger m) =>
ChangeHandler tag model m
-> tag
-> Map FilePath (FileAction (NonEmpty (Loc, FilePath)))
-> m (model -> model)
mapFsChangesOnExt ChangeHandler tag model m
h tag
fpType Map FilePath (FileAction (NonEmpty (Loc, FilePath)))
fps = do
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ChangeHandler tag model m
h tag
fpType) forall (m :: Type -> Type) b a.
Monad m =>
(b -> m (a -> a)) -> [b] -> m (a -> a)
`chainM` forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath (FileAction (NonEmpty (Loc, FilePath)))
fps

makeLenses ''EmanoteConfig