module Emanote.View.TaskIndex (renderTasks) where

import Data.IxSet.Typed qualified as Ix
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as Map
import Data.Map.Syntax ((##))
import Emanote.Model (Model)
import Emanote.Model.Task (Task)
import Emanote.Model.Task qualified as Task
import Emanote.Model.Type qualified as M
import Emanote.Route qualified as R
import Emanote.Route.SiteRoute qualified as SR
import Emanote.View.Common qualified as Common
import Heist.Extra.Splices.List qualified as Splices
import Heist.Extra.Splices.Pandoc qualified as Splices
import Heist.Extra.Splices.Pandoc.Ctx (emptyRenderCtx)
import Heist.Interpreted qualified as HI
import Optics.Operators ((^.))
import Relude
import Text.Pandoc.Definition qualified as B

newtype TaskIndex = TaskIndex {TaskIndex -> Map LMLRoute (NonEmpty Task)
unTaskIndex :: Map R.LMLRoute (NonEmpty Task)}

mkTaskIndex :: Model -> TaskIndex
mkTaskIndex :: Model -> TaskIndex
mkTaskIndex Model
model =
  Map LMLRoute (NonEmpty Task) -> TaskIndex
TaskIndex (Map LMLRoute (NonEmpty Task) -> TaskIndex)
-> (Map LMLRoute (NonEmpty Task) -> Map LMLRoute (NonEmpty Task))
-> Map LMLRoute (NonEmpty Task)
-> TaskIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Task -> NonEmpty Task)
-> Map LMLRoute (NonEmpty Task) -> Map LMLRoute (NonEmpty Task)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map NonEmpty Task -> NonEmpty Task
forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort (Map LMLRoute (NonEmpty Task) -> TaskIndex)
-> Map LMLRoute (NonEmpty Task) -> TaskIndex
forall a b. (a -> b) -> a -> b
$
    (NonEmpty Task -> NonEmpty Task -> NonEmpty Task)
-> [(LMLRoute, NonEmpty Task)] -> Map LMLRoute (NonEmpty Task)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith NonEmpty Task -> NonEmpty Task -> NonEmpty Task
forall a. Semigroup a => a -> a -> a
(<>) ([(LMLRoute, NonEmpty Task)] -> Map LMLRoute (NonEmpty Task))
-> [(LMLRoute, NonEmpty Task)] -> Map LMLRoute (NonEmpty Task)
forall a b. (a -> b) -> a -> b
$
      (Task -> Bool) -> [Task] -> [Task]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Task -> Bool) -> Task -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> Bool
Task._taskChecked) (IxSet TaskIxs Task -> [Task]
forall (ixs :: [Type]) a. IxSet ixs a -> [a]
Ix.toList (IxSet TaskIxs Task -> [Task]) -> IxSet TaskIxs Task -> [Task]
forall a b. (a -> b) -> a -> b
$ Model
model Model
-> Optic' A_Lens NoIx Model (IxSet TaskIxs Task)
-> IxSet TaskIxs Task
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Model (IxSet TaskIxs Task)
forall (encF :: Type -> Type).
Lens' (ModelT encF) (IxSet TaskIxs Task)
M.modelTasks) [Task]
-> (Task -> (LMLRoute, NonEmpty Task))
-> [(LMLRoute, NonEmpty Task)]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Task
task ->
        (Task
task Task -> Optic' A_Lens NoIx Task LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Task LMLRoute
Task.taskRoute, OneItem (NonEmpty Task) -> NonEmpty Task
forall x. One x => OneItem x -> x
one OneItem (NonEmpty Task)
Task
task)

renderTasks :: Model -> LByteString
renderTasks :: Model -> LByteString
renderTasks Model
model = do
  let (LMLRoute
defR, Value
meta) = Model -> (LMLRoute, Value)
Common.defaultRouteMeta Model
model
      tCtx :: TemplateRenderCtx @(Type -> Type) Identity
tCtx = Model
-> LMLRoute -> Value -> TemplateRenderCtx @(Type -> Type) Identity
Common.mkTemplateRenderCtx Model
model LMLRoute
defR Value
meta
      taskIndex :: TaskIndex
taskIndex = Model -> TaskIndex
mkTaskIndex Model
model
      taskGroupSplice :: LMLRoute -> NonEmpty Task -> MapSyntaxM Text (Splice Identity) ()
taskGroupSplice LMLRoute
r NonEmpty Task
tasks = do
        Text
"t:note:url" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
r)
        Text
"t:note:title" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) Identity
-> Title -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
Common.titleSplice TemplateRenderCtx @(Type -> Type) Identity
tCtx (LMLRoute -> Model -> Title
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
r Model
model)
        Text
"t:note:breadcrumbs" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
##
          TemplateRenderCtx @(Type -> Type) Identity
-> Model -> LMLRoute -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Model -> LMLRoute -> Splice Identity
Common.routeBreadcrumbs TemplateRenderCtx @(Type -> Type) Identity
tCtx Model
model LMLRoute
r
        Text
"t:tasks" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## [Task]
-> Text
-> (Task -> MapSyntaxM Text (Splice Identity) ())
-> Splice Identity
forall a.
[a]
-> Text
-> (a -> MapSyntaxM Text (Splice Identity) ())
-> Splice Identity
Splices.listSplice (NonEmpty Task -> [Task]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NonEmpty Task
tasks) Text
"task" Task -> MapSyntaxM Text (Splice Identity) ()
taskSplice
      taskSplice :: Task -> MapSyntaxM Text (Splice Identity) ()
taskSplice Task
task = do
        let r :: LMLRoute
r = Task
task Task -> Optic' A_Lens NoIx Task LMLRoute -> LMLRoute
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Task LMLRoute
Task.taskRoute
        -- TODO: reuse note splice
        Text
"task:description" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) Identity
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n
-> (RenderCtx -> Splice Identity) -> Splice Identity
Common.withInlineCtx TemplateRenderCtx @(Type -> Type) Identity
tCtx ((RenderCtx -> Splice Identity) -> Splice Identity)
-> (RenderCtx -> Splice Identity) -> Splice Identity
forall a b. (a -> b) -> a -> b
$ \RenderCtx
ctx ->
          RenderCtx -> Pandoc -> Splice Identity
Splices.pandocSplice RenderCtx
ctx (Pandoc -> Splice Identity) -> Pandoc -> Splice Identity
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
B.Pandoc Meta
forall a. Monoid a => a
mempty ([Block] -> Pandoc) -> [Block] -> Pandoc
forall a b. (a -> b) -> a -> b
$ OneItem [Block] -> [Block]
forall x. One x => OneItem x -> x
one (OneItem [Block] -> [Block]) -> OneItem [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
B.Plain ([Inline] -> Block) -> [Inline] -> Block
forall a b. (a -> b) -> a -> b
$ Task
task Task -> Optic' A_Lens NoIx Task [Inline] -> [Inline]
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Task [Inline]
Task.taskDescription
        Text
"note:title" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## TemplateRenderCtx @(Type -> Type) Identity
-> Title -> Splice Identity
forall {k} (n :: k).
TemplateRenderCtx @k n -> Title -> Splice Identity
Common.titleSplice TemplateRenderCtx @(Type -> Type) Identity
tCtx (LMLRoute -> Model -> Title
forall (f :: Type -> Type). LMLRoute -> ModelT f -> Title
M.modelLookupTitle LMLRoute
r Model
model)
        Text
"note:url" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## Text -> Splice Identity
forall (m :: Type -> Type) (n :: Type -> Type).
Monad m =>
Text -> HeistT n m Template
HI.textSplice (HasCallStack => Model -> SiteRoute -> Text
Model -> SiteRoute -> Text
SR.siteRouteUrl Model
model (SiteRoute -> Text) -> SiteRoute -> Text
forall a b. (a -> b) -> a -> b
$ LMLRoute -> SiteRoute
SR.lmlSiteRoute LMLRoute
r)

  Model
-> TemplateName
-> MapSyntaxM Text (Splice Identity) ()
-> LByteString
Common.renderModelTemplate Model
model TemplateName
"templates/special/tasks" (MapSyntaxM Text (Splice Identity) () -> LByteString)
-> MapSyntaxM Text (Splice Identity) () -> LByteString
forall a b. (a -> b) -> a -> b
$ do
    HasCallStack =>
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> MapSyntaxM Text (Splice Identity) ()
((RenderCtx -> Splice Identity) -> Splice Identity)
-> Model -> Value -> Title -> MapSyntaxM Text (Splice Identity) ()
Common.commonSplices ((RenderCtx -> Splice Identity) -> RenderCtx -> Splice Identity
forall a b. (a -> b) -> a -> b
$ RenderCtx
emptyRenderCtx) Model
model Value
meta Title
"Task Index"
    let groups :: [(LMLRoute, NonEmpty Task)]
groups =
          Map LMLRoute (NonEmpty Task) -> [(LMLRoute, NonEmpty Task)]
forall k a. Map k a -> [(k, a)]
Map.toList (TaskIndex -> Map LMLRoute (NonEmpty Task)
unTaskIndex TaskIndex
taskIndex)
            [(LMLRoute, NonEmpty Task)]
-> ([(LMLRoute, NonEmpty Task)] -> [(LMLRoute, NonEmpty Task)])
-> [(LMLRoute, NonEmpty Task)]
forall a b. a -> (a -> b) -> b
& ((LMLRoute, NonEmpty Task) -> LMLRoute)
-> [(LMLRoute, NonEmpty Task)] -> [(LMLRoute, NonEmpty Task)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (LMLRoute, NonEmpty Task) -> LMLRoute
forall a b. (a, b) -> a
fst
    Text
"ema:taskGroups" Text -> Splice Identity -> MapSyntaxM Text (Splice Identity) ()
forall k v. k -> v -> MapSyntax k v
## [(LMLRoute, NonEmpty Task)]
-> Text
-> ((LMLRoute, NonEmpty Task)
    -> MapSyntaxM Text (Splice Identity) ())
-> Splice Identity
forall a.
[a]
-> Text
-> (a -> MapSyntaxM Text (Splice Identity) ())
-> Splice Identity
Splices.listSplice [(LMLRoute, NonEmpty Task)]
groups Text
"taskGroup" ((LMLRoute -> NonEmpty Task -> MapSyntaxM Text (Splice Identity) ())
-> (LMLRoute, NonEmpty Task)
-> MapSyntaxM Text (Splice Identity) ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LMLRoute -> NonEmpty Task -> MapSyntaxM Text (Splice Identity) ()
taskGroupSplice)