{-# 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
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
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
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
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),
    -- | Dictates how exactly to render `Pandoc` to Heist nodes.
    forall (encF :: Type -> Type).
ModelT encF -> EmanotePandocRenderers Model LMLRoute
_modelPandocRenderers :: EmanotePandocRenderers Model LMLRoute,
    forall (encF :: Type -> Type). ModelT encF -> Bool
_modelCompileTailwind :: Bool,
    -- | An unique ID for this process's model. ID changes across processes.
    forall (encF :: Type -> Type). ModelT encF -> UUID
_modelInstanceID :: UUID,
    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 x. ModelT encF -> Rep (ModelT encF) x)
-> (forall x. Rep (ModelT encF) x -> ModelT encF)
-> Generic (ModelT encF)
forall x. Rep (ModelT encF) x -> ModelT encF
forall x. ModelT encF -> Rep (ModelT encF) x
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 = () -> Const @k () b
forall {k} a (b :: k). a -> Const @k a b
Const ()
   in (Identity (Prism' String SiteRoute) -> Prism' String SiteRoute
forall a. Identity a -> a
runIdentity (Identity (Prism' String SiteRoute) -> Prism' String SiteRoute)
-> Identity (Prism' String SiteRoute) -> Prism' String SiteRoute
forall a b. (a -> b) -> a -> b
$ Model
model Model
-> Optic'
     A_Lens ('[] @Type) Model (Identity (Prism' String SiteRoute))
-> Identity (Prism' String SiteRoute)
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens ('[] @Type) Model (Identity (Prism' String SiteRoute))
forall (encF :: Type -> Type) (encF :: Type -> Type).
Lens
  (ModelT encF)
  (ModelT encF)
  (encF (Prism' String SiteRoute))
  (encF (Prism' String SiteRoute))
modelRoutePrism, Model :: 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 {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
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 = Prism' String SiteRoute -> Identity (Prism' String SiteRoute)
forall a. a -> Identity a
Identity Prism' String SiteRoute
enc
   in Model :: 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 {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 =
  Status
-> Set Loc
-> Some @Type Action
-> Const @Type () (Prism' String SiteRoute)
-> EmanotePandocRenderers Model LMLRoute
-> Bool
-> UUID
-> IxNote
-> IxRel
-> IxSData
-> IxStaticFile
-> IxTask
-> [Tree Slug]
-> TemplateState
-> IndexVar
-> ModelEma
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 (() -> Const @Type () (Prism' String SiteRoute)
forall {k} a (b :: k). a -> Const @k a b
Const ()) EmanotePandocRenderers Model LMLRoute
ren Bool
ctw UUID
instanceId IxNote
forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty IxRel
forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty IxSData
forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty IxStaticFile
forall (ixs :: [Type]) a. Indexable ixs a => IxSet ixs a
Ix.empty IxTask
forall a. Monoid a => a
mempty [Tree Slug]
forall a. Monoid a => a
mempty TemplateState
forall a. Default a => a
def

modelReadyForView :: ModelT f -> ModelT f
modelReadyForView :: forall (f :: Type -> Type). ModelT f -> ModelT f
modelReadyForView =
  Lens' (ModelT f) Status
forall (encF :: Type -> Type). Lens' (ModelT encF) Status
modelStatus Lens' (ModelT f) Status -> Status -> ModelT f -> ModelT f
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 (Some @Type Action -> Bool)
-> (Model -> Some @Type Action) -> Model -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> Some @Type Action
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 =
  Lens' (ModelT f) IxNote
forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes
    Lens' (ModelT f) IxNote
-> (IxNote -> IxNote) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ( LMLRoute -> Note -> IxNote -> IxNote
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
           (IxNote -> IxNote) -> (IxNote -> IxNote) -> IxNote -> IxNote
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)
           (IxNote -> IxNote) -> (IxNote -> IxNote) -> IxNote -> IxNote
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
       )
    (ModelT f -> ModelT f)
-> (ModelT f -> ModelT f) -> ModelT f -> ModelT f
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> Lens' (ModelT f) IxRel
forall (encF :: Type -> Type). Lens' (ModelT encF) IxRel
modelRels
      Lens' (ModelT f) IxRel -> (IxRel -> IxRel) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ LMLRoute -> IxRel -> IxRel -> IxRel
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)
    (ModelT f -> ModelT f)
-> (ModelT f -> ModelT f) -> ModelT f -> ModelT f
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> Lens' (ModelT f) IxTask
forall (encF :: Type -> Type). Lens' (ModelT encF) IxTask
modelTasks
      Lens' (ModelT f) IxTask
-> (IxTask -> IxTask) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ LMLRoute -> IxTask -> IxTask -> IxTask
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)
    (ModelT f -> ModelT f)
-> (ModelT f -> ModelT f) -> ModelT f -> ModelT f
forall {k} (cat :: k -> k -> Type) (a :: k) (b :: k) (c :: k).
Category @k cat =>
cat a b -> cat b c -> cat a c
>>> Lens' (ModelT f) [Tree Slug]
forall (encF :: Type -> Type). Lens' (ModelT encF) [Tree Slug]
modelNav
      Lens' (ModelT f) [Tree Slug]
-> ([Tree Slug] -> [Tree Slug]) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ NonEmpty Slug -> [Tree Slug] -> [Tree Slug]
forall a. Eq a => NonEmpty a -> [Tree a] -> [Tree a]
PathTree.treeInsertPath ((forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> NonEmpty Slug)
-> LMLRoute -> NonEmpty Slug
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
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> NonEmpty Slug
R.unRoute LMLRoute
r)
  where
    r :: LMLRoute
r = Note
note Note -> Optic' A_Lens ('[] @Type) Note LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) 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
LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute (R @SourceExt ('LMLType 'Md) -> LMLRoute
R.LMLRoute_Md (R @SourceExt ('LMLType 'Md) -> LMLRoute)
-> R @SourceExt ('LMLType 'Md) -> LMLRoute
forall a b. (a -> b) -> a -> b
$ R @SourceExt ('LMLType 'Org) -> R @SourceExt ('LMLType 'Md)
coerce R @SourceExt ('LMLType 'Org)
r) IxNote
ns of
        Maybe Note
Nothing -> IxNote
ns
        Just Note
placeholderNote -> LMLRoute -> IxNote -> IxNote
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.deleteIx (Note
placeholderNote Note -> Optic' A_Lens ('[] @Type) Note LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note LMLRoute
N.noteRoute) IxNote
ns

injectAncestors :: [N.RAncestor] -> IxNote -> IxNote
injectAncestors :: [RAncestor] -> IxNote -> IxNote
injectAncestors [RAncestor]
ancs' =
  case [RAncestor] -> Maybe (NonEmpty RAncestor)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [RAncestor]
ancs' of
    Maybe (NonEmpty RAncestor)
Nothing ->
      IxNote -> IxNote
injectRoot
    Just NonEmpty RAncestor
ancs ->
      (IxNote -> NonEmpty RAncestor -> IxNote)
-> NonEmpty RAncestor -> IxNote -> IxNote
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((RAncestor -> IxNote -> IxNote)
-> IxNote -> NonEmpty RAncestor -> IxNote
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 =
  (IxNote -> IxNote)
-> (RAncestor -> IxNote -> IxNote)
-> Maybe RAncestor
-> IxNote
-> IxNote
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 IxNote
-> R @(Any @Type) (Any @(FileType (Any @Type))) -> Maybe LMLRoute
forall {a} (ext :: FileType a).
IxNote -> R @a ext -> Maybe LMLRoute
resolveLmlRouteIfExists IxNote
ns R @(Any @Type) (Any @(FileType (Any @Type)))
forall {a} {ext :: FileType a}. R @a ext
idxR of
    Just LMLRoute
_ -> IxNote
ns
    Maybe LMLRoute
Nothing ->
      let r :: LMLRoute
r = R @(Any @Type) (Any @(FileType (Any @Type))) -> LMLRoute
forall a (ext :: FileType a). R @a ext -> LMLRoute
R.defaultLmlRoute R @(Any @Type) (Any @(FileType (Any @Type)))
forall {a} {ext :: FileType a}. R @a ext
idxR
       in LMLRoute -> Note -> IxNote -> IxNote
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 -> Note) -> R @() 'Folder -> Note
forall a b. (a -> b) -> a -> b
$ R @(Any @Type) (Any @(FileType (Any @Type))) -> R @() 'Folder
coerce R @(Any @Type) (Any @(FileType (Any @Type)))
forall {a} {ext :: FileType a}. R @a ext
idxR) IxNote
ns
  where
    idxR :: R @a ext
idxR = R @a ext
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 IxNote -> R @() 'Folder -> Maybe LMLRoute
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 = R @() 'Folder -> LMLRoute
forall a (ext :: FileType a). R @a ext -> LMLRoute
R.defaultLmlRoute R @() 'Folder
folderR
       in LMLRoute -> Note -> IxNote -> IxNote
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
    ModelT f -> (ModelT f -> ModelT f) -> ModelT f
forall a b. a -> (a -> b) -> b
& Lens' (ModelT f) IxNote
forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes
      Lens' (ModelT f) IxNote
-> (IxNote -> IxNote) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ( LMLRoute -> IxNote -> IxNote
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.deleteIx LMLRoute
k
             (IxNote -> IxNote) -> (IxNote -> IxNote) -> IxNote -> IxNote
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 (R @() 'Folder -> RAncestor)
-> Maybe (R @() 'Folder) -> Maybe RAncestor
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (R @() 'Folder)
mFolderR)
         )
    ModelT f -> (ModelT f -> ModelT f) -> ModelT f
forall a b. a -> (a -> b) -> b
& Lens' (ModelT f) IxRel
forall (encF :: Type -> Type). Lens' (ModelT encF) IxRel
modelRels
      Lens' (ModelT f) IxRel -> (IxRel -> IxRel) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ LMLRoute -> IxRel -> IxRel
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
deleteIxMulti LMLRoute
k
    ModelT f -> (ModelT f -> ModelT f) -> ModelT f
forall a b. a -> (a -> b) -> b
& Lens' (ModelT f) IxTask
forall (encF :: Type -> Type). Lens' (ModelT encF) IxTask
modelTasks
      Lens' (ModelT f) IxTask
-> (IxTask -> IxTask) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ LMLRoute -> IxTask -> IxTask
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
deleteIxMulti LMLRoute
k
    ModelT f -> (ModelT f -> ModelT f) -> ModelT f
forall a b. a -> (a -> b) -> b
& Lens' (ModelT f) [Tree Slug]
forall (encF :: Type -> Type). Lens' (ModelT encF) [Tree Slug]
modelNav
      Lens' (ModelT f) [Tree Slug]
-> ([Tree Slug] -> [Tree Slug]) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ([Tree Slug] -> [Tree Slug])
-> (R @() 'Folder -> [Tree Slug] -> [Tree Slug])
-> Maybe (R @() 'Folder)
-> [Tree Slug]
-> [Tree Slug]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NonEmpty Slug -> [Tree Slug] -> [Tree Slug]
forall a. Eq a => NonEmpty a -> [Tree a] -> [Tree a]
PathTree.treeDeletePath ((forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> NonEmpty Slug)
-> LMLRoute -> NonEmpty Slug
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
forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> NonEmpty Slug
R.unRoute LMLRoute
k)) (([Tree Slug] -> [Tree Slug])
-> R @() 'Folder -> [Tree Slug] -> [Tree Slug]
forall a b. a -> b -> a
const [Tree Slug] -> [Tree Slug]
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 (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> R @() 'Folder)
-> LMLRoute -> R @() 'Folder
forall r.
(forall (lmlType :: LML).
 HasExt @SourceExt ('LMLType lmlType) =>
 R @SourceExt ('LMLType lmlType) -> r)
-> LMLRoute -> r
R.withLmlRoute forall (lmlType :: LML).
HasExt @SourceExt ('LMLType lmlType) =>
R @SourceExt ('LMLType lmlType) -> R @() 'Folder
coerce LMLRoute
k
      Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ R @() 'Folder -> IxNote -> Bool
N.hasChildNotes R @() 'Folder
folderR (IxNote -> Bool) -> IxNote -> Bool
forall a b. (a -> b) -> a -> b
$ ModelT f
model ModelT f -> Lens' (ModelT f) IxNote -> IxNote
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' (ModelT f) IxNote
forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes
      R @() 'Folder -> Maybe (R @() 'Folder)
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 IxSet ixs a -> ix -> IxSet ixs a
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 = (a -> IxSet ixs a -> IxSet ixs a)
-> IxSet ixs a -> IxSet ixs a -> IxSet ixs a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> IxSet ixs a -> IxSet ixs a
forall (ixs :: [Type]) a.
Indexable ixs a =>
a -> IxSet ixs a -> IxSet ixs a
Ix.delete
   in IxSet ixs a
new IxSet ixs a -> IxSet ixs a -> IxSet ixs a
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 = IxSet ixs a -> [a]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (IxSet ixs a -> [a]) -> IxSet ixs a -> [a]
forall a b. (a -> b) -> a -> b
$ ix -> IxSet ixs a -> IxSet ixs a
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 (a -> IxSet ixs a -> IxSet ixs a)
-> IxSet ixs a -> [a] -> IxSet ixs a
forall (f :: Type -> Type) a b.
Foldable f =>
(a -> b -> b) -> b -> f a -> b
flipfoldl' a -> IxSet ixs a -> IxSet ixs a
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 <- String -> Maybe (R @SourceExt 'AnyExt)
forall a (ext :: FileType a).
HasExt @a ext =>
String -> Maybe (R @a ext)
R.mkRouteFromFilePath String
fp
  IxStaticFile -> Maybe StaticFile
forall a (ixs :: [Type]). Ord a => IxSet ixs a -> Maybe a
Ix.getOne (IxStaticFile -> Maybe StaticFile)
-> IxStaticFile -> Maybe StaticFile
forall a b. (a -> b) -> a -> b
$ R @SourceExt 'AnyExt -> IxStaticFile -> IxStaticFile
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ R @SourceExt 'AnyExt
r (IxStaticFile -> IxStaticFile) -> IxStaticFile -> IxStaticFile
forall a b. (a -> b) -> a -> b
$ ModelT f
m ModelT f
-> Optic' A_Lens ('[] @Type) (ModelT f) IxStaticFile
-> IxStaticFile
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) (ModelT f) IxStaticFile
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 =
  Lens' (ModelT f) IxStaticFile
forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles Lens' (ModelT f) IxStaticFile
-> (IxStaticFile -> IxStaticFile) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ R @SourceExt 'AnyExt -> StaticFile -> IxStaticFile -> IxStaticFile
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 =
  Lens' (ModelT f) IxStaticFile
forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles Lens' (ModelT f) IxStaticFile
-> (IxStaticFile -> IxStaticFile) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ R @SourceExt 'AnyExt -> IxStaticFile -> IxStaticFile
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 =
  Lens' (ModelT f) IxSData
forall (encF :: Type -> Type). Lens' (ModelT encF) IxSData
modelSData Lens' (ModelT f) IxSData
-> (IxSData -> IxSData) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ R @SourceExt 'Yaml -> SData -> IxSData -> IxSData
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> a -> IxSet ixs a -> IxSet ixs a
Ix.updateIx (SData
v SData
-> Optic' A_Lens ('[] @Type) SData (R @SourceExt 'Yaml)
-> R @SourceExt 'Yaml
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) 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 =
  Lens' (ModelT f) IxSData
forall (encF :: Type -> Type). Lens' (ModelT encF) IxSData
modelSData Lens' (ModelT f) IxSData
-> (IxSData -> IxSData) -> ModelT f -> ModelT f
forall k (is :: [Type]) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ R @SourceExt 'Yaml -> IxSData -> IxSData
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 (ModelT f -> IxNote
forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes -> IxNote
notes) =
  HasCallStack => LMLRoute -> IxNote -> Maybe Note
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 =
  [Note] -> ResolvedRelTarget Note
forall a. [a] -> ResolvedRelTarget a
Rel.resolvedRelTargetFromCandidates
    ([Note] -> ResolvedRelTarget Note)
-> (ModelT f -> [Note]) -> ModelT f -> ResolvedRelTarget Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @() 'Html -> IxNote -> [Note]
N.lookupNotesByHtmlRoute R @() 'Html
r
    (IxNote -> [Note]) -> (ModelT f -> IxNote) -> ModelT f -> [Note]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelT f -> IxNote
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 =
  Title -> (Note -> Title) -> Maybe Note -> Title
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LMLRoute -> Title
Tit.fromRoute LMLRoute
r) Note -> Title
N._noteTitle (Maybe Note -> Title)
-> (ModelT f -> Maybe Note) -> ModelT f -> Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LMLRoute -> ModelT f -> Maybe Note
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 =
        IxNote -> [Note]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (IxNote -> [Note]) -> IxNote -> [Note]
forall a b. (a -> b) -> a -> b
$
          (Model
model Model -> Optic' A_Lens ('[] @Type) Model IxNote -> IxNote
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Model IxNote
forall (encF :: Type -> Type). Lens' (ModelT encF) IxNote
modelNotes) IxNote -> WikiLink -> IxNote
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= WikiLink
wl
      staticFiles :: [StaticFile]
staticFiles =
        IxStaticFile -> [StaticFile]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (IxStaticFile -> [StaticFile]) -> IxStaticFile -> [StaticFile]
forall a b. (a -> b) -> a -> b
$
          (Model
model Model
-> Optic' A_Lens ('[] @Type) Model IxStaticFile -> IxStaticFile
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Model IxStaticFile
forall (encF :: Type -> Type). Lens' (ModelT encF) IxStaticFile
modelStaticFiles) IxStaticFile -> WikiLink -> IxStaticFile
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
IxSet ixs a -> ix -> IxSet ixs a
@= WikiLink
wl
   in (StaticFile -> Either Note StaticFile)
-> [StaticFile] -> [Either Note StaticFile]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap StaticFile -> Either Note StaticFile
forall a b. b -> Either a b
Right [StaticFile]
staticFiles [Either Note StaticFile]
-> [Either Note StaticFile] -> [Either Note StaticFile]
forall a. Semigroup a => a -> a -> a
<> (Note -> Either Note StaticFile)
-> [Note] -> [Either Note StaticFile]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Note -> Either Note StaticFile
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 =
  IxStaticFile -> Maybe StaticFile
forall a (ixs :: [Type]). Ord a => IxSet ixs a -> Maybe a
Ix.getOne (IxStaticFile -> Maybe StaticFile)
-> (ModelT f -> IxStaticFile) -> ModelT f -> Maybe StaticFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R @SourceExt 'AnyExt -> IxStaticFile -> IxStaticFile
forall (ixs :: [Type]) a ix.
(Indexable ixs a, IsIndexOf ix ixs) =>
ix -> IxSet ixs a -> IxSet ixs a
Ix.getEQ R @SourceExt 'AnyExt
r (IxStaticFile -> IxStaticFile)
-> (ModelT f -> IxStaticFile) -> ModelT f -> IxStaticFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelT f -> IxStaticFile
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 (IxNote -> [(Tag, [Note])])
-> (ModelT f -> IxNote) -> ModelT f -> [(Tag, [Note])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelT f -> IxNote
forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes

modelNoteRels :: Model -> [Rel.Rel]
modelNoteRels :: Model -> [Rel]
modelNoteRels =
  IxRel -> [Rel]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (IxRel -> [Rel]) -> (Model -> IxRel) -> Model -> [Rel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> IxRel
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 =
  [(LMLRoute, (Title, LMLRoute, Value))]
-> Map LMLRoute (Title, LMLRoute, Value)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(LMLRoute, (Title, LMLRoute, Value))]
 -> Map LMLRoute (Title, LMLRoute, Value))
-> [(LMLRoute, (Title, LMLRoute, Value))]
-> Map LMLRoute (Title, LMLRoute, Value)
forall a b. (a -> b) -> a -> b
$
    IxNote -> [Note]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (Model -> IxNote
forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes Model
model) [Note]
-> (Note -> (LMLRoute, (Title, LMLRoute, Value)))
-> [(LMLRoute, (Title, LMLRoute, Value))]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Note
note ->
      (Note
note Note -> Optic' A_Lens ('[] @Type) Note LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note LMLRoute
N.noteRoute, (Note
note Note -> Optic' A_Lens ('[] @Type) Note Title -> Title
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note Title
N.noteTitle, Note
note Note -> Optic' A_Lens ('[] @Type) Note LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note LMLRoute
N.noteRoute, Note
note Note -> Optic' A_Lens ('[] @Type) Note Value -> Value
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note Value
N.noteMeta))

modelNoteErrors :: Model -> Map LMLRoute [Text]
modelNoteErrors :: Model -> Map LMLRoute [Text]
modelNoteErrors Model
model =
  [(LMLRoute, [Text])] -> Map LMLRoute [Text]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(LMLRoute, [Text])] -> Map LMLRoute [Text])
-> [(LMLRoute, [Text])] -> Map LMLRoute [Text]
forall a b. (a -> b) -> a -> b
$
    ((Note -> Maybe (LMLRoute, [Text]))
 -> [Note] -> [(LMLRoute, [Text])])
-> [Note]
-> (Note -> Maybe (LMLRoute, [Text]))
-> [(LMLRoute, [Text])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Note -> Maybe (LMLRoute, [Text]))
-> [Note] -> [(LMLRoute, [Text])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (IxNote -> [Note]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (Model -> IxNote
forall (encF :: Type -> Type). ModelT encF -> IxNote
_modelNotes Model
model)) ((Note -> Maybe (LMLRoute, [Text])) -> [(LMLRoute, [Text])])
-> (Note -> Maybe (LMLRoute, [Text])) -> [(LMLRoute, [Text])]
forall a b. (a -> b) -> a -> b
$ \Note
note -> do
      let errs :: [Text]
errs = Note
note Note -> Optic' A_Lens ('[] @Type) Note [Text] -> [Text]
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note [Text]
N.noteErrors
      Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Text]
errs
      (LMLRoute, [Text]) -> Maybe (LMLRoute, [Text])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Note
note Note -> Optic' A_Lens ('[] @Type) Note LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) 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
  ModelT f -> R @SourceExt ('LMLType (Any @LML)) -> LMLRoute
forall (lmlType :: LML) (f :: Type -> Type).
ModelT f -> R @SourceExt ('LMLType lmlType) -> LMLRoute
resolveLmlRoute ModelT f
model R @SourceExt ('LMLType (Any @LML))
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 =
  LMLRoute -> Maybe LMLRoute -> LMLRoute
forall a. a -> Maybe a -> a
fromMaybe (R @SourceExt ('LMLType lmlType) -> LMLRoute
forall a (ext :: FileType a). R @a ext -> LMLRoute
R.defaultLmlRoute R @SourceExt ('LMLType lmlType)
r) (Maybe LMLRoute -> LMLRoute) -> Maybe LMLRoute -> LMLRoute
forall a b. (a -> b) -> a -> b
$ IxNote -> R @SourceExt ('LMLType lmlType) -> Maybe LMLRoute
forall {a} (ext :: FileType a).
IxNote -> R @a ext -> Maybe LMLRoute
resolveLmlRouteIfExists (ModelT f
model ModelT f -> Optic' A_Lens ('[] @Type) (ModelT f) IxNote -> IxNote
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) (ModelT f) IxNote
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 <-
    [Maybe Note] -> Maybe Note
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ HasCallStack => LMLRoute -> IxNote -> Maybe Note
LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute (R @SourceExt ('LMLType 'Org) -> LMLRoute
R.LMLRoute_Org (R @SourceExt ('LMLType 'Org) -> LMLRoute)
-> R @SourceExt ('LMLType 'Org) -> LMLRoute
forall a b. (a -> b) -> a -> b
$ R @a ext -> R @SourceExt ('LMLType 'Org)
coerce R @a ext
r) IxNote
notes,
        HasCallStack => LMLRoute -> IxNote -> Maybe Note
LMLRoute -> IxNote -> Maybe Note
N.lookupNotesByRoute (R @SourceExt ('LMLType 'Md) -> LMLRoute
R.LMLRoute_Md (R @SourceExt ('LMLType 'Md) -> LMLRoute)
-> R @SourceExt ('LMLType 'Md) -> LMLRoute
forall a b. (a -> b) -> a -> b
$ R @a ext -> R @SourceExt ('LMLType 'Md)
coerce R @a ext
r) IxNote
notes
      ]
  LMLRoute -> Maybe LMLRoute
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (LMLRoute -> Maybe LMLRoute) -> LMLRoute -> Maybe LMLRoute
forall a b. (a -> b) -> a -> b
$ Note
note Note -> Optic' A_Lens ('[] @Type) Note LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note LMLRoute
N.noteRoute