packages feed

taskell (empty) → 1.3.5.0

raw patch · 76 files changed

+5176/−0 lines, 76 filesdep +aesondep +basedep +bricksetup-changed

Dependencies added: aeson, base, brick, bytestring, classy-prelude, config-ini, containers, directory, file-embed, fold-debounce, http-client, http-conduit, http-types, lens, mtl, taskell, tasty, tasty-discover, tasty-expected-failure, tasty-hunit, template-haskell, text, time, vty

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Mark Wales (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mark Wales nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,289 @@+# Taskell++[![Build Status](https://travis-ci.org/smallhadroncollider/taskell.svg?branch=master)](https://travis-ci.org/smallhadroncollider/taskell)++A CLI kanban board/task manager for Mac and Linux++- Per project task lists+- `vim` style key-bindings+- Stored using Markdown+- Clean diffs for easy version control+- Support for sub-tasks and due dates+- Trello board imports+- GitHub project imports++<a href="https://www.buymeacoffee.com/shc" target="_blank"><img src="https://www.buymeacoffee.com/assets/img/custom_images/orange_img.png" alt="Buy Me A Coffee" style="height: 41px !important;width: 174px !important;box-shadow: 0px 3px 2px 0px rgba(190, 190, 190, 0.5) !important;-webkit-box-shadow: 0px 3px 2px 0px rgba(190, 190, 190, 0.5) !important;" ></a>++Follow [@taskellcli](https://twitter.com/taskellcli) on Twitter for updates++![Demo](https://taskell.app/img/demo.gif)++---++## Contents++- [Installation](#installation)+- [Using Taskell](#using-taskell)+    - [Options](#options)+    - [Controls](#controls)+    - [Storage](#storage)+    - [Importing Trello Boards](#importing-trello-boards)+    - [Importing GitHub Projects](#importing-github-projects)+- [Configuration](#configuration)+    - [Theming](#theming)+- [Roadmap](#roadmap)++## Installation++### Homebrew (Mac)++You can install Taskell on your Mac using [Homebrew](https://brew.sh):++```bash+brew install taskell+```++There are usually bottles (binaries) available. If these are not available for your computer, Homebrew will build Taskell from scratch, which can take a while, particularly on older machines. Occasionally the build fails the first time, but usually works on a second attempt.++### Debian/Ubuntu++[A `.deb` package is available for Debian/Ubuntu](https://github.com/smallhadroncollider/taskell/releases). Download it and install with `dpkg -i <package-name>`.++### Fedora++Run `sudo dnf install ncurses-compat-libs` then download and run binary as described below.++### Binaries++[A binary is available for Mac and Linux](https://github.com/smallhadroncollider/taskell/releases). Download it and copy it to a directory in your `$PATH` (e.g. `/usr/local/bin` or `/usr/bin`).++### Stack++If none of the above options work you can build taskell using [Stack](https://docs.haskellstack.org/en/stable/README/). First [install Stack on your machine](https://docs.haskellstack.org/en/stable/README/#how-to-install). Then clone the repo and run `stack build && stack install`: this will build taskell and then install it in `~/.local/bin` (so make sure that directory is in your `$PATH`). Building from scratch can take a long time and occasionally doesn't work the first time (if this happens try running it again).++## Using Taskell++- `taskell`: will use `taskell.md` in the pwd - offers to create if not found+- `taskell filename.md`: will use `filename.md` in the pwd - offers to create if not found++### Options++- `-h`: show help+- `-v`: show version number+- `-t <trello-board-id>`: import a Trello board ([see below](#importing-trello-boards))+- `-g <github-project-id>`: import a GitHub project ([see below](#importing-github-projects))++### Controls++Press `?` for a [list of controls](https://github.com/smallhadroncollider/taskell/blob/master/templates/controls.md)++#### Tips++- If you're using a simple two-column "To Do" and "Done" then use the space bar to mark an item as complete while staying in the "To Do" list. If you're using a more complicated column setup then you will want to use `H`/`L` to move tasks between columns.++### Storage++By default stores in a `taskell.md` file in the working directory:++```md+## To Do++- Do this++## Done++- Do That+```++### Importing Trello Boards++Taskell includes the ability to fetch a Trello board and store it as local taskell file.++#### Authentication++Before fetching a Trello board, you'll need to create an access token and store it in `~/.taskell/config.ini`.++- First, [get a Trello token](https://trello.com/1/authorize?expiration=never&name=taskell&scope=read&response_type=token&key=80dbcf6f88f62cc5639774e13342c20b)+- Then add it to `~/.taskell/config.ini`:++    ```ini+    [trello]+    token = <your-trello-access-token>+    ```++You can revoke access tokens [on Trello](https://trello.com/my/account)++#### Fetching++Running the following would pull down the Trello board with the ID "TRe1l0iD" into a file named `trello.md` and then open taskell with that file.++```bash+taskell -t TRe1l0iD trello.md+```++Make sure you have permission to view the Trello board, otherwise you'll get an error.++#### Limitations++- This is a one-off procedure: it effectively imports a Trello board to taskell+- Currently imports:+    - Lists+    - Cards+    - Card descriptions+    - Card due dates+    - Card checklists (merged into one list per card)+++### Importing GitHub Projects++Taskell includes the ability to fetch a GitHub project and store it as local taskell file.++#### Authentication++Before fetching a GitHub board, you'll need to create a person access token and store it in `~/.taskell/config.ini`.++- First, [get a GitHub personal access token](https://github.com/settings/tokens/new)+- Make sure to tick the `repo` scope+- Then add it to `~/.taskell/config.ini`:++    ```ini+    [github]+    token = <your-github-personal-access-token>+    ```++You can delete personal access tokens [on GitHub](https://github.com/settings/tokens/)++#### Fetching++Projects can belong to [organisations](#organisations) or to [individual repositories](#repositories).++Make sure you have permission to view the GitHub project, otherwise you'll get an error.++![GitHub Demo](https://taskell.app/img/github.gif)++##### Organisations++To import a project for an organisation called "test-org" you would use the following:++```bash+taskell -g orgs/test-org github.md+```++This would then show you a list of possible projects to import. Enter the number of the project you wish to import.++##### Repositories++To import a project for the repository "test-repo" for the user "test-user":++```bash+taskell -g repos/test-user/test-repo github.md+```++This would then show you a list of possible projects to import. Enter the number of the project you with to import.++#### Limitations++- This is a one-off procedure: it effectively imports a GitHub project to taskell+- Currently imports:+    - Columns+    - Cards++++## Configuration++You can edit Taskell's settings by editing `~/.taskell/config.ini`:++```ini+[general]+; the default filename to create/look for+filename = taskell.md++[layout]+; the width of a column+column_width = 30++; the padding of a column+; for both sides, so 3 would give a gap of 6 between two columns+column_padding = 3++; the icon to use when a task has a description+; the default icon may not display on all systems+description_indicator = "≡"++[markdown]+; the markdown to start a title line with+title = "##"++; the markdown to start a task line with+task = "-"++; the markdown to start a sub-task line with+subtask = "    *"+```++Make sure that the values in the `[markdown]` section are surrounded by **double**-quotes.++If you always use sub-tasks, an alternative setup for `[markdown]` might be:++```ini+[markdown]+title = "##"++; each task is a header+task = "###"++; subtasks are list items under the header+subtask = "-"+```++**Warning**: currently if you change your `[markdown]` settings any older files stored with different settings will not be readable.++### Theming++You can edit Taskell's colour-scheme by editing `~/.taskell/theme.ini`:++```ini+[other]++; list title+title.fg = green++; current list title+titleCurrent.fg = blue++; current task+taskCurrent.fg = magenta+```++You can also change the background and default text colour:++```ini+[default]++; the app background colour+default.bg = brightBlack++; the app text colour+default.fg = white+```++The available colours are: `black`, `red`, `green`, `yellow`, `blue`, `magenta`, `cyan`, `white`, `brightBlack`, `brightRed`, `brightGreen`, `brightYellow`, `brightBlue`, `brightMagenta`, `brightCyan`, `brightWhite`, or `default`++---++## Roadmap++See [roadmap.md](https://github.com/smallhadroncollider/taskell/blob/develop/roadmap.md) for planned features++### Contributing++Please check the [roadmap.md](https://github.com/smallhadroncollider/taskell/blob/develop/roadmap.md) before adding any bugs/feature requests to Issues.++Anyone is welcome to contribute to the project, but please read through [CONTRIBUTING.md](https://github.com/smallhadroncollider/taskell/blob/master/CONTRIBUTING.md) and make sure that you agree with the [Code of Conduct](https://github.com/smallhadroncollider/taskell/blob/master/CODE_OF_CONDUCT.md) before getting involved.++---++## Acknowledgements++Built using [Brick](https://github.com/jtdaugherty/brick). Thanks to [Jonathan Daugherty](https://github.com/jtdaugherty) for answering all my questions and pointing me in the right direction. Also thanks to [Jack Leigh](https://github.com/leighman) and [Thom Wright](https://github.com/ThomWright) for helping me get started. Also thanks to [Katja Durrani](https://github.com/katjad) for submitting Taskell to [`homebrew-core`](https://github.com/Homebrew/homebrew-core).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Main where++import ClassyPrelude++import App          (go)+import Events.State (create)+import IO.Config    (setup)+import IO.Taskell   (Next (..), load)++main :: IO ()+main = do+    config <- setup+    next <- runReaderT load config+    case next of+        Exit            -> return ()+        Output text     -> putStrLn text+        Load path lists -> go config $ create path lists
+ src/App.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE NoImplicitPrelude #-}++module App+    ( go+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick+import Graphics.Vty              (Mode (BracketedPaste), 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          (event)+import Events.State            (continue, countCurrent)+import Events.State.Types      (State, current, io, lists, mode, path)+import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))+import IO.Config               (Config, generateAttrMap, layout)+import IO.Taskell              (writeData)+import UI.Draw                 (chooseCursor, draw)+import UI.Types                (ResourceName (..))++type DebouncedMessage = (Lists, FilePath)++type DebouncedWrite = DebouncedMessage -> IO ()++type Trigger = Debounce.Trigger DebouncedMessage DebouncedMessage++-- store+store :: Config -> DebouncedMessage -> IO ()+store config (ls, pth) = writeData config ls pth++next :: DebouncedWrite -> State -> EventM ResourceName (Next State)+next send state =+    case state ^. io of+        Just ls -> do+            invalidateCache+            liftIO $ send (ls, state ^. path)+            Brick.continue $ Events.State.continue state+        Nothing -> Brick.continue state++-- debouncing+debounce :: Config -> State -> IO (DebouncedWrite, Trigger)+debounce config initial = do+    trigger <-+        Debounce.new+            Debounce.Args+            { Debounce.cb = store config+            , Debounce.fold = \_ b -> b+            , Debounce.init = (initial ^. lists, initial ^. path)+            }+            Debounce.def+    let send = Debounce.send trigger+    return (send, trigger)++-- cache clearing+clearCache :: State -> EventM ResourceName ()+clearCache state = do+    let (li, ti) = state ^. current+    invalidateCacheEntry (RNList li)+    invalidateCacheEntry (RNTask (li, ti))++clearAllTitles :: State -> EventM ResourceName ()+clearAllTitles state = do+    let count = length (state ^. lists)+    let range = [0 .. (count - 1)]+    void . sequence $ invalidateCacheEntry . RNList <$> range+    void . sequence $ invalidateCacheEntry . (\x -> RNTask (x, -1)) <$> range++clearList :: State -> EventM ResourceName ()+clearList state = do+    let (list, _) = state ^. current+    let count = countCurrent state+    let range = [0 .. (count - 1)]+    invalidateCacheEntry $ RNList list+    void . sequence $ invalidateCacheEntry . (\x -> RNTask (list, x)) <$> range++-- event handling+handleVtyEvent :: (DebouncedWrite, Trigger) -> State -> Event -> EventM ResourceName (Next State)+handleVtyEvent (send, trigger) previousState e = do+    let state = event e previousState+    case previousState ^. mode of+        Search _ _               -> invalidateCache+        (Modal MoveTo)           -> clearAllTitles previousState+        (Insert ITask ICreate _) -> clearList previousState+        _                        -> return ()+    case state ^. mode of+        Shutdown -> liftIO (Debounce.close trigger) >> Brick.halt state+        (Modal MoveTo) -> clearAllTitles state >> next send state+        (Insert ITask ICreate _) -> clearList state >> next send state+        _ -> clearCache previousState >> clearCache state >> next send state++handleEvent ::+       (DebouncedWrite, Trigger)+    -> State+    -> BrickEvent ResourceName e+    -> EventM ResourceName (Next State)+handleEvent _ state (VtyEvent (EvResize _ _)) = invalidateCache >> Brick.continue state+handleEvent db state (VtyEvent ev)            = handleVtyEvent db state ev+handleEvent _ state _                         = Brick.continue state++-- | Runs when the app starts+--   Adds paste support+appStart :: State -> EventM ResourceName State+appStart state = do+    vty <- getVtyHandle+    let output = outputIface vty+    when (supportsMode output BracketedPaste) $ liftIO $ setMode output BracketedPaste True+    return state++-- | Sets up Brick+go :: Config -> State -> IO ()+go config initial = do+    attrMap' <- const <$> generateAttrMap+    today <- currentDay+    db <- debounce config initial+    let app =+            App+            { appDraw = draw (layout config) today+            , appChooseCursor = chooseCursor+            , appHandleEvent = handleEvent db+            , appStartEvent = appStart+            , appAttrMap = attrMap'+            }+    void (defaultMain app initial)
+ src/Config.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Config where++import ClassyPrelude++import Data.FileEmbed (embedFile)++version :: Text+version = "1.3.5"++usage :: Text+usage = decodeUtf8 $(embedFile "templates/usage.txt")
+ src/Data/Taskell/Date.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.Date+    ( Day+    , Deadline(..)+    , DeadlineFn+    , dayToText+    , dayToOutput+    , textToDay+    , utcToLocalDay+    , currentDay+    , deadline+    ) where++import ClassyPrelude++import Data.Time           (Day)+import Data.Time.Calendar  (diffDays, toGregorian)+import Data.Time.Clock     (secondsToDiffTime)+import Data.Time.Format    (formatTime, parseTimeM)+import Data.Time.LocalTime (TimeZone, localDay, utcToZonedTime, zonedTimeToLocalTime)++data Deadline+    = Passed+    | Today+    | Tomorrow+    | ThisWeek+    | Plenty+    deriving (Show, Eq)++type DeadlineFn = Day -> Deadline++dayToText :: Day -> Day -> Text+dayToText today day = pack $ formatTime defaultTimeLocale format (UTCTime day (secondsToDiffTime 0))+  where+    (currentYear, _, _) = toGregorian today+    (dateYear, _, _) = toGregorian day+    format =+        if currentYear == dateYear+            then "%d-%b"+            else "%d-%b %Y"++dayToOutput :: Day -> Text+dayToOutput day = pack $ formatTime defaultTimeLocale "%Y-%m-%d" (UTCTime day (secondsToDiffTime 0))++utcToLocalDay :: TimeZone -> UTCTime -> Day+utcToLocalDay tz = localDay . zonedTimeToLocalTime . utcToZonedTime tz++textToTime :: Text -> Maybe UTCTime+textToTime = parseTimeM False defaultTimeLocale "%Y-%m-%d" . unpack++textToDay :: Text -> Maybe Day+textToDay = (utctDay <$>) . textToTime++currentDay :: IO Day+currentDay = utctDay <$> getCurrentTime++-- work out the deadline+deadline :: Day -> Day -> Deadline+deadline today date+    | days < 0 = Passed+    | days == 0 = Today+    | days == 1 = Tomorrow+    | days < 7 = ThisWeek+    | otherwise = Plenty+  where+    days = diffDays date today
+ src/Data/Taskell/List.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Taskell.List+    ( List+    , title+    , tasks+    , create+    , empty+    , new+    , count+    , newAt+    , append+    , extract+    , updateFn+    , update+    , move+    , deleteTask+    , getTask+    , searchFor+    ) where++import Data.Taskell.List.Internal
+ src/Data/Taskell/List/Internal.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Taskell.List.Internal where++import ClassyPrelude++import Control.Lens (ix, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?))++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)++data List = List+    { _title :: Text+    , _tasks :: Seq T.Task+    } deriving (Show, Eq)++type Update = List -> List++-- create lenses+$(makeLenses ''List)++-- operations+create :: Text -> Seq T.Task -> List+create = List++empty :: Text -> List+empty text = List text ClassyPrelude.empty++new :: Update+new = append T.blank++count :: List -> Int+count = length . (^. tasks)++newAt :: Int -> Update+newAt idx = tasks %~ insertAt idx T.blank++append :: T.Task -> Update+append task = tasks %~ (|> task)++extract :: Int -> List -> Maybe (List, T.Task)+extract idx list = do+    (xs, x) <- S.extract idx (list ^. tasks)+    return (list & tasks .~ xs, x)++updateFn :: Int -> T.Update -> Update+updateFn idx fn = tasks %~ adjust' fn idx++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++deleteTask :: Int -> Update+deleteTask idx = tasks %~ deleteAt idx++getTask :: Int -> List -> Maybe T.Task+getTask idx = (^? tasks . ix idx)++searchFor :: Text -> Update+searchFor text = tasks %~ filter (T.contains text)
+ src/Data/Taskell/Lists.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Taskell.Lists+    ( Lists+    , initial+    , updateLists+    , count+    , get+    , changeList+    , newList+    , delete+    , exists+    , shiftBy+    , search+    , appendToLast+    , analyse+    ) where++import Data.Taskell.Lists.Internal
+ src/Data/Taskell/Lists/Internal.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.Lists.Internal where++import ClassyPrelude hiding (empty)++import Data.Sequence as S (deleteAt, update, (!?), (|>))++import           Data.Taskell.List as L (List, append, count, empty, extract, searchFor)+import qualified Data.Taskell.Seq  as S+import           Data.Taskell.Task (Task)++type Lists = Seq List++type Update = Lists -> Lists++initial :: Lists+initial = fromList [empty "To Do", empty "Done"]++updateLists :: Int -> List -> Update+updateLists = S.update++count :: Int -> Lists -> Int+count idx tasks = maybe 0 L.count (tasks !? idx)++get :: Lists -> Int -> Maybe List+get = (!?)++changeList :: (Int, Int) -> Lists -> Int -> Maybe Lists+changeList (list, 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+    return . updateLists next to $ updateLists list from tasks -- update lists++newList :: Text -> Update+newList title = (|> empty title)++delete :: Int -> Update+delete = deleteAt++exists :: Int -> Lists -> Bool+exists idx tasks = isJust $ tasks !? idx++shiftBy :: Int -> Int -> Lists -> Maybe Lists+shiftBy = S.shiftBy++search :: Text -> Update+search text = (searchFor text <$>)++appendToLast :: Task -> Update+appendToLast task lists =+    fromMaybe lists $ do+        let idx = length lists - 1+        list <- append task <$> lists !? idx+        return $ updateLists idx list lists++analyse :: Text -> Lists -> Text+analyse filepath lists =+    concat+        [ filepath+        , "\n"+        , "Lists: "+        , tshow $ length lists+        , "\n"+        , "Tasks: "+        , tshow $ foldl' (+) 0 (L.count <$> lists)+        ]
+ src/Data/Taskell/Seq.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Taskell.Seq where++import ClassyPrelude++import Data.Sequence (deleteAt, insertAt, (!?))++extract :: Int -> Seq a -> Maybe (Seq a, a)+extract idx xs = (,) (deleteAt idx xs) <$> xs !? idx++shiftBy :: Int -> Int -> Seq a -> Maybe (Seq a)+shiftBy idx dir xs = do+    (a, current) <- extract idx xs+    return $ insertAt (idx + dir) current a
+ src/Data/Taskell/Subtask.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Taskell.Subtask+    ( Subtask+    , Update+    , new+    , blank+    , name+    , complete+    , toggle+    ) where++import Data.Taskell.Subtask.Internal
+ src/Data/Taskell/Subtask/Internal.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.Subtask.Internal where++import ClassyPrelude+import Control.Lens  (makeLenses, (%~))++data Subtask = Subtask+    { _name     :: Text+    , _complete :: Bool+    } deriving (Show, Eq)++type Update = Subtask -> Subtask++-- create lenses+$(makeLenses ''Subtask)++-- operations+blank :: Subtask+blank = Subtask "" False++new :: Text -> Bool -> Subtask+new = Subtask++toggle :: Update+toggle = complete %~ not
+ src/Data/Taskell/Task.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Taskell.Task+    ( Task+    , Update+    , name+    , description+    , due+    , subtasks+    , blank+    , new+    , setDescription+    , appendDescription+    , setDue+    , getSubtask+    , addSubtask+    , hasSubtasks+    , updateSubtask+    , removeSubtask+    , countSubtasks+    , countCompleteSubtasks+    , contains+    , isBlank+    ) where++import Data.Taskell.Task.Internal
+ src/Data/Taskell/Task/Internal.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.Task.Internal where++import ClassyPrelude++import Control.Lens (ix, makeLenses, (%~), (&), (.~), (^.), (^?))++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           Data.Text            (strip)++data Task = Task+    { _name        :: Text+    , _description :: Maybe Text+    , _subtasks    :: Seq ST.Subtask+    , _due         :: Maybe Day+    } deriving (Show, Eq)++type Update = Task -> Task++-- create lenses+$(makeLenses ''Task)++-- operations+blank :: Task+blank = Task "" Nothing empty Nothing++new :: Text -> Task+new text = blank & (name .~ text)++setDescription :: Text -> Update+setDescription text =+    if null (strip text)+        then id+        else description .~ Just text++maybeAppend :: Text -> Maybe Text -> Maybe Text+maybeAppend text (Just current) = Just (concat [current, "\n", text])+maybeAppend text Nothing        = Just text++appendDescription :: Text -> Update+appendDescription text =+    if null (strip text)+        then id+        else description %~ maybeAppend text++setDue :: Text -> Update+setDue date =+    case textToDay date of+        Just day -> due .~ Just day+        Nothing  -> id++getSubtask :: Int -> Task -> Maybe ST.Subtask+getSubtask idx = (^? subtasks . ix idx)++addSubtask :: ST.Subtask -> Update+addSubtask subtask = subtasks %~ (|> subtask)++hasSubtasks :: Task -> Bool+hasSubtasks = not . null . (^. subtasks)++updateSubtask :: Int -> ST.Update -> Update+updateSubtask idx fn = subtasks %~ adjust' fn idx++removeSubtask :: Int -> Update+removeSubtask idx = subtasks %~ S.deleteAt idx++countSubtasks :: Task -> Int+countSubtasks = length . (^. subtasks)++countCompleteSubtasks :: Task -> Int+countCompleteSubtasks = length . filter (^. ST.complete) . (^. subtasks)++contains :: Text -> Task -> Bool+contains text task = text `isInfixOf` (task ^. name) || not (null sts)+  where+    sts = filter (isInfixOf text) $ (^. ST.name) <$> (task ^. subtasks)++isBlank :: Task -> Bool+isBlank task =+    null (task ^. name) &&+    isNothing (task ^. description) && null (task ^. subtasks) && isNothing (task ^. due)
+ src/Events/Actions.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Graphics.Vty.Input.Events (Event (..))++import Events.State.Types      (State, Stateful, mode)+import Events.State.Types.Mode (Mode (..))++import qualified Events.Actions.Insert as Insert+import qualified Events.Actions.Modal  as Modal+import qualified Events.Actions.Normal as Normal+import qualified Events.Actions.Search as Search++-- takes an event and returns a Maybe State+event' :: Event -> Stateful+-- for other events pass through to relevant modules+event' e state =+    case state ^. mode of+        Normal    -> Normal.event e state+        Search {} -> Search.event e state+        Insert {} -> Insert.event e state+        Modal {}  -> Modal.event e state+        _         -> return state++-- returns new state if successful+event :: Event -> State -> State+event e state = fromMaybe state $ event' e state
+ src/Events/Actions/Insert.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Insert+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((&), (.~), (^.))++import           Events.State+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)++event :: Event -> Stateful+event (EvKey KEnter _) state =+    case state ^. mode of+        Insert IList ICreate _ ->+            (write =<<) . (startCreate =<<) . (newItem =<<) . (store =<<) $ createList state+        Insert IList IEdit _ -> (write =<<) . (normalMode =<<) $ finishListTitle state+        Insert ITask ICreate _ ->+            (write =<<) . (below =<<) . (removeBlank =<<) . (store =<<) $ finishTask state+        Insert ITask IEdit _ ->+            (write =<<) . (removeBlank =<<) . (normalMode =<<) $ finishTask state+        _ -> return state+event (EvKey KEsc _) state =+    case state ^. mode of+        Insert IList ICreate _ -> (normalMode =<<) . (write =<<) $ createList state+        Insert IList IEdit _ -> (write =<<) . (normalMode =<<) $ finishListTitle state+        Insert ITask _ _ -> (write =<<) . (removeBlank =<<) . (normalMode =<<) $ finishTask state+        _ -> return state+event e state =+    return $+    case state ^. mode of+        Insert iType iMode field -> state & mode .~ Insert iType iMode (F.event e field)+        _                        -> state
+ src/Events/Actions/Modal.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Modal+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Events.State.Types        (Stateful, mode)+import Events.State.Types.Mode   (ModalType (..), Mode (Modal))+import Graphics.Vty.Input.Events++import qualified Events.Actions.Modal.Detail as Detail+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+        _                  -> return s
+ src/Events/Actions/Modal/Detail.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Modal.Detail+    ( event+    ) where++import ClassyPrelude++import           Events.State+import           Events.State.Modal.Detail as Detail+import           Events.State.Types+import           Events.State.Types.Mode   (DetailItem (..), DetailMode (..))+import           Graphics.Vty.Input.Events+import qualified UI.Field                  as F (event)++normal :: Event -> Stateful+normal (EvKey (KChar 'q') _) = quit+normal (EvKey KEsc _) = normalMode+normal (EvKey KEnter _) = (editDescription =<<) . store+normal (EvKey (KChar ' ') _) = (write =<<) . (setComplete =<<) . store+normal (EvKey (KChar 'k') _) = previousSubtask+normal (EvKey (KChar 'j') _) = nextSubtask+normal (EvKey (KChar 'a') _) =+    (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store+normal (EvKey (KChar 'e') _) = (Detail.insertMode =<<) . store+normal (EvKey (KChar 'D') _) = (write =<<) . (Detail.remove =<<) . store+normal (EvKey (KChar 'u') _) = (write =<<) . undo+normal (EvKey (KChar '@') _) = (editDue =<<) . store+normal _ = return++insert :: Event -> Stateful+insert (EvKey KEsc _) s = do+    item <- getCurrentItem s+    case item of+        DetailDescription -> (write =<<) $ finishDescription s+        DetailDate        -> (write =<<) $ finishDue s+        (DetailItem _)    -> (write =<<) . (showDetail =<<) $ finishSubtask s+insert (EvKey KEnter _) s = do+    item <- getCurrentItem s+    case item of+        DetailDescription -> (write =<<) $ finishDescription s+        DetailDate -> (write =<<) $ finishDue s+        (DetailItem _) ->+            (Detail.lastSubtask =<<) . (Detail.newItem =<<) . (store =<<) . (write =<<) $+            finishSubtask s+insert e s = updateField (F.event e) s++event :: Event -> Stateful+event e s = do+    m <- getCurrentMode s+    case m of+        DetailNormal     -> normal e s+        (DetailInsert _) -> insert e s
+ src/Events/Actions/Modal/Help.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Modal.Help+    ( event+    ) where++import ClassyPrelude+import Events.State+import Events.State.Types        (Stateful)+import Graphics.Vty.Input.Events++event :: Event -> Stateful+event (EvKey (KChar 'q') _) = quit+event (EvKey _ _)           = normalMode+event _                     = return
+ src/Events/Actions/Modal/MoveTo.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Modal.MoveTo+    ( event+    ) where++import ClassyPrelude+import Events.State+import Events.State.Types        (Stateful)+import Graphics.Vty.Input.Events++event :: Event -> Stateful+event (EvKey KEsc _)      = normalMode+event (EvKey KEnter _)    = normalMode+event (EvKey (KChar c) _) = (normalMode =<<) . (write =<<) . (moveTo c =<<) . store+event _                   = return
+ src/Events/Actions/Normal.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Normal+    ( event+    ) where++import ClassyPrelude hiding (delete)++import Data.Char                 (isDigit)+import Events.State+import Events.State.Modal.Detail (editDue, showDetail)+import Events.State.Types        (Stateful)+import Graphics.Vty.Input.Events++-- Normal+event :: Event -> Stateful+-- quit+event (EvKey (KChar 'q') _) = quit+-- add/edit+event (EvKey (KChar 'e') _) = (startEdit =<<) . store+event (EvKey (KChar 'A') _) = (startEdit =<<) . store+event (EvKey (KChar 'i') _) = (startEdit =<<) . store+event (EvKey (KChar 'C') _) = (startEdit =<<) . (clearItem =<<) . store+event (EvKey (KChar 'a') _) = (startCreate =<<) . (newItem =<<) . store+event (EvKey (KChar 'O') _) = (startCreate =<<) . (above =<<) . store+event (EvKey (KChar 'o') _) = (startCreate =<<) . (below =<<) . store+-- add list+event (EvKey (KChar 'N') _) = (createListStart =<<) . store+event (EvKey (KChar 'E') _) = (editListStart =<<) . store+event (EvKey (KChar 'X') _) = (write =<<) . (deleteCurrentList =<<) . store+-- navigation+event (EvKey (KChar 'k') _) = previous+event (EvKey (KChar 'j') _) = next+event (EvKey (KChar 'h') _) = left+event (EvKey (KChar 'l') _) = right+event (EvKey (KChar 'G') _) = bottom+-- moving items+event (EvKey (KChar 'K') _) = (write =<<) . (up =<<) . store+event (EvKey (KChar 'J') _) = (write =<<) . (down =<<) . store+event (EvKey (KChar 'H') _) = (write =<<) . (bottom =<<) . (left =<<) . (moveLeft =<<) . store+event (EvKey (KChar 'L') _) = (write =<<) . (bottom =<<) . (right =<<) . (moveRight =<<) . store+event (EvKey (KChar ' ') _) = (write =<<) . (moveRight =<<) . store+event (EvKey (KChar 'm') _) = showMoveTo+-- removing items+event (EvKey (KChar 'D') _) = (write =<<) . (delete =<<) . store+-- undo+event (EvKey (KChar 'u') _) = (write =<<) . undo+-- moving lists+event (EvKey (KChar '>') _) = (write =<<) . (listRight =<<) . store+event (EvKey (KChar '<') _) = (write =<<) . (listLeft =<<) . store+-- search+event (EvKey (KChar '/') _) = searchMode+-- help+event (EvKey (KChar '?') _) = showHelp+-- subtasks+event (EvKey KEnter _) = showDetail+event (EvKey (KChar '@') _) = (editDue =<<) . (store =<<) . showDetail+-- selecting lists+event (EvKey (KChar n) _)+    | isDigit n = selectList n+    | otherwise = return+-- fallback+event _ = return
+ src/Events/Actions/Search.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.Actions.Search+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((&), (.~), (^.))++import           Events.State+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 Events.Actions.Normal as Normal++search :: Event -> Stateful+search (EvKey KEnter _) s = searchEntered s+search e s =+    return $+    case s ^. mode of+        Search ent field -> s & mode .~ Search ent (F.event e field)+        _                -> s++event :: Event -> Stateful+event (EvKey KEsc _) s = normalMode s+event e s =+    case s ^. mode of+        Search ent _ ->+            (if ent+                 then search+                 else Normal.event)+                e+                s+        _ -> return s
+ src/Events/State.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Events.State+    -- App+    ( continue+    , write+    , countCurrent+    -- UI.Main+    , normalise+    -- Main+    , create+    -- Events.Actions.Normal+    , quit+    , startEdit+    , startCreate+    , createListStart+    , editListStart+    , deleteCurrentList+    , clearItem+    , above+    , below+    , bottom+    , previous+    , next+    , left+    , right+    , up+    , down+    , moveLeft+    , moveRight+    , delete+    , selectList+    , listLeft+    , listRight+    , undo+    , store+    , searchMode+    -- Events.Actions.Search+    , searchEntered+    -- Events.Actions.Insert+    , createList+    , removeBlank+    , newItem+    , normalMode+    , finishTask+    , finishListTitle+    -- Events.Actions.Modal+    , showHelp+    , showMoveTo+    , moveTo+    , getCurrentList+    , getCurrentTask+    , setCurrentTask+    ) where++import ClassyPrelude hiding (delete)++import Control.Lens ((&), (.~), (^.))++import Data.Char (digitToInt, ord)++import           Data.Taskell.List  (List, deleteTask, getTask, move, new, newAt, title, update)+import qualified Data.Taskell.Lists as Lists+import           Data.Taskell.Task  (Task, isBlank, name)++import Events.State.Types+import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))+import UI.Field                (blankField, getText, textToField)++type InternalStateful = State -> State++create :: FilePath -> Lists.Lists -> State+create p ls =+    State {_mode = Normal, _lists = ls, _history = [], _current = (0, 0), _path = p, _io = Nothing}++-- app state+quit :: Stateful+quit = Just . (mode .~ Shutdown)++continue :: State -> State+continue = io .~ Nothing++write :: Stateful+write state = Just $ state & io .~ Just (state ^. lists)++store :: Stateful+store state = Just $ state & history .~ (state ^. current, state ^. lists) : state ^. history++undo :: Stateful+undo state =+    Just $+    case state ^. history of+        []          -> state+        ((c, l):xs) -> state & current .~ c & lists .~ l & history .~ xs++-- createList+createList :: Stateful+createList state =+    Just $+    case state ^. mode of+        Insert IList ICreate f ->+            updateListToLast . setLists state $ Lists.newList (getText f) $ state ^. lists+        _ -> state++updateListToLast :: InternalStateful+updateListToLast state = setCurrentList state (length (state ^. lists) - 1)++createListStart :: Stateful+createListStart = Just . (mode .~ Insert IList ICreate blankField)++-- editList+editListStart :: Stateful+editListStart state = do+    f <- textToField . (^. title) <$> getList state+    return $ state & mode .~ Insert IList IEdit f++deleteCurrentList :: Stateful+deleteCurrentList state =+    Just . fixIndex . setLists state $ Lists.delete (getCurrentList state) (state ^. lists)++-- insert+getCurrentTask :: State -> Maybe Task+getCurrentTask state = getList state >>= getTask (getIndex state)++setCurrentTask :: Task -> Stateful+setCurrentTask task state = setList state . update (getIndex state) task <$> getList state++setCurrentTaskText :: Text -> Stateful+setCurrentTaskText text state =+    flip setCurrentTask state =<< (name .~ text) <$> getCurrentTask state++startCreate :: Stateful+startCreate = Just . (mode .~ Insert ITask ICreate blankField)++startEdit :: Stateful+startEdit state = do+    field <- textToField . (^. name) <$> getCurrentTask state+    return $ state & mode .~ Insert ITask IEdit field++finishTask :: Stateful+finishTask state =+    case state ^. mode of+        Insert ITask iMode f ->+            setCurrentTaskText (getText f) $ state & (mode .~ Insert ITask iMode blankField)+        _ -> Just state++finishListTitle :: Stateful+finishListTitle state =+    case state ^. mode of+        Insert IList iMode f ->+            setCurrentListTitle (getText f) $ state & (mode .~ Insert IList iMode blankField)+        _ -> Just state++normalMode :: Stateful+normalMode = Just . (mode .~ Normal)++addToListAt :: Int -> Stateful+addToListAt offset state = do+    let idx = getIndex state + offset+    fixIndex . setList (setIndex state idx) . newAt idx <$> getList state++above :: Stateful+above = addToListAt 0++below :: Stateful+below = addToListAt 1++newItem :: Stateful+newItem state = selectLast . setList state . new <$> getList state++clearItem :: Stateful+clearItem = setCurrentTaskText ""++bottom :: Stateful+bottom = return . selectLast++selectLast :: InternalStateful+selectLast state = setIndex state (countCurrent state - 1)++removeBlank :: Stateful+removeBlank state = do+    currentTask <- getCurrentTask state+    (if isBlank currentTask+         then delete+         else return)+        state++-- moving+up :: Stateful+up state = previous =<< setList state <$> (move (getIndex state) (-1) =<< getList state)++down :: Stateful+down state = next =<< setList state <$> (move (getIndex state) 1 =<< getList state)++move' :: Int -> State -> Maybe State+move' idx state =+    fixIndex . setLists state <$> Lists.changeList (state ^. current) (state ^. lists) idx++moveLeft :: Stateful+moveLeft = move' (-1)++moveRight :: Stateful+moveRight = move' 1++selectList :: Char -> Stateful+selectList idx state =+    Just $+    (if exists+         then current .~ (list, 0)+         else id)+        state+  where+    list = digitToInt idx - 1+    exists = Lists.exists list (state ^. lists)++-- removing+delete :: Stateful+delete state = fixIndex . setList state . 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)++setCurrentList :: State -> Int -> State+setCurrentList state idx = state & current .~ (idx, getIndex state)++getIndex :: State -> Int+getIndex = snd . (^. current)++next :: Stateful+next state = Just $ setIndex state idx'+  where+    idx = getIndex state+    count = countCurrent state+    idx' =+        if idx < (count - 1)+            then succ idx+            else idx++previous :: Stateful+previous state = Just $ setIndex state idx'+  where+    idx = getIndex state+    idx' =+        if idx > 0+            then pred idx+            else 0++left :: Stateful+left state =+    Just . fixIndex . setCurrentList state $+    if list > 0+        then pred list+        else 0+  where+    list = getCurrentList state++right :: Stateful+right state =+    Just . fixIndex . setCurrentList state $+    if list < (count - 1)+        then succ list+        else list+  where+    list = getCurrentList state+    count = length (state ^. lists)++fixIndex :: InternalStateful+fixIndex state =+    if getIndex state' > count+        then setIndex state' count'+        else state'+  where+    lists' = state ^. lists+    idx = Lists.exists (getCurrentList state) lists'+    state' =+        if idx+            then state+            else setCurrentList state (length lists' - 1)+    count = countCurrent state' - 1+    count' =+        if count < 0+            then 0+            else count++-- tasks+getCurrentList :: State -> Int+getCurrentList = fst . (^. current)++getList :: State -> Maybe List+getList state = Lists.get (state ^. lists) (getCurrentList state)++setList :: State -> List -> State+setList state list = setLists state (Lists.updateLists (getCurrentList state) list (state ^. lists))++setCurrentListTitle :: Text -> Stateful+setCurrentListTitle text state = setList state . (title .~ text) <$> getList state++setLists :: State -> Lists.Lists -> State+setLists state lists' = state & lists .~ lists'++moveTo :: Char -> Stateful+moveTo char state = do+    let li = ord char - ord 'a'+        cur = getCurrentList state+    if li == cur || li < 0 || li >= length (state ^. lists)+        then Nothing+        else do+            s <- move' (li - cur) state+            return . selectLast $ setCurrentList s li++-- move lists+listMove :: Int -> Stateful+listMove offset state = do+    let currentList = getCurrentList state+    let lists' = state ^. lists+    if currentList + offset < 0 || currentList + offset >= length lists'+        then Nothing+        else do+            let state' = fixIndex $ setCurrentList state (currentList + offset)+            setLists state' <$> Lists.shiftBy currentList offset lists'++listLeft :: Stateful+listLeft = listMove (-1)++listRight :: Stateful+listRight = listMove 1++-- search+searchMode :: Stateful+searchMode state =+    Just $+    case state ^. mode of+        Search _ field -> state & mode .~ Search True field+        _              -> state & mode .~ Search True blankField++searchEntered :: Stateful+searchEntered state =+    case state ^. mode of+        Search _ field -> Just $ state & mode .~ Search False field+        _              -> Nothing++-- help+showHelp :: Stateful+showHelp = Just . (mode .~ Modal Help)++showMoveTo :: Stateful+showMoveTo = Just . (mode .~ Modal MoveTo)++-- view - maybe shouldn't be in here...+search :: State -> State+search state =+    case state ^. mode of+        Search _ field -> fixIndex . setLists state $ Lists.search (getText field) (state ^. lists)+        _ -> state++newList :: State -> State+newList state =+    case state ^. mode of+        Insert IList ICreate f ->+            let ls = state ^. lists+            in fixIndex $ setCurrentList (setLists state (Lists.newList (getText f) ls)) (length ls)+        _ -> state++normalise :: State -> State+normalise = newList . search
+ src/Events/State/Modal/Detail.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Events.State.Modal.Detail+    ( updateField+    , finishSubtask+    , finishDescription+    , finishDue+    , showDetail+    , getCurrentItem+    , getCurrentMode+    , getField+    , setComplete+    , remove+    , insertMode+    , editDescription+    , editDue+    , newItem+    , nextSubtask+    , previousSubtask+    , lastSubtask+    ) where++import ClassyPrelude++import Control.Lens ((&), (.~), (^.))++import           Data.Taskell.Date       (dayToOutput)+import qualified Data.Taskell.Subtask    as ST (blank, name, toggle)+import           Data.Taskell.Task       (Task, addSubtask, countSubtasks, description, due,+                                          getSubtask, removeSubtask, setDescription, setDue,+                                          updateSubtask)+import           Events.State            (getCurrentTask, setCurrentTask)+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)++updateField :: (Field -> Field) -> Stateful+updateField fieldEvent s =+    return $+    case s ^. mode of+        Modal (Detail detailItem (DetailInsert field)) ->+            s & mode .~ Modal (Detail detailItem (DetailInsert (fieldEvent field)))+        _ -> s++finishSubtask :: Stateful+finishSubtask state = do+    text <- getText <$> getField state+    i <- getCurrentSubtask state+    task <- updateSubtask i (ST.name .~ text) <$> getCurrentTask state+    setCurrentTask task $ state & mode .~ Modal (Detail (DetailItem i) (DetailInsert blankField))++finish :: (Text -> Task -> Task) -> Stateful+finish fn state = do+    text <- getText <$> getField state+    task <- fn text <$> getCurrentTask state+    setCurrentTask task $ state & mode .~ Modal (Detail (DetailItem 0) DetailNormal)++finishDescription :: Stateful+finishDescription = finish setDescription++finishDue :: Stateful+finishDue = finish setDue++showDetail :: Stateful+showDetail s = do+    _ <- getCurrentTask s+    let i = fromMaybe 0 $ getCurrentSubtask s+    return $ s & mode .~ Modal (Detail (DetailItem i) DetailNormal)++getCurrentSubtask :: State -> Maybe Int+getCurrentSubtask state =+    case state ^. mode of+        Modal (Detail (DetailItem i) _) -> Just i+        _                               -> Nothing++getCurrentItem :: State -> Maybe DetailItem+getCurrentItem state =+    case state ^. mode of+        Modal (Detail item _) -> Just item+        _                     -> Nothing++getCurrentMode :: State -> Maybe DetailMode+getCurrentMode state =+    case state ^. mode of+        Modal (Detail _ m) -> Just m+        _                  -> Nothing++getField :: State -> Maybe Field+getField state =+    case state ^. mode of+        Modal (Detail _ (DetailInsert f)) -> Just f+        _                                 -> Nothing++setComplete :: Stateful+setComplete state = do+    i <- getCurrentSubtask state+    task <- updateSubtask i ST.toggle <$> getCurrentTask state+    setCurrentTask task state++remove :: Stateful+remove state = do+    i <- getCurrentSubtask state+    task <- removeSubtask i <$> getCurrentTask state+    state' <- setCurrentTask task state+    setIndex state' i++insertMode :: Stateful+insertMode state = do+    i <- getCurrentSubtask state+    task <- getCurrentTask state+    n <- (^. ST.name) <$> getSubtask i task+    case state ^. mode of+        Modal (Detail (DetailItem i') _) ->+            Just (state & mode .~ Modal (Detail (DetailItem i') (DetailInsert (textToField n))))+        _ -> Nothing++editDescription :: Stateful+editDescription state = do+    summ <- (^. description) <$> getCurrentTask state+    let summ' = fromMaybe "" summ+    return $ state & mode .~ Modal (Detail DetailDescription (DetailInsert (textToField summ')))++editDue :: Stateful+editDue state = do+    day <- (^. due) <$> getCurrentTask state+    let day' = maybe "" dayToOutput day+    return $ state & mode .~ Modal (Detail DetailDate (DetailInsert (textToField day')))++newItem :: Stateful+newItem state = do+    task <- addSubtask ST.blank <$> getCurrentTask state+    setCurrentTask task state++-- list navigation+changeSubtask :: Int -> Stateful+changeSubtask inc state = do+    i <- (+ inc) <$> getCurrentSubtask state+    setIndex state i++nextSubtask :: Stateful+nextSubtask = changeSubtask 1++previousSubtask :: Stateful+previousSubtask = changeSubtask (-1)++lastSubtask :: Stateful+lastSubtask state = lastIndex state >>= setIndex state++lastIndex :: State -> Maybe Int+lastIndex state = (+ (-1)) . countSubtasks <$> getCurrentTask state++setIndex :: State -> Int -> Maybe State+setIndex state i = do+    lst <- lastIndex state+    m <- getCurrentMode state+    let newIndex+            | i > lst = lst+            | i < 0 = 0+            | otherwise = i+    return $ state & mode .~ Modal (Detail (DetailItem newIndex) m)
+ src/Events/State/Types.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Events.State.Types where++import ClassyPrelude++import Control.Lens (makeLenses)++import Data.Taskell.Lists (Lists)++import qualified Events.State.Types.Mode as M (Mode)++type Pointer = (Int, Int)++data State = State+    { _mode    :: M.Mode+    , _lists   :: Lists+    , _history :: [(Pointer, Lists)]+    , _current :: Pointer+    , _path    :: FilePath+    , _io      :: Maybe Lists+    } deriving (Eq, Show)++-- create lenses+$(makeLenses ''State)++type Stateful = State -> Maybe State
+ src/Events/State/Types/Mode.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Events.State.Types.Mode where++import ClassyPrelude++import UI.Field (Field)++data DetailMode+    = DetailNormal+    | DetailInsert Field+    deriving (Eq, Show)++data DetailItem+    = DetailItem Int+    | DetailDescription+    | DetailDate+    deriving (Eq, Show)++data ModalType+    = Help+    | MoveTo+    | Detail DetailItem+             DetailMode+    deriving (Eq, Show)++data InsertType+    = ITask+    | IList+    deriving (Eq, Show)++data InsertMode+    = IEdit+    | ICreate+    deriving (Eq, Show)++data Mode+    = Normal+    | Insert InsertType+             InsertMode+             Field+    | Modal ModalType+    | Search Bool+             Field+    | Shutdown+    deriving (Eq, Show)
+ src/IO/Config.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.Config where++import ClassyPrelude++import qualified Data.Text.IO     as T (readFile)+import           System.Directory (createDirectoryIfMissing, doesFileExist, getHomeDirectory)++import Brick           (AttrMap)+import Brick.Themes    (loadCustomizations, themeToAttrMap)+import Data.FileEmbed  (embedFile)+import Data.Ini.Config++import UI.Theme (defaultTheme)++import qualified IO.Config.General  as General+import qualified IO.Config.GitHub   as GitHub+import qualified IO.Config.Layout   as Layout+import qualified IO.Config.Markdown as Markdown+import qualified IO.Config.Trello   as Trello++data Config = Config+    { general  :: General.Config+    , layout   :: Layout.Config+    , markdown :: Markdown.Config+    , trello   :: Trello.Config+    , github   :: GitHub.Config+    }++defaultConfig :: Config+defaultConfig =+    Config+    { general = General.defaultConfig+    , layout = Layout.defaultConfig+    , markdown = Markdown.defaultConfig+    , trello = Trello.defaultConfig+    , github = GitHub.defaultConfig+    }++getDir :: IO FilePath+getDir = (++ "/.taskell") <$> getHomeDirectory++getThemePath :: IO FilePath+getThemePath = (++ "/theme.ini") <$> getDir++getConfigPath :: IO FilePath+getConfigPath = (++ "/config.ini") <$> getDir++setup :: IO Config+setup = do+    getDir >>= createDirectoryIfMissing True+    createConfig+    createTheme+    getConfig++create :: IO FilePath -> (FilePath -> IO ()) -> IO ()+create getPath write = do+    path <- getPath+    exists <- doesFileExist path+    unless exists $ write path++writeTheme :: FilePath -> IO ()+writeTheme path = writeFile path $(embedFile "templates/theme.ini")++createTheme :: IO ()+createTheme = create getThemePath writeTheme++writeConfig :: FilePath -> IO ()+writeConfig path = writeFile path $(embedFile "templates/config.ini")++createConfig :: IO ()+createConfig = create getConfigPath writeConfig++configParser :: IniParser Config+configParser = do+    generalCf <- General.parser+    layoutCf <- Layout.parser+    markdownCf <- Markdown.parser+    trelloCf <- Trello.parser+    githubCf <- GitHub.parser+    return+        Config+        { general = generalCf+        , layout = layoutCf+        , markdown = markdownCf+        , trello = trelloCf+        , github = githubCf+        }++getConfig :: IO Config+getConfig = do+    content <- getConfigPath >>= T.readFile+    let config = parseIniFile content configParser+    case config of+        Right c -> return c+        Left s  -> putStrLn (pack $ "config.ini: " ++ s) >> return defaultConfig++-- generate theme+generateAttrMap :: IO AttrMap+generateAttrMap = do+    path <- getThemePath+    customizedTheme <- loadCustomizations path defaultTheme+    case customizedTheme of+        Right theme -> return $ themeToAttrMap theme+        Left s -> do+            putStrLn (pack $ "theme.ini: " ++ s)+            return $ themeToAttrMap defaultTheme
+ src/IO/Config/General.hs view
@@ -0,0 +1,23 @@+module IO.Config.General where++import ClassyPrelude++import Data.Ini.Config++import IO.Config.Parser (noEmpty)++data Config = Config+    { filename :: FilePath+    }++defaultConfig :: Config+defaultConfig = Config {filename = "taskell.md"}++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "general"+        (do filenameCf <-+                maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename"+            return Config {filename = filenameCf})
+ src/IO/Config/GitHub.hs view
@@ -0,0 +1,22 @@+module IO.Config.GitHub where++import ClassyPrelude++import Data.Ini.Config++import IO.HTTP.GitHub (GitHubToken)++data Config = Config+    { token :: Maybe GitHubToken+    }++defaultConfig :: Config+defaultConfig = Config {token = Nothing}++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "github"+        (do tokenCf <- fieldMb "token"+            return Config {token = tokenCf})
+ src/IO/Config/Layout.hs view
@@ -0,0 +1,35 @@+module IO.Config.Layout where++import ClassyPrelude++import Data.Ini.Config++import IO.Config.Parser (noEmpty, parseText)++data Config = Config+    { columnWidth          :: Int+    , columnPadding        :: Int+    , descriptionIndicator :: Text+    }++defaultConfig :: Config+defaultConfig = Config {columnWidth = 30, columnPadding = 3, descriptionIndicator = "≡"}++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "layout"+        (do columnWidthCf <-+                fromMaybe (columnWidth defaultConfig) <$> fieldMbOf "column_width" number+            columnPaddingCf <-+                fromMaybe (columnPadding defaultConfig) <$> fieldMbOf "column_padding" number+            descriptionIndicatorCf <-+                fromMaybe (descriptionIndicator defaultConfig) . (noEmpty . parseText =<<) <$>+                fieldMb "description_indicator"+            return+                Config+                { columnWidth = columnWidthCf+                , columnPadding = columnPaddingCf+                , descriptionIndicator = descriptionIndicatorCf+                })
+ src/IO/Config/Markdown.hs view
@@ -0,0 +1,52 @@+module IO.Config.Markdown where++import ClassyPrelude++import Data.Ini.Config++import IO.Config.Parser (noEmpty, parseText)++data Config = Config+    { titleOutput       :: Text+    , taskOutput        :: Text+    , descriptionOutput :: Text+    , dueOutput         :: Text+    , subtaskOutput     :: Text+    }++defaultConfig :: Config+defaultConfig =+    Config+    { titleOutput = "##"+    , taskOutput = "-"+    , descriptionOutput = "    >"+    , dueOutput = "    @"+    , subtaskOutput = "    *"+    }++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "markdown"+        (do titleOutputCf <-+                fromMaybe (titleOutput defaultConfig) . (noEmpty . parseText =<<) <$>+                fieldMb "title"+            taskOutputCf <-+                fromMaybe (taskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "task"+            descriptionOutputCf <-+                fromMaybe (descriptionOutput defaultConfig) . (noEmpty . parseText =<<) <$>+                fieldMb "summary"+            dueOutputCf <-+                fromMaybe (dueOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "due"+            subtaskOutputCf <-+                fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$>+                fieldMb "subtask"+            return+                Config+                { titleOutput = titleOutputCf+                , taskOutput = taskOutputCf+                , descriptionOutput = descriptionOutputCf+                , dueOutput = dueOutputCf+                , subtaskOutput = subtaskOutputCf+                })
+ src/IO/Config/Parser.hs view
@@ -0,0 +1,12 @@+module IO.Config.Parser where++import ClassyPrelude++import Data.Text as T (dropAround, strip)++noEmpty :: Text -> Maybe Text+noEmpty ""  = Nothing+noEmpty txt = Just txt++parseText :: Text -> Text+parseText = dropAround (== '"') . strip
+ src/IO/Config/Trello.hs view
@@ -0,0 +1,22 @@+module IO.Config.Trello where++import ClassyPrelude++import Data.Ini.Config++import IO.HTTP.Trello (TrelloToken)++data Config = Config+    { token :: Maybe TrelloToken+    }++defaultConfig :: Config+defaultConfig = Config {token = Nothing}++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "trello"+        (do tokenCf <- fieldMb "token"+            return Config {token = tokenCf})
+ src/IO/HTTP/Aeson.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoImplicitPrelude #-}++module IO.HTTP.Aeson where++import ClassyPrelude++import           Data.Aeson          (defaultOptions, fieldLabelModifier)+import qualified Data.Aeson.TH       as TH (deriveFromJSON)+import           Language.Haskell.TH (Dec, Name, Q)++import Data.FileEmbed (embedFile)++deriveFromJSON :: Name -> Q [Dec]+deriveFromJSON = TH.deriveFromJSON defaultOptions {fieldLabelModifier = drop 1}++parseError :: String -> Text+parseError err = decodeUtf8 $(embedFile "templates/api-error.txt") ++ "\n\n" ++ pack err
+ src/IO/HTTP/GitHub.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.HTTP.GitHub+    ( GitHubToken+    , GitHubIdentifier+    , getNextLink+    , getLists+    ) where++import ClassyPrelude++import Control.Lens  ((^.))+import Data.Either   (lefts, rights)+import Data.Sequence (mapWithIndex, (!?))+import Data.Text     (splitOn, strip)++import Data.Aeson+import UI.CLI     (prompt)++import Network.HTTP.Client       (requestHeaders)+import Network.HTTP.Simple       (getResponseBody, getResponseHeader, getResponseStatusCode, httpBS,+                                  parseRequest)+import Network.HTTP.Types.Header (HeaderName)++import IO.HTTP.Aeson          (parseError)+import IO.HTTP.GitHub.Card    (Card)+import IO.HTTP.GitHub.Column  (Column, cardsURL, columnToList)+import IO.HTTP.GitHub.Project (Project, columnsURL, name)++import Data.Taskell.List  (List)+import Data.Taskell.Lists (Lists)++type GitHubToken = Text++type GitHubIdentifier = Text++type ReaderGitHubToken a = ReaderT GitHubToken IO a++concatEithers :: [Either String [a]] -> Either String [a]+concatEithers vals =+    if null errors+        then Right $ concat (rights vals)+        else Left $ unlines errors+  where+    errors = lefts vals++root :: Text+root = "https://api.github.com/"++headers :: ReaderGitHubToken [(HeaderName, ByteString)]+headers = do+    token <- ask+    return+        [ ("User-Agent", "smallhadroncollider/taskell")+        , ("Accept", "application/vnd.github.inertia-preview+json")+        , ("Authorization", encodeUtf8 ("token " ++ token))+        ]++getNextLink :: [ByteString] -> Maybe Text+getNextLink bs = do+    lnks <- splitOn "," . decodeUtf8 <$> headMay bs+    let rel = "rel=\"next\""+    next <- find (isSuffixOf rel) lnks+    stripPrefix "<" =<< stripSuffix (">; " ++ rel) (strip next)++fetch' :: [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString])+fetch' bs url = do+    initialRequest <- lift $ parseRequest (unpack url)+    rHeaders <- headers+    let request = initialRequest {requestHeaders = rHeaders}+    response <- lift $ httpBS request+    let responses = bs ++ [getResponseBody response]+    case getNextLink (getResponseHeader "Link" response) of+        Nothing  -> return (getResponseStatusCode response, responses)+        Just lnk -> fetch' responses lnk++fetch :: Text -> ReaderGitHubToken (Int, [ByteString])+fetch = fetch' []++getCards :: Text -> ReaderGitHubToken (Either Text [Card])+getCards url = do+    (status, body) <- fetch url+    return $+        case status of+            200 ->+                case concatEithers (eitherDecodeStrict <$> body) of+                    Right cards -> Right cards+                    Left err    -> Left (parseError err)+            429 -> Left "Too many cards"+            _ -> Left $ tshow status ++ " error while fetching " ++ url++addCard :: Column -> ReaderGitHubToken (Either Text List)+addCard column = do+    cards <- getCards $ column ^. cardsURL+    return $ columnToList column <$> cards++addCards :: [Column] -> ReaderGitHubToken (Either Text Lists)+addCards columns = do+    cols <- sequence (addCard <$> columns)+    return $ fromList <$> sequence cols++getColumns :: Text -> ReaderGitHubToken (Either Text Lists)+getColumns url = do+    putStrLn "Fetching project from GitHub..."+    (status, body) <- fetch url+    case status of+        200 ->+            case concatEithers (eitherDecodeStrict <$> body) of+                Right columns -> addCards columns+                Left err      -> return $ Left (parseError err)+        404 -> return . Left $ "Could not find GitHub project ."+        401 -> return . Left $ "You do not have permission to view GitHub project " ++ url+        _ -> return . Left $ tshow status ++ " error. Cannot fetch columns from GitHub."++printProjects :: Seq Project -> Text+printProjects projects = unlines $ toList display+  where+    names = (^. name) <$> projects+    line i nm = concat ["[", tshow (i + 1), "] ", nm]+    display = line `mapWithIndex` names++chooseProject :: [Project] -> ReaderGitHubToken (Either Text Lists)+chooseProject projects = do+    let projects' = fromList projects+    putStrLn $ printProjects projects'+    chosen <- lift $ prompt "Import project"+    let project = (projects' !?) =<< (-) 1 <$> readMay chosen+    case project of+        Nothing   -> return $ Left "Invalid project selected"+        Just proj -> getColumns (proj ^. columnsURL)++getLists :: GitHubIdentifier -> ReaderGitHubToken (Either Text Lists)+getLists identifier = do+    putStrLn "Fetching project list from GitHub...\n"+    let url = concat [root, identifier, "/projects"]+    (status, body) <- fetch url+    case status of+        200 ->+            case concatEithers (eitherDecodeStrict <$> body) of+                Right projects ->+                    if null projects+                        then return . Left $ concat ["\nNo projects found for ", identifier, "\n"]+                        else chooseProject projects+                Left err -> return $ Left (parseError err)+        404 ->+            return . Left $+            "Could not find GitHub org/repo. For organisation make sure you use 'orgs/<org-name>' and for repos use 'repos/<username>/<repo-name>'"+        401 ->+            return . Left $+            "You do not have permission to view the GitHub projects for " ++ identifier+        _ -> return . Left $ tshow status ++ " error. Cannot fetch projects from GitHub."
+ src/IO/HTTP/GitHub/Card.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.GitHub.Card+    ( Card+    , cardToTask+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (^.))++import Data.Text (replace)++import qualified Data.Taskell.Task as T (Task, new)+import           IO.HTTP.Aeson     (deriveFromJSON)++data Card = Card+    { _note :: Text+    } deriving (Eq, Show)++-- strip underscores from field labels+$(deriveFromJSON ''Card)++-- create lenses+$(makeLenses ''Card)++-- operations+cardToTask :: Card -> T.Task+cardToTask card = T.new $ replace "\r" "" $ replace "\n" " " (card ^. note)
+ src/IO/HTTP/GitHub/Column.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.GitHub.Column+    ( Column+    , columnToList+    , cardsURL+    ) where++import ClassyPrelude++import Control.Lens (Lens', makeLenses, (^.))++import IO.HTTP.Aeson       (deriveFromJSON)+import IO.HTTP.GitHub.Card (Card, cardToTask)++import qualified Data.Taskell.List as L (List, create)++data Column = Column+    { _name      :: Text+    , _cards_url :: Text+    } deriving (Eq, Show)++-- create Aeson code+$(deriveFromJSON ''Column)++-- create lenses+$(makeLenses ''Column)++-- operations+cardsURL :: Lens' Column Text+cardsURL = cards_url++columnToList :: Column -> [Card] -> L.List+columnToList ls cards = L.create (ls ^. name) (fromList $ cardToTask <$> cards)
+ src/IO/HTTP/GitHub/Project.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.GitHub.Project+    ( Project+    , columnsURL+    , name+    ) where++import ClassyPrelude++import Control.Lens (Lens', makeLenses)++import IO.HTTP.Aeson (deriveFromJSON)++data Project = Project+    { _name        :: Text+    , _columns_url :: Text+    } deriving (Eq, Show)++-- create Aeson code+$(deriveFromJSON ''Project)++-- create lenses+$(makeLenses ''Project)++-- operations+columnsURL :: Lens' Project Text+columnsURL = columns_url
+ src/IO/HTTP/Trello.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.HTTP.Trello+    ( TrelloToken+    , TrelloBoardID+    , getLists+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Aeson+import Network.HTTP.Simple (getResponseBody, getResponseStatusCode, httpBS, parseRequest)++import IO.HTTP.Aeson                (parseError)+import IO.HTTP.Trello.Card          (Card, idChecklists, setChecklists)+import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems)+import IO.HTTP.Trello.List          (List, cards, listToList, setCards)++import Data.Taskell.Lists  (Lists)+import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)++type ReaderTrelloToken a = ReaderT TrelloToken IO a++type TrelloToken = Text++type TrelloBoardID = Text++type TrelloChecklistID = Text++key :: Text+key = "80dbcf6f88f62cc5639774e13342c20b"++root :: Text+root = "https://api.trello.com/1/"++fullURL :: Text -> ReaderTrelloToken String+fullURL uri = do+    token <- ask+    return . unpack $ concat [root, uri, "&key=", key, "&token=", token]++boardURL :: TrelloBoardID -> ReaderTrelloToken String+boardURL board =+    fullURL $+    concat+        [ "boards/"+        , board+        , "/lists"+        , "?cards=open"+        , "&card_fields=name,due,desc,idChecklists"+        , "&fields=name,cards"+        ]++checklistURL :: TrelloChecklistID -> ReaderTrelloToken String+checklistURL checklist =+    fullURL $ concat ["checklists/", checklist, "?fields=id", "&checkItem_fields=name,state"]++trelloListsToLists :: TimeZone -> [List] -> Lists+trelloListsToLists tz ls = fromList $ listToList tz <$> ls++fetch :: String -> IO (Int, ByteString)+fetch url = do+    request <- parseRequest url+    response <- httpBS request+    return (getResponseStatusCode response, getResponseBody response)++getChecklist :: TrelloChecklistID -> ReaderTrelloToken (Either Text [ChecklistItem])+getChecklist checklist = do+    url <- checklistURL checklist+    (status, body) <- lift $ fetch url+    return $+        case status of+            200 ->+                case (^. checkItems) <$> eitherDecodeStrict body of+                    Right ls -> Right ls+                    Left err -> Left $ parseError err+            429 -> Left "Too many checklists"+            _ -> Left $ tshow status ++ " error while fetching checklist " ++ checklist++updateCard :: Card -> ReaderTrelloToken (Either Text Card)+updateCard card = (setChecklists card . concat <$>) . sequence <$> checklists+  where+    checklists = sequence $ getChecklist <$> (card ^. idChecklists)++updateList :: List -> ReaderTrelloToken (Either Text List)+updateList l = (setCards l <$>) . sequence <$> sequence (updateCard <$> (l ^. cards))++getChecklists :: [List] -> ReaderTrelloToken (Either Text [List])+getChecklists ls = sequence <$> sequence (updateList <$> ls)++getLists :: TrelloBoardID -> ReaderTrelloToken (Either Text Lists)+getLists board = do+    putStrLn "Fetching from Trello..."+    url <- boardURL board+    (status, body) <- lift $ fetch url+    timezone <- lift getCurrentTimeZone+    case status of+        200 ->+            case eitherDecodeStrict body of+                Right raw -> fmap (trelloListsToLists timezone) <$> getChecklists raw+                Left err  -> return . Left $ parseError err+        404 ->+            return . Left $+            "Could not find Trello board " ++ board ++ ". Make sure the ID is correct"+        401 -> return . Left $ "You do not have permission to view Trello board " ++ board+        _ -> return . Left $ tshow status ++ " error. Cannot fetch from Trello."
+ src/IO/HTTP/Trello/Card.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.Trello.Card+    ( Card+    , idChecklists+    , cardToTask+    , setChecklists+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (&), (.~), (^.))++import           Data.Taskell.Date   (utcToLocalDay)+import qualified Data.Taskell.Task   as T (Task, due, new, setDescription, subtasks)+import           Data.Time.Format    (iso8601DateFormat, parseTimeM)+import           Data.Time.LocalTime (TimeZone)++import IO.HTTP.Aeson                (deriveFromJSON)+import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checklistItemToSubTask)++data Card = Card+    { _name         :: Text+    , _desc         :: Text+    , _due          :: Maybe Text+    , _idChecklists :: [Text]+    , _checklists   :: Maybe [ChecklistItem]+    } deriving (Eq, Show)++-- strip underscores from field labels+$(deriveFromJSON ''Card)++-- create lenses+$(makeLenses ''Card)++-- operations+textToTime :: TimeZone -> Text -> Maybe Day+textToTime tz text = utcToLocalDay tz <$> utc+  where+    utc = parseTimeM False defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S%Q%Z")) $ unpack text++cardToTask :: TimeZone -> Card -> T.Task+cardToTask tz card =+    task & T.due .~ textToTime tz (fromMaybe "" (card ^. due)) & T.subtasks .~+    fromList (checklistItemToSubTask <$> fromMaybe [] (card ^. checklists))+  where+    task = T.setDescription (card ^. desc) $ T.new (card ^. name)++setChecklists :: Card -> [ChecklistItem] -> Card+setChecklists card cls = card & checklists .~ Just cls
+ src/IO/HTTP/Trello/ChecklistItem.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.Trello.ChecklistItem+    ( ChecklistItem+    , checklistItemToSubTask+    , checkItems+    ) where++import ClassyPrelude++import           Control.Lens         (makeLenses, (^.))+import qualified Data.Taskell.Subtask as ST (Subtask, new)+import           IO.HTTP.Aeson        (deriveFromJSON)++data ChecklistItem = ChecklistItem+    { _name  :: Text+    , _state :: Text+    } deriving (Eq, Show)++-- create Aeson code+$(deriveFromJSON ''ChecklistItem)++-- create lenses+$(makeLenses ''ChecklistItem)++-- operations+checklistItemToSubTask :: ChecklistItem -> ST.Subtask+checklistItemToSubTask cl = ST.new (cl ^. name) ((cl ^. state) == "complete")++-- check list wrapper+newtype ChecklistWrapper = ChecklistWrapper+    { _checkItems :: [ChecklistItem]+    } deriving (Eq, Show)++-- create Aeson code+$(deriveFromJSON ''ChecklistWrapper)++-- create lenses+$(makeLenses ''ChecklistWrapper)
+ src/IO/HTTP/Trello/List.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.HTTP.Trello.List+    ( List+    , cards+    , setCards+    , listToList+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (&), (.~), (^.))++import IO.HTTP.Aeson       (deriveFromJSON)+import IO.HTTP.Trello.Card (Card, cardToTask)++import qualified Data.Taskell.List   as L (List, create)+import           Data.Time.LocalTime (TimeZone)++data List = List+    { _name  :: Text+    , _cards :: [Card]+    } deriving (Eq, Show)++-- create Aeson code+$(deriveFromJSON ''List)++-- create lenses+$(makeLenses ''List)++-- operations+setCards :: List -> [Card] -> List+setCards list cs = list & cards .~ cs++listToList :: TimeZone -> List -> L.List+listToList tz ls = L.create (ls ^. name) (fromList $ cardToTask tz <$> (ls ^. cards))
+ src/IO/Markdown.hs view
@@ -0,0 +1,6 @@+module IO.Markdown+    ( parse+    , stringify+    ) where++import IO.Markdown.Internal
+ src/IO/Markdown/Internal.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.Markdown.Internal where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Sequence      (adjust')+import Data.Text          as T (dropAround, splitOn, strip)+import Data.Text.Encoding (decodeUtf8With)++import           Data.Taskell.Date    (dayToOutput)+import           Data.Taskell.List    (List, count, tasks, title, updateFn)+import           Data.Taskell.Lists   (Lists, appendToLast, newList)+import qualified Data.Taskell.Subtask as ST (Subtask, complete, name, new)+import qualified Data.Taskell.Task    as T (Task, addSubtask, appendDescription, description, due,+                                            name, new, setDue, subtasks)++import qualified IO.Config          as C (Config, markdown)+import           IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput,+                                     taskOutput, titleOutput)++-- parse code+trimTilde :: Text -> Text+trimTilde = strip . T.dropAround (== '~')++addSubItem :: Text -> Lists -> Lists+addSubItem t ls = adjust' updateList i ls+  where+    i = length ls - 1+    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+        j = count l - 1++addDescription :: Text -> Lists -> Lists+addDescription t ls = adjust' updateList i ls+  where+    i = length ls - 1+    updateList l = updateFn j (T.appendDescription t) l+      where+        j = count l - 1++addDue :: Text -> Lists -> Lists+addDue t ls = adjust' updateList i ls+  where+    i = length ls - 1+    updateList l = updateFn j (T.setDue t) l+      where+        j = count l - 1++prefix :: Config -> Text -> (Config -> Text) -> (Text -> Lists -> Lists) -> Maybe (Lists -> Lists)+prefix config str get set+    | pre `isPrefixOf` str = Just $ set (drop (length pre) str)+    | otherwise = Nothing+  where+    pre = get config `snoc` ' '++matches :: [(Config -> Text, Text -> Lists -> Lists)]+matches =+    [ (titleOutput, newList)+    , (taskOutput, appendToLast . T.new)+    , (descriptionOutput, addDescription)+    , (dueOutput, addDue)+    , (subtaskOutput, addSubItem)+    ]++start :: Config -> (Lists, [Int]) -> (Text, Int) -> (Lists, [Int])+start config (current, errs) (text, line) =+    case find isJust $ uncurry (prefix config text) <$> matches of+        Just (Just set) -> (set current, errs)+        _ ->+            if not (null (strip text))+                then (current, errs ++ [line])+                else (current, errs)++decodeError :: String -> Maybe Word8 -> Maybe Char+decodeError _ _ = Just '\65533'++parse :: C.Config -> ByteString -> Either Text Lists+parse config s = do+    let lns = lines $ decodeUtf8With decodeError s+    let fn = start (C.markdown config)+    let acc = (empty, [])+    let (lists, errs) = foldl' fn acc $ zip lns [1 ..]+    if null errs+        then Right lists+        else Left $ "could not parse line(s) " ++ intercalate ", " (tshow <$> errs)++-- stringify code+subtaskStringify :: Config -> Text -> ST.Subtask -> Text+subtaskStringify config t st =+    foldl' (++) t [subtaskOutput config, " ", pre, " ", st ^. ST.name, "\n"]+  where+    pre =+        if st ^. ST.complete+            then "[x]"+            else "[ ]"++descriptionStringify :: Config -> Text -> Text+descriptionStringify config desc = concat $ add <$> splitOn "\n" desc+  where+    add d = concat [descriptionOutput config, " ", d, "\n"]++dueStringify :: Config -> Day -> Text+dueStringify config day = concat [dueOutput config, " ", dayToOutput day, "\n"]++nameStringify :: Config -> Text -> Text+nameStringify config desc = concat [taskOutput config, " ", desc, "\n"]++taskStringify :: Config -> Text -> T.Task -> Text+taskStringify config s t =+    foldl'+        (++)+        s+        [ nameStringify config (t ^. T.name)+        , maybe "" (dueStringify config) (t ^. T.due)+        , maybe "" (descriptionStringify config) (t ^. T.description)+        , foldl' (subtaskStringify config) "" (t ^. T.subtasks)+        ]++listStringify :: Config -> Text -> List -> Text+listStringify config text list =+    foldl'+        (++)+        text+        [ if null text+              then ""+              else "\n"+        , titleOutput config+        , " "+        , list ^. title+        , "\n\n"+        , foldl' (taskStringify config) "" (list ^. tasks)+        ]++stringify :: C.Config -> Lists -> ByteString+stringify config ls = encodeUtf8 $ foldl' (listStringify (C.markdown config)) "" ls
+ src/IO/Taskell.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module IO.Taskell where++import ClassyPrelude++import Data.FileEmbed   (embedFile)+import System.Directory (doesFileExist, getCurrentDirectory)++import Config             (usage, version)+import Data.Taskell.Lists (Lists, analyse, initial)++import           IO.Config         (Config, general, github, trello)+import           IO.Config.General (filename)+import qualified IO.Config.GitHub  as GitHub (token)+import qualified IO.Config.Trello  as Trello (token)++import IO.Markdown (parse, stringify)++import qualified IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists)+import qualified IO.HTTP.Trello as Trello (TrelloBoardID, getLists)++import UI.CLI (promptYN)++type ReaderConfig a = ReaderT Config IO a++data Next+    = Output Text+    | Load FilePath+           Lists+    | Exit++parseArgs :: [Text] -> ReaderConfig Next+parseArgs ["-v"]                   = return $ Output version+parseArgs ["-h"]                   = return $ Output usage+parseArgs ["-t", boardID, file]    = loadTrello boardID file+parseArgs ["-g", identifier, file] = loadGitHub identifier file+parseArgs ["-i", file]             = fileInfo file+parseArgs [file]                   = loadFile file+parseArgs []                       = (pack . filename . general <$> ask) >>= loadFile+parseArgs _                        = return $ Output (unlines ["Invalid options", "", usage])++load :: ReaderConfig Next+load = getArgs >>= parseArgs++loadFile :: Text -> ReaderConfig Next+loadFile filepath = do+    mPath <- exists filepath+    case mPath of+        Nothing -> return Exit+        Just path -> do+            content <- readData path+            return $+                case content of+                    Right lists -> Load path lists+                    Left err    -> Output $ pack path ++ ": " ++ err++loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next+loadRemote createFn identifier filepath = do+    let path = unpack filepath+    exists' <- fileExists path+    if exists'+        then return $ Output (filepath ++ " already exists")+        else createFn identifier path++loadTrello :: Trello.TrelloBoardID -> Text -> ReaderConfig Next+loadTrello = loadRemote createTrello++loadGitHub :: GitHub.GitHubIdentifier -> Text -> ReaderConfig Next+loadGitHub = loadRemote createGitHub++fileInfo :: Text -> ReaderConfig Next+fileInfo filepath = do+    let path = unpack filepath+    exists' <- fileExists path+    if exists'+        then do+            content <- readData path+            return $+                case content of+                    Right lists -> Output $ analyse filepath lists+                    Left err    -> Output $ pack path ++ ": " ++ err+        else return Exit++createRemote ::+       (Config -> Maybe token)+    -> Text+    -> (token -> ReaderT token IO (Either Text Lists))+    -> token+    -> FilePath+    -> ReaderConfig Next+createRemote tokenFn missingToken getFn identifier path = do+    config <- ask+    let maybeToken = tokenFn config+    case maybeToken of+        Nothing -> return $ Output missingToken+        Just token -> do+            lists <- lift $ runReaderT (getFn identifier) token+            case lists of+                Left txt -> return $ Output txt+                Right ls -> do+                    create <- promptCreate path+                    if create+                        then do+                            lift $ writeData config ls path+                            return $ Load path ls+                        else return Exit++createTrello :: Trello.TrelloBoardID -> FilePath -> ReaderConfig Next+createTrello =+    createRemote+        (Trello.token . trello)+        (decodeUtf8 $(embedFile "templates/trello-token.txt"))+        Trello.getLists++createGitHub :: GitHub.GitHubIdentifier -> FilePath -> ReaderConfig Next+createGitHub =+    createRemote+        (GitHub.token . github)+        (decodeUtf8 $(embedFile "templates/github-token.txt"))+        GitHub.getLists++exists :: Text -> ReaderConfig (Maybe FilePath)+exists filepath = do+    let path = unpack filepath+    exists' <- fileExists path+    if exists'+        then return $ Just path+        else do+            create <- promptCreate path+            if create+                then do+                    createPath path+                    return $ Just path+                else return Nothing++fileExists :: FilePath -> ReaderConfig Bool+fileExists path = lift $ doesFileExist path++promptCreate :: FilePath -> ReaderConfig Bool+promptCreate path = do+    cwd <- lift $ pack <$> getCurrentDirectory+    lift $ promptYN $ concat ["Create ", cwd, "/", pack path, "?"]++-- creates taskell file+createPath :: FilePath -> ReaderConfig ()+createPath path = do+    config <- ask+    lift (writeData config initial path)++-- writes Tasks to json file+writeData :: Config -> Lists -> FilePath -> IO ()+writeData config tasks path = void (writeFile path $ stringify config tasks)++-- reads json file+readData :: FilePath -> ReaderConfig (Either Text Lists)+readData path = do+    config <- ask+    content <- readFile path+    return $ parse config content
+ src/UI/CLI.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.CLI+  ( prompt+  , promptYN+  ) where++import           ClassyPrelude+import           Data.Text.IO  (hPutStrLn)+import           System.Exit   (exitFailure)++prompt :: Text -> IO Text+prompt s = do+  putStr $ s ++ ": "+  hFlush stdout -- prevents buffering+  getLine++promptYN :: Text -> IO Bool+promptYN s = (==) "y" <$> prompt (s ++ " (y/n)")++exitWithErrorMessage :: Text -> IO ()+exitWithErrorMessage str = hPutStrLn stderr str >> void exitFailure
+ src/UI/Draw.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Draw+    ( draw+    , chooseCursor+    ) where++import ClassyPrelude++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)+import qualified Data.Taskell.Task       as T (Task, countCompleteSubtasks, countSubtasks,+                                               description, due, hasSubtasks, name)+import           Events.State            (normalise)+import           Events.State.Types      (Pointer, State, current, lists, mode)+import           Events.State.Types.Mode (DetailMode (..), InsertType (..), ModalType (..),+                                          Mode (..))+import           IO.Config.Layout        (Config, columnPadding, columnWidth, descriptionIndicator)+import           UI.Field                (Field, field, textField, widgetFromMaybe)+import           UI.Modal                (showModal)+import           UI.Theme+import           UI.Types                (ResourceName (..))++-- | 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+    , dsToday        :: Day+    , dsCurrent      :: Pointer+    , dsField        :: Maybe Field+    , dsEditingTitle :: Bool+    }++-- | 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`+    return $ 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+    return . 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, taskIndex)+        widget = textField text+        widget' = widgetFromMaybe widget taskField+    return $+        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++-- | 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')+            return $+                if i /= selectedList && i >= 0 && i <= 26+                    then singleton col ++ ". "+                    else ""+        else do+            let col = i + 1+            return $+                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+    return $+        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+    return $+        if currentList == listIndex+            then visible widget+            else widget++-- | Renders the search area+renderSearch :: Widget ResourceName -> ReaderDrawState (Widget ResourceName)+renderSearch mainWidget = do+    m <- dsMode <$> ask+    case m of+        Search editing searchField -> do+            colPad <- columnPadding . dsLayout <$> ask+            let attr =+                    withAttr $+                    if editing+                        then taskCurrentAttr+                        else taskAttr+            let widget = attr . padTopBottom 1 . padLeftRight colPad $ txt "/" <+> field searchField+            return $ mainWidget <=> widget+        _ -> return mainWidget++-- | 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+    renderSearch mainWidget++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++-- draw+draw :: Config -> Day -> State -> [Widget ResourceName]+draw layout today state =+    showModal+        normalisedState+        today+        [ runReader+              main+              DrawState+              { dsLists = normalisedState ^. lists+              , dsMode = stateMode+              , dsLayout = layout+              , dsToday = today+              , dsField = getField stateMode+              , dsCurrent = normalisedState ^. current+              , dsEditingTitle = editingTitle stateMode+              }+        ]+  where+    normalisedState = normalise state+    stateMode = state ^. mode++-- cursors+chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName)+chooseCursor state =+    case normalise state ^. mode of+        Insert {}                         -> showCursorNamed RNCursor+        Search True _                     -> showCursorNamed RNCursor+        Modal (Detail _ (DetailInsert _)) -> showCursorNamed RNCursor+        _                                 -> neverShowCursor state
+ src/UI/Field.hs view
@@ -0,0 +1,138 @@+{-# 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]
+ src/UI/Modal.hs view
@@ -0,0 +1,40 @@+{-# 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 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 :: (Text, Widget ResourceName) -> Widget ResourceName+surround (title, widget) =+    padTopBottom 1 .+    centerLayer .+    border . padTopBottom 1 . padLeftRight 4 . hLimit 50 . (t <=>) . viewport RNModal Vertical $+    widget+  where+    t = padBottom (Pad 1) . withAttr titleAttr $ textField title++showModal :: State -> Day -> [Widget ResourceName] -> [Widget ResourceName]+showModal state today view =+    case state ^. mode of+        Modal Help      -> surround help : view+        Modal Detail {} -> surround (detail state today) : view+        Modal MoveTo    -> surround (moveTo state) : view+        _               -> view
+ src/UI/Modal/Detail.hs view
@@ -0,0 +1,84 @@+{-# 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+        return (task ^. name, renderDate today f i task <=> renderSummary f i task <=> w)
+ src/UI/Modal/Help.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.Modal.Help+    ( help+    ) where++import ClassyPrelude++import Brick+import Data.FileEmbed (embedFile)+import Data.Text      as T (breakOn, justifyRight, replace, strip)++import UI.Field (textField)+import UI.Theme (taskCurrentAttr)+import UI.Types (ResourceName)++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 . T.strip . drop 1 $ r++help :: (Text, Widget ResourceName)+help = ("Controls", w)+  where+    ls = lines $ decodeUtf8 $(embedFile "templates/controls.md")+    (l, r) = unzip $ breakOn ":" . T.replace "`" "" . T.strip . drop 1 <$> ls+    m = foldl' max 0 $ length <$> l+    w = vBox $ line m <$> zip l r
+ src/UI/Modal/MoveTo.hs view
@@ -0,0 +1,32 @@+{-# 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)
+ src/UI/Theme.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UI.Theme+    ( titleAttr+    , titleCurrentAttr+    , taskCurrentAttr+    , taskAttr+    , disabledAttr+    , dlToAttr+    , defaultTheme+    ) where++import Brick        (AttrName, attrName)+import Brick.Themes (Theme, newTheme)+import Brick.Util   (fg)+import Graphics.Vty (blue, defAttr, green, magenta, red, yellow)++import Data.Taskell.Date (Deadline (..))++-- attrs+titleAttr :: AttrName+titleAttr = attrName "title"++titleCurrentAttr :: AttrName+titleCurrentAttr = attrName "titleCurrent"++taskCurrentAttr :: AttrName+taskCurrentAttr = attrName "taskCurrent"++taskAttr :: AttrName+taskAttr = attrName "task"++disabledAttr :: AttrName+disabledAttr = attrName "disabled"++dlDue, dlSoon, dlFar :: AttrName+dlDue = attrName "dlDue"++dlSoon = attrName "dlSoon"++dlFar = attrName "dlFar"++-- convert deadline into attribute+dlToAttr :: Deadline -> AttrName+dlToAttr dl =+    case dl of+        Plenty   -> dlFar+        ThisWeek -> dlSoon+        Tomorrow -> dlSoon+        Today    -> dlDue+        Passed   -> dlDue++-- default theme+defaultTheme :: Theme+defaultTheme =+    newTheme+        defAttr+        [ (titleAttr, fg green)+        , (titleCurrentAttr, fg blue)+        , (taskCurrentAttr, fg magenta)+        , (disabledAttr, fg yellow)+        , (dlDue, fg red)+        , (dlSoon, fg yellow)+        , (dlFar, fg green)+        ]
+ src/UI/Types.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}++module UI.Types where++import ClassyPrelude (Eq, Int, Ord, Show)++data ResourceName+    = RNCursor+    | RNTask (Int, Int)+    | RNList Int+    | RNLists+    | RNModal+    deriving (Show, Eq, Ord)
+ taskell.cabal view
@@ -0,0 +1,156 @@+cabal-version: 1.12+name: taskell+version: 1.3.5.0+license: BSD3+license-file: LICENSE+copyright: 2019 Mark Wales+maintainer: mark@smallhadroncollider.com+author: Mark Wales+homepage: https://github.com/smallhadroncollider/taskell#readme+bug-reports: https://github.com/smallhadroncollider/taskell/issues+synopsis: A command-line kanban board/task manager+description:+    Please see the README on GitHub at <https://github.com/smallhadroncollider/taskell#readme>+category: Command Line Tools+build-type: Simple+extra-source-files:+    README.md+    templates/api-error.txt+    templates/config.ini+    templates/controls.md+    templates/github-token.txt+    templates/theme.ini+    templates/trello-token.txt+    templates/usage.txt++source-repository head+    type: git+    location: https://github.com/smallhadroncollider/taskell++library+    exposed-modules:+        App+        Events.State+        IO.Config+        IO.Taskell+        Data.Taskell.Date+        Data.Taskell.List+        Data.Taskell.List.Internal+        Data.Taskell.Lists+        Data.Taskell.Lists.Internal+        Data.Taskell.Seq+        Data.Taskell.Subtask+        Data.Taskell.Subtask.Internal+        Data.Taskell.Task+        Data.Taskell.Task.Internal+        Events.State.Types+        Events.State.Types.Mode+        IO.Config.Markdown+        IO.Markdown.Internal+        IO.HTTP.GitHub+        IO.HTTP.Trello.List+        IO.HTTP.Trello.ChecklistItem+        UI.Field+    hs-source-dirs: src+    other-modules:+        Config+        Events.Actions+        Events.Actions.Insert+        Events.Actions.Modal+        Events.Actions.Modal.Detail+        Events.Actions.Modal.Help+        Events.Actions.Modal.MoveTo+        Events.Actions.Normal+        Events.Actions.Search+        Events.State.Modal.Detail+        IO.Config.General+        IO.Config.GitHub+        IO.Config.Layout+        IO.Config.Parser+        IO.Config.Trello+        IO.HTTP.Aeson+        IO.HTTP.GitHub.Card+        IO.HTTP.GitHub.Column+        IO.HTTP.GitHub.Project+        IO.HTTP.Trello+        IO.HTTP.Trello.Card+        IO.Markdown+        UI.CLI+        UI.Draw+        UI.Modal+        UI.Modal.Detail+        UI.Modal.Help+        UI.Modal.MoveTo+        UI.Theme+        UI.Types+        Paths_taskell+    default-language: Haskell2010+    default-extensions: OverloadedStrings NoImplicitPrelude+    build-depends:+        aeson >=1.3.1.1 && <1.4,+        base >=4.11.1.0 && <=5,+        brick >=0.37.2 && <0.38,+        bytestring >=0.10.8.2 && <0.11,+        classy-prelude >=1.4.0 && <1.5,+        config-ini >=0.2.2.0 && <0.3,+        containers >=0.5.11.0 && <0.6,+        directory >=1.3.1.5 && <1.4,+        file-embed >=0.0.10.1 && <0.1,+        fold-debounce >=0.2.0.8 && <0.3,+        http-client >=0.5.14 && <0.6,+        http-conduit >=2.3.2 && <2.4,+        http-types >=0.12.2 && <0.13,+        lens >=4.16.1 && <4.17,+        mtl >=2.2.2 && <2.3,+        template-haskell >=2.13.0.0 && <2.14,+        text >=1.2.3.1 && <1.3,+        time >=1.8.0.2 && <1.9,+        vty ==5.21.*++executable taskell+    main-is: Main.hs+    hs-source-dirs: app+    other-modules:+        Paths_taskell+    default-language: Haskell2010+    default-extensions: OverloadedStrings NoImplicitPrelude+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        base >=4.11.1.0 && <4.12,+        classy-prelude >=1.4.0 && <1.5,+        taskell -any++test-suite taskell-test+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    hs-source-dirs: test+    other-modules:+        Data.Taskell.DateTest+        Data.Taskell.ListsTest+        Data.Taskell.ListTest+        Data.Taskell.SeqTest+        Data.Taskell.SubtaskTest+        Data.Taskell.TaskTest+        Events.StateTest+        IO.GitHubTest+        IO.MarkdownTest+        IO.TrelloTest+        UI.FieldTest+        Paths_taskell+    default-language: Haskell2010+    default-extensions: OverloadedStrings NoImplicitPrelude+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        aeson >=1.3.1.1 && <1.4,+        base >=4.11.1.0 && <4.12,+        classy-prelude >=1.4.0 && <1.5,+        containers >=0.5.11.0 && <0.6,+        file-embed >=0.0.10.1 && <0.1,+        lens >=4.16.1 && <4.17,+        taskell -any,+        tasty >=1.1.0.4 && <1.2,+        tasty-discover >=4.2.1 && <4.3,+        tasty-expected-failure >=0.11.1.1 && <0.12,+        tasty-hunit >=0.10.0.1 && <0.11,+        text >=1.2.3.1 && <1.3,+        time >=1.8.0.2 && <1.9
+ templates/api-error.txt view
@@ -0,0 +1,2 @@+Could not parse response. Please file an Issue on GitHub:+https://github.com/smallhadroncollider/taskell/issues/new
+ templates/config.ini view
@@ -0,0 +1,14 @@+[general]+filename = taskell.md++[layout]+column_width = 30+column_padding = 3+description_indicator = "≡"++[markdown]+title = "##"+task = "-"+summary = "    >"+due = "    @"+subtask = "    *"
+ templates/controls.md view
@@ -0,0 +1,23 @@+- `?`: Show this list of controls+- `j` / `k` / `h` / `l`: Move down/up/left/right+- `G`: Go to bottom of list+- `1`-`9`: Select list+- `a`: Add a task+- `O` / `o`: Add a task above/below+- `e`, `i`, `A`: Edit a task+- `C`: Change task+- `Enter`: Show task details / Edit task description+- `@`: Add/edit due date (yyyy-mm-dd)+- `J` / `K`: Shift task down/up+- `H` / `L`: Shift task left/right+- `Space`: Shift task right+- `m`: Move task to specific list+- `D`: Delete task+- `u`: Undo+- `N`: New list+- `E`: Edit list title+- `X`: Delete list+- `<` / `>`: Move list left/right+- `/`: Search+- `Esc`: Return to lists+- `q`: Quit
+ templates/github-token.txt view
@@ -0,0 +1,10 @@+Please visit:++https://github.com/settings/tokens/new++Make sure to tick the "repo" scope.++When you have your personal access token, add it to ~/.taskell/config.ini:++[github]+token = <your-github-personal-access-token>
+ templates/theme.ini view
@@ -0,0 +1,13 @@+[other]++; list title+title.fg = green++; current list title+titleCurrent.fg = blue++; current task+taskCurrent.fg = magenta++; disabled+disabled.fg = yellow
+ templates/trello-token.txt view
@@ -0,0 +1,8 @@+Please visit:++https://trello.com/1/authorize?expiration=never&name=taskell&scope=read&response_type=token&key=80dbcf6f88f62cc5639774e13342c20b++When you have your access token, add it to ~/.taskell/config.ini:++[trello]+token = <your-trello-access-token>
+ templates/usage.txt view
@@ -0,0 +1,9 @@+Usage: taskell ([options] | [-i | -t <trello-board-id> | -g [orgs/<org> | repos/<username>/<repo>]] file)++Options:++-h                                               Help+-v                                               Version number+-i file                                          Display information about a file+-t <trello-board-id> file                        Create a new taskell file from the given Trello board ID+-g [orgs/<org> | repos/<username>/<repo>] file   Create a new taskell file from the given GitHub identifier
+ test/Data/Taskell/DateTest.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.DateTest+    ( test_date+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Taskell.Date+import Data.Time++testDate :: Day+testDate = fromGregorian 2018 05 18++-- tests+test_date :: TestTree+test_date =+    testGroup+        "Data.Taskell.Date"+        [ testCase+              "dayToOutput"+              (assertEqual+                   "Date in yyyy-mm-dd format"+                   (Just "2018-05-18")+                   (dayToOutput <$> fromGregorianValid 2018 05 18))+        , testGroup+              "dayToText"+              [ testCase+                    "same year"+                    (assertEqual+                         "Date in 18-May format"+                         (Just "18-May")+                         (dayToText <$> fromGregorianValid 2018 08 18 <*>+                          fromGregorianValid 2018 05 18))+              , testCase+                    "different year"+                    (assertEqual+                         "Date in 18-May 2019 format"+                         (Just "18-May 2019")+                         (dayToText <$> fromGregorianValid 2018 08 18 <*>+                          fromGregorianValid 2019 05 18))+              , testCase+                    "different year"+                    (assertEqual+                         "Date in 18-May 2017 format"+                         (Just "18-May 2017")+                         (dayToText <$> fromGregorianValid 2018 08 18 <*>+                          fromGregorianValid 2017 05 18))+              ]+        , testCase+              "textToDay"+              (assertEqual "A valid Day" (fromGregorianValid 2018 05 18) (textToDay "2018-05-18"))+        , testGroup+              "deadline"+              [ testCase+                    "Plenty"+                    (assertEqual+                         "Plenty of time"+                         Plenty+                         (deadline testDate (fromGregorian 2018 05 28)))+              , testCase+                    "ThisWeek"+                    (assertEqual "This week" ThisWeek (deadline testDate (fromGregorian 2018 05 24)))+              , testCase+                    "Tomorrow"+                    (assertEqual "Tomorrow" Tomorrow (deadline testDate (fromGregorian 2018 05 19)))+              , testCase "Today" (assertEqual "Today" Today (deadline testDate testDate))+              , testCase+                    "Passed"+                    (assertEqual "Passed" Passed (deadline testDate (fromGregorian 2018 05 17)))+              ]+        ]
+ test/Data/Taskell/ListTest.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.ListTest+    ( test_list+    ) where++import ClassyPrelude as CP++import Control.Lens ((.~))++import Test.Tasty+import Test.Tasty.HUnit++import           Data.Taskell.List.Internal as L+import qualified Data.Taskell.Task          as T (Task, blank, name, new)++emptyList :: List+emptyList = L.empty "Test"++taskSeq :: Seq T.Task+taskSeq = fromList [T.new "Hello", T.new "Blah", T.new "Fish"]++populatedList :: List+populatedList = List "Populated" taskSeq++-- tests+test_list :: TestTree+test_list =+    testGroup+        "Data.Taskell.List"+        [ testCase+              "create"+              (assertEqual "Empty list with title" (List "Test" CP.empty) (create "Test" CP.empty))+        , testCase "empty" (assertEqual "Empty list with title" (List "Test" CP.empty) emptyList)+        , testCase+              "new"+              (assertEqual+                   "List with title and blank Task"+                   (List "Test" (fromList [T.blank]))+                   (new emptyList))+        , testGroup+              "count"+              [ testCase "empty" (assertEqual "List length" 0 (count emptyList))+              , testCase "one item" (assertEqual "List length" 1 (count $ new emptyList))+              ]+        , testCase+              "newAt"+              (assertEqual+                   "List with new item second position"+                   (List "Populated" (fromList [T.new "Hello", T.blank, T.new "Blah", T.new "Fish"]))+                   (newAt 1 populatedList))+        , testGroup+              "append"+              [ testCase+                    "populated"+                    (assertEqual+                         "List with new item"+                         (List+                              "Populated"+                              (fromList [T.new "Hello", T.new "Blah", T.new "Fish", T.new "Spoon"]))+                         (append (T.new "Spoon") populatedList))+              , testCase+                    "empty"+                    (assertEqual+                         "List with new item"+                         (List "Test" (fromList [T.new "Spoon"]))+                         (append (T.new "Spoon") emptyList))+              ]+        , testCase+              "extract"+              (assertEqual+                   "List and extracted item"+                   (Just (List "Populated" (fromList [T.new "Hello", T.new "Fish"]), T.new "Blah"))+                   (extract 1 populatedList))+        , testCase+              "updateFn"+              (assertEqual+                   "List with updated item"+                   (List "Populated" (fromList [T.new "Hello", T.new "Monkey", T.new "Fish"]))+                   (updateFn 1 (T.name .~ "Monkey") populatedList))+        , testCase+              "update"+              (assertEqual+                   "List with updated item"+                   (List "Populated" (fromList [T.new "Hello", T.new "Monkey", T.new "Fish"]))+                   (update 1 (T.new "Monkey") populatedList))+        , testGroup+              "move"+              [ testCase+                    "up"+                    (assertEqual+                         "List with moved item"+                         (Just+                              (List+                                   "Populated"+                                   (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])))+                         (move 1 1 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))+              , 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))+              , 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))+              ]+        , testCase+              "deleteTask"+              (assertEqual+                   "List with removed item"+                   (List "Populated" (fromList [T.new "Hello", T.new "Fish"]))+                   (deleteTask 1 populatedList))+        , testGroup+              "getTask"+              [ testCase+                    "exists"+                    (assertEqual "Middle item" (Just (T.new "Blah")) (getTask 1 populatedList))+              , testCase "doesn't exist" (assertEqual "Nothing" Nothing (getTask 5 populatedList))+              ]+        , testGroup+              "searchFor"+              [ testCase+                    "exists"+                    (assertEqual+                         "Blah item"+                         (List "Populated" (fromList [T.new "Blah"]))+                         (searchFor "Bl" populatedList))+              , testCase+                    "multiple"+                    (assertEqual+                         "Blah and Fish"+                         (List "Populated" (fromList [T.new "Blah", T.new "Fish"]))+                         (searchFor "h" populatedList))+              , testCase+                    "doesn't exist"+                    (assertEqual+                         "Empty list"+                         (List "Populated" CP.empty)+                         (searchFor "FFF" populatedList))+              ]+        ]
+ test/Data/Taskell/ListsTest.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.ListsTest+    ( test_lists+    ) where++import ClassyPrelude hiding (delete)++import Test.Tasty+import Test.Tasty.HUnit++import qualified Data.Taskell.List           as L+import           Data.Taskell.Lists.Internal+import qualified Data.Taskell.Task           as T++-- 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"]++list2 = foldl' (flip L.append) (L.empty "List 2") [T.new "1", T.new "2", T.new "3"]++list3 = foldl' (flip L.append) (L.empty "List 3") [T.new "01", T.new "10", T.new "11"]++testLists :: Lists+testLists = fromList [list1, list2, list3]++-- tests+test_lists :: TestTree+test_lists =+    testGroup+        "Data.Taskell.Lists"+        [ testCase+              "initial"+              (assertEqual+                   "Returns To Do and Done lists"+                   (fromList [L.empty "To Do", L.empty "Done"])+                   initial)+        , testCase+              "updateLists"+              (assertEqual+                   "Replaces the middle list"+                   (fromList [list1, list1, list3])+                   (updateLists 1 list1 testLists))+        , testGroup+              "count"+              [ testCase+                    "list exists"+                    (assertEqual "Returns length of middle list" 3 (count 1 testLists))+              , testCase "list does not exist" (assertEqual "Returns 0" 0 (count 10 testLists))+              ]+        , testGroup+              "get"+              [ testCase+                    "list exists"+                    (assertEqual "Returns the list" (Just list2) (get testLists 1))+              , testCase "list does not exist" (assertEqual "Nothing" Nothing (get testLists 10))+              ]+        , testGroup+              "changeList"+              [ testCase+                    "right"+                    (assertEqual+                         "Returns updated lists"+                         (Just+                              (fromList+                                   [ list1+                                   , foldl'+                                         (flip L.append)+                                         (L.empty "List 2")+                                         [T.new "1", T.new "3"]+                                   , foldl'+                                         (flip L.append)+                                         (L.empty "List 3")+                                         [T.new "01", T.new "10", T.new "11", T.new "2"]+                                   ]))+                         (changeList (1, 1) testLists 1))+              , testCase+                    "left"+                    (assertEqual+                         "Returns updated lists"+                         (Just+                              (fromList+                                   [ foldl'+                                         (flip L.append)+                                         (L.empty "List 1")+                                         [T.new "One", T.new "Two", T.new "Three", T.new "2"]+                                   , foldl'+                                         (flip L.append)+                                         (L.empty "List 2")+                                         [T.new "1", T.new "3"]+                                   , list3+                                   ]))+                         (changeList (1, 1) testLists (-1)))+              , testCase+                    "out of bounds list"+                    (assertEqual "Nothing" Nothing (changeList (5, 1) testLists 1))+              , testCase+                    "out of bounds task"+                    (assertEqual "Nothing" Nothing (changeList (1, 10) testLists 1))+              ]+        , testCase+              "newList"+              (assertEqual+                   "Returns lists with new list"+                   (fromList [list1, list2, list3, L.empty "Hello"])+                   (newList "Hello" testLists))+        , testCase+              "delete"+              (assertEqual+                   "Returns lists with middle list removed"+                   (fromList [list1, list3])+                   (delete 1 testLists))+        , testGroup+              "exists"+              [ testCase "list exists" (assertEqual "Returns True" True (exists 1 testLists))+              , testCase+                    "list does not exist"+                    (assertEqual "Returns False" False (exists 10 testLists))+              ]+        , testGroup+              "shiftBy"+              [ testCase+                    "right"+                    (assertEqual+                         "Returns updated lists"+                         (Just (fromList [list1, list3, list2]))+                         (shiftBy 1 1 testLists))+              , testCase+                    "left"+                    (assertEqual+                         "Returns updated lists"+                         (Just (fromList [list2, list1, list3]))+                         (shiftBy 1 (-1) testLists))+              , testCase+                    "out of bounds list"+                    (assertEqual "Nothing" Nothing (shiftBy 5 1 testLists))+              , testCase+                    "out of bounds shift"+                    (assertEqual+                         "Returns updated lists"+                         (Just (fromList [list2, list1, list3]))+                         (shiftBy 1 (-10) testLists))+              ]+        , testGroup+              "search"+              [ testCase+                    "term exists"+                    (assertEqual+                         "Returns filtered lists"+                         (fromList+                              [ foldl' (flip L.append) (L.empty "List 1") [T.new "One"]+                              , L.empty "List 2"+                              , L.empty "List 3"+                              ])+                         (search "One" testLists))+              , testCase+                    "term doesn't exist"+                    (assertEqual+                         "Returns updated lists"+                         (fromList [L.empty "List 1", L.empty "List 2", L.empty "List 3"])+                         (search "Fish" testLists))+              ]+        , testGroup+              "appendToLast"+              [ testCase+                    "previous list exists"+                    (assertEqual+                         "Returns updated lists"+                         (fromList+                              [ list1+                              , list2+                              , foldl'+                                    (flip L.append)+                                    (L.empty "List 3")+                                    [T.new "01", T.new "10", T.new "11", T.new "Blah"]+                              ])+                         (appendToLast (T.new "Blah") testLists))+              , testCase+                    "previous list doesn't exist"+                    (assertEqual "Returns original list" empty (appendToLast (T.new "Blah") empty))+              ]+        , testCase+              "analyse"+              (assertEqual+                   "Returns an analysis"+                   "test.md\nLists: 3\nTasks: 9"+                   (analyse "test.md" testLists))+        ]
+ test/Data/Taskell/SeqTest.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.SeqTest+    ( test_seq+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Taskell.Seq++testSeq :: Seq Int+testSeq = fromList [1, 2, 3, 4, 5]++-- tests+test_seq :: TestTree+test_seq =+    testGroup+        "Data.Taskell.Seq"+        [ testGroup+              "extract"+              [ testCase+                    "Standard"+                    (assertEqual+                         "Extracts third item"+                         (Just (fromList [1, 2, 4, 5], 3))+                         (extract 2 testSeq))+              , testCase+                    "First"+                    (assertEqual+                         "Extracts first item"+                         (Just (fromList [2, 3, 4, 5], 1))+                         (extract 0 testSeq))+              , testCase+                    "Last"+                    (assertEqual+                         "Extracts last item"+                         (Just (fromList [1, 2, 3, 4], 5))+                         (extract 4 testSeq))+              , testCase+                    "Out of range - positive"+                    (assertEqual "Nothing" Nothing (extract 5 testSeq))+              , testCase+                    "Out of range - negative"+                    (assertEqual "Nothing" Nothing (extract (-1) testSeq))+              ]+        , testGroup+              "shiftBy"+              [ testCase+                    "To right"+                    (assertEqual+                         "Moves third item right"+                         (Just (fromList [1, 2, 4, 3, 5]))+                         (shiftBy 2 1 testSeq))+              , testCase+                    "To left"+                    (assertEqual+                         "Moves third item left"+                         (Just (fromList [1, 3, 2, 4, 5]))+                         (shiftBy 2 (-1) testSeq))+              , testCase+                    "First to right"+                    (assertEqual+                         "Moves first item right"+                         (Just (fromList [2, 1, 3, 4, 5]))+                         (shiftBy 0 1 testSeq))+              , testCase+                    "First to left"+                    (assertEqual "The original sequence" (Just testSeq) (shiftBy 0 (-1) testSeq))+              , testCase+                    "Last to right"+                    (assertEqual "The original sequence" (Just testSeq) (shiftBy 4 1 testSeq))+              , testCase+                    "Last to left"+                    (assertEqual+                         "Moves last item left"+                         (Just (fromList [1, 2, 3, 5, 4]))+                         (shiftBy 4 (-1) testSeq))+              , testCase+                    "Ridiculous right shift"+                    (assertEqual+                         "Moves to right-most"+                         (Just (fromList [1, 2, 4, 5, 3]))+                         (shiftBy 2 20 testSeq))+              , testCase+                    "Ridiculous left shift"+                    (assertEqual+                         "Moves to left-most"+                         (Just (fromList [3, 1, 2, 4, 5]))+                         (shiftBy 2 (-20) testSeq))+              ]+        ]
+ test/Data/Taskell/SubtaskTest.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.SubtaskTest+    ( test_subtask+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Taskell.Subtask.Internal++-- tests+test_subtask :: TestTree+test_subtask =+    testGroup+        "Data.Taskell.Subtask"+        [ testCase "blank" (assertEqual "creates an empty sub-task" (Subtask "" False) blank)+        , testGroup+              "new"+              [ testCase+                    "completed"+                    (assertEqual "creates a new sub-task" (Subtask "Blah" True) (new "Blah" True))+              , testCase+                    "not completed"+                    (assertEqual "creates a new sub-task" (Subtask "Blah" False) (new "Blah" False))+              ]+        , testGroup+              "toggle"+              [ testCase+                    "false to true"+                    (assertEqual+                         "Sets completed to True"+                         (Subtask "Blah" True)+                         (toggle $ new "Blah" False))+              , testCase+                    "true to false"+                    (assertEqual+                         "Sets completed to False"+                         (Subtask "Blah" False)+                         (toggle $ new "Blah" True))+              ]+        ]
+ test/Data/Taskell/TaskTest.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Taskell.TaskTest+    ( test_task+    ) where++import ClassyPrelude++import Control.Lens ((.~))++import Test.Tasty+import Test.Tasty.HUnit++import Data.Time (fromGregorianValid)++import qualified Data.Taskell.Subtask       as ST (name, new)+import           Data.Taskell.Task.Internal++testTask :: Task+testTask =+    Task+    { _name = "Test"+    , _description = Nothing+    , _subtasks = fromList [ST.new "One" True, ST.new "Two" False, ST.new "Three" False]+    , _due = Nothing+    }++-- tests+test_task :: TestTree+test_task =+    testGroup+        "Data.Taskell.Task"+        [ testCase "blank" (assertEqual "Returns empty task" (Task "" Nothing empty Nothing) blank)+        , testCase+              "new"+              (assertEqual "Returns a new task" (Task "Hello" Nothing empty Nothing) (new "Hello"))+        , testGroup+              "getSubtask"+              [ testCase+                    "exists"+                    (assertEqual+                         "Returns a the sub-task"+                         (Just (ST.new "Two" False))+                         (getSubtask 1 testTask))+              , testCase+                    "doesn't exist"+                    (assertEqual "Returns Nothing" Nothing (getSubtask 10 testTask))+              ]+        , testGroup+              "setDescription"+              [ testCase+                    "empty sub-tasks"+                    (assertEqual+                         "Updates description"+                         (Task "Test" (Just "Description") empty Nothing)+                         (setDescription "Description" (new "Test")))+              , testCase+                    "empty"+                    (assertEqual+                         "Keeps description as Nothing"+                         (new "Test")+                         (setDescription "" (new "Test")))+              , testCase+                    "blank"+                    (assertEqual+                         "Keeps description as Nothing"+                         (new "Test")+                         (setDescription "   " (new "Test")))+              ]+        , testGroup+              "addSubtask"+              [ testCase+                    "existing"+                    (assertEqual+                         "Returns the task with added subtask"+                         (Task+                              "Test"+                              Nothing+                              (fromList+                                   [ ST.new "One" True+                                   , ST.new "Two" False+                                   , ST.new "Three" False+                                   , ST.new "Four" True+                                   ])+                              Nothing)+                         (addSubtask (ST.new "Four" True) testTask))+              , testCase+                    "empty sub-tasks"+                    (assertEqual+                         "Returns the task with added subtask"+                         (Task "Test" Nothing (fromList [ST.new "One" False]) Nothing)+                         (addSubtask (ST.new "One" False) (new "Test")))+              ]+        , testGroup+              "hasSubtasks"+              [ testCase "existing" (assertEqual "Returns True" True (hasSubtasks testTask))+              , testCase+                    "empty sub-tasks"+                    (assertEqual "Returns False" False (hasSubtasks (new "Test")))+              ]+        , testGroup+              "updateSubtask"+              [ testCase+                    "exists"+                    (assertEqual+                         "Returns updated task"+                         (Task+                              "Test"+                              Nothing+                              (fromList+                                   [ST.new "One" True, ST.new "Cow" False, ST.new "Three" False])+                              Nothing)+                         (updateSubtask 1 (ST.name .~ "Cow") testTask))+              , testCase+                    "doesn't exist"+                    (assertEqual+                         "Returns task"+                         (Task+                              "Test"+                              Nothing+                              (fromList+                                   [ST.new "One" True, ST.new "Two" False, ST.new "Three" False])+                              Nothing)+                         (updateSubtask 10 (ST.name .~ "Cow") testTask))+              ]+        , testGroup+              "removeSubtask"+              [ testCase+                    "exists"+                    (assertEqual+                         "Returns updated task"+                         (Task+                              "Test"+                              Nothing+                              (fromList [ST.new "One" True, ST.new "Three" False])+                              Nothing)+                         (removeSubtask 1 testTask))+              , testCase+                    "doesn't exist"+                    (assertEqual+                         "Returns task"+                         (Task+                              "Test"+                              Nothing+                              (fromList+                                   [ST.new "One" True, ST.new "Two" False, ST.new "Three" False])+                              Nothing)+                         (removeSubtask 10 testTask))+              ]+        , testCase "countSubtasks" (assertEqual "Returns 3" 3 (countSubtasks testTask))+        , testCase+              "countCompleteSubtasks"+              (assertEqual "Returns 1" 1 (countCompleteSubtasks testTask))+        , testGroup+              "contains"+              [ testCase "in task" (assertEqual "Finds in task" True (contains "Test" testTask))+              , testCase "in sub-task" (assertEqual "Find sub-task" True (contains "One" testTask))+              , testCase "missing" (assertEqual "Find sub-task" False (contains "Fish" testTask))+              ]+        , testGroup+              "isBlank"+              [ testCase+                    "blank"+                    (assertEqual "Return True" True (isBlank (Task "" Nothing empty Nothing)))+              , testCase "name not blank" (assertEqual "Returns False" False (isBlank testTask))+              , testCase+                    "description not blank"+                    (assertEqual+                         "Returns False"+                         False+                         (isBlank (Task "" (Just "Blah") empty Nothing)))+              , testCase+                    "subtasks not blank"+                    (assertEqual+                         "Returns False"+                         False+                         (isBlank (Task "" Nothing (fromList [ST.new "One" True]) Nothing)))+              , testCase+                    "due date not blank"+                    (assertEqual+                         "Returns False"+                         False+                         (isBlank (Task "" Nothing empty (fromGregorianValid 2018 05 18))))+              ]+        ]
+ test/Events/StateTest.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Events.StateTest+    ( test_state+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Control.Lens ((&), (.~), (^.))++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++testState :: State+testState =+    State+    { _mode = Normal+    , _lists = empty+    , _history = []+    , _current = (0, 0)+    , _path = "test.md"+    , _io = Nothing+    }++moveToState :: State+moveToState =+    State+    { _mode = Modal MoveTo+    , _lists =+          fromList+              [ L.empty "List 1"+              , L.empty "List 2"+              , L.empty "List 3"+              , L.empty "List 4"+              , L.append (T.new "Test Item") (L.empty "List 5")+              , L.empty "List 6"+              , L.empty "List 7"+              , L.empty "List 8"+              , L.empty "List 9"+              ]+    , _history = []+    , _current = (4, 0)+    , _path = "test.md"+    , _io = Nothing+    }++-- tests+test_state :: TestTree+test_state =+    testGroup+        "Events.State"+        [ testCase+              "quit"+              (assertEqual+                   "Retuns Just with mode set to Shutdown"+                   (Just (testState & mode .~ Shutdown))+                   (quit testState))+        , testCase+              "continue"+              (assertEqual "Retuns with io set to " (testState & io .~ Nothing) (continue testState))+        -- 1 - a, 2 - b, 3 - c, 4 - d, 5 - e, 6 - f, 7 - g, 8 - h, 9 - i+        , testGroup+              "moveTo"+              [ testCase+                    "first"+                    (assertEqual+                         "Moves to first list"+                         (Just (L.append (T.new "Test Item") (L.empty "List 1")))+                         (S.lookup 0 . (^. lists) =<< moveTo 'a' moveToState))+              , testCase+                    "second"+                    (assertEqual+                         "Moves to second list"+                         (Just (L.append (T.new "Test Item") (L.empty "List 2")))+                         (S.lookup 1 . (^. lists) =<< moveTo 'b' moveToState))+              , testCase+                    "fourth"+                    (assertEqual+                         "Moves to fourth list"+                         (Just (L.append (T.new "Test Item") (L.empty "List 4")))+                         (S.lookup 3 . (^. lists) =<< moveTo 'd' moveToState))+              , testCase+                    "sixth"+                    (assertEqual+                         "Moves to sixth list"+                         (Just (L.append (T.new "Test Item") (L.empty "List 6")))+                         (S.lookup 5 . (^. lists) =<< moveTo 'f' moveToState))+              , testCase+                    "penultimate"+                    (assertEqual+                         "Moves to penultime list"+                         (Just (L.append (T.new "Test Item") (L.empty "List 8")))+                         (S.lookup 7 . (^. lists) =<< moveTo 'h' moveToState))+              , testCase+                    "last"+                    (assertEqual+                         "Moves to last list"+                         (Just (L.append (T.new "Test Item") (L.empty "List 9")))+                         (S.lookup 8 . (^. lists) =<< moveTo 'i' moveToState))+              , testCase+                    "current list"+                    (assertEqual "Doesn't do anything" Nothing (moveTo 'e' moveToState))+              , testCase+                    "invalid option"+                    (assertEqual "Doesn't do anything" Nothing (moveTo 'q' moveToState))+              ]+        ]
+ test/IO/GitHubTest.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.GitHubTest+    ( test_github+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import IO.HTTP.GitHub (getNextLink)++-- tests+test_github :: TestTree+test_github =+    testGroup+        "IO.HTTP.GitHub"+        [ testGroup+              "getNextLink"+              [ testCase+                    "next exists"+                    (assertEqual+                         "Parses next link"+                         (Just "https://api.github.com/projects/columns/3152155/cards?page=2")+                         (getNextLink+                              [ "<https://api.github.com/projects/columns/3152155/cards?page=2>; rel=\"next\", <https://api.github.com/projects/columns/3152155/cards?page=2>; rel=\"last\""+                              ]))+              , testCase "empty" (assertEqual "Returns Nothing" Nothing (getNextLink []))+              , testCase+                    "no next"+                    (assertEqual+                         "Returns Nothing"+                         Nothing+                         (getNextLink+                              [ "<https://api.github.com/projects/columns/3152155/cards?page=2>; rel=\"prev\", <https://api.github.com/projects/columns/3152155/cards?page=2>; rel=\"last\""+                              ]))+              , testCase+                    "next last"+                    (assertEqual+                         "Parses next link"+                         (Just "https://api.github.com/projects/columns/3152155/cards?page=2")+                         (getNextLink+                              [ "<https://api.github.com/projects/columns/3152155/cards?page=1>; rel=\"prev\", <https://api.github.com/projects/columns/3152155/cards?page=2>; rel=\"next\", <https://api.github.com/projects/columns/3152155/cards?page=3>; rel=\"last\""+                              ]))+              ]+        ]
+ test/IO/MarkdownTest.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.MarkdownTest+    ( test_markdown+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.ExpectedFailure (ignoreTest)+import Test.Tasty.HUnit++import           Data.Taskell.Lists   (Lists, appendToLast, newList)+import qualified Data.Taskell.Subtask as ST (new)+import           Data.Taskell.Task    (Task, addSubtask, new, setDescription, setDue)+import qualified IO.Config            as C (defaultConfig)+import           IO.Config.Markdown   (Config (..), defaultConfig)+import           IO.Markdown.Internal (listStringify, parse, start)++-- alternative markdown configs+alternativeConfig :: Config+alternativeConfig =+    Config+    { titleOutput = "##"+    , taskOutput = "###"+    , descriptionOutput = ">"+    , dueOutput = "@"+    , subtaskOutput = "-"+    }++-- useful records+task :: Task+task = new "Test Item"++list :: Lists+list = newList "Test" empty++listWithItem :: Lists+listWithItem = appendToLast task list++makeSubTask :: Text -> Bool -> Lists+makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list++taskWithSummary :: Task+taskWithSummary = setDescription "Summary" task++taskWithMultiLineSummary :: Task+taskWithMultiLineSummary = setDescription "Summary Line 1\nSummary Line 2" task++listWithSummaryItem :: Lists+listWithSummaryItem = appendToLast taskWithSummary list++listWithMultiLineSummaryItem :: Lists+listWithMultiLineSummaryItem = appendToLast taskWithMultiLineSummary list++taskWithDueDate :: Task+taskWithDueDate = setDue "2018-04-12" task++listWithDueDateItem :: Lists+listWithDueDateItem = appendToLast taskWithDueDate list++-- tests+test_markdown :: TestTree+test_markdown =+    testGroup+        "IO.Markdown"+        [ testGroup+              "Line Parsing"+              [ testGroup+                    "Default Format"+                    [ testCase+                          "List Title"+                          (assertEqual+                               "One list"+                               (list, [])+                               (start defaultConfig (empty, []) ("## Test", 1)))+                    , testCase+                          "Blank line"+                          (assertEqual+                               "Nothing"+                               (empty, [])+                               (start defaultConfig (empty, []) ("", 1)))+                    , testCase+                          "Just spaces"+                          (assertEqual+                               "Nothing"+                               (empty, [])+                               (start defaultConfig (empty, []) ("        ", 1)))+                    , testCase+                          "Error"+                          (assertEqual+                               "Error on line 1"+                               (empty, [1])+                               (start defaultConfig (empty, []) ("Test", 1)))+                    , testCase+                          "List item"+                          (assertEqual+                               "List item"+                               (listWithItem, [])+                               (start defaultConfig (list, []) ("- Test Item", 1)))+                    , testCase+                          "Summary"+                          (assertEqual+                               "Summary"+                               (listWithSummaryItem, [])+                               (start defaultConfig (listWithItem, []) ("    > Summary", 1)))+                    , testCase+                          "Due Date"+                          (assertEqual+                               "Due Date"+                               (listWithDueDateItem, [])+                               (start defaultConfig (listWithItem, []) ("    @ 2018-04-12", 1)))+                    , testCase+                          "Sub-Task"+                          (assertEqual+                               "List item with Sub-Task"+                               (makeSubTask "Blah" False, [])+                               (start defaultConfig (listWithItem, []) ("    * Blah", 1)))+                    , testCase+                          "Complete Sub-Task"+                          (assertEqual+                               "List item with Sub-Task"+                               (makeSubTask "Blah" True, [])+                               (start defaultConfig (listWithItem, []) ("    * ~Blah~", 1)))+                    , ignoreTest $+                      testCase+                          "List item without list"+                          (assertEqual+                               "Parse Error"+                               (empty, [1])+                               (start defaultConfig (empty, []) ("- Test Item", 1)))+                    , ignoreTest $+                      testCase+                          "Sub task without list item"+                          (assertEqual+                               "Parse Error"+                               (list, [1])+                               (start defaultConfig (list, []) ("    * Blah", 1)))+                    ]+              , testGroup+                    "Alternative Format"+                    [ testCase+                          "List Title"+                          (assertEqual+                               "One list"+                               (list, [])+                               (start alternativeConfig (empty, []) ("## Test", 1)))+                    , testCase+                          "Blank line"+                          (assertEqual+                               "Nothing"+                               (empty, [])+                               (start alternativeConfig (empty, []) ("", 1)))+                    , testCase+                          "Just spaces"+                          (assertEqual+                               "Nothing"+                               (empty, [])+                               (start alternativeConfig (empty, []) ("        ", 1)))+                    , testCase+                          "Error"+                          (assertEqual+                               "Error on line 1"+                               (empty, [1])+                               (start alternativeConfig (empty, []) ("* Test", 1)))+                    , testCase+                          "List item"+                          (assertEqual+                               "List item"+                               (listWithItem, [])+                               (start alternativeConfig (list, []) ("### Test Item", 1)))+                    , testCase+                          "Sub-Task"+                          (assertEqual+                               "List item with Sub-Task"+                               (makeSubTask "Blah" False, [])+                               (start alternativeConfig (listWithItem, []) ("- [ ] Blah", 1)))+                    , testCase+                          "Complete Sub-Task"+                          (assertEqual+                               "List item with Sub-Task"+                               (makeSubTask "Blah" True, [])+                               (start alternativeConfig (listWithItem, []) ("- [x] Blah", 1)))+                    , testCase+                          "Blank Sub-Task"+                          (assertEqual+                               "List item with blank Sub-Task"+                               (makeSubTask "" True, [])+                               (start alternativeConfig (listWithItem, []) ("- [x] ", 1)))+                    , testCase+                          "Sub-Task (old style)"+                          (assertEqual+                               "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+              "Parsing"+              [ testCase+                    "List Title"+                    (assertEqual+                         "One empty list"+                         (Right list)+                         (parse C.defaultConfig (encodeUtf8 "## Test")))+              , testCase+                    "List Items"+                    (assertEqual+                         "List with item"+                         (Right listWithItem)+                         (parse C.defaultConfig (encodeUtf8 "## Test\n- Test Item")))+              , testCase+                    "List Item with Summary"+                    (assertEqual+                         "List item with a summary"+                         (Right listWithSummaryItem)+                         (parse C.defaultConfig (encodeUtf8 "## Test\n- Test Item\n    > Summary")))+              , testCase+                    "Parsing Errors"+                    (assertEqual+                         "Errors"+                         (Left "could not parse line(s) 3, 5")+                         (parse+                              C.defaultConfig+                              (encodeUtf8 "## Test\n- Test Item\n* Spoon\n- Test Item\nCow")))+              , testCase+                    "List Item with multi-line Summary"+                    (assertEqual+                         "List item with a summary"+                         (Right listWithMultiLineSummaryItem)+                         (parse+                              C.defaultConfig+                              (encodeUtf8+                                   "## Test\n- Test Item\n    > Summary Line 1\n    > Summary Line 2")))+              ]+        , testGroup+              "Stringification"+              [ testGroup+                    "Default Format"+                    [ testCase+                          "Standard list"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n"+                               (foldl' (listStringify defaultConfig) "" listWithItem))+                    , testCase+                          "Standard list with summary"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    > Summary\n"+                               (foldl' (listStringify defaultConfig) "" listWithSummaryItem))+                    , testCase+                          "Standard list with date"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    @ 2018-04-12\n"+                               (foldl' (listStringify defaultConfig) "" listWithDueDateItem))+                    , testCase+                          "Standard list with sub-task"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    * [x] Blah\n"+                               (foldl' (listStringify defaultConfig) "" (makeSubTask "Blah" True)))+                    , testCase+                          "Standard list with multi-line summary"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    > Summary Line 1\n    > Summary Line 2\n"+                               (foldl' (listStringify defaultConfig) "" listWithMultiLineSummaryItem))+                    ]+              , testGroup+                    "Alternative Format"+                    [ testCase+                          "Standard list"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n### Test Item\n"+                               (foldl' (listStringify alternativeConfig) "" listWithItem))+                    , testCase+                          "Standard list with sub-task"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    * [ ] Blah\n"+                               (foldl' (listStringify defaultConfig) "" (makeSubTask "Blah" False)))+                    ]+              ]+        ]
+ test/IO/TrelloTest.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}++module IO.TrelloTest+    ( test_trello+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Test.Tasty+import Test.Tasty.HUnit++import Data.Aeson          (decodeStrict)+import Data.FileEmbed      (embedFile)+import Data.Time.LocalTime (getCurrentTimeZone)++import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems, checklistItemToSubTask)+import IO.HTTP.Trello.List          (List, listToList)++json :: Maybe [List]+json = decodeStrict $(embedFile "test/IO/data/trello.json")++checklistJson :: Maybe [ChecklistItem]+checklistJson = (^. checkItems) <$> decodeStrict $(embedFile "test/IO/data/trello-checklists.json")++-- tests+test_trello :: IO TestTree+test_trello = do+    tz <- getCurrentTimeZone+    return $+        testGroup+            "IO.Trello"+            [ testCase+                  "Lists"+                  (assertEqual "Parses list JSON" (Just 5) (length . (listToList tz <$>) <$> json))+            , testCase+                  "Checklists"+                  (assertEqual+                       "Parses checklist JSON"+                       (Just 5)+                       (length . (checklistItemToSubTask <$>) <$> checklistJson))+            ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}
+ test/UI/FieldTest.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module UI.FieldTest+    ( test_field+    ) where++import ClassyPrelude++import UI.Field (Field (Field), backspace, cursorPosition, insertCharacter, insertText,+                 updateCursor, wrap)++import Test.Tasty+import Test.Tasty.HUnit++width :: Int+width = 30++cursorPosition' :: Text -> Int -> (Int, Int)+cursorPosition' text cursor = cursorPosition wrapped width (cursor - offset)+  where+    (wrapped, offset) = wrap width text++test_field :: TestTree+test_field =+    testGroup+        "UI.Field"+        [ testGroup+              "Field cursor left"+              [ testCase+                    "Standard"+                    (assertEqual+                         "Should move left"+                         (Field "Blah" 1)+                         (updateCursor (-1) (Field "Blah" 2)))+              , testCase+                    "Out of bounds"+                    (assertEqual+                         "Should stay 0"+                         (Field "Blah" 0)+                         (updateCursor (-1) (Field "Blah" 0)))+              ]+        , testGroup+              "Field cursor right"+              [ testCase+                    "Standard"+                    (assertEqual+                         "Should move right"+                         (Field "Blah" 3)+                         (updateCursor 1 (Field "Blah" 2)))+              , testCase+                    "At end"+                    (assertEqual+                         "Should move right"+                         (Field "Blah" 4)+                         (updateCursor 1 (Field "Blah" 3)))+              , testCase+                    "Out of bounds"+                    (assertEqual "Should stay" (Field "Blah" 4) (updateCursor 1 (Field "Blah" 4)))+              ]+        , testGroup+              "Field insert character"+              [ testCase+                    "At end"+                    (assertEqual+                         "Should insert character at end"+                         (Field "Blahs" 5)+                         (insertCharacter 's' (Field "Blah" 4)))+              , testCase+                    "At beginning"+                    (assertEqual+                         "Should insert character at beginning"+                         (Field "sBlah" 1)+                         (insertCharacter 's' (Field "Blah" 0)))+              ]+        , testGroup+              "Field backspace"+              [ testCase+                    "At end"+                    (assertEqual+                         "Should remove last character"+                         (Field "Bla" 3)+                         (backspace (Field "Blah" 4)))+              , testCase+                    "At beginning"+                    (assertEqual+                         "Should stay the same"+                         (Field "Blah" 0)+                         (backspace (Field "Blah" 0)))+              , testCase+                    "In middle"+                    (assertEqual "Should remove middle" (Field "Bah" 1) (backspace (Field "Blah" 2)))+              ]+        , testGroup+              "Field insert text"+              [ testCase+                    "At end"+                    (assertEqual+                         "Should insert text at end"+                         (Field "Blah hello" 10)+                         (insertText " hello" (Field "Blah" 4)))+              , testCase+                    "At beginning"+                    (assertEqual+                         "Should insert text at beginning"+                         (Field "Hello Blah" 6)+                         (insertText "Hello " (Field "Blah" 0)))+              ]+        , testGroup+              "Cursor position"+              [ testCase+                    "Empty"+                    (assertEqual "Should be at beginning" (0, 0) (cursorPosition' "" 0))+              , testCase+                    "First line"+                    (assertEqual+                         "Should be on first line"+                         (14, 0)+                         (cursorPosition' "Blah blah blah" 14))+              , testCase+                    "Half way along"+                    (assertEqual+                         "Should be on first line"+                         (7, 0)+                         (cursorPosition' "Blah blah blah" 7))+              , testCase+                    "End of line"+                    (assertEqual+                         "Should be on first line"+                         (29, 0)+                         (cursorPosition' "Blah blah blah blah blah blah" 29))+              , testCase+                    "End of line wrap"+                    (assertEqual+                         "Should wrap"+                         (0, 1)+                         (cursorPosition' "Blah blah blah blah blah blahs" 30))+              , testCase+                    "End of line with space wrap"+                    (assertEqual+                         "Should wrap"+                         (0, 1)+                         (cursorPosition' "Blah blah blah blah blah blah " 30))+              , testCase+                    "Long words"+                    (assertEqual+                         "Should wrap to correct position"+                         (6, 1)+                         (cursorPosition' "Artichoke penguin astronaut wombat" 34))+              , testCase+                    "Long words with space"+                    (assertEqual+                         "Should ignore the space when counting"+                         (16, 1)+                         (cursorPosition' "Blah fish wombat monkey sponge catpult arsonist" 47))+              ]+        ]