taskell 1.5.0.0 → 1.7.0.0

raw patch · 62 files changed

+1389/−814 lines, 62 filesdep ~aesondep ~attoparsecdep ~fold-debouncePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, attoparsec, fold-debounce, http-client, http-conduit, tasty, tasty-expected-failure, tasty-hunit

API changes (from Hackage documentation)

Files

• app/Main.hs +2/−2
• src/App.hs +51/−12
• src/Config.hs +1/−1
• src/Data/Taskell/Date.hs +0/−4
• src/Data/Taskell/List.hs +4/−0
• src/Data/Taskell/List/Internal.hs +27/−10
• src/Data/Taskell/Lists.hs +2/−0
• src/Data/Taskell/Lists/Internal.hs +32/−16
• src/Data/Taskell/Seq.hs +10/−1
• src/Data/Taskell/Subtask.hs +1/−0
• src/Data/Taskell/Subtask/Internal.hs +3/−0
• src/Data/Taskell/Task.hs +2/−0
• src/Data/Taskell/Task/Internal.hs +7/−1
• src/Events/Actions.hs +4/−0
• src/Events/Actions/Insert.hs +1/−1
• src/Events/Actions/Modal.hs +6/−4
• src/Events/Actions/Modal/Detail.hs +3/−2
• src/Events/Actions/Modal/Due.hs +29/−0
• src/Events/Actions/Normal.hs +5/−0
• src/Events/Actions/Search.hs +1/−1
• src/Events/Actions/Types.hs +8/−0
• src/Events/State.hs +97/−56
• src/Events/State/Modal/Detail.hs +2/−2
• src/Events/State/Modal/Due.hs +68/−0
• src/Events/State/Types.hs +3/−3
• src/Events/State/Types/Mode.hs +5/−1
• src/IO/Config.hs +3/−0
• src/IO/Config/General.hs +4/−2
• src/IO/Keyboard.hs +4/−1
• src/IO/Markdown/Internal.hs +1/−5
• src/Types.hs +15/−0
• src/UI/Draw.hs +14/−262
• src/UI/Draw/Field.hs +146/−0
• src/UI/Draw/Main.hs +26/−0
• src/UI/Draw/Main/List.hs +93/−0
• src/UI/Draw/Main/Search.hs +34/−0
• src/UI/Draw/Main/StatusBar.hs +69/−0
• src/UI/Draw/Modal.hs +46/−0
• src/UI/Draw/Modal/Detail.hs +87/−0
• src/UI/Draw/Modal/Due.hs +42/−0
• src/UI/Draw/Modal/Help.hs +67/−0
• src/UI/Draw/Modal/MoveTo.hs +33/−0
• src/UI/Draw/Mode.hs +20/−0
• src/UI/Draw/Task.hs +108/−0
• src/UI/Draw/Types.hs +28/−0
• src/UI/Field.hs +0/−138
• src/UI/Modal.hs +0/−43
• src/UI/Modal/Detail.hs +0/−84
• src/UI/Modal/Help.hs +0/−62
• src/UI/Modal/MoveTo.hs +0/−32
• src/UI/Types.hs +2/−7
• taskell.cabal +26/−15
• templates/bindings.ini +5/−1
• test/Data/Taskell/ListNavigationTest.hs +6/−3
• test/Data/Taskell/ListTest.hs +40/−16
• test/Data/Taskell/ListsTest.hs +53/−12
• test/Events/StateTest.hs +10/−2
• test/IO/Keyboard/ParserTest.hs +2/−0
• test/IO/Keyboard/TypesTest.hs +4/−1
• test/IO/KeyboardTest.hs +6/−1
• test/IO/MarkdownTest.hs +1/−7
• test/UI/FieldTest.hs +20/−3

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}  module Main where@@ -14,7 +13,8 @@ main = do     config <- setup     next <- runReaderT load config+    time <- getCurrentTime     case next of         Exit            -> pure ()         Output text     -> putStrLn text-        Load path lists -> go config $ create path lists+        Load path lists -> go config $ create time path lists

@@ -6,25 +6,28 @@  import ClassyPrelude +import Control.Concurrent (forkIO, threadDelay)+ import Control.Lens ((^.))  import Brick-import Graphics.Vty              (Mode (BracketedPaste), displayBounds, outputIface, setMode,-                                  supportsMode)+import Brick.BChan               (BChan, newBChan, writeBChan)+import Graphics.Vty              (Mode (BracketedPaste), defaultConfig, displayBounds, mkVty,+                                  outputIface, setMode, supportsMode) import Graphics.Vty.Input.Events (Event (..))  import qualified Control.FoldDebounce as Debounce -import Data.Taskell.Date       (currentDay) import Data.Taskell.Lists      (Lists) import Events.Actions          (ActionSets, event, generateActions)-import Events.State            (continue, countCurrent, setHeight)+import Events.State            (continue, countCurrent, setHeight, setTime) import Events.State.Types      (State, current, io, lists, mode, path, searchTerm) import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))-import IO.Config               (Config, generateAttrMap, getBindings, layout)+import IO.Config               (Config, debugging, generateAttrMap, getBindings, layout) import IO.Taskell              (writeData)+import Types                   (ListIndex (..), TaskIndex (..)) import UI.Draw                 (chooseCursor, draw)-import UI.Types                (ListIndex (..), ResourceName (..), TaskIndex (..))+import UI.Types                (ResourceName (..))  type DebouncedMessage = (Lists, FilePath) @@ -32,6 +35,22 @@  type Trigger = Debounce.Trigger DebouncedMessage DebouncedMessage +-- tick+data TaskellEvent =+    Tick++oneSecond :: Int+oneSecond = 1000000++frequency :: Int+frequency = 60 * oneSecond++timer :: BChan TaskellEvent -> IO ()+timer chan =+    void . forkIO . forever $ do+        writeBChan chan Tick+        threadDelay frequency+ -- store store :: Config -> DebouncedMessage -> IO () store config (ls, pth) = writeData config ls pth@@ -62,7 +81,7 @@ -- cache clearing clearCache :: State -> EventM ResourceName () clearCache state = do-    let (li, ti) = state ^. current+    let (ListIndex li, TaskIndex ti) = state ^. current     invalidateCacheEntry (RNList li)     invalidateCacheEntry (RNTask (ListIndex li, TaskIndex ti)) @@ -75,12 +94,20 @@  clearList :: State -> EventM ResourceName () clearList state = do-    let (list, _) = state ^. current+    let (ListIndex list, _) = state ^. current     let count = countCurrent state     let range = [0 .. (count - 1)]     invalidateCacheEntry $ RNList list     traverse_ (invalidateCacheEntry . RNTask . (,) (ListIndex list) . TaskIndex) range +clearDue :: State -> EventM ResourceName ()+clearDue state =+    case state ^. mode of+        Modal (Due dues _) -> do+            let range = [0 .. (length dues + 1)]+            traverse_ (invalidateCacheEntry . RNDue) range+        _ -> pure ()+ -- event handling handleVtyEvent ::        (DebouncedWrite, Trigger) -> ActionSets -> State -> Event -> EventM ResourceName (Next State)@@ -93,6 +120,7 @@         _                        -> pure ()     case state ^. mode of         Shutdown -> liftIO (Debounce.close trigger) *> Brick.halt state+        (Modal Due {}) -> clearDue state *> next send state         (Modal MoveTo) -> clearAllTitles state *> next send state         (Insert ITask ICreate _) -> clearList state *> next send state         _ -> clearCache previousState *> clearCache state *> next send state@@ -104,8 +132,11 @@        (DebouncedWrite, Trigger)     -> ActionSets     -> State-    -> BrickEvent ResourceName e+    -> BrickEvent ResourceName TaskellEvent     -> EventM ResourceName (Next State)+handleEvent _ _ state (AppEvent Tick) = do+    t <- liftIO getCurrentTime+    Brick.continue $ setTime t state handleEvent _ _ state (VtyEvent (EvResize _ _)) = do     invalidateCache     h <- getHeight@@ -126,15 +157,23 @@ go :: Config -> State -> IO () go config initial = do     attrMap' <- const <$> generateAttrMap-    today <- currentDay+    -- setup debouncing     db <- debounce config initial+    -- get bindings     bindings <- getBindings+    -- setup timer channel+    timerChan <- newBChan 1+    timer timerChan+    -- create app     let app =             App-            { appDraw = draw (layout config) bindings today+            { appDraw = draw (layout config) bindings (debugging config)             , appChooseCursor = chooseCursor             , appHandleEvent = handleEvent db (generateActions bindings)             , appStartEvent = appStart             , appAttrMap = attrMap'             }-    void (defaultMain app initial)+    -- start+    let builder = mkVty defaultConfig+    initialVty <- builder+    void $ customMain initialVty builder (Just timerChan) app initial

@@ -9,7 +9,7 @@ import Data.FileEmbed (embedFile)  version :: Text-version = "1.5.0"+version = "1.7.0"  usage :: Text usage = decodeUtf8 $(embedFile "templates/usage.txt")

@@ -9,7 +9,6 @@     , dayToOutput     , textToDay     , utcToLocalDay-    , currentDay     , deadline     ) where @@ -52,9 +51,6 @@  textToDay :: Text -> Maybe Day textToDay = (utctDay <$>) . textToTime--currentDay :: IO Day-currentDay = utctDay <$> getCurrentTime  -- work out the deadline deadline :: Day -> Day -> Deadline

@@ -2,13 +2,17 @@  module Data.Taskell.List     ( List+    , Update     , title     , tasks     , create     , empty+    , due+    , clearDue     , new     , count     , newAt+    , duplicate     , append     , extract     , updateFn

@@ -1,5 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}  module Data.Taskell.List.Internal where @@ -10,7 +11,8 @@ import Data.Sequence as S (adjust', deleteAt, insertAt, update, (|>))  import qualified Data.Taskell.Seq  as S-import qualified Data.Taskell.Task as T (Task, Update, blank, contains)+import qualified Data.Taskell.Task as T (Task, Update, blank, clearDue, contains, due, duplicate)+import           Types             (TaskIndex (TaskIndex))  data List = List     { _title :: Text@@ -35,9 +37,22 @@ count :: List -> Int count = length . (^. tasks) +due :: List -> Seq (TaskIndex, T.Task)+due list = catMaybes (filt S.<#> (list ^. tasks))+  where+    filt int task = const (TaskIndex int, task) <$> task ^. T.due++clearDue :: TaskIndex -> Update+clearDue (TaskIndex int) = updateFn int T.clearDue+ newAt :: Int -> Update-newAt idx = tasks %~ insertAt idx T.blank+newAt idx = tasks %~ S.insertAt idx T.blank +duplicate :: Int -> List -> Maybe List+duplicate idx list = do+    task <- T.duplicate <$> getTask idx list+    pure $ list & tasks %~ S.insertAt idx task+ append :: T.Task -> Update append task = tasks %~ (|> task) @@ -52,8 +67,13 @@ update :: Int -> T.Task -> Update update idx task = tasks %~ S.update idx task -move :: Int -> Int -> List -> Maybe List-move from dir = tasks %%~ S.shiftBy from dir+move :: Int -> Int -> Maybe Text -> List -> Maybe (List, Int)+move current dir term list =+    case term of+        Nothing -> (, bound list (current + dir)) <$> (list & tasks %%~ S.shiftBy current dir)+        Just _ -> do+            idx <- changeTask dir current term list+            (, idx) <$> (list & tasks %%~ S.shiftBy current (idx - current))  deleteTask :: Int -> Update deleteTask idx = tasks %~ deleteAt idx@@ -87,11 +107,8 @@         then next         else previous -bound :: Int -> List -> Int-bound idx lst-    | idx < 0 = 0-    | idx > count lst = count lst - 1-    | otherwise = idx+bound :: List -> Int -> Int+bound lst = S.bound (lst ^. tasks)  nearest' :: Int -> Maybe Text -> List -> Maybe Int nearest' current term lst = do@@ -106,5 +123,5 @@     near = fromMaybe (-1) $ nearest' current term lst     idx =         case term of-            Nothing  -> bound current lst+            Nothing  -> bound lst current             Just txt -> maybe near (bool near current . T.contains txt) $ getTask current lst

@@ -5,6 +5,8 @@     , initial     , updateLists     , count+    , due+    , clearDue     , get     , changeList     , newList

@@ -1,41 +1,57 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}  module Data.Taskell.Lists.Internal where -import ClassyPrelude hiding (empty)+import ClassyPrelude -import Data.Sequence as S (deleteAt, update, (!?), (|>))+import Control.Lens  ((^.))+import Data.Sequence as S (adjust', deleteAt, update, (!?), (|>)) -import           Data.Taskell.List as L (List, append, count, empty, extract, searchFor)+import qualified Data.Taskell.List as L (List, Update, append, clearDue, count, due, empty, extract,+                                         searchFor) import qualified Data.Taskell.Seq  as S-import           Data.Taskell.Task (Task)+import qualified Data.Taskell.Task as T (Task, due)+import           Types             (ListIndex (ListIndex), Pointer, TaskIndex (TaskIndex)) -type Lists = Seq List+type Lists = Seq L.List  type Update = Lists -> Lists  initial :: Lists-initial = fromList [empty "To Do", empty "Done"]+initial = fromList [L.empty "To Do", L.empty "Done"] -updateLists :: Int -> List -> Update+updateLists :: Int -> L.List -> Update updateLists = S.update  count :: Int -> Lists -> Int count idx tasks = maybe 0 L.count (tasks !? idx) -get :: Lists -> Int -> Maybe List+due :: Lists -> Seq (Pointer, T.Task)+due lists = sortOn ((^. T.due) . snd) dues+  where+    format x lst = (\(y, t) -> ((ListIndex x, y), t)) <$> L.due lst+    dues = concat $ format S.<#> lists++clearDue :: Pointer -> Update+clearDue (idx, tsk) = updateFn idx (L.clearDue tsk)++updateFn :: ListIndex -> L.Update -> Update+updateFn (ListIndex idx) fn = adjust' fn idx++get :: Lists -> Int -> Maybe L.List get = (!?) -changeList :: (Int, Int) -> Lists -> Int -> Maybe Lists-changeList (list, idx) tasks dir = do+changeList :: Pointer -> Lists -> Int -> Maybe Lists+changeList (ListIndex list, TaskIndex idx) tasks dir = do     let next = list + dir-    (from, task) <- extract idx =<< tasks !? list -- extract current task-    to <- append task <$> tasks !? next -- get next list and append task+    (from, task) <- L.extract idx =<< tasks !? list -- extract current task+    to <- L.append task <$> tasks !? next -- get next list and append task     pure . updateLists next to $ updateLists list from tasks -- update lists  newList :: Text -> Update-newList title = (|> empty title)+newList title = (|> L.empty title)  delete :: Int -> Update delete = deleteAt@@ -47,13 +63,13 @@ shiftBy = S.shiftBy  search :: Text -> Update-search text = (searchFor text <$>)+search text = (L.searchFor text <$>) -appendToLast :: Task -> Update+appendToLast :: T.Task -> Update appendToLast task lists =     fromMaybe lists $ do         let idx = length lists - 1-        list <- append task <$> lists !? idx+        list <- L.append task <$> lists !? idx         pure $ updateLists idx list lists  analyse :: Text -> Lists -> Text

@@ -4,8 +4,11 @@  import ClassyPrelude -import Data.Sequence (deleteAt, insertAt, (!?))+import Data.Sequence (deleteAt, insertAt, mapWithIndex, (!?)) +(<#>) :: (Int -> a -> b) -> Seq a -> Seq b+(<#>) = mapWithIndex+ extract :: Int -> Seq a -> Maybe (Seq a, a) extract idx xs = (,) (deleteAt idx xs) <$> xs !? idx @@ -13,3 +16,9 @@ shiftBy idx dir xs = do     (a, current) <- extract idx xs     pure $ insertAt (idx + dir) current a++bound :: Seq a -> Int -> Int+bound s i+    | i < 0 = 0+    | i >= length s = pred (length s)+    | otherwise = i

@@ -8,6 +8,7 @@     , name     , complete     , toggle+    , duplicate     ) where  import Data.Taskell.Subtask.Internal

@@ -26,3 +26,6 @@  toggle :: Update toggle = complete %~ not++duplicate :: Subtask -> Subtask+duplicate (Subtask n c) = Subtask n c

@@ -9,9 +9,11 @@     , subtasks     , blank     , new+    , duplicate     , setDescription     , appendDescription     , setDue+    , clearDue     , getSubtask     , addSubtask     , hasSubtasks

@@ -10,7 +10,7 @@  import           Data.Sequence        as S (adjust', deleteAt, (|>)) import           Data.Taskell.Date    (Day, textToDay)-import qualified Data.Taskell.Subtask as ST (Subtask, Update, complete, name)+import qualified Data.Taskell.Subtask as ST (Subtask, Update, complete, duplicate, name) import           Data.Text            (strip)  data Task = Task@@ -57,6 +57,9 @@                  Just day -> task & due .~ Just day                  Nothing  -> task +clearDue :: Update+clearDue task = task & due .~ Nothing+ getSubtask :: Int -> Task -> Maybe ST.Subtask getSubtask idx = (^? subtasks . ix idx) @@ -89,3 +92,6 @@ isBlank task =     null (task ^. name) &&     isNothing (task ^. description) && null (task ^. subtasks) && isNothing (task ^. due)++duplicate :: Task -> Task+duplicate (Task n d st du) = Task n d (ST.duplicate <$> st) du

@@ -21,6 +21,7 @@ import qualified Events.Actions.Insert       as Insert import qualified Events.Actions.Modal        as Modal import qualified Events.Actions.Modal.Detail as Detail+import qualified Events.Actions.Modal.Due    as Due import qualified Events.Actions.Modal.Help   as Help import qualified Events.Actions.Normal       as Normal import qualified Events.Actions.Search       as Search@@ -43,6 +44,7 @@             case state ^. mode of                 Normal                        -> lookup e $ normal actions                 Modal (Detail _ DetailNormal) -> lookup e $ detail actions+                Modal Due {}                  -> lookup e $ due actions                 Modal Help                    -> lookup e $ help actions                 _                             -> Nothing     fromMaybe state $@@ -54,6 +56,7 @@     { normal :: BoundActions     , detail :: BoundActions     , help   :: BoundActions+    , due    :: BoundActions     }  generateActions :: Bindings -> ActionSets@@ -62,4 +65,5 @@     { normal = generate bindings Normal.events     , detail = generate bindings Detail.events     , help = generate bindings Help.events+    , due = generate bindings Due.events     }

@@ -12,7 +12,7 @@ import           Events.State.Types import           Events.State.Types.Mode   (InsertMode (..), InsertType (..), Mode (Insert)) import           Graphics.Vty.Input.Events (Event (EvKey), Key (KEnter, KEsc))-import qualified UI.Field                  as F (event)+import qualified UI.Draw.Field             as F (event)  event :: Event -> Stateful event (EvKey KEnter _) state =

@@ -13,13 +13,15 @@ import Graphics.Vty.Input.Events  import qualified Events.Actions.Modal.Detail as Detail+import qualified Events.Actions.Modal.Due    as Due import qualified Events.Actions.Modal.Help   as Help import qualified Events.Actions.Modal.MoveTo as MoveTo  event :: Event -> Stateful event e s =     case s ^. mode of-        Modal Help         -> Help.event e s-        Modal (Detail _ _) -> Detail.event e s-        Modal MoveTo       -> MoveTo.event e s-        _                  -> pure s+        Modal Help      -> Help.event e s+        Modal Detail {} -> Detail.event e s+        Modal MoveTo    -> MoveTo.event e s+        Modal Due {}    -> Due.event e s+        _               -> pure s

@@ -16,7 +16,7 @@ import           Events.State.Types.Mode   (DetailItem (..), DetailMode (..)) import           Graphics.Vty.Input.Events import           IO.Keyboard.Types         (Actions)-import qualified UI.Field                  as F (event)+import qualified UI.Draw.Field             as F (event)  events :: Actions events@@ -28,9 +28,10 @@     , (A.Next, nextSubtask)     , (A.New, (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store)     , (A.Edit, (Detail.insertMode =<<) . store)-    , (A.MoveRight, (write =<<) . (setComplete =<<) . store)+    , (A.Complete, (write =<<) . (setComplete =<<) . store)     , (A.Delete, (write =<<) . (Detail.remove =<<) . store)     , (A.DueDate, (editDue =<<) . store)+    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)     , (A.Detail, (editDescription =<<) . store)     ] 

@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedLists #-}++module Events.Actions.Modal.Due+    ( event+    , events+    ) where++import ClassyPrelude++import Events.Actions.Types      as A (ActionType (..))+import Events.State              (normalMode, store, write)+import Events.State.Modal.Detail (showDetail)+import Events.State.Modal.Due    (clearDate, goto, next, previous)+import Events.State.Types        (Stateful)+import Graphics.Vty.Input.Events (Event (EvKey))+import IO.Keyboard.Types         (Actions)++events :: Actions+events =+    [ (A.Previous, previous)+    , (A.Next, next)+    , (A.Detail, (showDetail =<<) . goto)+    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)+    ]++event :: Event -> Stateful+event (EvKey _ _) = normalMode+event _           = pure

@@ -12,6 +12,7 @@ import Events.Actions.Types      as A (ActionType (..)) import Events.State import Events.State.Modal.Detail (editDue, showDetail)+import Events.State.Modal.Due    (showDue) import Events.State.Types        (Stateful) import Graphics.Vty.Input.Events import IO.Keyboard.Types         (Actions)@@ -24,6 +25,7 @@     , (A.Undo, (write =<<) . undo)     , (A.Search, searchMode)     , (A.Help, showHelp)+    , (A.Due, showDue)         -- navigation     , (A.Previous, previous)     , (A.Next, next)@@ -34,17 +36,20 @@     , (A.New, (startCreate =<<) . (newItem =<<) . store)     , (A.NewAbove, (startCreate =<<) . (above =<<) . store)     , (A.NewBelow, (startCreate =<<) . (below =<<) . store)+    , (A.Duplicate, (next =<<) . (write =<<) . (duplicate =<<) . store)     -- editing tasks     , (A.Edit, (startEdit =<<) . store)     , (A.Clear, (startEdit =<<) . (clearItem =<<) . store)     , (A.Delete, (write =<<) . (delete =<<) . store)     , (A.Detail, showDetail)     , (A.DueDate, (editDue =<<) . (store =<<) . showDetail)+    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)     -- moving tasks     , (A.MoveUp, (write =<<) . (up =<<) . store)     , (A.MoveDown, (write =<<) . (down =<<) . store)     , (A.MoveLeft, (write =<<) . (bottom =<<) . (left =<<) . (moveLeft =<<) . store)     , (A.MoveRight, (write =<<) . (bottom =<<) . (right =<<) . (moveRight =<<) . store)+    , (A.Complete, (write =<<) . (moveToLast =<<) . (clearDate =<<) . store)     , (A.MoveMenu, showMoveTo)     -- lists     , (A.ListNew, (createListStart =<<) . store)

@@ -12,7 +12,7 @@ import           Events.State.Types        (Stateful, mode) import           Events.State.Types.Mode   (Mode (Search)) import           Graphics.Vty.Input.Events-import qualified UI.Field                  as F (event)+import qualified UI.Draw.Field             as F (event)  event :: Event -> Stateful event (EvKey KEsc _) s = clearSearch =<< normalMode s

@@ -9,6 +9,7 @@     = Quit     | Undo     | Search+    | Due     | Help     | Previous     | Next@@ -18,15 +19,18 @@     | New     | NewAbove     | NewBelow+    | Duplicate     | Edit     | Clear     | Delete     | Detail     | DueDate+    | ClearDate     | MoveUp     | MoveDown     | MoveLeft     | MoveRight+    | Complete     | MoveMenu     | ListNew     | ListEdit@@ -43,6 +47,7 @@ read "quit"       = Quit read "undo"       = Undo read "search"     = Search+read "due"        = Due read "help"       = Help read "previous"   = Previous read "next"       = Next@@ -52,15 +57,18 @@ read "new"        = New read "newAbove"   = NewAbove read "newBelow"   = NewBelow+read "duplicate"  = Duplicate read "edit"       = Edit read "clear"      = Clear read "delete"     = Delete read "detail"     = Detail read "dueDate"    = DueDate+read "clearDate"  = ClearDate read "moveUp"     = MoveUp read "moveDown"   = MoveDown read "moveLeft"   = MoveLeft read "moveRight"  = MoveRight+read "complete"   = Complete read "moveMenu"   = MoveMenu read "listNew"    = ListNew read "listEdit"   = ListEdit

@@ -5,6 +5,7 @@     -- App     ( continue     , write+    , setTime     , countCurrent     , setHeight     -- UI.Main@@ -19,10 +20,12 @@     , editListStart     , deleteCurrentList     , clearItem+    , clearDate     , above     , below     , bottom     , previous+    , duplicate     , next     , left     , right@@ -30,6 +33,7 @@     , down     , moveLeft     , moveRight+    , moveToLast     , delete     , selectList     , listLeft@@ -61,46 +65,51 @@  import Data.Char (digitToInt, ord) -import           Data.Taskell.List  (List, deleteTask, getTask, move, nearest, new, newAt, nextTask,-                                     prevTask, title, update)+import qualified Data.Taskell.List  as L (List, deleteTask, duplicate, getTask, move, nearest, new,+                                          newAt, nextTask, prevTask, title, update) import qualified Data.Taskell.Lists as Lists import           Data.Taskell.Task  (Task, isBlank, name)+import           Types  import Events.State.Types import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))-import UI.Field                (Field, blankField, getText, textToField)+import UI.Draw.Field           (Field, blankField, getText, textToField)  type InternalStateful = State -> State -create :: FilePath -> Lists.Lists -> State-create p ls =+create :: UTCTime -> FilePath -> Lists.Lists -> State+create t p ls =     State     { _mode = Normal     , _lists = ls     , _history = []-    , _current = (0, 0)+    , _current = (ListIndex 0, TaskIndex 0)     , _path = p     , _io = Nothing     , _height = 0     , _searchTerm = Nothing+    , _time = t     }  -- app state quit :: Stateful-quit = Just . (mode .~ Shutdown)+quit = pure . (mode .~ Shutdown)  continue :: State -> State continue = io .~ Nothing +setTime :: UTCTime -> State -> State+setTime t = time .~ t+ write :: Stateful-write state = Just $ state & io .~ Just (state ^. lists)+write state = pure $ state & io .~ Just (state ^. lists)  store :: Stateful-store state = Just $ state & history .~ (state ^. current, state ^. lists) : state ^. history+store state = pure $ state & history .~ (state ^. current, state ^. lists) : state ^. history  undo :: Stateful undo state =-    Just $+    pure $     case state ^. history of         []          -> state         ((c, l):xs) -> state & current .~ c & lists .~ l & history .~ xs@@ -108,7 +117,7 @@ -- createList createList :: Stateful createList state =-    Just $+    pure $     case state ^. mode of         Insert IList ICreate f ->             updateListToLast . setLists state $ Lists.newList (getText f) $ state ^. lists@@ -118,31 +127,31 @@ updateListToLast state = setCurrentList state (length (state ^. lists) - 1)  createListStart :: Stateful-createListStart = Just . (mode .~ Insert IList ICreate blankField)+createListStart = pure . (mode .~ Insert IList ICreate blankField)  -- editList editListStart :: Stateful editListStart state = do-    f <- textToField . (^. title) <$> getList state+    f <- textToField . (^. L.title) <$> getList state     pure $ state & mode .~ Insert IList IEdit f  deleteCurrentList :: Stateful deleteCurrentList state =-    Just . fixIndex . setLists state $ Lists.delete (getCurrentList state) (state ^. lists)+    pure . fixIndex . setLists state $ Lists.delete (getCurrentList state) (state ^. lists)  -- insert getCurrentTask :: State -> Maybe Task-getCurrentTask state = getList state >>= getTask (getIndex state)+getCurrentTask state = getList state >>= L.getTask (getIndex state)  setCurrentTask :: Task -> Stateful-setCurrentTask task state = setList state . update (getIndex state) task <$> getList state+setCurrentTask task state = setList state . L.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)+startCreate = pure . (mode .~ Insert ITask ICreate blankField)  startEdit :: Stateful startEdit state = do@@ -154,22 +163,22 @@     case state ^. mode of         Insert ITask iMode f ->             setCurrentTaskText (getText f) $ state & (mode .~ Insert ITask iMode blankField)-        _ -> Just state+        _ -> pure state  finishListTitle :: Stateful finishListTitle state =     case state ^. mode of         Insert IList iMode f ->             setCurrentListTitle (getText f) $ state & (mode .~ Insert IList iMode blankField)-        _ -> Just state+        _ -> pure state  normalMode :: Stateful-normalMode = Just . (mode .~ Normal)+normalMode = pure . (mode .~ Normal)  addToListAt :: Int -> Stateful addToListAt offset state = do     let idx = getIndex state + offset-    fixIndex . setList (setIndex state idx) . newAt idx <$> getList state+    fixIndex . setList (setIndex state idx) . L.newAt idx <$> getList state  above :: Stateful above = addToListAt 0@@ -178,11 +187,17 @@ below = addToListAt 1  newItem :: Stateful-newItem state = selectLast . setList state . new <$> getList state+newItem state = selectLast . setList state . L.new <$> getList state +duplicate :: Stateful+duplicate state = setList state <$> (L.duplicate (getIndex state) =<< getList state)+ clearItem :: Stateful clearItem = setCurrentTaskText "" +clearDate :: Stateful+clearDate state = pure $ state & lists .~ Lists.clearDue (state ^. current) (state ^. lists)+ bottom :: Stateful bottom = pure . selectLast @@ -198,27 +213,42 @@         state  -- moving+--+moveVertical :: Int -> Stateful+moveVertical dir state = do+    (lst, idx) <- L.move (getIndex state) dir (getText <$> state ^. searchTerm) =<< getList state+    pure $ setIndex (setList state lst) idx+ up :: Stateful-up state = previous =<< setList state <$> (move (getIndex state) (-1) =<< getList state)+up = moveVertical (-1)  down :: Stateful-down state = next =<< setList state <$> (move (getIndex state) 1 =<< getList state)+down = moveVertical 1 -move' :: Int -> State -> Maybe State-move' idx state =+moveHorizontal :: Int -> State -> Maybe State+moveHorizontal idx state =     fixIndex . setLists state <$> Lists.changeList (state ^. current) (state ^. lists) idx  moveLeft :: Stateful-moveLeft = move' (-1)+moveLeft = moveHorizontal (-1)  moveRight :: Stateful-moveRight = move' 1+moveRight = moveHorizontal 1 +moveToLast :: Stateful+moveToLast state =+    if idx == cur+        then pure state+        else moveHorizontal (idx - cur) state+  where+    idx = length (state ^. lists) - 1+    cur = getCurrentList state+ selectList :: Char -> Stateful selectList idx state =-    Just $+    pure $     (if exists-         then current .~ (list, 0)+         then current .~ (ListIndex list, TaskIndex 0)          else id)         state   where@@ -227,37 +257,37 @@  -- removing delete :: Stateful-delete state = fixIndex . setList state . deleteTask (getIndex state) <$> getList state+delete state = fixIndex . setList state . L.deleteTask (getIndex state) <$> getList state  -- list and index countCurrent :: State -> Int countCurrent state = Lists.count (getCurrentList state) (state ^. lists)  setIndex :: State -> Int -> State-setIndex state idx = state & current .~ (getCurrentList state, idx)+setIndex state idx = state & current .~ (ListIndex (getCurrentList state), TaskIndex idx)  setCurrentList :: State -> Int -> State-setCurrentList state idx = state & current .~ (idx, getIndex state)+setCurrentList state idx = state & current .~ (ListIndex idx, TaskIndex (getIndex state))  getIndex :: State -> Int-getIndex = snd . (^. current)+getIndex = showTaskIndex . snd . (^. current) -changeTask :: (Int -> Maybe Text -> List -> Int) -> Stateful+changeTask :: (Int -> Maybe Text -> L.List -> Int) -> Stateful changeTask fn state = do     list <- getList state     let idx = getIndex state     let term = getText <$> state ^. searchTerm-    Just $ setIndex state (fn idx term list)+    pure $ setIndex state (fn idx term list)  next :: Stateful-next = changeTask nextTask+next = changeTask L.nextTask  previous :: Stateful-previous = changeTask prevTask+previous = changeTask L.prevTask  left :: Stateful left state =-    Just . fixIndex . setCurrentList state $+    pure . fixIndex . setCurrentList state $     if list > 0         then pred list         else 0@@ -266,7 +296,7 @@  right :: Stateful right state =-    Just . fixIndex . setCurrentList state $+    pure . fixIndex . setCurrentList state $     if list < (count - 1)         then succ list         else list@@ -274,41 +304,52 @@     list = getCurrentList state     count = length (state ^. lists) +fixListIndex :: InternalStateful+fixListIndex state =+    if listIdx+        then state+        else setCurrentList state (length lists' - 1)+  where+    lists' = state ^. lists+    listIdx = Lists.exists (getCurrentList state) lists'+ fixIndex :: InternalStateful fixIndex state =     case getList state of-        Just list -> setIndex state (nearest idx trm list)-        Nothing   -> state+        Just list -> setIndex state (L.nearest idx trm list)+        Nothing   -> fixListIndex state   where     trm = getText <$> state ^. searchTerm     idx = getIndex state  -- tasks getCurrentList :: State -> Int-getCurrentList = fst . (^. current)+getCurrentList = showListIndex . fst . (^. current) -getList :: State -> Maybe List+getList :: State -> Maybe L.List getList state = Lists.get (state ^. lists) (getCurrentList state) -setList :: State -> List -> State+setList :: State -> L.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+setCurrentListTitle text state = setList state . (L.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+moveTo' :: Int -> Stateful+moveTo' li state = do+    let cur = getCurrentList state     if li == cur || li < 0 || li >= length (state ^. lists)         then Nothing         else do-            s <- move' (li - cur) state+            s <- moveHorizontal (li - cur) state             pure . selectLast $ setCurrentList s li +moveTo :: Char -> Stateful+moveTo char = moveTo' (ord char - ord 'a')+ -- move lists listMove :: Int -> Stateful listMove offset state = do@@ -330,7 +371,7 @@ searchMode :: Stateful searchMode state = pure . fixIndex $ (state & mode .~ Search) & searchTerm .~ sTerm   where-    sTerm = Just (fromMaybe blankField (state ^. searchTerm))+    sTerm = pure (fromMaybe blankField (state ^. searchTerm))  clearSearch :: Stateful clearSearch state = pure $ state & searchTerm .~ Nothing@@ -338,18 +379,18 @@ appendSearch :: (Field -> Field) -> Stateful appendSearch genField state = do     let field = fromMaybe blankField (state ^. searchTerm)-    pure . fixIndex $ state & searchTerm .~ Just (genField field)+    pure . fixIndex $ state & searchTerm .~ pure (genField field)  -- help showHelp :: Stateful-showHelp = Just . (mode .~ Modal Help)+showHelp = pure . (mode .~ Modal Help)  showMoveTo :: Stateful-showMoveTo = Just . (mode .~ Modal MoveTo)+showMoveTo state = const (state & mode .~ Modal MoveTo) <$> getCurrentTask state  -- view setHeight :: Int -> State -> State-setHeight i = height .~ i+setHeight = (.~) height  -- more view - maybe shouldn't be in here... newList :: State -> State

@@ -34,7 +34,7 @@ import           Events.State.Types      (State, Stateful, mode) import           Events.State.Types.Mode (DetailItem (..), DetailMode (..), ModalType (Detail),                                           Mode (Modal))-import           UI.Field                (Field, blankField, getText, textToField)+import           UI.Draw.Field           (Field, blankField, getText, textToField)  updateField :: (Field -> Field) -> Stateful updateField fieldEvent s =@@ -159,4 +159,4 @@             | i > lst = lst             | i < 0 = 0             | otherwise = i-    pure $ state & mode .~ Modal (Detail (DetailItem newIndex) m)+    return $ state & mode .~ Modal (Detail (DetailItem newIndex) m)

@@ -0,0 +1,68 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.State.Modal.Due+    ( showDue+    , clearDate+    , previous+    , next+    , goto+    ) where++import ClassyPrelude++import Control.Lens  ((&), (.~), (^.))+import Data.Sequence ((!?))++import qualified Data.Taskell.Lists      as L (clearDue, due)+import           Data.Taskell.Seq        (bound)+import           Data.Taskell.Task       (Task)+import           Events.State.Types      (Stateful, current, lists, mode)+import           Events.State.Types.Mode (ModalType (Due), Mode (..))+import           Types                   (Pointer)++type DueStateful = Seq (Pointer, Task) -> Int -> Stateful++λfilter :: DueStateful -> Stateful+λfilter fn state =+    case state ^. mode of+        Modal (Due due cur) -> fn due cur state+        _                   -> pure state++λsetMode :: DueStateful+λsetMode due pos state = pure $ state & mode .~ Modal (Due due pos)++λprevious :: DueStateful+λprevious due cur = λsetMode due (bound due (cur - 1))++λnext :: DueStateful+λnext due cur = λsetMode due (bound due (cur + 1))++λgoto :: DueStateful+λgoto due cur state =+    case due !? cur of+        Just (pointer, _) -> pure $ state & current .~ pointer+        Nothing           -> Nothing++λclearDate :: DueStateful+λclearDate due cur state =+    case due !? cur of+        Just (pointer, _) -> do+            let new = L.clearDue pointer (state ^. lists)+            let dues = L.due new+            λsetMode dues (bound dues cur) (state & lists .~ new)+        Nothing -> Nothing++showDue :: Stateful+showDue state = λsetMode (L.due (state ^. lists)) 0 state++previous :: Stateful+previous = λfilter λprevious++next :: Stateful+next = λfilter λnext++goto :: Stateful+goto = λfilter λgoto++clearDate :: Stateful+clearDate = λfilter λclearDate

@@ -8,12 +8,11 @@ import Control.Lens (makeLenses)  import Data.Taskell.Lists (Lists)-import UI.Field           (Field)+import Types              (Pointer)+import UI.Draw.Field      (Field)  import qualified Events.State.Types.Mode as M (Mode) -type Pointer = (Int, Int)- data State = State     { _mode       :: M.Mode     , _lists      :: Lists@@ -23,6 +22,7 @@     , _io         :: Maybe Lists     , _height     :: Int     , _searchTerm :: Maybe Field+    , _time       :: UTCTime     } deriving (Eq, Show)  -- create lenses

@@ -4,7 +4,9 @@  import ClassyPrelude -import UI.Field (Field)+import Data.Taskell.Task (Task)+import Types             (Pointer)+import UI.Draw.Field     (Field)  data DetailMode     = DetailNormal@@ -20,6 +22,8 @@ data ModalType     = Help     | MoveTo+    | Due (Seq (Pointer, Task))+          Int     | Detail DetailItem              DetailMode     deriving (Eq, Show)

@@ -36,6 +36,9 @@     , github   :: GitHub.Config     } +debugging :: Config -> Bool+debugging config = General.debug (general config)+ defaultConfig :: Config defaultConfig =     Config

@@ -8,10 +8,11 @@  data Config = Config     { filename :: FilePath+    , debug    :: Bool     }  defaultConfig :: Config-defaultConfig = Config {filename = "taskell.md"}+defaultConfig = Config {filename = "taskell.md", debug = False}  parser :: IniParser Config parser =@@ -20,4 +21,5 @@         "general"         (do filenameCf <-                 maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename"-            pure Config {filename = filenameCf})+            debugCf <- fieldFlagDef "debug" False+            pure Config {filename = filenameCf, debug = debugCf})

@@ -43,6 +43,7 @@     [ (BChar 'q', A.Quit)     , (BChar 'u', A.Undo)     , (BChar '/', A.Search)+    , (BChar '!', A.Due)     , (BChar '?', A.Help)     , (BChar 'k', A.Previous)     , (BChar 'j', A.Next)@@ -52,6 +53,7 @@     , (BChar 'a', A.New)     , (BChar 'O', A.NewAbove)     , (BChar 'o', A.NewBelow)+    , (BChar '+', A.Duplicate)     , (BChar 'e', A.Edit)     , (BChar 'A', A.Edit)     , (BChar 'i', A.Edit)@@ -59,11 +61,12 @@     , (BChar 'D', A.Delete)     , (BKey "Enter", A.Detail)     , (BChar '@', A.DueDate)+    , (BKey "Backspace", A.ClearDate)     , (BChar 'K', A.MoveUp)     , (BChar 'J', A.MoveDown)     , (BChar 'H', A.MoveLeft)     , (BChar 'L', A.MoveRight)-    , (BKey "Space", A.MoveRight)+    , (BKey "Space", A.Complete)     , (BChar 'm', A.MoveMenu)     , (BChar 'N', A.ListNew)     , (BChar 'E', A.ListEdit)

@@ -8,7 +8,7 @@ import Control.Lens ((^.))  import Data.Sequence      (adjust')-import Data.Text          as T (dropAround, splitOn, strip)+import Data.Text          as T (splitOn, strip) import Data.Text.Encoding (decodeUtf8With)  import           Data.Taskell.Date    (dayToOutput)@@ -23,9 +23,6 @@                                      taskOutput, titleOutput)  -- parse code-trimTilde :: Text -> Text-trimTilde = strip . T.dropAround (== '~')- addSubItem :: Text -> Lists -> Lists addSubItem t ls = adjust' updateList i ls   where@@ -33,7 +30,6 @@     st         | "[ ] " `isPrefixOf` t = ST.new (drop 4 t) False         | "[x] " `isPrefixOf` t = ST.new (drop 4 t) True-        | "~" `isPrefixOf` t = ST.new (trimTilde t) True         | otherwise = ST.new t False     updateList l = updateFn j (T.addSubtask st) l       where

@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Types where++import ClassyPrelude++newtype ListIndex = ListIndex+    { showListIndex :: Int+    } deriving (Show, Eq, Ord)++newtype TaskIndex = TaskIndex+    { showTaskIndex :: Int+    } deriving (Show, Eq, Ord)++type Pointer = (ListIndex, TaskIndex)

@@ -1,6 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-}  module UI.Draw     ( draw@@ -12,272 +10,26 @@ import Control.Lens ((^.))  import Control.Monad.Reader (runReader)-import Data.Char            (chr, ord)-import Data.Sequence        (mapWithIndex)  import Brick -import           Data.Taskell.Date       (Day, dayToText, deadline)-import           Data.Taskell.List       (List, tasks, title)-import           Data.Taskell.Lists      (Lists, count)-import qualified Data.Taskell.Task       as T (Task, contains, countCompleteSubtasks, countSubtasks,-                                               description, due, hasSubtasks, name)-import           Events.State            (normalise)-import           Events.State.Types      (Pointer, State, current, height, lists, mode, path,-                                          searchTerm)-import           Events.State.Types.Mode (DetailMode (..), InsertType (..), ModalType (..),-                                          Mode (..))-import           IO.Config.Layout        (Config, columnPadding, columnWidth, descriptionIndicator)-import           IO.Keyboard.Types       (Bindings)-import           UI.Field                (Field, field, getText, textField, widgetFromMaybe)-import           UI.Modal                (showModal)-import           UI.Theme-import           UI.Types                (ListIndex (..), ResourceName (..), TaskIndex (..))---- | Draw needs to know various pieces of information, so keep track of them in a record-data DrawState = DrawState-    { dsLists        :: Lists-    , dsMode         :: Mode-    , dsLayout       :: Config-    , dsPath         :: FilePath-    , dsToday        :: Day-    , dsCurrent      :: Pointer-    , dsField        :: Maybe Field-    , dsEditingTitle :: Bool-    , dsSearchTerm   :: Maybe Field-    }---- | Use a Reader to pass around DrawState-type ReaderDrawState = ReaderT DrawState Identity---- | Takes a task's 'due' property and renders a date with appropriate styling (e.g. red if overdue)-renderDate :: Maybe Day -> ReaderDrawState (Maybe (Widget ResourceName))-renderDate dueDay = do-    today <- dsToday <$> ask -- get the value of `today` from DrawState-    let attr = withAttr . dlToAttr . deadline today <$> dueDay -- create a `Maybe (Widget -> Widget)` attribute function-        widget = txt . dayToText today <$> dueDay -- get the formatted due date `Maybe Text`-    pure $ attr <*> widget---- | Renders the appropriate completed sub task count e.g. "[2/3]"-renderSubtaskCount :: T.Task -> Widget ResourceName-renderSubtaskCount task =-    txt $ concat ["[", tshow $ T.countCompleteSubtasks task, "/", tshow $ T.countSubtasks task, "]"]---- | Renders the appropriate indicators: description, sub task count, and due date-indicators :: T.Task -> ReaderDrawState (Widget ResourceName)-indicators task = do-    dateWidget <- renderDate (task ^. T.due) -- get the due date widget-    descIndicator <- descriptionIndicator . dsLayout <$> ask-    pure . hBox $-        padRight (Pad 1) <$>-        catMaybes-            [ const (txt descIndicator) <$> task ^. T.description -- show the description indicator if one is set-            , bool Nothing (Just (renderSubtaskCount task)) (T.hasSubtasks task) -- if it has subtasks, render the sub task count-            , dateWidget-            ]---- | Renders an individual task-renderTask' :: Int -> Int -> T.Task -> ReaderDrawState (Widget ResourceName)-renderTask' listIndex taskIndex task = do-    eTitle <- dsEditingTitle <$> ask -- is the title being edited? (for visibility)-    selected <- (== (listIndex, taskIndex)) . dsCurrent <$> ask -- is the current task selected?-    taskField <- dsField <$> ask -- get the field, if it's being edited-    after <- indicators task -- get the indicators widget-    let text = task ^. T.name-        name = RNTask (ListIndex listIndex, TaskIndex taskIndex)-        widget = textField text-        widget' = widgetFromMaybe widget taskField-    pure $-        cached name .-        (if selected && not eTitle-             then visible-             else id) .-        padBottom (Pad 1) .-        (<=> withAttr disabledAttr after) .-        withAttr-            (if selected-                 then taskCurrentAttr-                 else taskAttr) $-        if selected && not eTitle-            then widget'-            else widget--renderTask :: Int -> Int -> T.Task -> ReaderDrawState (Widget ResourceName)-renderTask listIndex taskIndex task = do-    searchT <- asks dsSearchTerm-    case searchT of-        Nothing -> renderTask' listIndex taskIndex task-        Just term ->-            if T.contains (getText term) task-                then renderTask' listIndex taskIndex task-                else pure emptyWidget---- | Gets the relevant column prefix - number in normal mode, letter in moveTo-columnPrefix :: Int -> Int -> ReaderDrawState Text-columnPrefix selectedList i = do-    m <- dsMode <$> ask-    if moveTo m-        then do-            let col = chr (i + ord 'a')-            pure $-                if i /= selectedList && i >= 0 && i <= 26-                    then singleton col <> ". "-                    else ""-        else do-            let col = i + 1-            pure $-                if col >= 1 && col <= 9-                    then tshow col <> ". "-                    else ""---- | Renders the title for a list-renderTitle :: Int -> List -> ReaderDrawState (Widget ResourceName)-renderTitle listIndex list = do-    (selectedList, selectedTask) <- dsCurrent <$> ask-    editing <- (selectedList == listIndex &&) . dsEditingTitle <$> ask-    titleField <- dsField <$> ask-    col <- txt <$> columnPrefix selectedList listIndex-    let text = list ^. title-        attr =-            if selectedList == listIndex-                then titleCurrentAttr-                else titleAttr-        widget = textField text-        widget' = widgetFromMaybe widget titleField-        title' =-            padBottom (Pad 1) . withAttr attr . (col <+>) $-            if editing-                then widget'-                else widget-    pure $-        if editing || selectedList /= listIndex || selectedTask == 0-            then visible title'-            else title'---- | Renders a list-renderList :: Int -> List -> ReaderDrawState (Widget ResourceName)-renderList listIndex list = do-    layout <- dsLayout <$> ask-    eTitle <- dsEditingTitle <$> ask-    titleWidget <- renderTitle listIndex list-    (currentList, _) <- dsCurrent <$> ask-    taskWidgets <- sequence $ renderTask listIndex `mapWithIndex` (list ^. tasks)-    let widget =-            (if not eTitle-                 then cached (RNList listIndex)-                 else id) .-            padLeftRight (columnPadding layout) .-            hLimit (columnWidth layout) .-            viewport (RNList listIndex) Vertical . vBox . (titleWidget :) $-            toList taskWidgets-    pure $-        if currentList == listIndex-            then visible widget-            else widget---- | Renders the search area-renderSearch :: Widget ResourceName -> ReaderDrawState (Widget ResourceName)-renderSearch mainWidget = do-    m <- asks dsMode-    term <- asks dsSearchTerm-    case term of-        Just searchField -> do-            colPad <- columnPadding . dsLayout <$> ask-            let attr =-                    withAttr $-                    case m of-                        Search -> taskCurrentAttr-                        _      -> taskAttr-            let widget = attr . padLeftRight colPad $ txt "/" <+> field searchField-            pure $ mainWidget <=> widget-        _ -> pure mainWidget---- | Render the status bar-getPosition :: ReaderDrawState Text-getPosition = do-    (col, pos) <- asks dsCurrent-    len <- count col <$> asks dsLists-    let posNorm =-            if len > 0-                then pos + 1-                else 0-    pure $ tshow posNorm <> "/" <> tshow len--modeToText :: Maybe Field -> Mode -> Text-modeToText fld =-    \case-        Normal ->-            case fld of-                Nothing -> "NORMAL"-                Just _  -> "NORMAL + SEARCH"-        Insert {} -> "INSERT"-        Modal Help -> "HELP"-        Modal MoveTo -> "MOVE"-        Modal Detail {} -> "DETAIL"-        Search {} -> "SEARCH"-        _ -> ""--getMode :: ReaderDrawState Text-getMode = modeToText <$> asks dsSearchTerm <*> asks dsMode--renderStatusBar :: ReaderDrawState (Widget ResourceName)-renderStatusBar = do-    topPath <- pack <$> asks dsPath-    colPad <- columnPadding <$> asks dsLayout-    posTxt <- getPosition-    modeTxt <- getMode-    let titl = padLeftRight colPad $ txt topPath-    let pos = padRight (Pad colPad) $ txt posTxt-    let md = txt modeTxt-    let bar = padRight Max (titl <+> md) <+> pos-    pure . padTop (Pad 1) $ withAttr statusBarAttr bar---- | Renders the main widget-main :: ReaderDrawState (Widget ResourceName)-main = do-    ls <- dsLists <$> ask-    listWidgets <- toList <$> sequence (renderList `mapWithIndex` ls)-    let mainWidget = viewport RNLists Horizontal . padTopBottom 1 $ hBox listWidgets-    statusBar <- renderStatusBar-    renderSearch (mainWidget <=> statusBar)--getField :: Mode -> Maybe Field-getField (Insert _ _ f) = Just f-getField _              = Nothing--editingTitle :: Mode -> Bool-editingTitle (Insert IList _ _) = True-editingTitle _                  = False--moveTo :: Mode -> Bool-moveTo (Modal MoveTo) = True-moveTo _              = False+import Events.State            (normalise)+import Events.State.Types      (State, mode)+import Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))+import IO.Config.Layout        (Config)+import IO.Keyboard.Types       (Bindings)+import UI.Draw.Main            (renderMain)+import UI.Draw.Modal           (renderModal)+import UI.Draw.Types           (DrawState (DrawState), ReaderDrawState, TWidget)+import UI.Types                (ResourceName (..))  -- draw-drawR :: Int -> State -> Bindings -> ReaderDrawState [Widget ResourceName]-drawR ht normalisedState bindings = do-    modal <- showModal ht bindings normalisedState <$> asks dsToday-    mn <- main-    pure [modal, mn]+renderApp :: ReaderDrawState [TWidget]+renderApp = sequence [renderModal, renderMain] -draw :: Config -> Bindings -> Day -> State -> [Widget ResourceName]-draw layout bindings today state = runReader (drawR ht normalisedState bindings) drawState-  where-    normalisedState = normalise state-    stateMode = state ^. mode-    ht = state ^. height-    drawState =-        DrawState-        { dsLists = normalisedState ^. lists-        , dsMode = stateMode-        , dsLayout = layout-        , dsPath = normalisedState ^. path-        , dsToday = today-        , dsField = getField stateMode-        , dsCurrent = normalisedState ^. current-        , dsEditingTitle = editingTitle stateMode-        , dsSearchTerm = normalisedState ^. searchTerm-        }+draw :: Config -> Bindings -> Bool -> State -> [TWidget]+draw layout bindings debug state =+    runReader renderApp (DrawState layout bindings debug (normalise state))  -- cursors chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName)

@@ -0,0 +1,146 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Field where++import ClassyPrelude++import qualified Data.List as L (scanl1)+import qualified Data.Text as T (splitAt, takeEnd)++import qualified Brick                     as B (Location (Location), Size (Fixed), Widget (Widget),+                                                 availWidth, getContext, render, showCursor, txt,+                                                 vBox)+import qualified Brick.Widgets.Core        as B (textWidth)+import qualified Graphics.Text.Width       as V (safeWcwidth)+import qualified Graphics.Vty.Input.Events as V (Event (..), Key (..))++import qualified UI.Types as UI (ResourceName (RNCursor))++data Field = Field+    { _text   :: Text+    , _cursor :: Int+    } deriving (Eq, Show)++blankField :: Field+blankField = Field "" 0++event :: V.Event -> Field -> Field+event (V.EvKey (V.KChar '\t') _) f = f+event (V.EvPaste bs) f             = insertText (decodeUtf8 bs) f+event (V.EvKey V.KBS _) f          = backspace f+event (V.EvKey V.KLeft _) f        = updateCursor (-1) f+event (V.EvKey V.KRight _) f       = updateCursor 1 f+event (V.EvKey (V.KChar char) _) f = insertCharacter char f+event _ f                          = f++updateCursor :: Int -> Field -> Field+updateCursor dir (Field text cursor) = Field text newCursor+  where+    next = cursor + dir+    limit = length text+    newCursor+        | next <= 0 = 0+        | next > limit = limit+        | otherwise = next++backspace :: Field -> Field+backspace (Field text cursor) =+    let (start, end) = T.splitAt cursor text+    in case fromNullable start of+           Nothing     -> Field end cursor+           Just start' -> Field (init start' <> end) (cursor - 1)++insertCharacter :: Char -> Field -> Field+insertCharacter char (Field text cursor) = Field newText newCursor+  where+    (start, end) = T.splitAt cursor text+    newText = snoc start char <> end+    newCursor = cursor + 1++insertText :: Text -> Field -> Field+insertText insert (Field text cursor) = Field newText newCursor+  where+    (start, end) = T.splitAt cursor text+    newText = concat [start, insert, end]+    newCursor = cursor + length insert++widthFold :: [Int] -> Char -> [Int]+widthFold l t = l <> [V.safeWcwidth t]++cursorPosition :: [Text] -> Int -> Int -> (Int, Int)+cursorPosition lns width cursor =+    if x == width+        then (0, y + 1) -- go to next line if at end of line+        else (x, y)+  where+    parts = foldl' widthFold [] <$> lns -- list of list of individual character lengths+    lengths = length <$> parts -- list of line lengths+    cumulative = L.scanl1 (+) lengths -- cumulative total of line lengths+    above = takeWhile (< cursor) cumulative -- lines above the cursor+    y = length above -- number of lines above+    adjustedCursor = cursor - fromMaybe 0 (lastMay above) -- subtract lines above from cursor position+    cumulativeWidths = L.scanl1 (+) <$> index parts y -- get cumulative widths for current line+    x = fromMaybe 0 $ flip index (adjustedCursor - 1) =<< cumulativeWidths++getText :: Field -> Text+getText (Field text _) = text++textToField :: Text -> Field+textToField text = Field text (length text)++field :: Field -> B.Widget UI.ResourceName+field (Field text cursor) =+    B.Widget B.Fixed B.Fixed $ do+        width <- B.availWidth <$> B.getContext+        let (wrapped, offset) = wrap width text+            location = cursorPosition wrapped width (cursor - offset)+        B.render $+            if null text+                then B.showCursor UI.RNCursor (B.Location (0, 0)) $ B.txt " "+                else B.showCursor UI.RNCursor (B.Location location) . B.vBox $ B.txt <$> wrapped++widgetFromMaybe :: B.Widget UI.ResourceName -> Maybe Field -> B.Widget UI.ResourceName+widgetFromMaybe _ (Just f) = field f+widgetFromMaybe w Nothing  = w++textField :: Text -> B.Widget UI.ResourceName+textField text =+    B.Widget B.Fixed B.Fixed $ do+        width <- B.availWidth <$> B.getContext+        let (wrapped, _) = wrap width text+        B.render $+            if null text+                then B.txt "---"+                else B.vBox $ B.txt <$> wrapped++-- wrap+wrap :: Int -> Text -> ([Text], Int)+wrap width = foldl' (combine width) ([""], 0) . spl++spl' :: [Text] -> Char -> [Text]+spl' ts c+    | c == ' ' = ts <> [" "] <> [""]+    | otherwise =+        case fromNullable ts of+            Just ts' -> init ts' <> [snoc (last ts') c]+            Nothing  -> [singleton c]++spl :: Text -> [Text]+spl = foldl' spl' [""]++combine :: Int -> ([Text], Int) -> Text -> ([Text], Int)+combine width (acc, offset) s+    | newline && s == " " = (acc, offset + 1)+    | T.takeEnd 1 l == " " && s == " " = (acc, offset + 1)+    | newline = (acc <> [s], offset)+    | otherwise = (append (l <> s) acc, offset)+  where+    l = maybe "" last (fromNullable acc)+    newline = B.textWidth l + B.textWidth s > width++append :: Text -> [Text] -> [Text]+append s l =+    case fromNullable l of+        Just l' -> init l' <> [s]+        Nothing -> l <> [s]

@@ -0,0 +1,26 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UI.Draw.Main+    ( renderMain+    ) where++import ClassyPrelude++import Brick+import Control.Lens  ((^.))+import Data.Sequence (mapWithIndex)++import Events.State.Types     (lists)+import UI.Draw.Main.List      (renderList)+import UI.Draw.Main.Search    (renderSearch)+import UI.Draw.Main.StatusBar (renderStatusBar)+import UI.Draw.Types          (DSWidget, DrawState (..))+import UI.Types               (ResourceName (..))++renderMain :: DSWidget+renderMain = do+    ls <- (^. lists) <$> asks dsState+    listWidgets <- toList <$> sequence (renderList `mapWithIndex` ls)+    let mainWidget = viewport RNLists Horizontal . padTopBottom 1 $ hBox listWidgets+    statusBar <- renderStatusBar+    renderSearch (mainWidget <=> statusBar)

@@ -0,0 +1,93 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module UI.Draw.Main.List+    ( renderList+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Char     (chr, ord)+import Data.Sequence (mapWithIndex)++import Brick++import Data.Taskell.List  (List, tasks, title)+import Events.State.Types (current, mode)+import IO.Config.Layout   (columnPadding, columnWidth)+import Types              (ListIndex (ListIndex), TaskIndex (TaskIndex))+import UI.Draw.Field      (textField, widgetFromMaybe)+import UI.Draw.Mode+import UI.Draw.Task       (renderTask)+import UI.Draw.Types      (DSWidget, DrawState (..), ReaderDrawState)+import UI.Theme+import UI.Types           (ResourceName (..))++-- | Gets the relevant column prefix - number in normal mode, letter in moveTo+columnPrefix :: Int -> Int -> ReaderDrawState Text+columnPrefix selectedList i = do+    m <- (^. mode) <$> asks dsState+    if moveTo m+        then do+            let col = chr (i + ord 'a')+            pure $+                if i /= selectedList && i >= 0 && i <= 26+                    then singleton col <> ". "+                    else ""+        else do+            let col = i + 1+            pure $+                if col >= 1 && col <= 9+                    then tshow col <> ". "+                    else ""++-- | Renders the title for a list+renderTitle :: Int -> List -> DSWidget+renderTitle listIndex list = do+    (ListIndex selectedList, TaskIndex selectedTask) <- (^. current) <$> asks dsState+    editing <- (selectedList == listIndex &&) . editingTitle . (^. mode) <$> asks dsState+    titleField <- getField . (^. mode) <$> asks dsState+    col <- txt <$> columnPrefix selectedList listIndex+    let text = list ^. title+        attr =+            if selectedList == listIndex+                then titleCurrentAttr+                else titleAttr+        widget = textField text+        widget' = widgetFromMaybe widget titleField+        title' =+            padBottom (Pad 1) . withAttr attr . (col <+>) $+            if editing+                then widget'+                else widget+    pure $+        if editing || selectedList /= listIndex || selectedTask == 0+            then visible title'+            else title'++-- | Renders a list+renderList :: Int -> List -> DSWidget+renderList listIndex list = do+    layout <- dsLayout <$> ask+    eTitle <- editingTitle . (^. mode) <$> asks dsState+    titleWidget <- renderTitle listIndex list+    (ListIndex currentList, _) <- (^. current) <$> asks dsState+    taskWidgets <-+        sequence $+        renderTask (RNTask . (ListIndex listIndex, ) . TaskIndex) listIndex `mapWithIndex`+        (list ^. tasks)+    let widget =+            (if not eTitle+                 then cached (RNList listIndex)+                 else id) .+            padLeftRight (columnPadding layout) .+            hLimit (columnWidth layout) .+            viewport (RNList listIndex) Vertical . vBox . (titleWidget :) $+            toList taskWidgets+    pure $+        if currentList == listIndex+            then visible widget+            else widget

@@ -0,0 +1,34 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Main.Search+    ( renderSearch+    ) where++import Brick+import ClassyPrelude+import Control.Lens  ((^.))++import Events.State.Types      (mode, searchTerm)+import Events.State.Types.Mode (Mode (..))+import IO.Config.Layout        (columnPadding)+import UI.Draw.Field           (field)+import UI.Draw.Types           (DSWidget, DrawState (..))+import UI.Theme+import UI.Types                (ResourceName (..))++renderSearch :: Widget ResourceName -> DSWidget+renderSearch mainWidget = do+    m <- (^. mode) <$> asks dsState+    term <- (^. searchTerm) <$> asks dsState+    case term of+        Just searchField -> do+            colPad <- columnPadding . dsLayout <$> ask+            let attr =+                    withAttr $+                    case m of+                        Search -> taskCurrentAttr+                        _      -> taskAttr+            let widget = attr . padLeftRight colPad $ txt "/" <+> field searchField+            pure $ mainWidget <=> widget+        _ -> pure mainWidget

@@ -0,0 +1,69 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module UI.Draw.Main.StatusBar+    ( renderStatusBar+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick++import Data.Taskell.Lists (count)+import Events.State.Types (current, lists, mode, path, searchTerm)++import Events.State.Types.Mode (ModalType (..), Mode (..))+import IO.Config.Layout        (columnPadding)+import Types                   (ListIndex (ListIndex), TaskIndex (TaskIndex))+import UI.Draw.Field           (Field)+import UI.Draw.Types           (DSWidget, DrawState (..), ReaderDrawState)+import UI.Theme++getPosition :: ReaderDrawState Text+getPosition = do+    (ListIndex col, TaskIndex pos) <- (^. current) <$> asks dsState+    len <- count col . (^. lists) <$> asks dsState+    let posNorm =+            if len > 0+                then pos + 1+                else 0+    pure $ tshow posNorm <> "/" <> tshow len++modeToText :: Maybe Field -> Mode -> ReaderDrawState Text+modeToText fld md = do+    debug <- asks dsDebug+    pure $+        if debug+            then tshow md+            else case md of+                     Normal ->+                         case fld of+                             Nothing -> "NORMAL"+                             Just _  -> "NORMAL + SEARCH"+                     Insert {} -> "INSERT"+                     Modal Help -> "HELP"+                     Modal MoveTo -> "MOVE"+                     Modal Detail {} -> "DETAIL"+                     Modal Due {} -> "DUE"+                     Search {} -> "SEARCH"+                     _ -> ""++getMode :: ReaderDrawState Text+getMode = do+    state <- asks dsState+    modeToText (state ^. searchTerm) (state ^. mode)++renderStatusBar :: DSWidget+renderStatusBar = do+    topPath <- pack . (^. path) <$> asks dsState+    colPad <- columnPadding <$> asks dsLayout+    posTxt <- getPosition+    modeTxt <- getMode+    let titl = padLeftRight colPad $ txt topPath+    let pos = padRight (Pad colPad) $ txt posTxt+    let md = txt modeTxt+    let bar = padRight Max (titl <+> md) <+> pos+    pure . padTop (Pad 1) $ withAttr statusBarAttr bar

@@ -0,0 +1,46 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UI.Draw.Modal+    ( renderModal+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick+import Brick.Widgets.Border+import Brick.Widgets.Center++import Events.State.Types      (height, mode)+import Events.State.Types.Mode (ModalType (..), Mode (..))+import UI.Draw.Field           (textField)+import UI.Draw.Modal.Detail    (detail)+import UI.Draw.Modal.Due       (due)+import UI.Draw.Modal.Help      (help)+import UI.Draw.Modal.MoveTo    (moveTo)+import UI.Draw.Types           (DSWidget, DrawState (dsState), TWidget)+import UI.Theme                (titleAttr)+import UI.Types                (ResourceName (..))++surround :: (Text, TWidget) -> DSWidget+surround (title, widget) = do+    ht <- (^. height) <$> asks dsState+    let t = padBottom (Pad 1) . withAttr titleAttr $ textField title+    pure .+        padTopBottom 1 .+        centerLayer .+        border .+        padTopBottom 1 .+        padLeftRight 4 . vLimit (ht - 9) . hLimit 50 . (t <=>) . viewport RNModal Vertical $+        widget++renderModal :: DSWidget+renderModal = do+    md <- (^. mode) <$> asks dsState+    case md of+        Modal Help                 -> surround =<< help+        Modal Detail {}            -> surround =<< detail+        Modal MoveTo               -> surround =<< moveTo+        Modal (Due tasks selected) -> surround =<< due tasks selected+        _                          -> pure emptyWidget

@@ -0,0 +1,87 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Modal.Detail+    ( detail+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Sequence (mapWithIndex)++import Brick++import           Data.Taskell.Date         (Day, dayToOutput, deadline)+import qualified Data.Taskell.Subtask      as ST (Subtask, complete, name)+import           Data.Taskell.Task         (Task, description, due, name, subtasks)+import           Events.State              (getCurrentTask)+import           Events.State.Modal.Detail (getCurrentItem, getField)+import           Events.State.Types        (time)+import           Events.State.Types.Mode   (DetailItem (..))+import           UI.Draw.Field             (Field, textField, widgetFromMaybe)+import           UI.Draw.Types             (DrawState (..), ModalWidget, TWidget)+import           UI.Theme                  (disabledAttr, dlToAttr, taskCurrentAttr,+                                            titleCurrentAttr)++renderSubtask :: Maybe Field -> DetailItem -> Int -> ST.Subtask -> TWidget+renderSubtask f current i subtask = padBottom (Pad 1) $ prefix <+> final+  where+    cur =+        case current of+            DetailItem c -> i == c+            _            -> False+    done = subtask ^. ST.complete+    attr =+        withAttr+            (if cur+                 then taskCurrentAttr+                 else titleCurrentAttr)+    prefix =+        attr . txt $+        if done+            then "[x] "+            else "[ ] "+    widget = textField (subtask ^. ST.name)+    final+        | cur = visible . attr $ widgetFromMaybe widget f+        | not done = attr widget+        | otherwise = widget++renderSummary :: Maybe Field -> DetailItem -> Task -> TWidget+renderSummary f i task = padTop (Pad 1) $ padBottom (Pad 2) w'+  where+    w = textField $ fromMaybe "No description" (task ^. description)+    w' =+        case i of+            DetailDescription -> visible $ widgetFromMaybe w f+            _                 -> w++renderDate :: Day -> Maybe Field -> DetailItem -> Task -> TWidget+renderDate today field item task =+    case item of+        DetailDate -> visible $ prefix <+> widgetFromMaybe widget field+        _ ->+            case day of+                Just d  -> prefix <+> withAttr (dlToAttr (deadline today d)) widget+                Nothing -> emptyWidget+  where+    day = task ^. due+    prefix = txt "Due: "+    widget = textField $ maybe "" dayToOutput day++detail :: ModalWidget+detail = do+    state <- asks dsState+    let today = utctDay (state ^. time)+    pure $+        fromMaybe ("Error", txt "Oops") $ do+            task <- getCurrentTask state+            i <- getCurrentItem state+            let f = getField state+            let sts = task ^. subtasks+                w+                    | null sts = withAttr disabledAttr $ txt "No sub-tasks"+                    | otherwise = vBox . toList $ renderSubtask f i `mapWithIndex` sts+            pure (task ^. name, renderDate today f i task <=> renderSummary f i task <=> w)

@@ -0,0 +1,42 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Modal.Due+    ( due+    ) where++import ClassyPrelude++import Brick+import Data.Taskell.Seq ((<#>))++import qualified Data.Taskell.Task as T (Task)+import           Types             (Pointer)+import           UI.Draw.Task      (TaskWidget (..), parts)+import           UI.Draw.Types     (DSWidget, ModalWidget)+import           UI.Theme          (taskAttr, taskCurrentAttr)+import           UI.Types          (ResourceName (RNDue))++renderTask :: Int -> Int -> T.Task -> DSWidget+renderTask current position task = do+    (TaskWidget text date _ _) <- parts task+    let selected = current == position+    let attr =+            if selected+                then taskCurrentAttr+                else taskAttr+    let shw =+            if selected+                then visible+                else id+    pure . shw . cached (RNDue position) . padBottom (Pad 1) . withAttr attr $ vBox [date, text]++due :: Seq (Pointer, T.Task) -> Int -> ModalWidget+due tasks selected = do+    let items = snd <$> tasks+    widgets <- sequence $ renderTask selected <#> items+    pure+        ( "Due Tasks"+        , if null items+              then txt "No due tasks"+              else vBox $ toList widgets)

@@ -0,0 +1,67 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Modal.Help+    ( help+    ) where++import ClassyPrelude++import Brick+import Data.Text as T (justifyRight)++import Events.Actions.Types as A (ActionType (..))+import IO.Keyboard.Types    (bindingsToText)++import IO.Keyboard.Types (Bindings)+import UI.Draw.Field     (textField)+import UI.Draw.Types     (DrawState (dsBindings), ModalWidget, TWidget)+import UI.Theme          (taskCurrentAttr)++descriptions :: [([ActionType], Text)]+descriptions =+    [ ([A.Help], "Show this list of controls")+    , ([A.Due], "Show tasks with due dates")+    , ([A.Previous, A.Next, A.Left, A.Right], "Move down / up / left / right")+    , ([A.Bottom], "Go to bottom of list")+    , ([A.New], "Add a task")+    , ([A.NewAbove, A.NewBelow], "Add a task above / below")+    , ([A.Duplicate], "Duplicate a task")+    , ([A.Edit], "Edit a task")+    , ([A.Clear], "Change task")+    , ([A.Detail], "Show task details / Edit task description")+    , ([A.DueDate], "Add/edit due date (yyyy-mm-dd)")+    , ([A.ClearDate], "Removes due date")+    , ([A.MoveUp, A.MoveDown], "Shift task down / up")+    , ([A.MoveLeft, A.MoveRight], "Shift task left / right")+    , ([A.Complete], "Move task to last list and remove any due dates")+    , ([A.MoveMenu], "Move task to specific list")+    , ([A.Delete], "Delete task")+    , ([A.Undo], "Undo")+    , ([A.ListNew], "New list")+    , ([A.ListEdit], "Edit list title")+    , ([A.ListDelete], "Delete list")+    , ([A.ListLeft, A.ListRight], "Move list left / right")+    , ([A.Search], "Search")+    , ([A.Quit], "Quit")+    ]++generate :: Bindings -> [([Text], Text)]+generate bindings = first (intercalate ", " . bindingsToText bindings <$>) <$> descriptions++format :: ([Text], Text) -> (Text, Text)+format = first (intercalate " / ")++line :: Int -> (Text, Text) -> TWidget+line m (l, r) = left <+> right+  where+    left = padRight (Pad 2) . withAttr taskCurrentAttr . txt $ justifyRight m ' ' l+    right = textField r++help :: ModalWidget+help = do+    bindings <- asks dsBindings+    let ls = format <$> generate bindings+    let m = foldl' max 0 $ length . fst <$> ls+    let w = vBox $ line m <$> ls+    pure ("Controls", w)

@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Modal.MoveTo+    ( moveTo+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick++import Data.Taskell.List  (title)+import Events.State.Types (current, lists)+import Types              (showListIndex)+import UI.Draw.Field      (textField)+import UI.Draw.Types      (DrawState (dsState), ModalWidget)+import UI.Theme           (taskCurrentAttr)++moveTo :: ModalWidget+moveTo = do+    skip <- showListIndex . fst . (^. current) <$> asks dsState+    ls <- toList . (^. lists) <$> asks dsState+    let titles = textField . (^. title) <$> ls+    let letter a =+            padRight (Pad 1) . hBox $+            [txt "[", withAttr taskCurrentAttr $ txt (singleton a), txt "]"]+    let letters = letter <$> ['a' ..]+    let remove i l = take i l <> drop (i + 1) l+    let output (l, t) = l <+> t+    let widget = vBox $ output <$> remove skip (zip letters titles)+    pure ("Move To:", widget)

@@ -0,0 +1,20 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UI.Draw.Mode where++import ClassyPrelude++import Events.State.Types.Mode (InsertType (..), ModalType (..), Mode (..))+import UI.Draw.Field           (Field)++getField :: Mode -> Maybe Field+getField (Insert _ _ f) = Just f+getField _              = Nothing++editingTitle :: Mode -> Bool+editingTitle (Insert IList _ _) = True+editingTitle _                  = False++moveTo :: Mode -> Bool+moveTo (Modal MoveTo) = True+moveTo _              = False

@@ -0,0 +1,108 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw.Task+    ( TaskWidget(..)+    , renderTask+    , parts+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick++import           Data.Taskell.Date  (dayToText, deadline)+import qualified Data.Taskell.Task  as T (Task, contains, countCompleteSubtasks, countSubtasks,+                                          description, due, hasSubtasks, name)+import           Events.State.Types (current, mode, searchTerm, time)+import           IO.Config.Layout   (descriptionIndicator)+import           Types              (ListIndex (..), TaskIndex (..))+import           UI.Draw.Field      (getText, textField, widgetFromMaybe)+import           UI.Draw.Mode+import           UI.Draw.Types      (DSWidget, DrawState (..), ReaderDrawState, TWidget)+import           UI.Theme+import           UI.Types           (ResourceName)++data TaskWidget = TaskWidget+    { textW     :: TWidget+    , dateW     :: TWidget+    , summaryW  :: TWidget+    , subtasksW :: TWidget+    }++-- | Takes a task's 'due' property and renders a date with appropriate styling (e.g. red if overdue)+renderDate :: T.Task -> DSWidget+renderDate task = do+    today <- utctDay . (^. time) <$> asks dsState+    pure . fromMaybe emptyWidget $+        (\day -> withAttr (dlToAttr $ deadline today day) (txt $ dayToText today day)) <$>+        task ^. T.due++-- | Renders the appropriate completed sub task count e.g. "[2/3]"+renderSubtaskCount :: T.Task -> DSWidget+renderSubtaskCount task =+    pure . fromMaybe emptyWidget $ bool Nothing (Just indicator) (T.hasSubtasks task)+  where+    complete = tshow $ T.countCompleteSubtasks task+    total = tshow $ T.countSubtasks task+    indicator = txt $ concat ["[", complete, "/", total, "]"]++-- | Renders the description indicator+renderDescIndicator :: T.Task -> DSWidget+renderDescIndicator task = do+    indicator <- descriptionIndicator <$> asks dsLayout+    pure . fromMaybe emptyWidget $ const (txt indicator) <$> task ^. T.description -- show the description indicator if one is set++-- | Renders the task text+renderText :: T.Task -> DSWidget+renderText task = pure $ textField (task ^. T.name)++-- | Renders the appropriate indicators: description, sub task count, and due date+indicators :: T.Task -> DSWidget+indicators task = do+    widgets <- sequence (($ task) <$> [renderDescIndicator, renderSubtaskCount, renderDate])+    pure . hBox $ padRight (Pad 1) <$> widgets++-- | The individual parts of a task widget+parts :: T.Task -> ReaderDrawState TaskWidget+parts task =+    TaskWidget <$> renderText task <*> renderDate task <*> renderDescIndicator task <*>+    renderSubtaskCount task++-- | Renders an individual task+renderTask' :: (Int -> ResourceName) -> Int -> Int -> T.Task -> DSWidget+renderTask' rn listIndex taskIndex task = do+    eTitle <- editingTitle . (^. mode) <$> asks dsState -- is the title being edited? (for visibility)+    selected <- (== (ListIndex listIndex, TaskIndex taskIndex)) . (^. current) <$> asks dsState -- is the current task selected?+    taskField <- getField . (^. mode) <$> asks dsState -- get the field, if it's being edited+    after <- indicators task -- get the indicators widget+    widget <- renderText task+    let name = rn taskIndex+        widget' = widgetFromMaybe widget taskField+    pure $+        cached name .+        (if selected && not eTitle+             then visible+             else id) .+        padBottom (Pad 1) .+        (<=> withAttr disabledAttr after) .+        withAttr+            (if selected+                 then taskCurrentAttr+                 else taskAttr) $+        if selected && not eTitle+            then widget'+            else widget++renderTask :: (Int -> ResourceName) -> Int -> Int -> T.Task -> DSWidget+renderTask rn listIndex taskIndex task = do+    searchT <- (getText <$>) . (^. searchTerm) <$> asks dsState+    let taskWidget = renderTask' rn listIndex taskIndex task+    case searchT of+        Nothing -> taskWidget+        Just term ->+            if T.contains term task+                then taskWidget+                else pure emptyWidget

@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UI.Draw.Types where++import ClassyPrelude++import Brick              (Widget)+import Events.State.Types (State)+import IO.Config.Layout   (Config)+import IO.Keyboard.Types  (Bindings)+import UI.Types           (ResourceName)++data DrawState = DrawState+    { dsLayout   :: Config+    , dsBindings :: Bindings+    , dsDebug    :: Bool+    , dsState    :: State+    }++-- | Use a Reader to pass around DrawState+type ReaderDrawState = ReaderT DrawState Identity++-- | Aliases for common combinations+type TWidget = Widget ResourceName++type ModalWidget = ReaderDrawState (Text, TWidget)++type DSWidget = ReaderDrawState TWidget

@@ -1,138 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Field where--import ClassyPrelude--import qualified Data.List as L (scanl1)-import qualified Data.Text as T (splitAt, takeEnd)--import qualified Brick                     as B (Location (Location), Size (Fixed), Widget (Widget),-                                                 availWidth, getContext, render, showCursor, txt,-                                                 vBox)-import qualified Brick.Widgets.Core        as B (textWidth)-import qualified Graphics.Vty.Input.Events as V (Event (..), Key (..))--import qualified UI.Types as UI (ResourceName (RNCursor))--data Field = Field-    { _text   :: Text-    , _cursor :: Int-    } deriving (Eq, Show)--blankField :: Field-blankField = Field "" 0--event :: V.Event -> Field -> Field-event (V.EvKey (V.KChar '\t') _) f = f-event (V.EvPaste bs) f             = insertText (decodeUtf8 bs) f-event (V.EvKey V.KBS _) f          = backspace f-event (V.EvKey V.KLeft _) f        = updateCursor (-1) f-event (V.EvKey V.KRight _) f       = updateCursor 1 f-event (V.EvKey (V.KChar char) _) f = insertCharacter char f-event _ f                          = f--updateCursor :: Int -> Field -> Field-updateCursor dir (Field text cursor) = Field text newCursor-  where-    next = cursor + dir-    limit = length text-    newCursor-        | next <= 0 = 0-        | next > limit = limit-        | otherwise = next--backspace :: Field -> Field-backspace (Field text cursor) =-    let (start, end) = T.splitAt cursor text-    in case fromNullable start of-           Nothing     -> Field end cursor-           Just start' -> Field (init start' <> end) (cursor - 1)--insertCharacter :: Char -> Field -> Field-insertCharacter char (Field text cursor) = Field newText newCursor-  where-    (start, end) = T.splitAt cursor text-    newText = snoc start char <> end-    newCursor = cursor + 1--insertText :: Text -> Field -> Field-insertText insert (Field text cursor) = Field newText newCursor-  where-    (start, end) = T.splitAt cursor text-    newText = concat [start, insert, end]-    newCursor = cursor + length insert--cursorPosition :: [Text] -> Int -> Int -> (Int, Int)-cursorPosition text width cursor =-    if x == width-        then (0, y + 1)-        else (x, y)-  where-    scanned = L.scanl1 (+) $ length <$> text-    below = takeWhile (< cursor) scanned-    x = cursor - maybe 0 last (fromNullable below)-    y = length below--getText :: Field -> Text-getText (Field text _) = text--textToField :: Text -> Field-textToField text = Field text (length text)--field :: Field -> B.Widget UI.ResourceName-field (Field text cursor) =-    B.Widget B.Fixed B.Fixed $ do-        width <- B.availWidth <$> B.getContext-        let (wrapped, offset) = wrap width text-            location = cursorPosition wrapped width (cursor - offset)-        B.render $-            if null text-                then B.showCursor UI.RNCursor (B.Location (0, 0)) $ B.txt " "-                else B.showCursor UI.RNCursor (B.Location location) . B.vBox $ B.txt <$> wrapped--widgetFromMaybe :: B.Widget UI.ResourceName -> Maybe Field -> B.Widget UI.ResourceName-widgetFromMaybe _ (Just f) = field f-widgetFromMaybe w Nothing  = w--textField :: Text -> B.Widget UI.ResourceName-textField text =-    B.Widget B.Fixed B.Fixed $ do-        width <- B.availWidth <$> B.getContext-        let (wrapped, _) = wrap width text-        B.render $-            if null text-                then B.txt "---"-                else B.vBox $ B.txt <$> wrapped---- wrap-wrap :: Int -> Text -> ([Text], Int)-wrap width = foldl' (combine width) ([""], 0) . spl--spl' :: [Text] -> Char -> [Text]-spl' ts c-    | c == ' ' = ts <> [" "] <> [""]-    | otherwise =-        case fromNullable ts of-            Just ts' -> init ts' <> [snoc (last ts') c]-            Nothing  -> [singleton c]--spl :: Text -> [Text]-spl = foldl' spl' [""]--combine :: Int -> ([Text], Int) -> Text -> ([Text], Int)-combine width (acc, offset) s-    | newline && s == " " = (acc, offset + 1)-    | T.takeEnd 1 l == " " && s == " " = (acc, offset + 1)-    | newline = (acc <> [s], offset)-    | otherwise = (append (l <> s) acc, offset)-  where-    l = maybe "" last (fromNullable acc)-    newline = B.textWidth l + B.textWidth s > width--append :: Text -> [Text] -> [Text]-append s l =-    case fromNullable l of-        Just l' -> init l' <> [s]-        Nothing -> l <> [s]

@@ -1,43 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Modal-    ( showModal-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Brick-import Brick.Widgets.Border-import Brick.Widgets.Center--import Data.Taskell.Date       (Day)-import Events.State.Types      (State, mode)-import Events.State.Types.Mode (ModalType (..), Mode (..))-import IO.Keyboard.Types       (Bindings)-import UI.Field                (textField)-import UI.Modal.Detail         (detail)-import UI.Modal.Help           (help)-import UI.Modal.MoveTo         (moveTo)-import UI.Theme                (titleAttr)-import UI.Types                (ResourceName (..))--surround :: Int -> (Text, Widget ResourceName) -> Widget ResourceName-surround ht (title, widget) =-    padTopBottom 1 .-    centerLayer .-    border .-    padTopBottom 1 .-    padLeftRight 4 . vLimit (ht - 9) . hLimit 50 . (t <=>) . viewport RNModal Vertical $-    widget-  where-    t = padBottom (Pad 1) . withAttr titleAttr $ textField title--showModal :: Int -> Bindings -> State -> Day -> Widget ResourceName-showModal ht bindings state today =-    case state ^. mode of-        Modal Help      -> surround ht (help bindings)-        Modal Detail {} -> surround ht (detail state today)-        Modal MoveTo    -> surround ht (moveTo state)-        _               -> emptyWidget

@@ -1,84 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Modal.Detail-    ( detail-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Data.Sequence (mapWithIndex)--import Brick--import           Data.Taskell.Date         (Day, dayToOutput, deadline)-import qualified Data.Taskell.Subtask      as ST (Subtask, complete, name)-import           Data.Taskell.Task         (Task, description, due, name, subtasks)-import           Events.State              (getCurrentTask)-import           Events.State.Modal.Detail (getCurrentItem, getField)-import           Events.State.Types        (State)-import           Events.State.Types.Mode   (DetailItem (..))-import           UI.Field                  (Field, textField, widgetFromMaybe)-import           UI.Theme                  (disabledAttr, dlToAttr, taskCurrentAttr,-                                            titleCurrentAttr)-import           UI.Types                  (ResourceName (..))--renderSubtask :: Maybe Field -> DetailItem -> Int -> ST.Subtask -> Widget ResourceName-renderSubtask f current i subtask = padBottom (Pad 1) $ prefix <+> final-  where-    cur =-        case current of-            DetailItem c -> i == c-            _            -> False-    done = subtask ^. ST.complete-    attr =-        withAttr-            (if cur-                 then taskCurrentAttr-                 else titleCurrentAttr)-    prefix =-        attr . txt $-        if done-            then "[x] "-            else "[ ] "-    widget = textField (subtask ^. ST.name)-    final-        | cur = visible . attr $ widgetFromMaybe widget f-        | not done = attr widget-        | otherwise = widget--renderSummary :: Maybe Field -> DetailItem -> Task -> Widget ResourceName-renderSummary f i task = padTop (Pad 1) $ padBottom (Pad 2) w'-  where-    w = textField $ fromMaybe "No description" (task ^. description)-    w' =-        case i of-            DetailDescription -> visible $ widgetFromMaybe w f-            _                 -> w--renderDate :: Day -> Maybe Field -> DetailItem -> Task -> Widget ResourceName-renderDate today field item task =-    case item of-        DetailDate -> visible $ prefix <+> widgetFromMaybe widget field-        _ ->-            case day of-                Just d  -> prefix <+> withAttr (dlToAttr (deadline today d)) widget-                Nothing -> emptyWidget-  where-    day = task ^. due-    prefix = txt "Due: "-    widget = textField $ maybe "" dayToOutput day--detail :: State -> Day -> (Text, Widget ResourceName)-detail state today =-    fromMaybe ("Error", txt "Oops") $ do-        task <- getCurrentTask state-        i <- getCurrentItem state-        let f = getField state-        let sts = task ^. subtasks-            w-                | null sts = withAttr disabledAttr $ txt "No sub-tasks"-                | otherwise = vBox . toList $ renderSubtask f i `mapWithIndex` sts-        pure (task ^. name, renderDate today f i task <=> renderSummary f i task <=> w)

@@ -1,62 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Modal.Help-    ( help-    ) where--import ClassyPrelude--import Brick-import Data.Text as T (justifyRight)--import Events.Actions.Types as A (ActionType (..))-import IO.Keyboard.Types    (Bindings, bindingsToText)--import UI.Field (textField)-import UI.Theme (taskCurrentAttr)-import UI.Types (ResourceName)--descriptions :: [([ActionType], Text)]-descriptions =-    [ ([A.Help], "Show this list of controls")-    , ([A.Previous, A.Next, A.Left, A.Right], "Move down / up / left / right")-    , ([A.Bottom], "Go to bottom of list")-    , ([A.New], "Add a task")-    , ([A.NewAbove, A.NewBelow], "Add a task above / below")-    , ([A.Edit], "Edit a task")-    , ([A.Clear], "Change task")-    , ([A.Detail], "Show task details / Edit task description")-    , ([A.DueDate], "Add/edit due date (yyyy-mm-dd)")-    , ([A.MoveUp, A.MoveDown], "Shift task down / up")-    , ([A.MoveLeft, A.MoveRight], "Shift task left / right")-    , ([A.MoveMenu], "Move task to specific list")-    , ([A.Delete], "Delete task")-    , ([A.Undo], "Undo")-    , ([A.ListNew], "New list")-    , ([A.ListEdit], "Edit list title")-    , ([A.ListDelete], "Delete list")-    , ([A.ListLeft, A.ListRight], "Move list left / right")-    , ([A.Search], "Search")-    , ([A.Quit], "Quit")-    ]--generate :: Bindings -> [([Text], Text)]-generate bindings = first (intercalate ", " . bindingsToText bindings <$>) <$> descriptions--format :: ([Text], Text) -> (Text, Text)-format = first (intercalate " / ")--line :: Int -> (Text, Text) -> Widget ResourceName-line m (l, r) = left <+> right-  where-    left = padRight (Pad 2) . withAttr taskCurrentAttr . txt $ justifyRight m ' ' l-    right = textField r--help :: Bindings -> (Text, Widget ResourceName)-help bindings = ("Controls", w)-  where-    ls = format <$> generate bindings-    m = foldl' max 0 $ length . fst <$> ls-    w = vBox $ line m <$> ls

@@ -1,32 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Modal.MoveTo-    ( moveTo-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Brick--import Data.Taskell.List  (title)-import Events.State       (getCurrentList)-import Events.State.Types (State, lists)-import UI.Field           (textField)-import UI.Theme           (taskCurrentAttr)-import UI.Types           (ResourceName)--moveTo :: State -> (Text, Widget ResourceName)-moveTo state = ("Move To:", widget)-  where-    skip = getCurrentList state-    ls = toList $ state ^. lists-    titles = textField . (^. title) <$> ls-    letter a =-        padRight (Pad 1) . hBox $ [txt "[", withAttr taskCurrentAttr $ txt (singleton a), txt "]"]-    letters = letter <$> ['a' ..]-    remove i l = take i l <> drop (i + 1) l-    output (l, t) = l <+> t-    widget = vBox $ output <$> remove skip (zip letters titles)

@@ -4,13 +4,7 @@  import ClassyPrelude (Eq, Int, Ord, Show) -newtype ListIndex = ListIndex-    { showListIndex :: Int-    } deriving (Show, Eq, Ord)--newtype TaskIndex = TaskIndex-    { showTaskIndex :: Int-    } deriving (Show, Eq, Ord)+import Types (ListIndex, TaskIndex)  data ResourceName     = RNCursor@@ -18,4 +12,5 @@     | RNList Int     | RNLists     | RNModal+    | RNDue Int     deriving (Show, Eq, Ord)

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell-version: 1.5.0.0+version: 1.7.0.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales@@ -54,7 +54,8 @@         IO.Keyboard         IO.Keyboard.Parser         IO.Keyboard.Types-        UI.Field+        UI.Draw.Field+        Types     hs-source-dirs: src     other-modules:         Config@@ -62,11 +63,13 @@         Events.Actions.Insert         Events.Actions.Modal         Events.Actions.Modal.Detail+        Events.Actions.Modal.Due         Events.Actions.Modal.Help         Events.Actions.Modal.MoveTo         Events.Actions.Normal         Events.Actions.Search         Events.State.Modal.Detail+        Events.State.Modal.Due         IO.Config.General         IO.Config.GitHub         IO.Config.Layout@@ -81,18 +84,26 @@         IO.Markdown         UI.CLI         UI.Draw-        UI.Modal-        UI.Modal.Detail-        UI.Modal.Help-        UI.Modal.MoveTo+        UI.Draw.Main+        UI.Draw.Main.List+        UI.Draw.Main.Search+        UI.Draw.Main.StatusBar+        UI.Draw.Modal+        UI.Draw.Modal.Detail+        UI.Draw.Modal.Due+        UI.Draw.Modal.Help+        UI.Draw.Modal.MoveTo+        UI.Draw.Mode+        UI.Draw.Task+        UI.Draw.Types         UI.Theme         UI.Types         Paths_taskell     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude     build-depends:-        aeson >=1.4.2.0 && <1.5,-        attoparsec >=0.13.2.2 && <0.14,+        aeson >=1.4.5.0 && <1.5,+        attoparsec >=0.13.2.3 && <0.14,         base >=4.12.0.0 && <=5,         brick >=0.47.1 && <0.48,         bytestring >=0.10.8.2 && <0.11,@@ -101,9 +112,9 @@         containers >=0.6.0.1 && <0.7,         directory >=1.3.3.0 && <1.4,         file-embed >=0.0.11 && <0.1,-        fold-debounce >=0.2.0.8 && <0.3,-        http-client >=0.5.14 && <0.6,-        http-conduit >=2.3.7.1 && <2.4,+        fold-debounce >=0.2.0.9 && <0.3,+        http-client >=0.6.4 && <0.7,+        http-conduit >=2.3.7.3 && <2.4,         http-types >=0.12.3 && <0.13,         lens >=4.17.1 && <4.18,         mtl >=2.2.2 && <2.3,@@ -150,7 +161,7 @@     default-extensions: OverloadedStrings NoImplicitPrelude     ghc-options: -threaded -rtsopts -with-rtsopts=-N     build-depends:-        aeson >=1.4.2.0 && <1.5,+        aeson >=1.4.5.0 && <1.5,         base >=4.12.0.0 && <4.13,         classy-prelude >=1.5.0 && <1.6,         containers >=0.6.0.1 && <0.7,@@ -158,10 +169,10 @@         lens >=4.17.1 && <4.18,         raw-strings-qq ==1.1.*,         taskell -any,-        tasty ==1.2.*,+        tasty >=1.2.3 && <1.3,         tasty-discover >=4.2.1 && <4.3,-        tasty-expected-failure >=0.11.1.1 && <0.12,-        tasty-hunit >=0.10.0.1 && <0.11,+        tasty-expected-failure >=0.11.1.2 && <0.12,+        tasty-hunit >=0.10.0.2 && <0.11,         text >=1.2.3.1 && <1.3,         time >=1.8.0.2 && <1.9,         vty >=5.25.1 && <5.26

@@ -3,6 +3,7 @@ undo = u search = / help = ?+due = !  # navigation previous = k@@ -15,6 +16,7 @@ new = a newAbove = O newBelow = o+duplicate = +  # editing tasks edit = e, A, i@@ -22,12 +24,14 @@ delete = D detail = <Enter> dueDate = @+clearDate = <Backspace>  # moving tasks moveUp = K moveDown = J moveLeft = H-moveRight = L, <Space>+moveRight = L+complete = <Space> moveMenu = m  # lists

@@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-}  module Data.Taskell.ListNavigationTest-    ( test_list+    ( test_listNav     ) where  import ClassyPrelude as CP@@ -28,8 +28,8 @@ list = List "Populated" taskSeq  -- tests-test_list :: TestTree-test_list =+test_listNav :: TestTree+test_listNav =     testGroup         "Data.Taskell.List Navigation"         [ testGroup@@ -74,5 +74,8 @@               , testCase                     "out of bounds with no term"                     (assertEqual "nothing" 5 (L.nearest 50 Nothing list))+              , testCase+                    "out of bounds by 1 with no term"+                    (assertEqual "nothing" 5 (L.nearest 6 Nothing list))               ]         ]

@@ -92,37 +92,61 @@                     (assertEqual                          "List with moved item"                          (Just-                              (List-                                   "Populated"-                                   (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])))-                         (move 1 1 populatedList))+                              ( List+                                    "Populated"+                                    (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])+                              , 2))+                         (move 1 1 Nothing populatedList))               , testCase                     "down"                     (assertEqual                          "List with moved item"                          (Just-                              (List-                                   "Populated"-                                   (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])))-                         (move 1 (-1) populatedList))+                              ( List+                                    "Populated"+                                    (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])+                              , 0))+                         (move 1 (-1) Nothing populatedList))               , testCase                     "up - out of bounds"                     (assertEqual                          "List with moved item"                          (Just-                              (List-                                   "Populated"-                                   (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])))-                         (move 1 10 populatedList))+                              ( List+                                    "Populated"+                                    (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])+                              , 2))+                         (move 1 10 Nothing populatedList))               , testCase                     "down - out of bounds"                     (assertEqual                          "List with moved item"                          (Just-                              (List-                                   "Populated"-                                   (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])))-                         (move 1 (-10) populatedList))+                              ( List+                                    "Populated"+                                    (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])+                              , 0))+                         (move 1 (-10) Nothing populatedList))+              , testCase+                    "up - with search"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Blah", T.new "Fish", T.new "Hello"])+                              , 2))+                         (move 0 1 (Just "Fish") populatedList))+              , testCase+                    "down - with search"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Fish", T.new "Hello", T.new "Blah"])+                              , 0))+                         (move 2 (-1) (Just "Hello") populatedList))               ]         , testCase               "deleteTask"

@@ -13,14 +13,27 @@ import qualified Data.Taskell.List           as L import           Data.Taskell.Lists.Internal import qualified Data.Taskell.Task           as T+import           Types                       (ListIndex (ListIndex), TaskIndex (TaskIndex))  -- test data list1, list2, list3 :: L.List-list1 = foldl' (flip L.append) (L.empty "List 1") [T.new "One", T.new "Two", T.new "Three"]+list1 =+    foldl'+        (flip L.append)+        (L.empty "List 1")+        [T.new "One", T.setDue "2019-08-14" (T.new "Two"), T.new "Three"] -list2 = foldl' (flip L.append) (L.empty "List 2") [T.new "1", T.new "2", T.new "3"]+list2 =+    foldl'+        (flip L.append)+        (L.empty "List 2")+        [T.new "1", T.new "2", T.setDue "2018-12-03" (T.new "3")] -list3 = foldl' (flip L.append) (L.empty "List 3") [T.new "01", T.new "10", T.new "11"]+list3 =+    foldl'+        (flip L.append)+        (L.empty "List 3")+        [T.setDue "2019-04-05" (T.new "01"), T.new "10", T.new "11"]  testLists :: Lists testLists = fromList [list1, list2, list3]@@ -68,13 +81,17 @@                                    , foldl'                                          (flip L.append)                                          (L.empty "List 2")-                                         [T.new "1", T.new "3"]+                                         [T.new "1", T.setDue "2018-12-03" (T.new "3")]                                    , foldl'                                          (flip L.append)                                          (L.empty "List 3")-                                         [T.new "01", T.new "10", T.new "11", T.new "2"]+                                         [ T.setDue "2019-04-05" (T.new "01")+                                         , T.new "10"+                                         , T.new "11"+                                         , T.new "2"+                                         ]                                    ]))-                         (changeList (1, 1) testLists 1))+                         (changeList (ListIndex 1, TaskIndex 1) testLists 1))               , testCase                     "left"                     (assertEqual@@ -84,20 +101,30 @@                                    [ foldl'                                          (flip L.append)                                          (L.empty "List 1")-                                         [T.new "One", T.new "Two", T.new "Three", T.new "2"]+                                         [ T.new "One"+                                         , T.setDue "2019-08-14" (T.new "Two")+                                         , T.new "Three"+                                         , T.new "2"+                                         ]                                    , foldl'                                          (flip L.append)                                          (L.empty "List 2")-                                         [T.new "1", T.new "3"]+                                         [T.new "1", T.setDue "2018-12-03" (T.new "3")]                                    , list3                                    ]))-                         (changeList (1, 1) testLists (-1)))+                         (changeList (ListIndex 1, TaskIndex 1) testLists (-1)))               , testCase                     "out of bounds list"-                    (assertEqual "Nothing" Nothing (changeList (5, 1) testLists 1))+                    (assertEqual+                         "Nothing"+                         Nothing+                         (changeList (ListIndex 5, TaskIndex 1) testLists 1))               , testCase                     "out of bounds task"-                    (assertEqual "Nothing" Nothing (changeList (1, 10) testLists 1))+                    (assertEqual+                         "Nothing"+                         Nothing+                         (changeList (ListIndex 1, TaskIndex 10) testLists 1))               ]         , testCase               "newList"@@ -173,7 +200,11 @@                               , foldl'                                     (flip L.append)                                     (L.empty "List 3")-                                    [T.new "01", T.new "10", T.new "11", T.new "Blah"]+                                    [ T.setDue "2019-04-05" (T.new "01")+                                    , T.new "10"+                                    , T.new "11"+                                    , T.new "Blah"+                                    ]                               ])                          (appendToLast (T.new "Blah") testLists))               , testCase@@ -186,4 +217,14 @@                    "Returns an analysis"                    "test.md\nLists: 3\nTasks: 9"                    (analyse "test.md" testLists))+        , testCase+              "due"+              (assertEqual+                   "returns just due list"+                   (fromList+                        [ ((ListIndex 1, TaskIndex 2), T.setDue "2018-12-03" (T.new "3"))+                        , ((ListIndex 2, TaskIndex 0), T.setDue "2019-04-05" (T.new "01"))+                        , ((ListIndex 0, TaskIndex 1), T.setDue "2019-08-14" (T.new "Two"))+                        ])+                   (due testLists))         ]

@@ -12,24 +12,31 @@  import Control.Lens ((&), (.~), (^.)) +import Data.Time.Clock (secondsToDiffTime)+ import qualified Data.Sequence           as S (lookup) import qualified Data.Taskell.List       as L (append, empty) import qualified Data.Taskell.Task       as T (new) import           Events.State import           Events.State.Types import           Events.State.Types.Mode+import           Types                   (ListIndex (..), TaskIndex (..)) +mockTime :: UTCTime+mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)+ testState :: State testState =     State     { _mode = Normal     , _lists = empty     , _history = []-    , _current = (0, 0)+    , _current = (ListIndex 0, TaskIndex 0)     , _path = "test.md"     , _io = Nothing     , _height = 0     , _searchTerm = Nothing+    , _time = mockTime     }  moveToState :: State@@ -49,11 +56,12 @@               , L.empty "List 9"               ]     , _history = []-    , _current = (4, 0)+    , _current = (ListIndex 4, TaskIndex 0)     , _path = "test.md"     , _io = Nothing     , _height = 0     , _searchTerm = Nothing+    , _time = mockTime     }  -- tests

@@ -44,6 +44,7 @@     , (BChar 'u', A.Undo)     , (BChar '/', A.Search)     , (BChar '?', A.Help)+    , (BChar '!', A.Due)     , (BChar 'k', A.Previous)     , (BChar 'j', A.Next)     , (BChar 'h', A.Left)@@ -52,6 +53,7 @@     , (BChar 'a', A.New)     , (BChar 'O', A.NewAbove)     , (BChar 'o', A.NewBelow)+    , (BChar '+', A.Duplicate)     , (BChar 'e', A.Edit)     , (BChar 'A', A.Edit)     , (BChar 'i', A.Edit)

@@ -22,6 +22,7 @@     [ (BChar 'œ', A.Quit)     , (BChar 'U', A.Undo)     , (BChar '/', A.Search)+    , (BChar '!', A.Due)     , (BChar '?', A.Help)     , (BChar 'k', A.Previous)     , (BChar 'j', A.Next)@@ -31,6 +32,7 @@     , (BChar 'a', A.New)     , (BChar 'O', A.NewAbove)     , (BChar 'o', A.NewBelow)+    , (BChar '+', A.Duplicate)     , (BChar 'e', A.Edit)     , (BChar 'A', A.Edit)     , (BChar 'i', A.Edit)@@ -38,11 +40,12 @@     , (BChar 'D', A.Delete)     , (BKey "Enter", A.Detail)     , (BChar '@', A.DueDate)+    , (BKey "Backspace", A.ClearDate)     , (BChar 'K', A.MoveUp)     , (BChar 'J', A.MoveDown)     , (BChar 'H', A.MoveLeft)     , (BChar 'L', A.MoveRight)-    , (BKey "Space", A.MoveRight)+    , (BKey "Space", A.Complete)     , (BChar 'm', A.MoveMenu)     , (BChar 'N', A.ListNew)     , (BChar 'E', A.ListEdit)

@@ -13,6 +13,8 @@  import Control.Lens ((.~)) +import Data.Time.Clock (secondsToDiffTime)+ import Data.Taskell.Lists.Internal (initial) import Events.Actions.Types        as A import Events.State                (create, quit)@@ -22,11 +24,14 @@ import IO.Keyboard                 (generate) import IO.Keyboard.Types +mockTime :: UTCTime+mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)+ tester :: BoundActions -> Event -> Stateful tester actions ev state = lookup ev actions >>= ($ state)  cleanState :: State-cleanState = create "taskell.md" initial+cleanState = create mockTime "taskell.md" initial  basicBindings :: Bindings basicBindings = [(BChar 'q', A.Quit)]

@@ -122,7 +122,7 @@                           (assertEqual                                "List item with Sub-Task"                                (makeSubTask "Blah" True, [])-                               (start defaultConfig (listWithItem, []) ("    * ~Blah~", 1)))+                               (start defaultConfig (listWithItem, []) ("    * [x] Blah", 1)))                     , ignoreTest $                       testCase                           "List item without list"@@ -194,12 +194,6 @@                                "List item with Sub-Task"                                (makeSubTask "Blah" False, [])                                (start alternativeConfig (listWithItem, []) ("- Blah", 1)))-                    , testCase-                          "Complete Sub-Task (old style)"-                          (assertEqual-                               "List item with Sub-Task"-                               (makeSubTask "Blah" True, [])-                               (start alternativeConfig (listWithItem, []) ("- ~Blah~", 1)))                     ]               ]         , testGroup

@@ -7,8 +7,8 @@  import ClassyPrelude -import UI.Field (Field (Field), backspace, cursorPosition, insertCharacter, insertText,-                 updateCursor, wrap)+import UI.Draw.Field (Field (Field), backspace, cursorPosition, insertCharacter, insertText,+                      updateCursor, wrap)  import Test.Tasty import Test.Tasty.HUnit@@ -24,7 +24,7 @@ test_field :: TestTree test_field =     testGroup-        "UI.Field"+        "UI.Draw.Field"         [ testGroup               "Field cursor left"               [ testCase@@ -148,10 +148,27 @@                          (6, 1)                          (cursorPosition' "Artichoke penguin astronaut wombat" 34))               , testCase+                    "Triple line"+                    (assertEqual+                         "Should wrap to correct position"+                         (11, 2)+                         (cursorPosition'+                              "Artichoke penguin astronaut wombat artichoke penguin astronaut wombat"+                              64))+              , testCase                     "Long words with space"                     (assertEqual                          "Should ignore the space when counting"                          (16, 1)                          (cursorPosition' "Blah fish wombat monkey sponge catpult arsonist" 47))+              , testCase+                    "Multibyte string single line"+                    (assertEqual "Should move in twos" (4, 0) (cursorPosition' "乤乭亍乫" 2))+              , testCase+                    "Multibyte string multi-line"+                    (assertEqual+                         "Should move in twos"+                         (4, 1)+                         (cursorPosition' "乤乭亍乫 乤乭亍乫 乤乭亍乫 乤乭亍乫" 17))               ]         ]