{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Events.State
( continue
, write
, countCurrent
, normalise
, create
, quit
, startEdit
, startCreate
, createListStart
, editListStart
, deleteCurrentList
, clearItem
, above
, below
, bottom
, previous
, next
, left
, right
, up
, down
, moveLeft
, moveRight
, delete
, selectList
, listLeft
, listRight
, undo
, store
, searchMode
, searchEntered
, createList
, removeBlank
, newItem
, normalMode
, finishTask
, finishListTitle
, showHelp
, showMoveTo
, moveTo
, getCurrentList
, getCurrentTask
, setCurrentTask
) where
import ClassyPrelude hiding (delete)
import Control.Lens ((&), (.~), (^.))
import Data.Char (digitToInt, ord)
import Data.Taskell.List (List, deleteTask, getTask, move, new, newAt, title, update)
import qualified Data.Taskell.Lists as Lists
import Data.Taskell.Task (Task, isBlank, name)
import Events.State.Types
import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))
import UI.Field (blankField, getText, textToField)
type InternalStateful = State -> State
create :: FilePath -> Lists.Lists -> State
create p ls =
State {_mode = Normal, _lists = ls, _history = [], _current = (0, 0), _path = p, _io = Nothing}
quit :: Stateful
quit = Just . (mode .~ Shutdown)
continue :: State -> State
continue = io .~ Nothing
write :: Stateful
write state = Just $ state & io .~ Just (state ^. lists)
store :: Stateful
store state = Just $ state & history .~ (state ^. current, state ^. lists) : state ^. history
undo :: Stateful
undo state =
Just $
case state ^. history of
[] -> state
((c, l):xs) -> state & current .~ c & lists .~ l & history .~ xs
createList :: Stateful
createList state =
Just $
case state ^. mode of
Insert IList ICreate f ->
updateListToLast . setLists state $ Lists.newList (getText f) $ state ^. lists
_ -> state
updateListToLast :: InternalStateful
updateListToLast state = setCurrentList state (length (state ^. lists) - 1)
createListStart :: Stateful
createListStart = Just . (mode .~ Insert IList ICreate blankField)
editListStart :: Stateful
editListStart state = do
f <- textToField . (^. title) <$> getList state
pure $ state & mode .~ Insert IList IEdit f
deleteCurrentList :: Stateful
deleteCurrentList state =
Just . fixIndex . setLists state $ Lists.delete (getCurrentList state) (state ^. lists)
getCurrentTask :: State -> Maybe Task
getCurrentTask state = getList state >>= getTask (getIndex state)
setCurrentTask :: Task -> Stateful
setCurrentTask task state = setList state . update (getIndex state) task <$> getList state
setCurrentTaskText :: Text -> Stateful
setCurrentTaskText text state =
flip setCurrentTask state =<< (name .~ text) <$> getCurrentTask state
startCreate :: Stateful
startCreate = Just . (mode .~ Insert ITask ICreate blankField)
startEdit :: Stateful
startEdit state = do
field <- textToField . (^. name) <$> getCurrentTask state
pure $ state & mode .~ Insert ITask IEdit field
finishTask :: Stateful
finishTask state =
case state ^. mode of
Insert ITask iMode f ->
setCurrentTaskText (getText f) $ state & (mode .~ Insert ITask iMode blankField)
_ -> Just state
finishListTitle :: Stateful
finishListTitle state =
case state ^. mode of
Insert IList iMode f ->
setCurrentListTitle (getText f) $ state & (mode .~ Insert IList iMode blankField)
_ -> Just state
normalMode :: Stateful
normalMode = Just . (mode .~ Normal)
addToListAt :: Int -> Stateful
addToListAt offset state = do
let idx = getIndex state + offset
fixIndex . setList (setIndex state idx) . newAt idx <$> getList state
above :: Stateful
above = addToListAt 0
below :: Stateful
below = addToListAt 1
newItem :: Stateful
newItem state = selectLast . setList state . new <$> getList state
clearItem :: Stateful
clearItem = setCurrentTaskText ""
bottom :: Stateful
bottom = pure . selectLast
selectLast :: InternalStateful
selectLast state = setIndex state (countCurrent state - 1)
removeBlank :: Stateful
removeBlank state = do
currentTask <- getCurrentTask state
(if isBlank currentTask
then delete
else pure)
state
up :: Stateful
up state = previous =<< setList state <$> (move (getIndex state) (-1) =<< getList state)
down :: Stateful
down state = next =<< setList state <$> (move (getIndex state) 1 =<< getList state)
move' :: Int -> State -> Maybe State
move' idx state =
fixIndex . setLists state <$> Lists.changeList (state ^. current) (state ^. lists) idx
moveLeft :: Stateful
moveLeft = move' (-1)
moveRight :: Stateful
moveRight = move' 1
selectList :: Char -> Stateful
selectList idx state =
Just $
(if exists
then current .~ (list, 0)
else id)
state
where
list = digitToInt idx - 1
exists = Lists.exists list (state ^. lists)
delete :: Stateful
delete state = fixIndex . setList state . deleteTask (getIndex state) <$> getList state
countCurrent :: State -> Int
countCurrent state = Lists.count (getCurrentList state) (state ^. lists)
setIndex :: State -> Int -> State
setIndex state idx = state & current .~ (getCurrentList state, idx)
setCurrentList :: State -> Int -> State
setCurrentList state idx = state & current .~ (idx, getIndex state)
getIndex :: State -> Int
getIndex = snd . (^. current)
next :: Stateful
next state = Just $ setIndex state idx'
where
idx = getIndex state
count = countCurrent state
idx' =
if idx < (count - 1)
then succ idx
else idx
previous :: Stateful
previous state = Just $ setIndex state idx'
where
idx = getIndex state
idx' =
if idx > 0
then pred idx
else 0
left :: Stateful
left state =
Just . fixIndex . setCurrentList state $
if list > 0
then pred list
else 0
where
list = getCurrentList state
right :: Stateful
right state =
Just . fixIndex . setCurrentList state $
if list < (count - 1)
then succ list
else list
where
list = getCurrentList state
count = length (state ^. lists)
fixIndex :: InternalStateful
fixIndex state =
if getIndex state' > count
then setIndex state' count'
else state'
where
lists' = state ^. lists
idx = Lists.exists (getCurrentList state) lists'
state' =
if idx
then state
else setCurrentList state (length lists' - 1)
count = countCurrent state' - 1
count' =
if count < 0
then 0
else count
getCurrentList :: State -> Int
getCurrentList = fst . (^. current)
getList :: State -> Maybe List
getList state = Lists.get (state ^. lists) (getCurrentList state)
setList :: State -> List -> State
setList state list = setLists state (Lists.updateLists (getCurrentList state) list (state ^. lists))
setCurrentListTitle :: Text -> Stateful
setCurrentListTitle text state = setList state . (title .~ text) <$> getList state
setLists :: State -> Lists.Lists -> State
setLists state lists' = state & lists .~ lists'
moveTo :: Char -> Stateful
moveTo char state = do
let li = ord char - ord 'a'
cur = getCurrentList state
if li == cur || li < 0 || li >= length (state ^. lists)
then Nothing
else do
s <- move' (li - cur) state
pure . selectLast $ setCurrentList s li
listMove :: Int -> Stateful
listMove offset state = do
let currentList = getCurrentList state
let lists' = state ^. lists
if currentList + offset < 0 || currentList + offset >= length lists'
then Nothing
else do
let state' = fixIndex $ setCurrentList state (currentList + offset)
setLists state' <$> Lists.shiftBy currentList offset lists'
listLeft :: Stateful
listLeft = listMove (-1)
listRight :: Stateful
listRight = listMove 1
searchMode :: Stateful
searchMode state =
Just $
case state ^. mode of
Search _ field -> state & mode .~ Search True field
_ -> state & mode .~ Search True blankField
searchEntered :: Stateful
searchEntered state =
case state ^. mode of
Search _ field -> Just $ state & mode .~ Search False field
_ -> Nothing
showHelp :: Stateful
showHelp = Just . (mode .~ Modal Help)
showMoveTo :: Stateful
showMoveTo = Just . (mode .~ Modal MoveTo)
search :: State -> State
search state =
case state ^. mode of
Search _ field -> fixIndex . setLists state $ Lists.search (getText field) (state ^. lists)
_ -> state
newList :: State -> State
newList state =
case state ^. mode of
Insert IList ICreate f ->
let ls = state ^. lists
in fixIndex $ setCurrentList (setLists state (Lists.newList (getText f) ls)) (length ls)
_ -> state
normalise :: State -> State
normalise = newList . search