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

module Emanote.Model.Type where

import Commonmark.Extensions.WikiLink qualified as WL
import Data.Aeson qualified as Aeson
import Data.Default (Default (def))
import Data.IxSet.Typed ((@=))
import Data.IxSet.Typed qualified as Ix
import Data.Map.Strict qualified as Map
import Data.Some (Some)
import Data.Time (UTCTime)
import Data.Tree (Tree)
import Data.Tree.Path qualified as PathTree
import Data.UUID (UUID)
import Ema.CLI qualified
import Emanote.Model.Link.Rel (IxRel)
import Emanote.Model.Link.Rel qualified as Rel
import Emanote.Model.Note (
  IxNote,
  Note,
 )
import Emanote.Model.Note qualified as N
import Emanote.Model.SData (IxSData, SData, sdataRoute)
import Emanote.Model.StaticFile (
  IxStaticFile,
  StaticFile (StaticFile),
 )
import Emanote.Model.Stork.Index qualified as Stork
import Emanote.Model.Task (IxTask)
import Emanote.Model.Task qualified as Task
import Emanote.Model.Title qualified as Tit
import Emanote.Pandoc.Markdown.Syntax.HashTag qualified as HT
import Emanote.Pandoc.Renderer (EmanotePandocRenderers)
import Emanote.Route (FileType (AnyExt), LMLRoute, R)
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute.Type (SiteRoute)
import Emanote.Source.Loc (Loc)
import Heist.Extra.TemplateState (TemplateState)
import Network.URI.Slug (Slug)
import Optics.Core (Prism')
import Optics.Operators ((%~), (.~), (^.))
import Optics.TH (makeLenses)
import Relude

data Status = Status_Loading | Status_Ready
  deriving stock (Status -> Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show)

data ModelT encF = Model
  { forall (encF :: Type -> Type). ModelT encF -> Status
_modelStatus :: Status
  , forall (encF :: Type -> Type). ModelT encF -> Set Loc
_modelLayers :: Set Loc
  , forall (encF :: Type -> Type). ModelT encF -> Some @Type Action
_modelEmaCLIAction :: Some Ema.CLI.Action
  , forall (encF :: Type -> Type).
ModelT encF -> encF (Prism' String SiteRoute)
_modelRoutePrism :: encF (Prism' FilePath SiteRoute)
  , forall (encF :: Type -> Type).
ModelT encF -> EmanotePandocRenderers Model LMLRoute
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
  -- ^ Dictates how exactly to render `Pandoc` to Heist nodes.
  , forall (encF :: Type -> Type). ModelT encF -> Bool
_modelCompileTailwind :: Bool
  , forall (encF :: Type -> Type). ModelT encF -> UUID
_modelInstanceID :: UUID
  -- ^ An unique ID for this process's model. ID changes across processes.
  , forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes :: IxNote
  , forall (encF :: Type -> Type). ModelT encF -> IxRel
_modelRels :: IxRel
  , forall (encF :: Type -> Type). ModelT encF -> IxSData
_modelSData :: IxSData
  , forall (encF :: Type -> Type). ModelT encF -> IxStaticFile
_modelStaticFiles :: IxStaticFile
  , forall (encF :: Type -> Type). ModelT encF -> IxTask
_modelTasks :: IxTask
  , forall (encF :: Type -> Type). ModelT encF -> [Tree Slug]
_modelNav :: [Tree Slug]
  , forall (encF :: Type -> Type). ModelT encF -> TemplateState
_modelHeistTemplate :: TemplateState
  , forall (encF :: Type -> Type). ModelT encF -> IndexVar
_modelStorkIndex :: Stork.IndexVar
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (encF :: Type -> Type) x. Rep (ModelT encF) x -> ModelT encF
forall (encF :: Type -> Type) x. ModelT encF -> Rep (ModelT encF) x
$cto :: forall (encF :: Type -> Type) x. Rep (ModelT encF) x -> ModelT encF
$cfrom :: forall (encF :: Type -> Type) x. ModelT encF -> Rep (ModelT encF) x
Generic)

type Model = ModelT Identity

{- | A bare version of `Model` that is managed by the Ema app.

 The only difference is that this one has no `RouteEncoder`.
-}
type ModelEma = ModelT (Const ())

deriving stock instance Generic ModelEma

deriving stock instance Generic Model

makeLenses ''ModelT

withoutRoutePrism :: Model -> (Prism' FilePath SiteRoute, ModelEma)
withoutRoutePrism :: Model -> (Prism' String SiteRoute, ModelEma)
withoutRoutePrism model :: Model
model@Model {Bool
[Tree Slug]
Set Loc
Identity (Prism' String SiteRoute)
TemplateState
IxSData
IxStaticFile
IxNote
IxRel
IxTask
Some @Type Action
UUID
EmanotePandocRenderers Model LMLRoute
IndexVar
Status
_modelStorkIndex :: IndexVar
_modelHeistTemplate :: TemplateState
_modelNav :: [Tree Slug]
_modelTasks :: IxTask
_modelStaticFiles :: IxStaticFile
_modelSData :: IxSData
_modelRels :: IxRel
_modelNotes :: IxNote
_modelInstanceID :: UUID
_modelCompileTailwind :: Bool
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_modelRoutePrism :: Identity (Prism' String SiteRoute)
_modelEmaCLIAction :: Some @Type Action
_modelLayers :: Set Loc
_modelStatus :: Status
_modelStorkIndex :: forall (encF :: Type -> Type). ModelT encF -> IndexVar
_modelHeistTemplate :: forall (encF :: Type -> Type). ModelT encF -> TemplateState
_modelNav :: forall (encF :: Type -> Type). ModelT encF -> [Tree Slug]
_modelTasks :: forall (encF :: Type -> Type). ModelT encF -> IxTask
_modelStaticFiles :: forall (encF :: Type -> Type). ModelT encF -> IxStaticFile
_modelSData :: forall (encF :: Type -> Type). ModelT encF -> IxSData
_modelRels :: forall (encF :: Type -> Type). ModelT encF -> IxRel
_modelNotes :: forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelInstanceID :: forall (encF :: Type -> Type). ModelT encF -> UUID
_modelCompileTailwind :: forall (encF :: Type -> Type). ModelT encF -> Bool
_modelPandocRenderers :: forall (encF :: Type -> Type).
ModelT encF -> EmanotePandocRenderers Model LMLRoute
_modelRoutePrism :: forall (encF :: Type -> Type).
ModelT encF -> encF (Prism' String SiteRoute)
_modelEmaCLIAction :: forall (encF :: Type -> Type). ModelT encF -> Some @Type Action
_modelLayers :: forall (encF :: Type -> Type). ModelT encF -> Set Loc
_modelStatus :: forall (encF :: Type -> Type). ModelT encF -> Status
..} =
  let _modelRoutePrism :: Const @k () b
_modelRoutePrism = forall {k} a (b :: k). a -> Const @k a b
Const ()
   in (forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ Model
model forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type) (encF :: Type -> Type).
Lens
  (ModelT encF)
  (ModelT encF)
  (encF (Prism' String SiteRoute))
  (encF (Prism' String SiteRoute))
modelRoutePrism, Model {Bool
[Tree Slug]
Set Loc
TemplateState
IxSData
IxStaticFile
IxNote
IxRel
IxTask
Some @Type Action
UUID
EmanotePandocRenderers Model LMLRoute
IndexVar
Status
forall {k} {b :: k}. Const @k () b
_modelRoutePrism :: forall {k} {b :: k}. Const @k () b
_modelStorkIndex :: IndexVar
_modelHeistTemplate :: TemplateState
_modelNav :: [Tree Slug]
_modelTasks :: IxTask
_modelStaticFiles :: IxStaticFile
_modelSData :: IxSData
_modelRels :: IxRel
_modelNotes :: IxNote
_modelInstanceID :: UUID
_modelCompileTailwind :: Bool
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_modelEmaCLIAction :: Some @Type Action
_modelLayers :: Set Loc
_modelStatus :: Status
_modelStorkIndex :: IndexVar
_modelHeistTemplate :: TemplateState
_modelNav :: [Tree Slug]
_modelTasks :: IxTask
_modelStaticFiles :: IxStaticFile
_modelSData :: IxSData
_modelRels :: IxRel
_modelNotes :: IxNote
_modelInstanceID :: UUID
_modelCompileTailwind :: Bool
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_modelRoutePrism :: Const @Type () (Prism' String SiteRoute)
_modelEmaCLIAction :: Some @Type Action
_modelLayers :: Set Loc
_modelStatus :: Status
..})

withRoutePrism :: Prism' FilePath SiteRoute -> ModelEma -> Model
withRoutePrism :: Prism' String SiteRoute -> ModelEma -> Model
withRoutePrism Prism' String SiteRoute
enc Model {Bool
[Tree Slug]
Set Loc
Const @Type () (Prism' String SiteRoute)
TemplateState
IxSData
IxStaticFile
IxNote
IxRel
IxTask
Some @Type Action
UUID
EmanotePandocRenderers Model LMLRoute
IndexVar
Status
_modelStorkIndex :: IndexVar
_modelHeistTemplate :: TemplateState
_modelNav :: [Tree Slug]
_modelTasks :: IxTask
_modelStaticFiles :: IxStaticFile
_modelSData :: IxSData
_modelRels :: IxRel
_modelNotes :: IxNote
_modelInstanceID :: UUID
_modelCompileTailwind :: Bool
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_modelRoutePrism :: Const @Type () (Prism' String SiteRoute)
_modelEmaCLIAction :: Some @Type Action
_modelLayers :: Set Loc
_modelStatus :: Status
_modelStorkIndex :: forall (encF :: Type -> Type). ModelT encF -> IndexVar
_modelHeistTemplate :: forall (encF :: Type -> Type). ModelT encF -> TemplateState
_modelNav :: forall (encF :: Type -> Type). ModelT encF -> [Tree Slug]
_modelTasks :: forall (encF :: Type -> Type). ModelT encF -> IxTask
_modelStaticFiles :: forall (encF :: Type -> Type). ModelT encF -> IxStaticFile
_modelSData :: forall (encF :: Type -> Type). ModelT encF -> IxSData
_modelRels :: forall (encF :: Type -> Type). ModelT encF -> IxRel
_modelNotes :: forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelInstanceID :: forall (encF :: Type -> Type). ModelT encF -> UUID
_modelCompileTailwind :: forall (encF :: Type -> Type). ModelT encF -> Bool
_modelPandocRenderers :: forall (encF :: Type -> Type).
ModelT encF -> EmanotePandocRenderers Model LMLRoute
_modelRoutePrism :: forall (encF :: Type -> Type).
ModelT encF -> encF (Prism' String SiteRoute)
_modelEmaCLIAction :: forall (encF :: Type -> Type). ModelT encF -> Some @Type Action
_modelLayers :: forall (encF :: Type -> Type). ModelT encF -> Set Loc
_modelStatus :: forall (encF :: Type -> Type). ModelT encF -> Status
..} =
  let _modelRoutePrism :: Identity (Prism' String SiteRoute)
_modelRoutePrism = forall a. a -> Identity a
Identity Prism' String SiteRoute
enc
   in Model {Bool
[Tree Slug]
Set Loc
Identity (Prism' String SiteRoute)
TemplateState
IxSData
IxStaticFile
IxNote
IxRel
IxTask
Some @Type Action
UUID
EmanotePandocRenderers Model LMLRoute
IndexVar
Status
_modelRoutePrism :: Identity (Prism' String SiteRoute)
_modelStorkIndex :: IndexVar
_modelHeistTemplate :: TemplateState
_modelNav :: [Tree Slug]
_modelTasks :: IxTask
_modelStaticFiles :: IxStaticFile
_modelSData :: IxSData
_modelRels :: IxRel
_modelNotes :: IxNote
_modelInstanceID :: UUID
_modelCompileTailwind :: Bool
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_modelEmaCLIAction :: Some @Type Action
_modelLayers :: Set Loc
_modelStatus :: Status
_modelStorkIndex :: IndexVar
_modelHeistTemplate :: TemplateState
_modelNav :: [Tree Slug]
_modelTasks :: IxTask
_modelStaticFiles :: IxStaticFile
_modelSData :: IxSData
_modelRels :: IxRel
_modelNotes :: IxNote
_modelInstanceID :: UUID
_modelCompileTailwind :: Bool
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute
_modelRoutePrism :: Identity (Prism' String SiteRoute)
_modelEmaCLIAction :: Some @Type Action
_modelLayers :: Set Loc
_modelStatus :: Status
..}

emptyModel :: Set Loc -> Some Ema.CLI.Action -> EmanotePandocRenderers Model LMLRoute -> Bool -> UUID -> Stork.IndexVar -> ModelEma
emptyModel :: Set Loc
-> Some @Type Action
-> EmanotePandocRenderers Model LMLRoute
-> Bool
-> UUID
-> IndexVar
-> ModelEma
emptyModel Set Loc
layers Some @Type Action
act EmanotePandocRenderers Model LMLRoute
ren Bool
ctw UUID
instanceId =
  forall (encF :: Type -> Type).
Status
-> Set Loc
-> Some @Type Action
-> encF (Prism' String SiteRoute)
-> EmanotePandocRenderers Model LMLRoute
-> Bool
-> UUID
-> IxNote
-> IxRel
-> IxSData
-> IxStaticFile
-> IxTask
-> [Tree Slug]
-> TemplateState
-> IndexVar
-> ModelT encF
Model Status
Status_Loading Set Loc
layers Some @Type Action
act (forall {k} a (b :: k). a -> Const @k a b
Const ()) EmanotePandocRenderers Model LMLRoute
ren Bool
ctw UUID
instanceId forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Default a => a
def

modelReadyForView :: ModelT f -> ModelT f
modelReadyForView :: forall (f :: Type -> Type). ModelT f -> ModelT f
modelReadyForView =
  forall (encF :: Type -> Type). Lens' (ModelT encF) Status
modelStatus forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Status
Status_Ready

-- | Are we running in live server, or statically generated website?
inLiveServer :: Model -> Bool
inLiveServer :: Model -> Bool
inLiveServer = Some @Type Action -> Bool
Ema.CLI.isLiveServer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (encF :: Type -> Type). ModelT encF -> Some @Type Action
_modelEmaCLIAction

modelInsertNote :: Note -> ModelT f -> ModelT f
modelInsertNote :: forall (f :: Type -> Type). Note -> ModelT f -> ModelT f
modelInsertNote Note
note =
  forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes
    forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ( forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> a -> IxSet ixs a -> IxSet ixs a
Ix.updateIx LMLRoute
r Note
note
          -- Insert folder placeholder automatically for ancestor paths
          forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> [RAncestor] -> IxNote -> IxNote
injectAncestors (Note -> [RAncestor]
N.noteAncestors Note
note)
          forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> LMLRoute -> IxNote -> IxNote
dropRedundantAncestor LMLRoute
r
       )
    forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> forall (encF :: Type -> Type). Lens' (ModelT encF) IxRel
modelRels
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall ix (ixs :: [Type]) a.
(IsIndexOf ix ixs, Indexable ixs a) =>
ix -> IxSet ixs a -> IxSet ixs a -> IxSet ixs a
updateIxMulti LMLRoute
r (Note -> IxRel
Rel.noteRels Note
note)
    forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> forall (encF :: Type -> Type). Lens' (ModelT encF) IxTask
modelTasks
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall ix (ixs :: [Type]) a.
(IsIndexOf ix ixs, Indexable ixs a) =>
ix -> IxSet ixs a -> IxSet ixs a -> IxSet ixs a
updateIxMulti LMLRoute
r (Note -> IxTask
Task.noteTasks Note
note)
    forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> forall (encF :: Type -> Type). Lens' (ModelT encF) [Tree Slug]
modelNav
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall a. Eq a => NonEmpty a -> [Tree a] -> [Tree a]
PathTree.treeInsertPath (forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
R.unRoute LMLRoute
r)
  where
    r :: LMLRoute
r = Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute

{- | If a placeholder route was added already, but the newly added note is a
 non-Markdown, removce that markdown placeholder route.
-}
dropRedundantAncestor :: LMLRoute -> IxNote -> IxNote
dropRedundantAncestor :: LMLRoute -> IxNote -> IxNote
dropRedundantAncestor LMLRoute
recentNoteRoute IxNote
ns =
  case LMLRoute
recentNoteRoute of
    R.LMLRoute_Md R @SourceExt ('LMLType 'Md)
_ -> IxNote
ns
    R.LMLRoute_Org R @SourceExt ('LMLType 'Org)
r ->
      case HasCallStack => LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute (R @SourceExt ('LMLType 'Md) -> LMLRoute
R.LMLRoute_Md forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible @Type a b => a -> b
coerce R @SourceExt ('LMLType 'Org)
r) IxNote
ns of
        Maybe Note
Nothing -> IxNote
ns
        Just Note
placeholderNote -> forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.deleteIx (Note
placeholderNote forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute) IxNote
ns

injectAncestors :: [N.RAncestor] -> IxNote -> IxNote
injectAncestors :: [RAncestor] -> IxNote -> IxNote
injectAncestors [RAncestor]
ancs' =
  case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [RAncestor]
ancs' of
    Maybe (NonEmpty RAncestor)
Nothing ->
      IxNote -> IxNote
injectRoot
    Just NonEmpty RAncestor
ancs ->
      forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RAncestor -> IxNote -> IxNote
injectAncestor) NonEmpty RAncestor
ancs

-- Restore folder placeholder, if $folder.md gets deleted (with $folder/*.md still present)
-- TODO: If $k.md is the only file in its parent, delete unnecessary ancestors
restoreAncestor :: Maybe N.RAncestor -> IxNote -> IxNote
restoreAncestor :: Maybe RAncestor -> IxNote -> IxNote
restoreAncestor =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe IxNote -> IxNote
injectRoot RAncestor -> IxNote -> IxNote
injectAncestor

injectRoot :: IxNote -> IxNote
injectRoot :: IxNote -> IxNote
injectRoot IxNote
ns =
  case forall {a} (ext :: FileType a).
IxNote -> R @a ext -> Maybe LMLRoute
resolveLmlRouteIfExists IxNote
ns forall {a} {ext :: FileType a}. R @a ext
idxR of
    Just LMLRoute
_ -> IxNote
ns
    Maybe LMLRoute
Nothing ->
      let r :: LMLRoute
r = forall a (ext :: FileType a). R @a ext -> LMLRoute
R.defaultLmlRoute forall {a} {ext :: FileType a}. R @a ext
idxR
       in forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> a -> IxSet ixs a -> IxSet ixs a
Ix.updateIx LMLRoute
r (R @() 'Folder -> Note
N.ancestorPlaceholderNote forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible @Type a b => a -> b
coerce forall {a} {ext :: FileType a}. R @a ext
idxR) IxNote
ns
  where
    idxR :: R @a ext
idxR = forall {a} {ext :: FileType a}. R @a ext
R.indexRoute

injectAncestor :: N.RAncestor -> IxNote -> IxNote
injectAncestor :: RAncestor -> IxNote -> IxNote
injectAncestor (RAncestor -> R @() 'Folder
N.unRAncestor -> R @() 'Folder
folderR) IxNote
ns =
  case forall {a} (ext :: FileType a).
IxNote -> R @a ext -> Maybe LMLRoute
resolveLmlRouteIfExists IxNote
ns R @() 'Folder
folderR of
    Just LMLRoute
_ -> IxNote
ns
    Maybe LMLRoute
Nothing ->
      let r :: LMLRoute
r = forall a (ext :: FileType a). R @a ext -> LMLRoute
R.defaultLmlRoute R @() 'Folder
folderR
       in forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> a -> IxSet ixs a -> IxSet ixs a
Ix.updateIx LMLRoute
r (R @() 'Folder -> Note
N.ancestorPlaceholderNote R @() 'Folder
folderR) IxNote
ns

modelDeleteNote :: LMLRoute -> ModelT f -> ModelT f
modelDeleteNote :: forall (f :: Type -> Type). LMLRoute -> ModelT f -> ModelT f
modelDeleteNote LMLRoute
k ModelT f
model =
  ModelT f
model
    forall a b. a -> (a -> b) -> b
& forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ( forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.deleteIx LMLRoute
k
            forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> Maybe RAncestor -> IxNote -> IxNote
restoreAncestor (R @() 'Folder -> RAncestor
N.RAncestor forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (R @() 'Folder)
mFolderR)
         )
    forall a b. a -> (a -> b) -> b
& forall (encF :: Type -> Type). Lens' (ModelT encF) IxRel
modelRels
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
deleteIxMulti LMLRoute
k
    forall a b. a -> (a -> b) -> b
& forall (encF :: Type -> Type). Lens' (ModelT encF) IxTask
modelTasks
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
deleteIxMulti LMLRoute
k
    forall a b. a -> (a -> b) -> b
& forall (encF :: Type -> Type). Lens' (ModelT encF) [Tree Slug]
modelNav
      forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Eq a => NonEmpty a -> [Tree a] -> [Tree a]
PathTree.treeDeletePath (forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall a (ext :: FileType a). R @a ext -> NonEmpty Slug
R.unRoute LMLRoute
k)) (forall a b. a -> b -> a
const forall a. a -> a
id) Maybe (R @() 'Folder)
mFolderR
  where
    -- If the note being deleted is $folder.md *and* folder/ has .md files, this
    -- will be `Just folderRoute`.
    mFolderR :: Maybe (R @() 'Folder)
mFolderR = do
      let folderR :: R @() 'Folder
folderR = forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute coerce :: forall a b. Coercible @Type a b => a -> b
coerce LMLRoute
k
      forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ R @() 'Folder -> IxNote -> Bool
N.hasChildNotes R @() 'Folder
folderR forall a b. (a -> b) -> a -> b
$ ModelT f
model forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure R @() 'Folder
folderR

-- | Like `Ix.updateIx`, but works for multiple items.
updateIxMulti ::
  (Ix.IsIndexOf ix ixs, Ix.Indexable ixs a) =>
  ix ->
  Ix.IxSet ixs a ->
  Ix.IxSet ixs a ->
  Ix.IxSet ixs a
updateIxMulti :: forall ix (ixs :: [Type]) a.
(IsIndexOf ix ixs, Indexable ixs a) =>
ix -> IxSet ixs a -> IxSet ixs a -> IxSet ixs a
updateIxMulti ix
r IxSet ixs a
new IxSet ixs a
rels =
  let old :: IxSet ixs a
old = IxSet ixs a
rels forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= ix
r
      deleteMany :: IxSet ixs a -> IxSet ixs a -> IxSet ixs a
deleteMany = forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (ixs :: [Type]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
Ix.delete
   in IxSet ixs a
new forall (ixs :: [Type]) a.
Indexable ixs a =>
IxSet ixs a -> IxSet ixs a -> IxSet ixs a
`Ix.union` (IxSet ixs a
rels IxSet ixs a -> IxSet ixs a -> IxSet ixs a
`deleteMany` IxSet ixs a
old)

-- | Like `Ix.deleteIx`, but works for multiple items
deleteIxMulti ::
  (Ix.Indexable ixs a, Ix.IsIndexOf ix ixs) =>
  ix ->
  Ix.IxSet ixs a ->
  Ix.IxSet ixs a
deleteIxMulti :: forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
deleteIxMulti ix
r IxSet ixs a
rels =
  let candidates :: [a]
candidates = forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList forall a b. (a -> b) -> a -> b
$ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ ix
r IxSet ixs a
rels
   in forall (f :: Type -> Type) a b.
Foldable f =>
(a -> b -> b) -> b -> f a -> b
flipfoldl' forall (ixs :: [Type]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
Ix.delete IxSet ixs a
rels [a]
candidates

modelLookupStaticFile :: FilePath -> ModelT f -> Maybe StaticFile
modelLookupStaticFile :: forall (f :: Type -> Type). String -> ModelT f -> Maybe StaticFile
modelLookupStaticFile String
fp ModelT f
m = do
  R @SourceExt 'AnyExt
r :: R.R 'AnyExt <- forall a (ext :: FileType a).
HasExt @a ext =>
String -> Maybe (R @a ext)
R.mkRouteFromFilePath String
fp
  forall a (ixs :: [Type]). Ord a => IxSet ixs a -> Maybe a
Ix.getOne forall a b. (a -> b) -> a -> b
$ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ R @SourceExt 'AnyExt
r forall a b. (a -> b) -> a -> b
$ ModelT f
m forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles

modelInsertStaticFile :: UTCTime -> R.R 'AnyExt -> FilePath -> ModelT f -> ModelT f
modelInsertStaticFile :: forall (f :: Type -> Type).
UTCTime -> R @SourceExt 'AnyExt -> String -> ModelT f -> ModelT f
modelInsertStaticFile UTCTime
t R @SourceExt 'AnyExt
r String
fp =
  forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> a -> IxSet ixs a -> IxSet ixs a
Ix.updateIx R @SourceExt 'AnyExt
r StaticFile
staticFile
  where
    staticFile :: StaticFile
staticFile = R @SourceExt 'AnyExt -> String -> UTCTime -> StaticFile
StaticFile R @SourceExt 'AnyExt
r String
fp UTCTime
t

modelDeleteStaticFile :: R.R 'AnyExt -> ModelT f -> ModelT f
modelDeleteStaticFile :: forall (f :: Type -> Type).
R @SourceExt 'AnyExt -> ModelT f -> ModelT f
modelDeleteStaticFile R @SourceExt 'AnyExt
r =
  forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.deleteIx R @SourceExt 'AnyExt
r

modelInsertData :: SData -> ModelT f -> ModelT f
modelInsertData :: forall (f :: Type -> Type). SData -> ModelT f -> ModelT f
modelInsertData SData
v =
  forall (encF :: Type -> Type). Lens' (ModelT encF) IxSData
modelSData forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> a -> IxSet ixs a -> IxSet ixs a
Ix.updateIx (SData
v forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' SData (R @SourceExt 'Yaml)
sdataRoute) SData
v

modelDeleteData :: R.R 'R.Yaml -> ModelT f -> ModelT f
modelDeleteData :: forall (f :: Type -> Type).
R @SourceExt 'Yaml -> ModelT f -> ModelT f
modelDeleteData R @SourceExt 'Yaml
k =
  forall (encF :: Type -> Type). Lens' (ModelT encF) IxSData
modelSData forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.deleteIx R @SourceExt 'Yaml
k

modelLookupNoteByRoute :: LMLRoute -> ModelT f -> Maybe Note
modelLookupNoteByRoute :: forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
modelLookupNoteByRoute LMLRoute
r (forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes -> IxNote
notes) =
  HasCallStack => LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute LMLRoute
r IxNote
notes

modelLookupNoteByHtmlRoute :: R 'R.Html -> ModelT f -> Rel.ResolvedRelTarget Note
modelLookupNoteByHtmlRoute :: forall (f :: Type -> Type).
R @() 'Html -> ModelT f -> ResolvedRelTarget Note
modelLookupNoteByHtmlRoute R @() 'Html
r =
  forall a. [a] -> ResolvedRelTarget a
Rel.resolvedRelTargetFromCandidates
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @() 'Html -> IxNote -> [Note]
N.lookupNotesByHtmlRoute R @() 'Html
r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes

modelLookupTitle :: LMLRoute -> ModelT f -> Tit.Title
modelLookupTitle :: forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
modelLookupTitle LMLRoute
r =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LMLRoute -> Title
Tit.fromRoute LMLRoute
r) Note -> Title
N._noteTitle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Type -> Type). LMLRoute -> ModelT f -> Maybe Note
modelLookupNoteByRoute LMLRoute
r

-- Lookup the wiki-link and return its candidates in the model.
modelWikiLinkTargets :: WL.WikiLink -> Model -> [Either Note StaticFile]
modelWikiLinkTargets :: WikiLink -> Model -> [Either Note StaticFile]
modelWikiLinkTargets WikiLink
wl Model
model =
  let notes :: [Note]
notes =
        forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList forall a b. (a -> b) -> a -> b
$
          (Model
model forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes) forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= WikiLink
wl
      staticFiles :: [StaticFile]
staticFiles =
        forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList forall a b. (a -> b) -> a -> b
$
          (Model
model forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles) forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= WikiLink
wl
   in forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right [StaticFile]
staticFiles forall a. Semigroup a => a -> a -> a
<> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left [Note]
notes

modelLookupStaticFileByRoute :: R 'AnyExt -> ModelT f -> Maybe StaticFile
modelLookupStaticFileByRoute :: forall (f :: Type -> Type).
R @SourceExt 'AnyExt -> ModelT f -> Maybe StaticFile
modelLookupStaticFileByRoute R @SourceExt 'AnyExt
r =
  forall a (ixs :: [Type]). Ord a => IxSet ixs a -> Maybe a
Ix.getOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ R @SourceExt 'AnyExt
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (encF :: Type -> Type). ModelT encF -> IxStaticFile
_modelStaticFiles

modelTags :: ModelT f -> [(HT.Tag, [Note])]
modelTags :: forall (f :: Type -> Type). ModelT f -> [(Tag, [Note])]
modelTags =
  forall ix (ixs :: [Type]) a.
IsIndexOf ix ixs =>
IxSet ixs a -> [(ix, [a])]
Ix.groupAscBy @HT.Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes

modelNoteRels :: Model -> [Rel.Rel]
modelNoteRels :: Model -> [Rel]
modelNoteRels =
  forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (encF :: Type -> Type). ModelT encF -> IxRel
_modelRels

modelNoteMetas :: Model -> Map LMLRoute (Tit.Title, LMLRoute, Aeson.Value)
modelNoteMetas :: Model -> Map LMLRoute (Title, LMLRoute, Value)
modelNoteMetas Model
model =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
    forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes Model
model) forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Note
note ->
      (Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute, (Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Title
N.noteTitle, Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute, Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note Value
N.noteMeta))

modelNoteErrors :: Model -> Map LMLRoute [Text]
modelNoteErrors :: Model -> Map LMLRoute [Text]
modelNoteErrors Model
model =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList 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 (forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes Model
model)) forall a b. (a -> b) -> a -> b
$ \Note
note -> do
      let errs :: [Text]
errs = Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note [Text]
N.noteErrors
      forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Text]
errs
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute, [Text]
errs)

{- | Return the most suitable index LML route

  If index.org exist, use that. Otherwise, fallback to index.md.
-}
modelIndexRoute :: ModelT f -> LMLRoute
modelIndexRoute :: forall (f :: Type -> Type). ModelT f -> LMLRoute
modelIndexRoute ModelT f
model = do
  forall (lmlType :: LML) (f :: Type -> Type).
ModelT f -> R @SourceExt ('LMLType lmlType) -> LMLRoute
resolveLmlRoute ModelT f
model forall {a} {ext :: FileType a}. R @a ext
R.indexRoute

resolveLmlRoute :: forall lmlType f. ModelT f -> R ('R.LMLType lmlType) -> LMLRoute
resolveLmlRoute :: forall (lmlType :: LML) (f :: Type -> Type).
ModelT f -> R @SourceExt ('LMLType lmlType) -> LMLRoute
resolveLmlRoute ModelT f
model R @SourceExt ('LMLType lmlType)
r =
  forall a. a -> Maybe a -> a
fromMaybe (forall a (ext :: FileType a). R @a ext -> LMLRoute
R.defaultLmlRoute R @SourceExt ('LMLType lmlType)
r) forall a b. (a -> b) -> a -> b
$ forall {a} (ext :: FileType a).
IxNote -> R @a ext -> Maybe LMLRoute
resolveLmlRouteIfExists (ModelT f
model forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes) R @SourceExt ('LMLType lmlType)
r

-- | Lookup a LML route, returning the less popular LML format if there are ambiguities.
resolveLmlRouteIfExists :: forall ext. IxNote -> R ext -> Maybe LMLRoute
resolveLmlRouteIfExists :: forall {a} (ext :: FileType a).
IxNote -> R @a ext -> Maybe LMLRoute
resolveLmlRouteIfExists IxNote
notes R @a ext
r = do
  -- TODO: Refactor using `[minBound..maxBound] :: [LML]`
  Note
note <-
    forall (t :: Type -> Type) (f :: Type -> Type) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ HasCallStack => LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute (R @SourceExt ('LMLType 'Org) -> LMLRoute
R.LMLRoute_Org forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible @Type a b => a -> b
coerce R @a ext
r) IxNote
notes
      , HasCallStack => LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute (R @SourceExt ('LMLType 'Md) -> LMLRoute
R.LMLRoute_Md forall a b. (a -> b) -> a -> b
$ coerce :: forall a b. Coercible @Type a b => a -> b
coerce R @a ext
r) IxNote
notes
      ]
  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Note
note forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Note LMLRoute
N.noteRoute