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 -- extract current task
    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 -- get next list and append task
    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 -- update lists

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)
        ]