{-# 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
, forall (encF :: Type -> Type). ModelT encF -> Bool
_modelCompileTailwind :: Bool
, 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 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
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
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
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
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
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
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
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)
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
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)
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
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
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