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

module Emanote.Model.Task where

import Data.Aeson qualified as Aeson
import Data.IxSet.Typed (Indexable (..), IxSet, ixFun, ixList)
import Data.IxSet.Typed qualified as Ix
import Emanote.Model.Note (Note)
import Emanote.Model.Note qualified as N
import Emanote.Route qualified as R
import Heist.Extra.Splices.Pandoc.TaskList qualified as TaskList
import Optics.Operators ((^.))
import Optics.TH (makeLenses)
import Relude
import Text.Pandoc.Builder qualified as B

data Task = Task
  { Task -> LMLRoute
_taskRoute :: R.LMLRoute,
    -- Index of this task within the containing note. Used to sort tasks by
    -- their original order of appearance in the Markdown file.
    Task -> Word
_taskNum :: Word,
    Task -> [Inline]
_taskDescription :: [B.Inline],
    Task -> Bool
_taskChecked :: Bool
  }
  deriving stock (Task -> Task -> Bool
(Task -> Task -> Bool) -> (Task -> Task -> Bool) -> Eq Task
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c== :: Task -> Task -> Bool
Eq, Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
(Int -> Task -> ShowS)
-> (Task -> String) -> ([Task] -> ShowS) -> Show Task
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Task] -> ShowS
$cshowList :: [Task] -> ShowS
show :: Task -> String
$cshow :: Task -> String
showsPrec :: Int -> Task -> ShowS
$cshowsPrec :: Int -> Task -> ShowS
Show, (forall x. Task -> Rep Task x)
-> (forall x. Rep Task x -> Task) -> Generic Task
forall x. Rep Task x -> Task
forall x. Task -> Rep Task x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Task x -> Task
$cfrom :: forall x. Task -> Rep Task x
Generic)
  deriving anyclass ([Task] -> Encoding
[Task] -> Value
Task -> Encoding
Task -> Value
(Task -> Value)
-> (Task -> Encoding)
-> ([Task] -> Value)
-> ([Task] -> Encoding)
-> ToJSON Task
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Task] -> Encoding
$ctoEncodingList :: [Task] -> Encoding
toJSONList :: [Task] -> Value
$ctoJSONList :: [Task] -> Value
toEncoding :: Task -> Encoding
$ctoEncoding :: Task -> Encoding
toJSON :: Task -> Value
$ctoJSON :: Task -> Value
Aeson.ToJSON)

instance Ord Task where
  <= :: Task -> Task -> Bool
(<=) = (LMLRoute, Word) -> (LMLRoute, Word) -> Bool
forall a. Ord a => a -> a -> Bool
(<=) ((LMLRoute, Word) -> (LMLRoute, Word) -> Bool)
-> (Task -> (LMLRoute, Word)) -> Task -> Task -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Task -> LMLRoute
_taskRoute (Task -> LMLRoute) -> (Task -> Word) -> Task -> (LMLRoute, Word)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Task -> Word
_taskNum)

type TaskIxs =
  '[ -- Route to the note containing this task
     R.LMLRoute
   ]

type IxTask = IxSet TaskIxs Task

instance Indexable TaskIxs Task where
  indices :: IxList TaskIxs Task
indices =
    Ix LMLRoute Task -> IxList TaskIxs Task
forall (ixs :: [Type]) a r. MkIxList ixs ixs a r => r
ixList
      ((Task -> [LMLRoute]) -> Ix LMLRoute Task
forall ix a. Ord ix => (a -> [ix]) -> Ix ix a
ixFun ((Task -> [LMLRoute]) -> Ix LMLRoute Task)
-> (Task -> [LMLRoute]) -> Ix LMLRoute Task
forall a b. (a -> b) -> a -> b
$ LMLRoute -> [LMLRoute]
forall x. One x => OneItem x -> x
one (LMLRoute -> [LMLRoute])
-> (Task -> LMLRoute) -> Task -> [LMLRoute]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Task -> LMLRoute
_taskRoute)

noteTasks :: Note -> IxTask
noteTasks :: Note -> IxTask
noteTasks Note
note =
  let taskListItems :: [(Bool, [Inline])]
taskListItems = Pandoc -> [(Bool, [Inline])]
forall b. Walkable Block b => b -> [(Bool, [Inline])]
TaskList.queryTasks (Pandoc -> [(Bool, [Inline])]) -> Pandoc -> [(Bool, [Inline])]
forall a b. (a -> b) -> a -> b
$ Note
note Note -> Optic' A_Lens ('[] @Type) Note Pandoc -> Pandoc
forall k s (is :: [Type]) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens ('[] @Type) Note Pandoc
N.noteDoc
   in [Task] -> IxTask
forall (ixs :: [Type]) a. Indexable ixs a => [a] -> IxSet ixs a
Ix.fromList ([Task] -> IxTask) -> [Task] -> IxTask
forall a b. (a -> b) -> a -> b
$
        [Word] -> [(Bool, [Inline])] -> [(Word, (Bool, [Inline]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
1 ..] [(Bool, [Inline])]
taskListItems [(Word, (Bool, [Inline]))]
-> ((Word, (Bool, [Inline])) -> Task) -> [Task]
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Word
idx, (Bool
checked, [Inline]
doc)) ->
          LMLRoute -> Word -> [Inline] -> Bool -> Task
Task (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) Word
idx [Inline]
doc Bool
checked

makeLenses ''Task