{-# LANGUAGE TemplateHaskell #-}

module Taskell.Data.List where

import ClassyPrelude

import Control.Lens (element, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?))

import Data.Sequence as S (adjust', deleteAt, insertAt, update, (<|), (|>))

import qualified Taskell.Data.Seq  as S
import qualified Taskell.Data.Task as T (Task, Update, blank, clearDue, contains, due, duplicate)
import           Taskell.Types     (TaskIndex (TaskIndex))

data List = List
    { List -> Text
_title :: Text
    , List -> Seq Task
_tasks :: Seq T.Task
    } deriving (Int -> List -> ShowS
[List] -> ShowS
List -> String
(Int -> List -> ShowS)
-> (List -> String) -> ([List] -> ShowS) -> Show List
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [List] -> ShowS
$cshowList :: [List] -> ShowS
show :: List -> String
$cshow :: List -> String
showsPrec :: Int -> List -> ShowS
$cshowsPrec :: Int -> List -> ShowS
Show, List -> List -> Bool
(List -> List -> Bool) -> (List -> List -> Bool) -> Eq List
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: List -> List -> Bool
$c/= :: List -> List -> Bool
== :: List -> List -> Bool
$c== :: List -> List -> Bool
Eq)

type Update = List -> List

-- create lenses
$(makeLenses ''List)

-- operations
create :: Text -> Seq T.Task -> List
create :: Text -> Seq Task -> List
create = Text -> Seq Task -> List
List

empty :: Text -> List
empty :: Text -> List
empty Text
text = Text -> Seq Task -> List
List Text
text Seq Task
forall (f :: * -> *) a. Alternative f => f a
ClassyPrelude.empty

new :: Update
new :: Update
new = Task -> Update
append Task
T.blank

count :: List -> Int
count :: List -> Int
count = Seq Task -> Int
forall mono. MonoFoldable mono => mono -> Int
length (Seq Task -> Int) -> (List -> Seq Task) -> List -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (List -> Getting (Seq Task) List (Seq Task) -> Seq Task
forall s a. s -> Getting a s a -> a
^. Getting (Seq Task) List (Seq Task)
Lens' List (Seq Task)
tasks)

due :: List -> Seq (TaskIndex, T.Task)
due :: List -> Seq (TaskIndex, Task)
due List
list = Seq (Maybe (TaskIndex, Task)) -> Seq (TaskIndex, Task)
forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
 Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes (Int -> Task -> Maybe (TaskIndex, Task)
filt (Int -> Task -> Maybe (TaskIndex, Task))
-> Seq Task -> Seq (Maybe (TaskIndex, Task))
forall a b. (Int -> a -> b) -> Seq a -> Seq b
S.<#> (List
list List -> Getting (Seq Task) List (Seq Task) -> Seq Task
forall s a. s -> Getting a s a -> a
^. Getting (Seq Task) List (Seq Task)
Lens' List (Seq Task)
tasks))
  where
    filt :: Int -> Task -> Maybe (TaskIndex, Task)
filt Int
int Task
task = (TaskIndex, Task) -> Due -> (TaskIndex, Task)
forall a b. a -> b -> a
const (Int -> TaskIndex
TaskIndex Int
int, Task
task) (Due -> (TaskIndex, Task)) -> Maybe Due -> Maybe (TaskIndex, Task)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Task
task 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

clearDue :: TaskIndex -> Update
clearDue :: TaskIndex -> Update
clearDue (TaskIndex Int
int) = Int -> Update -> Update
updateFn Int
int Update
T.clearDue

newAt :: Int -> Update
newAt :: Int -> Update
newAt Int
idx = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Task -> Seq Task -> Seq Task
forall a. Int -> a -> Seq a -> Seq a
S.insertAt Int
idx Task
T.blank

duplicate :: Int -> List -> Maybe List
duplicate :: Int -> List -> Maybe List
duplicate Int
idx List
list = do
    Task
task <- Update
T.duplicate Update -> Maybe Task -> Maybe Task
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> List -> Maybe Task
getTask Int
idx List
list
    List -> Maybe List
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List -> Maybe List) -> List -> Maybe List
forall a b. (a -> b) -> a -> b
$ List
list List -> Update -> List
forall a b. a -> (a -> b) -> b
& (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Task -> Seq Task -> Seq Task
forall a. Int -> a -> Seq a -> Seq a
S.insertAt Int
idx Task
task

append :: T.Task -> Update
append :: Task -> Update
append Task
task = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq Task -> Task -> Seq Task
forall a. Seq a -> a -> Seq a
S.|> Task
task)

prepend :: T.Task -> Update
prepend :: Task -> Update
prepend Task
task = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Task
task Task -> Seq Task -> Seq Task
forall a. a -> Seq a -> Seq a
S.<|)

extract :: Int -> List -> Maybe (List, T.Task)
extract :: Int -> List -> Maybe (List, Task)
extract Int
idx List
list = do
    (Seq Task
xs, Task
x) <- Int -> Seq Task -> Maybe (Seq Task, Task)
forall a. Int -> Seq a -> Maybe (Seq a, a)
S.extract Int
idx (List
list List -> Getting (Seq Task) List (Seq Task) -> Seq Task
forall s a. s -> Getting a s a -> a
^. Getting (Seq Task) List (Seq Task)
Lens' List (Seq Task)
tasks)
    (List, Task) -> Maybe (List, Task)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List
list List -> Update -> List
forall a b. a -> (a -> b) -> b
& (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> Seq Task -> Update
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seq Task
xs, Task
x)

updateFn :: Int -> T.Update -> Update
updateFn :: Int -> Update -> Update
updateFn Int
idx Update
fn = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Update -> Int -> Seq Task -> Seq Task
forall a. (a -> a) -> Int -> Seq a -> Seq a
adjust' Update
fn Int
idx

update :: Int -> T.Task -> Update
update :: Int -> Task -> Update
update Int
idx Task
task = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Task -> Seq Task -> Seq Task
forall a. Int -> a -> Seq a -> Seq a
S.update Int
idx Task
task

move :: Int -> Int -> Maybe Text -> List -> Maybe (List, Int)
move :: Int -> Int -> Maybe Text -> List -> Maybe (List, Int)
move Int
current Int
dir Maybe Text
term List
list =
    case Maybe Text
term of
        Maybe Text
Nothing -> (, List -> Int -> Int
bound List
list (Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dir)) (List -> (List, Int)) -> Maybe List -> Maybe (List, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (List
list List -> (List -> Maybe List) -> Maybe List
forall a b. a -> (a -> b) -> b
& (Seq Task -> Maybe (Seq Task)) -> List -> Maybe List
Lens' List (Seq Task)
tasks ((Seq Task -> Maybe (Seq Task)) -> List -> Maybe List)
-> (Seq Task -> Maybe (Seq Task)) -> List -> Maybe List
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ Int -> Int -> Seq Task -> Maybe (Seq Task)
forall a. Int -> Int -> Seq a -> Maybe (Seq a)
S.shiftBy Int
current Int
dir)
        Just Text
_ -> do
            Int
idx <- Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask Int
dir Int
current Maybe Text
term List
list
            (, Int
idx) (List -> (List, Int)) -> Maybe List -> Maybe (List, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (List
list List -> (List -> Maybe List) -> Maybe List
forall a b. a -> (a -> b) -> b
& (Seq Task -> Maybe (Seq Task)) -> List -> Maybe List
Lens' List (Seq Task)
tasks ((Seq Task -> Maybe (Seq Task)) -> List -> Maybe List)
-> (Seq Task -> Maybe (Seq Task)) -> List -> Maybe List
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ Int -> Int -> Seq Task -> Maybe (Seq Task)
forall a. Int -> Int -> Seq a -> Maybe (Seq a)
S.shiftBy Int
current (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
current))

deleteTask :: Int -> Update
deleteTask :: Int -> Update
deleteTask Int
idx = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Seq Task -> Seq Task
forall a. Int -> Seq a -> Seq a
deleteAt Int
idx

getTask :: Int -> List -> Maybe T.Task
getTask :: Int -> List -> Maybe Task
getTask Int
idx = (List -> Getting (First Task) List Task -> Maybe Task
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Seq Task -> Const (First Task) (Seq Task))
-> List -> Const (First Task) List
Lens' List (Seq Task)
tasks ((Seq Task -> Const (First Task) (Seq Task))
 -> List -> Const (First Task) List)
-> ((Task -> Const (First Task) Task)
    -> Seq Task -> Const (First Task) (Seq Task))
-> Getting (First Task) List Task
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> IndexedTraversal' Int (Seq Task) Task
forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
idx)

searchFor :: Text -> Update
searchFor :: Text -> Update
searchFor Text
text = (Seq Task -> Identity (Seq Task)) -> List -> Identity List
Lens' List (Seq Task)
tasks ((Seq Task -> Identity (Seq Task)) -> List -> Identity List)
-> (Seq Task -> Seq Task) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Element (Seq Task) -> Bool) -> Seq Task -> Seq Task
forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter (Text -> Task -> Bool
T.contains Text
text)

changeTask :: Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask :: Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask Int
dir Int
current Maybe Text
term List
list = do
    let next :: Int
next = Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dir
    Task
tsk <- Int -> List -> Maybe Task
getTask Int
next List
list
    case Maybe Text
term of
        Maybe Text
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
next
        Just Text
trm ->
            if Text -> Task -> Bool
T.contains Text
trm Task
tsk
                then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
next
                else Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask Int
dir Int
next Maybe Text
term List
list

nextTask :: Int -> Maybe Text -> List -> Int
nextTask :: Int -> Maybe Text -> List -> Int
nextTask Int
idx Maybe Text
text List
lst = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
idx (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask Int
1 Int
idx Maybe Text
text List
lst

prevTask :: Int -> Maybe Text -> List -> Int
prevTask :: Int -> Maybe Text -> List -> Int
prevTask Int
idx Maybe Text
text List
lst = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
idx (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask (-Int
1) Int
idx Maybe Text
text List
lst

closest :: Int -> Int -> Int -> Int
closest :: Int -> Int -> Int -> Int
closest Int
current Int
previous Int
next =
    if (Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
current) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
previous)
        then Int
next
        else Int
previous

bound :: List -> Int -> Int
bound :: List -> Int -> Int
bound List
lst = Seq Task -> Int -> Int
forall a. Seq a -> Int -> Int
S.bound (List
lst List -> Getting (Seq Task) List (Seq Task) -> Seq Task
forall s a. s -> Getting a s a -> a
^. Getting (Seq Task) List (Seq Task)
Lens' List (Seq Task)
tasks)

nearest' :: Int -> Maybe Text -> List -> Maybe Int
nearest' :: Int -> Maybe Text -> List -> Maybe Int
nearest' Int
current Maybe Text
term List
lst = do
    let prev :: Maybe Int
prev = Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask (-Int
1) Int
current Maybe Text
term List
lst
    let nxt :: Maybe Int
nxt = Int -> Int -> Maybe Text -> List -> Maybe Int
changeTask Int
1 Int
current Maybe Text
term List
lst
    let comp :: Int -> Maybe Int
comp Int
idx = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
idx (Int -> Int -> Int -> Int
closest Int
current Int
idx) Maybe Int
nxt
    Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
nxt Int -> Maybe Int
comp Maybe Int
prev

nearest :: Int -> Maybe Text -> List -> Int
nearest :: Int -> Maybe Text -> List -> Int
nearest Int
current Maybe Text
term List
lst = Int
idx
  where
    near :: Int
near = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Text -> List -> Maybe Int
nearest' Int
current Maybe Text
term List
lst
    idx :: Int
idx =
        case Maybe Text
term of
            Maybe Text
Nothing  -> List -> Int -> Int
bound List
lst Int
current
            Just Text
txt -> Int -> (Task -> Int) -> Maybe Task -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
near (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool Int
near Int
current (Bool -> Int) -> (Task -> Bool) -> Task -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Task -> Bool
T.contains Text
txt) (Maybe Task -> Int) -> Maybe Task -> Int
forall a b. (a -> b) -> a -> b
$ Int -> List -> Maybe Task
getTask Int
current List
lst