module Taskell.Data.Lists where
import ClassyPrelude
import Control.Lens ((^.))
import Data.Sequence as S (adjust', deleteAt, update, (!?), (|>))
import qualified Taskell.Data.List as L (List, Update, append, clearDue, count, due, empty, extract,
prepend, searchFor)
import qualified Taskell.Data.Seq as S
import qualified Taskell.Data.Task as T (Task, due)
import Taskell.Types (ListIndex (ListIndex), Pointer, TaskIndex (TaskIndex))
type Lists = Seq L.List
type Update = Lists -> Lists
data ListPosition
= Top
| Bottom
initial :: Lists
initial :: Lists
initial = [Element Lists] -> Lists
forall seq. IsSequence seq => [Element seq] -> seq
fromList []
updateLists :: Int -> L.List -> Update
updateLists :: Int -> List -> Update
updateLists = Int -> List -> Update
forall a. Int -> a -> Seq a -> Seq a
S.update
count :: Int -> Lists -> Int
count :: Int -> Lists -> Int
count Int
idx Lists
tasks = Int -> (List -> Int) -> Maybe List -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 List -> Int
L.count (Lists
tasks Lists -> Int -> Maybe List
forall a. Seq a -> Int -> Maybe a
!? Int
idx)
due :: Lists -> Seq (Pointer, T.Task)
due :: Lists -> Seq (Pointer, Task)
due Lists
lists = (Element (Seq (Pointer, Task)) -> Maybe Due)
-> Seq (Pointer, Task) -> Seq (Pointer, Task)
forall o seq.
(Ord o, SemiSequence seq) =>
(Element seq -> o) -> seq -> seq
sortOn ((Task -> Getting (Maybe Due) Task (Maybe Due) -> Maybe Due
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Due) Task (Maybe Due)
Lens' Task (Maybe Due)
T.due) (Task -> Maybe Due)
-> ((Pointer, Task) -> Task) -> (Pointer, Task) -> Maybe Due
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Pointer, Task) -> Task
forall a b. (a, b) -> b
snd) Seq (Pointer, Task)
dues
where
format :: Int -> List -> Seq (Pointer, Task)
format Int
x List
lst = (\(TaskIndex
y, Task
t) -> ((Int -> ListIndex
ListIndex Int
x, TaskIndex
y), Task
t)) ((TaskIndex, Task) -> (Pointer, Task))
-> Seq (TaskIndex, Task) -> Seq (Pointer, Task)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List -> Seq (TaskIndex, Task)
L.due List
lst
dues :: Element (Seq (Seq (Pointer, Task)))
dues = Seq (Seq (Pointer, Task)) -> Element (Seq (Seq (Pointer, Task)))
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat (Seq (Seq (Pointer, Task)) -> Element (Seq (Seq (Pointer, Task))))
-> Seq (Seq (Pointer, Task)) -> Element (Seq (Seq (Pointer, Task)))
forall a b. (a -> b) -> a -> b
$ Int -> List -> Seq (Pointer, Task)
format (Int -> List -> Seq (Pointer, Task))
-> Lists -> Seq (Seq (Pointer, Task))
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.<#> Lists
lists
clearDue :: Pointer -> Update
clearDue :: Pointer -> Update
clearDue (ListIndex
idx, TaskIndex
tsk) = ListIndex -> Update -> Update
updateFn ListIndex
idx (TaskIndex -> Update
L.clearDue TaskIndex
tsk)
updateFn :: ListIndex -> L.Update -> Update
updateFn :: ListIndex -> Update -> Update
updateFn (ListIndex Int
idx) Update
fn = Update -> Int -> Update
forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust' Update
fn Int
idx
get :: Lists -> Int -> Maybe L.List
get :: Lists -> Int -> Maybe List
get = Lists -> Int -> Maybe List
forall a. Seq a -> Int -> Maybe a
(!?)
changeList :: ListPosition -> Pointer -> Lists -> Int -> Maybe Lists
changeList :: ListPosition -> Pointer -> Lists -> Int -> Maybe Lists
changeList ListPosition
pos (ListIndex Int
list, TaskIndex Int
idx) Lists
tasks Int
dir = do
let next :: Int
next = Int
list Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dir
let fn :: Task -> Update
fn =
case ListPosition
pos of
ListPosition
Top -> Task -> Update
L.prepend
ListPosition
Bottom -> Task -> Update
L.append
(List
from, Task
task) <- Int -> List -> Maybe (List, Task)
L.extract Int
idx (List -> Maybe (List, Task)) -> Maybe List -> Maybe (List, Task)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Lists
tasks Lists -> Int -> Maybe List
forall a. Seq a -> Int -> Maybe a
!? Int
list
List
to <- Task -> Update
fn Task
task Update -> Maybe List -> Maybe List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lists
tasks Lists -> Int -> Maybe List
forall a. Seq a -> Int -> Maybe a
!? Int
next
Lists -> Maybe Lists
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lists -> Maybe Lists) -> Update -> Lists -> Maybe Lists
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> List -> Update
updateLists Int
next List
to (Lists -> Maybe Lists) -> Lists -> Maybe Lists
forall a b. (a -> b) -> a -> b
$ Int -> List -> Update
updateLists Int
list List
from Lists
tasks
newList :: Text -> Update
newList :: Text -> Update
newList Text
title = (Lists -> List -> Lists
forall a. Seq a -> a -> Seq a
|> Text -> List
L.empty Text
title)
delete :: Int -> Update
delete :: Int -> Update
delete = Int -> Update
forall a. Int -> Seq a -> Seq a
deleteAt
exists :: Int -> Lists -> Bool
exists :: Int -> Lists -> Bool
exists Int
idx Lists
tasks = Maybe List -> Bool
forall a. Maybe a -> Bool
isJust (Maybe List -> Bool) -> Maybe List -> Bool
forall a b. (a -> b) -> a -> b
$ Lists
tasks Lists -> Int -> Maybe List
forall a. Seq a -> Int -> Maybe a
!? Int
idx
shiftBy :: Int -> Int -> Lists -> Maybe Lists
shiftBy :: Int -> Int -> Lists -> Maybe Lists
shiftBy = Int -> Int -> Lists -> Maybe Lists
forall a. Int -> Int -> Seq a -> Maybe (Seq a)
S.shiftBy
search :: Text -> Update
search :: Text -> Update
search Text
text = (Text -> Update
L.searchFor Text
text Update -> Update
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
appendToLast :: T.Task -> Update
appendToLast :: Task -> Update
appendToLast Task
task Lists
lists =
Lists -> Maybe Lists -> Lists
forall a. a -> Maybe a -> a
fromMaybe Lists
lists (Maybe Lists -> Lists) -> Maybe Lists -> Lists
forall a b. (a -> b) -> a -> b
$ do
let idx :: Int
idx = Lists -> Int
forall mono. MonoFoldable mono => mono -> Int
length Lists
lists Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
List
list <- Task -> Update
L.append Task
task Update -> Maybe List -> Maybe List
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lists
lists Lists -> Int -> Maybe List
forall a. Seq a -> Int -> Maybe a
!? Int
idx
Lists -> Maybe Lists
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lists -> Maybe Lists) -> Lists -> Maybe Lists
forall a b. (a -> b) -> a -> b
$ Int -> List -> Update
updateLists Int
idx List
list Lists
lists
analyse :: Text -> Lists -> Text
analyse :: Text -> Lists -> Text
analyse Text
filepath Lists
lists =
[Text] -> Element [Text]
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
concat
[ Text
filepath
, Text
"\n"
, Text
"Lists: "
, Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Lists -> Int
forall mono. MonoFoldable mono => mono -> Int
length Lists
lists
, Text
"\n"
, Text
"Tasks: "
, Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Element (Seq Int) -> Int) -> Int -> Seq Int -> Int
forall mono a.
MonoFoldable mono =>
(a -> Element mono -> a) -> a -> mono -> a
foldl' Int -> Element (Seq Int) -> Int
forall a. Num a => a -> a -> a
(+) Int
0 (List -> Int
L.count (List -> Int) -> Lists -> Seq Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lists
lists)
]