packages feed

taskell 1.9.2.0 → 1.9.3.0

raw patch · 194 files changed

+7015/−6961 lines, 194 filesdep ~aesondep ~basedep ~brick

Dependency ranges changed: aeson, base, brick, bytestring, containers, directory, file-embed, lens, template-haskell, text, time, tz

Files

README.md view
@@ -297,7 +297,7 @@ title.fg = green  ; status bar-statusBar.bg = magenta+statusBar.bg = blue statusBar.fg = black  ; current list title@@ -305,6 +305,17 @@  ; current task taskCurrent.fg = magenta++; subtasks+; selected+subtaskCurrent.fg = magenta+; incomplete+subtaskIncomplete.fg = blue+; complete+subtaskComplete.fg = yellow++; disabled+disabled.fg = yellow ```  You can also change the background and default text colour:
app/Main.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-}- module Main where  import ClassyPrelude@@ -8,10 +6,10 @@  import Data.Time.Zones (loadLocalTZ) -import App          (go)-import Events.State (create)-import IO.Config    (setup)-import IO.Taskell   (IOInfo (IOInfo), Next (..), load)+import Taskell              (go)+import Taskell.Events.State (create)+import Taskell.IO           (IOInfo (IOInfo), Next (..), load)+import Taskell.IO.Config    (setup)  main :: IO () main = do
− src/App.hs 
@@ -1,182 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TupleSections #-}--module App-    ( go-    ) where--import ClassyPrelude--import Control.Concurrent (forkIO, threadDelay)--import Control.Lens ((^.))--import Data.Time.Zones (TZ)--import Brick-import Brick.BChan               (BChan, newBChan, writeBChan)-import Graphics.Vty              (Mode (BracketedPaste), defaultConfig, displayBounds, mkVty,-                                  outputIface, setMode, supportsMode)-import Graphics.Vty.Input.Events (Event (..))--import qualified Control.FoldDebounce as Debounce--import Data.Taskell.Lists      (Lists)-import Events.Actions          (ActionSets, event, generateActions)-import Events.State            (continue, countCurrent, setHeight, setTime)-import Events.State.Types      (State, current, io, lists, mode, path, searchTerm, timeZone)-import Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))-import IO.Config               (Config, debugging, generateAttrMap, getBindings, layout)-import IO.Taskell              (writeData)-import Types                   (ListIndex (..), TaskIndex (..))-import UI.Draw                 (chooseCursor, draw)-import UI.Types                (ResourceName (..))--type DebouncedMessage = (Lists, FilePath, TZ)--type DebouncedWrite = DebouncedMessage -> IO ()--type Trigger = Debounce.Trigger DebouncedMessage DebouncedMessage---- tick-data TaskellEvent =-    Tick--oneSecond :: Int-oneSecond = 1000000--frequency :: Int-frequency = 60 * oneSecond--timer :: BChan TaskellEvent -> IO ()-timer chan =-    void . forkIO . forever $ do-        writeBChan chan Tick-        threadDelay frequency---- store-store :: Config -> DebouncedMessage -> IO ()-store config (ls, pth, tz) = writeData tz 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, state ^. timeZone)-            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 = flip const-            , Debounce.init = (initial ^. lists, initial ^. path, initial ^. timeZone)-            }-            Debounce.def-    let send = Debounce.send trigger-    pure (send, trigger)---- cache clearing-clearCache :: State -> EventM ResourceName ()-clearCache state = do-    let (ListIndex li, TaskIndex ti) = state ^. current-    invalidateCacheEntry (RNList li)-    invalidateCacheEntry (RNTask (ListIndex li, TaskIndex ti))--clearAllTitles :: State -> EventM ResourceName ()-clearAllTitles state = do-    let count = length (state ^. lists)-    let range = [0 .. (count - 1)]-    traverse_ (invalidateCacheEntry . RNList) range-    traverse_ (invalidateCacheEntry . RNTask . (, TaskIndex (-1)) . ListIndex) range--clearList :: State -> EventM ResourceName ()-clearList state = do-    let (ListIndex list, _) = state ^. current-    let count = countCurrent state-    let range = [0 .. (count - 1)]-    invalidateCacheEntry $ RNList list-    traverse_ (invalidateCacheEntry . RNTask . (,) (ListIndex list) . TaskIndex) range--clearDue :: State -> EventM ResourceName ()-clearDue state =-    case state ^. mode of-        Modal (Due dues _) -> do-            let range = [0 .. (length dues + 1)]-            traverse_ (invalidateCacheEntry . RNDue) range-        _ -> pure ()---- event handling-handleVtyEvent ::-       (DebouncedWrite, Trigger) -> ActionSets -> State -> Event -> EventM ResourceName (Next State)-handleVtyEvent (send, trigger) actions previousState e = do-    let state = event actions e previousState-    when (previousState ^. searchTerm /= state ^. searchTerm) invalidateCache-    case previousState ^. mode of-        (Modal MoveTo)           -> clearAllTitles previousState-        (Insert ITask ICreate _) -> clearList previousState-        _                        -> pure ()-    case state ^. mode of-        Shutdown -> liftIO (Debounce.close trigger) *> Brick.halt state-        (Modal Due {}) -> clearDue state *> next send state-        (Modal MoveTo) -> clearAllTitles state *> next send state-        (Insert ITask ICreate _) -> clearList state *> next send state-        _ -> clearCache previousState *> clearCache state *> next send state--getHeight :: EventM ResourceName Int-getHeight = snd <$> (liftIO . displayBounds =<< outputIface <$> getVtyHandle)--handleEvent ::-       (DebouncedWrite, Trigger)-    -> ActionSets-    -> State-    -> BrickEvent ResourceName TaskellEvent-    -> EventM ResourceName (Next State)-handleEvent _ _ state (AppEvent Tick) = do-    t <- liftIO getCurrentTime-    Brick.continue $ setTime t state-handleEvent _ _ state (VtyEvent (EvResize _ _)) = do-    invalidateCache-    h <- getHeight-    Brick.continue (setHeight h state)-handleEvent db actions state (VtyEvent ev) = handleVtyEvent db actions state ev-handleEvent _ _ state _ = Brick.continue state---- | Runs when the app starts---   Adds paste support-appStart :: State -> EventM ResourceName State-appStart state = do-    output <- outputIface <$> getVtyHandle-    when (supportsMode output BracketedPaste) . liftIO $ setMode output BracketedPaste True-    h <- getHeight-    pure (setHeight h state)---- | Sets up Brick-go :: Config -> State -> IO ()-go config initial = do-    attrMap' <- const <$> generateAttrMap-    -- setup debouncing-    db <- debounce config initial-    -- get bindings-    bindings <- getBindings-    -- setup timer channel-    timerChan <- newBChan 1-    timer timerChan-    -- create app-    let app =-            App-            { appDraw = draw (layout config) bindings (debugging config)-            , appChooseCursor = chooseCursor-            , appHandleEvent = handleEvent db (generateActions bindings)-            , appStartEvent = appStart-            , appAttrMap = attrMap'-            }-    -- start-    let builder = mkVty defaultConfig-    initialVty <- builder-    void $ customMain initialVty builder (Just timerChan) app initial
− src/Config.hs 
@@ -1,15 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module Config where--import ClassyPrelude--import Data.FileEmbed (embedFile)--version :: Text-version = "1.9.2"--usage :: Text-usage = decodeUtf8 $(embedFile "templates/usage.txt")
− src/Data/Taskell/Date.hs 
@@ -1,115 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Taskell.Date-    ( Day-    , Deadline(..)-    , Due(..)-    , timeToText-    , timeToDisplay-    , timeToOutput-    , timeToOutputLocal-    , textToTime-    , inputToTime-    , isoToTime-    , deadline-    ) where--import ClassyPrelude--import Control.Monad.Fail (MonadFail)--import Data.Time.LocalTime (ZonedTime (ZonedTime))-import Data.Time.Zones     (TZ, localTimeToUTCTZ, timeZoneForUTCTime, utcToLocalTimeTZ)--import Data.Time.Calendar (diffDays)-import Data.Time.Format   (FormatTime, ParseTime, formatTime, iso8601DateFormat, parseTimeM)--import Data.Taskell.Date.RelativeParser (parseRelative)-import Data.Taskell.Date.Types          (Deadline (..), Due (..))---- formats-dateFormat :: String-dateFormat = "%Y-%m-%d"--timeDisplayFormat :: String-timeDisplayFormat = "%Y-%m-%d %H:%M"--timeFormat :: String-timeFormat = "%Y-%m-%d %H:%M %Z"--isoFormat :: String-isoFormat = iso8601DateFormat (Just "%H:%M:%S%Q%Z")---- utility functions-utcToZonedTime :: TZ -> UTCTime -> ZonedTime-utcToZonedTime tz time = ZonedTime (utcToLocalTimeTZ tz time) (timeZoneForUTCTime tz time)--appendYear :: (FormatTime t, FormatTime s) => String -> t -> s -> String-appendYear txt t1 t2 =-    if format "%Y" t1 == format "%Y" t2-        then txt-        else txt <> " %Y"---- output-format :: (FormatTime t) => String -> t -> Text-format fmt = pack . formatTime defaultTimeLocale fmt--timeToText :: TZ -> UTCTime -> Due -> Text-timeToText _ now (DueDate day) = format fmt day-  where-    fmt = appendYear "%d-%b" now day-timeToText tz now (DueTime time) = format fmt local-  where-    local = utcToLocalTimeTZ tz time-    fmt = appendYear "%H:%M %d-%b" now local--timeToDisplay :: TZ -> Due -> Text-timeToDisplay _ (DueDate day)   = format dateFormat day-timeToDisplay tz (DueTime time) = format timeDisplayFormat (utcToLocalTimeTZ tz time)--timeToOutput :: Due -> Text-timeToOutput (DueDate day)  = format dateFormat day-timeToOutput (DueTime time) = format timeFormat time--timeToOutputLocal :: TZ -> Due -> Text-timeToOutputLocal _ (DueDate day)   = format dateFormat day-timeToOutputLocal tz (DueTime time) = format timeFormat (utcToZonedTime tz time)---- input-parseT :: (Monad m, MonadFail m, ParseTime t) => String -> Text -> m t-parseT fmt txt = parseTimeM False defaultTimeLocale fmt (unpack txt)--parseDate :: Text -> Maybe Due-parseDate txt = DueDate <$> parseT dateFormat txt--(<?>) :: Maybe a -> Maybe a -> Maybe a-(<?>) Nothing b = b-(<?>) a _       = a--textToTime :: Text -> Maybe Due-textToTime txt = parseDate txt <?> (DueTime <$> parseT timeFormat txt)--inputToTime :: TZ -> UTCTime -> Text -> Maybe Due-inputToTime tz now txt =-    parseDate txt <?> (DueTime . localTimeToUTCTZ tz <$> parseT timeDisplayFormat txt) <?>-    case parseRelative now txt of-        Right due -> Just due-        Left _    -> Nothing--isoToTime :: Text -> Maybe Due-isoToTime txt = DueTime <$> parseT isoFormat txt---- deadlines-deadline :: UTCTime -> Due -> Deadline-deadline now date-    | days < 0 = Passed-    | days == 0 = Today-    | days == 1 = Tomorrow-    | days < 7 = ThisWeek-    | otherwise = Plenty-  where-    days =-        case date of-            DueTime t -> diffDays (utctDay t) (utctDay now)-            DueDate d -> diffDays d (utctDay now)
− src/Data/Taskell/Date/RelativeParser.hs 
@@ -1,67 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Taskell.Date.RelativeParser-    ( parseRelative-    ) where--import ClassyPrelude--import Data.Attoparsec.Text--import Data.Time.Clock (addUTCTime)--import Data.Taskell.Date.Types (Due (DueDate, DueTime))-import Utility.Parser          (lexeme, only)---- utility functions-addP :: (Integral a) => Parser a -> UTCTime -> Parser UTCTime-addP p now = ($ now) . addUTCTime . fromIntegral . sum <$> many1 p---- relative time parsing-minute :: Int-minute = 60--hour :: Int-hour = minute * 60--day :: Int-day = hour * 24--week :: Int-week = day * 7--timePeriodP :: Char -> Parser Int-timePeriodP c = lexeme decimal <* char c--wP :: Parser Int-wP = (* week) <$> timePeriodP 'w'--dP :: Parser Int-dP = (* day) <$> timePeriodP 'd'--hP :: Parser Int-hP = (* hour) <$> timePeriodP 'h'--mP :: Parser Int-mP = (* minute) <$> timePeriodP 'm'--sP :: Parser Int-sP = timePeriodP 's'--timeP :: UTCTime -> Parser (Maybe Due)-timeP now = only . lexeme $ Just . DueTime <$> addP (sP <|> mP <|> hP <|> dP <|> wP) now---- relative date parsing-dateP :: UTCTime -> Parser (Maybe Due)-dateP now = only . lexeme $ Just . DueDate . utctDay <$> addP (dP <|> wP) now---- relative parser-relativeP :: UTCTime -> Parser (Maybe Due)-relativeP now = dateP now <|> timeP now--parseRelative :: UTCTime -> Text -> Either Text Due-parseRelative now text =-    case parseOnly (relativeP now) text of-        Right (Just due) -> Right due-        _                -> Left "Could not parse date."
− src/Data/Taskell/Date/Types.hs 
@@ -1,27 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Taskell.Date.Types-    ( Deadline(..)-    , Due(..)-    ) where--import ClassyPrelude--data Due-    = DueTime UTCTime-    | DueDate Day-    deriving (Show, Eq)--instance Ord Due where-    compare (DueTime t) (DueDate d)   = t `compare` UTCTime d 0-    compare (DueDate d) (DueTime t)   = UTCTime d 0 `compare` t-    compare (DueDate d1) (DueDate d2) = d1 `compare` d2-    compare (DueTime t1) (DueTime t2) = t1 `compare` t2--data Deadline-    = Passed-    | Today-    | Tomorrow-    | ThisWeek-    | Plenty-    deriving (Show, Eq)
− src/Data/Taskell/List.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Taskell.List-    ( List-    , Update-    , title-    , tasks-    , create-    , empty-    , due-    , clearDue-    , new-    , count-    , newAt-    , duplicate-    , append-    , extract-    , updateFn-    , update-    , move-    , deleteTask-    , getTask-    , searchFor-    , nextTask-    , prevTask-    , nearest-    ) where--import Data.Taskell.List.Internal
− src/Data/Taskell/List/Internal.hs 
@@ -1,127 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections #-}--module Data.Taskell.List.Internal where--import ClassyPrelude--import Control.Lens (element, 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, clearDue, contains, due, duplicate)-import           Types             (TaskIndex (TaskIndex))--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)--due :: List -> Seq (TaskIndex, T.Task)-due list = catMaybes (filt S.<#> (list ^. tasks))-  where-    filt int task = const (TaskIndex int, task) <$> task ^. T.due--clearDue :: TaskIndex -> Update-clearDue (TaskIndex int) = updateFn int T.clearDue--newAt :: Int -> Update-newAt idx = tasks %~ S.insertAt idx T.blank--duplicate :: Int -> List -> Maybe List-duplicate idx list = do-    task <- T.duplicate <$> getTask idx list-    pure $ list & tasks %~ S.insertAt idx task--append :: T.Task -> Update-append task = tasks %~ (|> task)--extract :: Int -> List -> Maybe (List, T.Task)-extract idx list = do-    (xs, x) <- S.extract idx (list ^. tasks)-    pure (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 -> Maybe Text -> List -> Maybe (List, Int)-move current dir term list =-    case term of-        Nothing -> (, bound list (current + dir)) <$> (list & tasks %%~ S.shiftBy current dir)-        Just _ -> do-            idx <- changeTask dir current term list-            (, idx) <$> (list & tasks %%~ S.shiftBy current (idx - current))--deleteTask :: Int -> Update-deleteTask idx = tasks %~ deleteAt idx--getTask :: Int -> List -> Maybe T.Task-getTask idx = (^? tasks . element idx)--searchFor :: Text -> Update-searchFor text = tasks %~ filter (T.contains text)--changeTask :: Int -> Int -> Maybe Text -> List -> Maybe Int-changeTask dir current term list = do-    let next = current + dir-    tsk <- getTask next list-    case term of-        Nothing -> Just next-        Just trm ->-            if T.contains trm tsk-                then Just next-                else changeTask dir next term list--nextTask :: Int -> Maybe Text -> List -> Int-nextTask idx text lst = fromMaybe idx $ changeTask 1 idx text lst--prevTask :: Int -> Maybe Text -> List -> Int-prevTask idx text lst = fromMaybe idx $ changeTask (-1) idx text lst--closest :: Int -> Int -> Int -> Int-closest current previous next =-    if (next - current) < (current - previous)-        then next-        else previous--bound :: List -> Int -> Int-bound lst = S.bound (lst ^. tasks)--nearest' :: Int -> Maybe Text -> List -> Maybe Int-nearest' current term lst = do-    let prev = changeTask (-1) current term lst-    let nxt = changeTask 1 current term lst-    let comp idx = Just $ maybe idx (closest current idx) nxt-    maybe nxt comp prev--nearest :: Int -> Maybe Text -> List -> Int-nearest current term lst = idx-  where-    near = fromMaybe (-1) $ nearest' current term lst-    idx =-        case term of-            Nothing  -> bound lst current-            Just txt -> maybe near (bool near current . T.contains txt) $ getTask current lst
− src/Data/Taskell/Lists.hs 
@@ -1,21 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Taskell.Lists-    ( Lists-    , initial-    , updateLists-    , count-    , due-    , clearDue-    , get-    , changeList-    , newList-    , delete-    , exists-    , shiftBy-    , search-    , appendToLast-    , analyse-    ) where--import Data.Taskell.Lists.Internal
− src/Data/Taskell/Lists/Internal.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}--module Data.Taskell.Lists.Internal where--import ClassyPrelude--import Control.Lens  ((^.))-import Data.Sequence as S (adjust', deleteAt, update, (!?), (|>))--import qualified Data.Taskell.List as L (List, Update, append, clearDue, count, due, empty, extract,-                                         searchFor)-import qualified Data.Taskell.Seq  as S-import qualified Data.Taskell.Task as T (Task, due)-import           Types             (ListIndex (ListIndex), Pointer, TaskIndex (TaskIndex))--type Lists = Seq L.List--type Update = Lists -> Lists--initial :: Lists-initial = fromList [L.empty "To Do", L.empty "Done"]--updateLists :: Int -> L.List -> Update-updateLists = S.update--count :: Int -> Lists -> Int-count idx tasks = maybe 0 L.count (tasks !? idx)--due :: Lists -> Seq (Pointer, T.Task)-due lists = sortOn ((^. T.due) . snd) dues-  where-    format x lst = (\(y, t) -> ((ListIndex x, y), t)) <$> L.due lst-    dues = concat $ format S.<#> lists--clearDue :: Pointer -> Update-clearDue (idx, tsk) = updateFn idx (L.clearDue tsk)--updateFn :: ListIndex -> L.Update -> Update-updateFn (ListIndex idx) fn = adjust' fn idx--get :: Lists -> Int -> Maybe L.List-get = (!?)--changeList :: Pointer -> Lists -> Int -> Maybe Lists-changeList (ListIndex list, TaskIndex idx) tasks dir = do-    let next = list + dir-    (from, task) <- L.extract idx =<< tasks !? list -- extract current task-    to <- L.append task <$> tasks !? next -- get next list and append task-    pure . updateLists next to $ updateLists list from tasks -- update lists--newList :: Text -> Update-newList title = (|> L.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 = (L.searchFor text <$>)--appendToLast :: T.Task -> Update-appendToLast task lists =-    fromMaybe lists $ do-        let idx = length lists - 1-        list <- L.append task <$> lists !? idx-        pure $ 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 
@@ -1,24 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Taskell.Seq where--import ClassyPrelude--import Data.Sequence (deleteAt, insertAt, mapWithIndex, (!?))--(<#>) :: (Int -> a -> b) -> Seq a -> Seq b-(<#>) = mapWithIndex--extract :: Int -> Seq a -> Maybe (Seq a, a)-extract idx xs = (,) (deleteAt idx xs) <$> xs !? idx--shiftBy :: Int -> Int -> Seq a -> Maybe (Seq a)-shiftBy idx dir xs = do-    (a, current) <- extract idx xs-    pure $ insertAt (idx + dir) current a--bound :: Seq a -> Int -> Int-bound s i-    | i < 0 = 0-    | i >= length s = pred (length s)-    | otherwise = i
− src/Data/Taskell/Subtask.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Taskell.Subtask-    ( Subtask-    , Update-    , new-    , blank-    , name-    , complete-    , toggle-    , duplicate-    ) where--import Data.Taskell.Subtask.Internal
− src/Data/Taskell/Subtask/Internal.hs 
@@ -1,31 +0,0 @@-{-# 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--duplicate :: Subtask -> Subtask-duplicate (Subtask n c) = Subtask n c
− src/Data/Taskell/Task.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Data.Taskell.Task-    ( Task-    , Update-    , name-    , description-    , due-    , subtasks-    , blank-    , new-    , create-    , duplicate-    , setDescription-    , appendDescription-    , setDue-    , clearDue-    , getSubtask-    , addSubtask-    , hasSubtasks-    , updateSubtask-    , removeSubtask-    , countSubtasks-    , countCompleteSubtasks-    , contains-    , isBlank-    ) where--import Data.Taskell.Task.Internal
− src/Data/Taskell/Task/Internal.hs 
@@ -1,99 +0,0 @@-{-# 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    (Due (..), inputToTime)-import qualified Data.Taskell.Subtask as ST (Subtask, Update, complete, duplicate, name)-import           Data.Text            (strip)-import           Data.Time.Zones      (TZ)--data Task = Task-    { _name        :: Text-    , _description :: Maybe Text-    , _subtasks    :: Seq ST.Subtask-    , _due         :: Maybe Due-    } deriving (Show, Eq)--type Update = Task -> Task---- create lenses-$(makeLenses ''Task)---- operations-create :: Text -> Maybe Due -> Maybe Text -> Seq ST.Subtask -> Task-create name' due' description' subtasks' = Task name' description' subtasks' due'--blank :: Task-blank = Task "" Nothing empty Nothing--new :: Text -> Task-new text = blank & (name .~ text)--setDescription :: Text -> Update-setDescription text =-    description .~-    if null (strip text)-        then Nothing-        else 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 :: TZ -> UTCTime -> Text -> Task -> Maybe Task-setDue tz now date task =-    if null date-        then Just (task & due .~ Nothing)-        else (\d -> task & due ?~ d) <$> inputToTime tz now (strip date)--clearDue :: Update-clearDue task = task & due .~ Nothing--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 =-    check (task ^. name) || maybe False check (task ^. description) || not (null sts)-  where-    check = isInfixOf (toLower text) . toLower-    sts = filter check $ (^. ST.name) <$> (task ^. subtasks)--isBlank :: Task -> Bool-isBlank task =-    null (task ^. name) &&-    isNothing (task ^. description) && null (task ^. subtasks) && isNothing (task ^. due)--duplicate :: Task -> Task-duplicate (Task n d st du) = Task n d (ST.duplicate <$> st) du
− src/Events/Actions.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Events.Actions-    ( event-    , generateActions-    , ActionSets-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Graphics.Vty.Input.Events (Event (..))--import Events.State.Types      (State, Stateful, mode)-import Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))--import IO.Keyboard       (generate)-import IO.Keyboard.Types (Bindings, BoundActions)--import qualified Events.Actions.Insert       as Insert-import qualified Events.Actions.Modal        as Modal-import qualified Events.Actions.Modal.Detail as Detail-import qualified Events.Actions.Modal.Due    as Due-import qualified Events.Actions.Modal.Help   as Help-import qualified Events.Actions.Normal       as Normal-import qualified Events.Actions.Search       as Search---- 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-        _         -> pure state---- returns new state if successful-event :: ActionSets -> Event -> State -> State-event actions e state = do-    let mEv =-            case state ^. mode of-                Normal                        -> lookup e $ normal actions-                Modal (Detail _ DetailNormal) -> lookup e $ detail actions-                Modal Due {}                  -> lookup e $ due actions-                Modal Help                    -> lookup e $ help actions-                _                             -> Nothing-    fromMaybe state $-        case mEv of-            Nothing -> event' e state-            Just ev -> ev state--data ActionSets = ActionSets-    { normal :: BoundActions-    , detail :: BoundActions-    , help   :: BoundActions-    , due    :: BoundActions-    }--generateActions :: Bindings -> ActionSets-generateActions bindings =-    ActionSets-    { normal = generate bindings Normal.events-    , detail = generate bindings Detail.events-    , help = generate bindings Help.events-    , due = generate bindings Due.events-    }
− src/Events/Actions/Insert.hs 
@@ -1,38 +0,0 @@-{-# 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.Draw.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-        _ -> pure 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-        _ -> pure state-event e state =-    pure $-    case state ^. mode of-        Insert iType iMode field -> state & mode .~ Insert iType iMode (F.event e field)-        _                        -> state
− src/Events/Actions/Modal.hs 
@@ -1,27 +0,0 @@-{-# 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.Due    as Due-import qualified Events.Actions.Modal.Help   as Help-import qualified Events.Actions.Modal.MoveTo as MoveTo--event :: Event -> Stateful-event e s =-    case s ^. mode of-        Modal Help      -> Help.event e s-        Modal Detail {} -> Detail.event e s-        Modal MoveTo    -> MoveTo.event e s-        Modal Due {}    -> Due.event e s-        _               -> pure s
− src/Events/Actions/Modal/Detail.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}--module Events.Actions.Modal.Detail-    ( event-    , events-    ) where--import ClassyPrelude--import           Events.Actions.Types      as A (ActionType (..))-import           Events.State              (clearDate, normalMode, quit, store, undo, write)-import           Events.State.Modal.Detail as Detail-import           Events.State.Types-import           Events.State.Types.Mode   (DetailItem (..), DetailMode (..))-import           Graphics.Vty.Input.Events-import           IO.Keyboard.Types         (Actions)-import qualified UI.Draw.Field             as F (event)--events :: Actions-events-    -- general- =-    [ (A.Quit, quit)-    , (A.Undo, (write =<<) . undo)-    , (A.Previous, previousSubtask)-    , (A.Next, nextSubtask)-    , (A.MoveUp, (write =<<) . (up =<<) . store)-    , (A.MoveDown, (write =<<) . (down =<<) . store)-    , (A.New, (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store)-    , (A.Edit, (Detail.insertMode =<<) . store)-    , (A.Complete, (write =<<) . (setComplete =<<) . store)-    , (A.Delete, (write =<<) . (Detail.remove =<<) . store)-    , (A.DueDate, (editDue =<<) . store)-    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)-    , (A.Detail, (editDescription =<<) . store)-    ]--normal :: Event -> Stateful-normal (EvKey KEsc _) = normalMode-normal _              = pure--insert :: Event -> Stateful-insert (EvKey KEsc _) s = do-    item <- getCurrentItem s-    case item of-        DetailDescription -> (write =<<) $ finishDescription s-        DetailDate        -> showDetail 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/Due.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedLists #-}--module Events.Actions.Modal.Due-    ( event-    , events-    ) where--import ClassyPrelude--import Events.Actions.Types      as A (ActionType (..))-import Events.State              (normalMode, store, write)-import Events.State.Modal.Detail (showDetail)-import Events.State.Modal.Due    (clearDate, goto, next, previous)-import Events.State.Types        (Stateful)-import Graphics.Vty.Input.Events (Event (EvKey))-import IO.Keyboard.Types         (Actions)--events :: Actions-events =-    [ (A.Previous, previous)-    , (A.Next, next)-    , (A.Detail, (showDetail =<<) . goto)-    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)-    ]--event :: Event -> Stateful-event (EvKey _ _) = normalMode-event _           = pure
− src/Events/Actions/Modal/Help.hs 
@@ -1,22 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}--module Events.Actions.Modal.Help-    ( event-    , events-    ) where--import ClassyPrelude-import Events.Actions.Types      as A (ActionType (..))-import Events.State-import Events.State.Types        (Stateful)-import Graphics.Vty.Input.Events-import IO.Keyboard.Types         (Actions)--events :: Actions-events = [(A.Quit, quit)]--event :: Event -> Stateful-event (EvKey _ _) = normalMode-event _           = pure
− src/Events/Actions/Modal/MoveTo.hs 
@@ -1,16 +0,0 @@-{-# 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 _                   = pure
− src/Events/Actions/Normal.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedLists #-}--module Events.Actions.Normal-    ( event-    , events-    ) where--import ClassyPrelude hiding (delete)--import Data.Char                 (isDigit)-import Events.Actions.Types      as A (ActionType (..))-import Events.State-import Events.State.Modal.Detail (editDue, showDetail)-import Events.State.Modal.Due    (showDue)-import Events.State.Types        (Stateful)-import Graphics.Vty.Input.Events-import IO.Keyboard.Types         (Actions)--events :: Actions-events-    -- general- =-    [ (A.Quit, quit)-    , (A.Undo, (write =<<) . undo)-    , (A.Redo, (write =<<) . redo)-    , (A.Search, searchMode)-    , (A.Help, showHelp)-    , (A.Due, showDue)-        -- navigation-    , (A.Previous, previous)-    , (A.Next, next)-    , (A.Left, left)-    , (A.Right, right)-    , (A.Bottom, bottom)-    , (A.Top, top)-    -- new tasks-    , (A.New, (startCreate =<<) . (newItem =<<) . store)-    , (A.NewAbove, (startCreate =<<) . (above =<<) . store)-    , (A.NewBelow, (startCreate =<<) . (below =<<) . store)-    , (A.Duplicate, (next =<<) . (write =<<) . (duplicate =<<) . store)-    -- editing tasks-    , (A.Edit, (startEdit =<<) . store)-    , (A.Clear, (startEdit =<<) . (clearItem =<<) . store)-    , (A.Delete, (write =<<) . (delete =<<) . store)-    , (A.Detail, showDetail)-    , (A.DueDate, (editDue =<<) . (store =<<) . showDetail)-    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)-    -- moving tasks-    , (A.MoveUp, (write =<<) . (up =<<) . store)-    , (A.MoveDown, (write =<<) . (down =<<) . store)-    , (A.MoveLeft, (write =<<) . (bottom =<<) . (left =<<) . (moveLeft =<<) . store)-    , (A.MoveRight, (write =<<) . (bottom =<<) . (right =<<) . (moveRight =<<) . store)-    , (A.Complete, (write =<<) . (moveToLast =<<) . (clearDate =<<) . store)-    , (A.MoveMenu, showMoveTo)-    -- lists-    , (A.ListNew, (createListStart =<<) . store)-    , (A.ListEdit, (editListStart =<<) . store)-    , (A.ListDelete, (write =<<) . (deleteCurrentList =<<) . store)-    , (A.ListRight, (write =<<) . (listRight =<<) . store)-    , (A.ListLeft, (write =<<) . (listLeft =<<) . store)-    ]---- Normal-event :: Event -> Stateful--- selecting lists-event (EvKey (KChar n) _)-    | isDigit n = selectList n-    | otherwise = pure-event (EvKey KEsc _) = clearSearch--- fallback-event _ = pure
− src/Events/Actions/Search.hs 
@@ -1,23 +0,0 @@-{-# 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.Draw.Field             as F (event)--event :: Event -> Stateful-event (EvKey KEsc _) s = clearSearch =<< normalMode s-event (EvKey KEnter _) s = normalMode s-event e s =-    case s ^. mode of-        Search -> appendSearch (F.event e) s-        _      -> pure s
− src/Events/Actions/Types.hs 
@@ -1,82 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Events.Actions.Types where--import ClassyPrelude hiding (Left, Nothing, Right)--data ActionType-    = Quit-    | Undo-    | Redo-    | Search-    | Due-    | Help-    | Previous-    | Next-    | Left-    | Right-    | Bottom-    | Top-    | New-    | NewAbove-    | NewBelow-    | Duplicate-    | Edit-    | Clear-    | Delete-    | Detail-    | DueDate-    | ClearDate-    | MoveUp-    | MoveDown-    | MoveLeft-    | MoveRight-    | Complete-    | MoveMenu-    | ListNew-    | ListEdit-    | ListDelete-    | ListRight-    | ListLeft-    | Nothing-    deriving (Show, Eq, Ord, Enum)--allActions :: [ActionType]-allActions = [toEnum 0 ..]--read :: Text -> ActionType-read "quit"       = Quit-read "undo"       = Undo-read "redo"       = Redo-read "search"     = Search-read "due"        = Due-read "help"       = Help-read "previous"   = Previous-read "next"       = Next-read "left"       = Left-read "right"      = Right-read "bottom"     = Bottom-read "top"        = Top-read "new"        = New-read "newAbove"   = NewAbove-read "newBelow"   = NewBelow-read "duplicate"  = Duplicate-read "edit"       = Edit-read "clear"      = Clear-read "delete"     = Delete-read "detail"     = Detail-read "dueDate"    = DueDate-read "clearDate"  = ClearDate-read "moveUp"     = MoveUp-read "moveDown"   = MoveDown-read "moveLeft"   = MoveLeft-read "moveRight"  = MoveRight-read "complete"   = Complete-read "moveMenu"   = MoveMenu-read "listNew"    = ListNew-read "listEdit"   = ListEdit-read "listDelete" = ListDelete-read "listRight"  = ListRight-read "listLeft"   = ListLeft-read _            = Nothing
− src/Events/State.hs 
@@ -1,414 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Events.State-    -- App-    ( continue-    , write-    , setTime-    , countCurrent-    , setHeight-    -- UI.Main-    , normalise-    -- Main-    , create-    -- Events.Actions.Normal-    , quit-    , startEdit-    , startCreate-    , createListStart-    , editListStart-    , deleteCurrentList-    , clearItem-    , clearDate-    , above-    , below-    , bottom-    , top-    , previous-    , duplicate-    , next-    , left-    , right-    , up-    , down-    , moveLeft-    , moveRight-    , moveToLast-    , delete-    , selectList-    , listLeft-    , listRight-    , undo-    , redo-    , store-    , searchMode-    , clearSearch-    , appendSearch-    -- 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.Time.Zones (TZ)--import qualified Data.Taskell.List  as L (List, deleteTask, duplicate, getTask, move, nearest, new,-                                          newAt, nextTask, prevTask, title, update)-import qualified Data.Taskell.Lists as Lists-import           Data.Taskell.Task  (Task, isBlank, name)-import           Types--import qualified Events.State.History    as History (redo, store, undo)-import           Events.State.Types-import           Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..),-                                          Mode (..))-import           UI.Draw.Field           (Field, blankField, getText, textToField)--type InternalStateful = State -> State--create :: TZ -> UTCTime -> FilePath -> Lists.Lists -> State-create tz t p ls =-    State-    { _mode = Normal-    , _history = fresh ls-    , _path = p-    , _io = Nothing-    , _height = 0-    , _searchTerm = Nothing-    , _time = t-    , _timeZone = tz-    }---- app state-quit :: Stateful-quit = pure . (mode .~ Shutdown)--continue :: State -> State-continue = io .~ Nothing--store :: Stateful-store state = pure $ state & history %~ History.store--undo :: Stateful-undo state = pure $ state & history %~ History.undo--redo :: Stateful-redo state = pure $ state & history %~ History.redo--setTime :: UTCTime -> State -> State-setTime t = time .~ t--write :: Stateful-write state = pure $ state & (io ?~ (state ^. lists))---- createList-createList :: Stateful-createList state =-    pure $-    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 = pure . (mode .~ Insert IList ICreate blankField)---- editList-editListStart :: Stateful-editListStart state = do-    f <- textToField . (^. L.title) <$> getList state-    pure $ state & mode .~ Insert IList IEdit f--deleteCurrentList :: Stateful-deleteCurrentList state =-    pure . fixIndex . setLists state $ Lists.delete (getCurrentList state) (state ^. lists)---- insert-getCurrentTask :: State -> Maybe Task-getCurrentTask state = getList state >>= L.getTask (getIndex state)--setCurrentTask :: Task -> Stateful-setCurrentTask task state = setList state . L.update (getIndex state) task <$> getList state--setCurrentTaskText :: Text -> Stateful-setCurrentTaskText text state =-    flip setCurrentTask state =<< (name .~ text) <$> getCurrentTask state--startCreate :: Stateful-startCreate = pure . (mode .~ Insert ITask ICreate blankField)--startEdit :: Stateful-startEdit state = do-    field <- textToField . (^. name) <$> getCurrentTask state-    pure $ state & mode .~ Insert ITask IEdit field--finishTask :: Stateful-finishTask state =-    case state ^. mode of-        Insert ITask iMode f ->-            setCurrentTaskText (getText f) $ state & (mode .~ Insert ITask iMode blankField)-        _ -> pure state--finishListTitle :: Stateful-finishListTitle state =-    case state ^. mode of-        Insert IList iMode f ->-            setCurrentListTitle (getText f) $ state & (mode .~ Insert IList iMode blankField)-        _ -> pure state--normalMode :: Stateful-normalMode = pure . (mode .~ Normal)--addToListAt :: Int -> Stateful-addToListAt offset state = do-    let idx = getIndex state + offset-    fixIndex . setList (setIndex state idx) . L.newAt idx <$> getList state--above :: Stateful-above = addToListAt 0--below :: Stateful-below = addToListAt 1--newItem :: Stateful-newItem state = selectLast . setList state . L.new <$> getList state--duplicate :: Stateful-duplicate state = setList state <$> (L.duplicate (getIndex state) =<< getList state)--clearItem :: Stateful-clearItem = setCurrentTaskText ""--clearDate :: Stateful-clearDate state = pure $ state & lists .~ Lists.clearDue (state ^. current) (state ^. lists)--bottom :: Stateful-bottom = pure . selectLast--selectLast :: InternalStateful-selectLast state = setIndex state (countCurrent state - 1)--top :: Stateful-top = pure . selectFirst--selectFirst :: InternalStateful-selectFirst state = setIndex state (0)--removeBlank :: Stateful-removeBlank state = do-    currentTask <- getCurrentTask state-    (if isBlank currentTask-         then delete-         else pure)-        state---- moving----moveVertical :: Int -> Stateful-moveVertical dir state = do-    (lst, idx) <- L.move (getIndex state) dir (getText <$> state ^. searchTerm) =<< getList state-    pure $ setIndex (setList state lst) idx--up :: Stateful-up = moveVertical (-1)--down :: Stateful-down = moveVertical 1--moveHorizontal :: Int -> State -> Maybe State-moveHorizontal idx state =-    fixIndex . setLists state <$> Lists.changeList (state ^. current) (state ^. lists) idx--moveLeft :: Stateful-moveLeft = moveHorizontal (-1)--moveRight :: Stateful-moveRight = moveHorizontal 1--moveToLast :: Stateful-moveToLast state =-    if idx == cur-        then pure state-        else moveHorizontal (idx - cur) state-  where-    idx = length (state ^. lists) - 1-    cur = getCurrentList state--selectList :: Char -> Stateful-selectList idx state =-    pure $-    (if exists-         then current .~ (ListIndex list, TaskIndex 0)-         else id)-        state-  where-    list = digitToInt idx - 1-    exists = Lists.exists list (state ^. lists)---- removing-delete :: Stateful-delete state = fixIndex . setList state . L.deleteTask (getIndex state) <$> getList state---- list and index-countCurrent :: State -> Int-countCurrent state = Lists.count (getCurrentList state) (state ^. lists)--setIndex :: State -> Int -> State-setIndex state idx = state & current .~ (ListIndex (getCurrentList state), TaskIndex idx)--setCurrentList :: State -> Int -> State-setCurrentList state idx = state & current .~ (ListIndex idx, TaskIndex (getIndex state))--getIndex :: State -> Int-getIndex = showTaskIndex . snd . (^. current)--changeTask :: (Int -> Maybe Text -> L.List -> Int) -> Stateful-changeTask fn state = do-    list <- getList state-    let idx = getIndex state-    let term = getText <$> state ^. searchTerm-    pure $ setIndex state (fn idx term list)--next :: Stateful-next = changeTask L.nextTask--previous :: Stateful-previous = changeTask L.prevTask--left :: Stateful-left state =-    pure . fixIndex . setCurrentList state $-    if list > 0-        then pred list-        else 0-  where-    list = getCurrentList state--right :: Stateful-right state =-    pure . fixIndex . setCurrentList state $-    if list < (count - 1)-        then succ list-        else list-  where-    list = getCurrentList state-    count = length (state ^. lists)--fixListIndex :: InternalStateful-fixListIndex state =-    if listIdx-        then state-        else setCurrentList state (length lists' - 1)-  where-    lists' = state ^. lists-    listIdx = Lists.exists (getCurrentList state) lists'--fixIndex :: InternalStateful-fixIndex state =-    case getList state of-        Just list -> setIndex state (L.nearest idx trm list)-        Nothing   -> fixListIndex state-  where-    trm = getText <$> state ^. searchTerm-    idx = getIndex state---- tasks-getCurrentList :: State -> Int-getCurrentList = showListIndex . fst . (^. current)--getList :: State -> Maybe L.List-getList state = Lists.get (state ^. lists) (getCurrentList state)--setList :: State -> L.List -> State-setList state list = setLists state (Lists.updateLists (getCurrentList state) list (state ^. lists))--setCurrentListTitle :: Text -> Stateful-setCurrentListTitle text state = setList state . (L.title .~ text) <$> getList state--setLists :: State -> Lists.Lists -> State-setLists state lists' = state & lists .~ lists'--moveTo' :: Int -> Stateful-moveTo' li state = do-    let cur = getCurrentList state-    if li == cur || li < 0 || li >= length (state ^. lists)-        then Nothing-        else do-            s <- moveHorizontal (li - cur) state-            pure . selectLast $ setCurrentList s li--moveTo :: Char -> Stateful-moveTo char = moveTo' (ord char - ord 'a')---- move lists-listMove :: Int -> Stateful-listMove offset state = do-    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 = pure . fixIndex $ (state & mode .~ Search) & searchTerm .~ sTerm-  where-    sTerm = pure (fromMaybe blankField (state ^. searchTerm))--clearSearch :: Stateful-clearSearch state = pure $ state & searchTerm .~ Nothing--appendSearch :: (Field -> Field) -> Stateful-appendSearch genField state = do-    let field = fromMaybe blankField (state ^. searchTerm)-    pure . fixIndex $ state & searchTerm .~ pure (genField field)---- help-showHelp :: Stateful-showHelp = pure . (mode .~ Modal Help)--showMoveTo :: Stateful-showMoveTo state = const (state & mode .~ Modal MoveTo) <$> getCurrentTask state---- view-setHeight :: Int -> State -> State-setHeight = (.~) height---- more view - maybe shouldn't be in here...-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
− src/Events/State/History.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE RankNTypes #-}--module Events.State.History-    ( undo-    , redo-    , store-    ) where--import ClassyPrelude--import Control.Lens (Lens', (&), (.~), (^.))--import Events.State.Types (History (History), future, past, present)--λstack :: Lens' (History a) [a] -> History a -> [a]-λstack fn history = history ^. present : (history ^. fn)--store :: History a -> History a-store history = history & past .~ λstack past history & future .~ empty--undo :: History a -> History a-undo history =-    case history ^. past of-        []          -> history-        (moment:xs) -> History xs moment (λstack future history)--redo :: History a -> History a-redo history =-    case history ^. future of-        []          -> history-        (moment:xs) -> History (λstack past history) moment xs
− src/Events/State/Modal/Detail.hs 
@@ -1,187 +0,0 @@-{-# 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-    , up-    , down-    ) where--import ClassyPrelude--import Control.Lens ((&), (.~), (^.))--import           Data.Taskell.Date       (timeToDisplay)-import qualified Data.Taskell.Seq        as S-import qualified Data.Taskell.Subtask    as ST (blank, name, toggle)-import           Data.Taskell.Task       (Task, addSubtask, countSubtasks, description, due,-                                          getSubtask, removeSubtask, setDescription, setDue,-                                          subtasks, updateSubtask)-import           Events.State            (getCurrentTask, setCurrentTask)-import           Events.State.Types      (State, Stateful, mode, time, timeZone)-import           Events.State.Types.Mode (DetailItem (..), DetailMode (..), ModalType (Detail),-                                          Mode (Modal))-import           UI.Draw.Field           (Field, blankField, getText, textToField)--updateField :: (Field -> Field) -> Stateful-updateField fieldEvent s =-    pure $-    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 state = do-    let tz = state ^. timeZone-    let now = state ^. time-    text <- getText <$> getField state-    task <- setDue tz now text =<< getCurrentTask state-    setCurrentTask task $ state & mode .~ Modal (Detail (DetailItem 0) DetailNormal)--showDetail :: Stateful-showDetail s = do-    _ <- getCurrentTask s-    let i = fromMaybe 0 $ getCurrentSubtask s-    pure $ 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-    pure $ state & mode .~ Modal (Detail DetailDescription (DetailInsert (textToField summ')))--editDue :: Stateful-editDue state = do-    day <- (^. due) <$> getCurrentTask state-    let tz = state ^. timeZone-    let day' = maybe "" (timeToDisplay tz) day-    pure $ 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)---- moving tasks-moveVertical :: Int -> Stateful-moveVertical dir state = do-    task <- getCurrentTask state-    let tasks = task ^. subtasks-    i <- getCurrentSubtask state-    shifted <- S.shiftBy i dir tasks-    state' <- setCurrentTask (task & subtasks .~ shifted) state-    changeSubtask dir state'--up :: Stateful-up = moveVertical (-1)--down :: Stateful-down = moveVertical 1
− src/Events/State/Modal/Due.hs 
@@ -1,68 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Events.State.Modal.Due-    ( showDue-    , clearDate-    , previous-    , next-    , goto-    ) where--import ClassyPrelude--import Control.Lens  ((&), (.~), (^.))-import Data.Sequence ((!?))--import qualified Data.Taskell.Lists      as L (clearDue, due)-import           Data.Taskell.Seq        (bound)-import           Data.Taskell.Task       (Task)-import           Events.State.Types      (Stateful, current, lists, mode)-import           Events.State.Types.Mode (ModalType (Due), Mode (..))-import           Types                   (Pointer)--type DueStateful = Seq (Pointer, Task) -> Int -> Stateful--λfilter :: DueStateful -> Stateful-λfilter fn state =-    case state ^. mode of-        Modal (Due due cur) -> fn due cur state-        _                   -> pure state--λsetMode :: DueStateful-λsetMode due pos state = pure $ state & mode .~ Modal (Due due pos)--λprevious :: DueStateful-λprevious due cur = λsetMode due (bound due (cur - 1))--λnext :: DueStateful-λnext due cur = λsetMode due (bound due (cur + 1))--λgoto :: DueStateful-λgoto due cur state =-    case due !? cur of-        Just (pointer, _) -> pure $ state & current .~ pointer-        Nothing           -> Nothing--λclearDate :: DueStateful-λclearDate due cur state =-    case due !? cur of-        Just (pointer, _) -> do-            let new = L.clearDue pointer (state ^. lists)-            let dues = L.due new-            λsetMode dues (bound dues cur) (state & lists .~ new)-        Nothing -> Nothing--showDue :: Stateful-showDue state = λsetMode (L.due (state ^. lists)) 0 state--previous :: Stateful-previous = λfilter λprevious--next :: Stateful-next = λfilter λnext--goto :: Stateful-goto = λfilter λgoto--clearDate :: Stateful-clearDate = λfilter λclearDate
− src/Events/State/Types.hs 
@@ -1,52 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell #-}--module Events.State.Types where--import ClassyPrelude--import Control.Lens             (Lens', makeLenses)-import Control.Lens.Combinators (_1, _2)--import Data.Time.Zones (TZ)--import Data.Taskell.Lists (Lists)-import Types              (Pointer, startPointer)-import UI.Draw.Field      (Field)--import qualified Events.State.Types.Mode as M (Mode)--type Moment = (Pointer, Lists)--data History a = History-    { _past    :: [a]-    , _present :: a-    , _future  :: [a]-    } deriving (Eq, Show)--fresh :: Lists -> History Moment-fresh ls = History empty (startPointer, ls) empty--data State = State-    { _mode       :: M.Mode-    , _history    :: History Moment-    , _path       :: FilePath-    , _io         :: Maybe Lists-    , _height     :: Int-    , _searchTerm :: Maybe Field-    , _time       :: UTCTime-    , _timeZone   :: TZ-    } deriving (Eq, Show)---- create lenses-$(makeLenses ''State)--$(makeLenses ''History)--type Stateful = State -> Maybe State--current :: Lens' State Pointer-current = history . present . _1--lists :: Lens' State Lists-lists = history . present . _2
− src/Events/State/Types/Mode.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Events.State.Types.Mode where--import ClassyPrelude--import Data.Taskell.Task (Task)-import Types             (Pointer)-import UI.Draw.Field     (Field)--data DetailMode-    = DetailNormal-    | DetailInsert Field-    deriving (Eq, Show)--data DetailItem-    = DetailItem Int-    | DetailDescription-    | DetailDate-    deriving (Eq, Show)--data ModalType-    = Help-    | MoveTo-    | Due (Seq (Pointer, Task))-          Int-    | 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-    | Shutdown-    deriving (Eq, Show)
− src/IO/Config.hs 
@@ -1,119 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}--module IO.Config where--import ClassyPrelude--import qualified Data.Text.IO       as T (readFile)-import           System.Directory   (createDirectoryIfMissing, doesDirectoryExist, doesFileExist,-                                     getHomeDirectory)-import           System.Environment (lookupEnv)--import Brick           (AttrMap)-import Brick.Themes    (loadCustomizations, themeToAttrMap)-import Data.FileEmbed  (embedFile)-import Data.Ini.Config--import IO.Keyboard        (addMissing, badMapping, defaultBindings)-import IO.Keyboard.Parser (bindings)-import IO.Keyboard.Types  (Bindings)-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-    }--debugging :: Config -> Bool-debugging config = General.debug (general config)--defaultConfig :: Config-defaultConfig =-    Config-        General.defaultConfig-        Layout.defaultConfig-        Markdown.defaultConfig-        Trello.defaultConfig-        GitHub.defaultConfig--directoryName :: FilePath-directoryName = "taskell"--legacyConfigPath :: IO FilePath-legacyConfigPath = (</> "." <> directoryName) <$> getHomeDirectory--xdgDefaultConfig :: IO FilePath-xdgDefaultConfig = (</> ".config") <$> getHomeDirectory--xdgConfigPath :: IO FilePath-xdgConfigPath =-    (</> directoryName) <$> (fromMaybe <$> xdgDefaultConfig <*> lookupEnv "XDG_CONFIG_HOME")--getDir :: IO FilePath-getDir = legacyConfigPath >>= doesDirectoryExist >>= bool xdgConfigPath legacyConfigPath--themePath :: FilePath -> FilePath-themePath = (</> "theme.ini")--configPath :: FilePath -> FilePath-configPath = (</> "config.ini")--bindingsPath :: FilePath -> FilePath-bindingsPath = (</> "bindings.ini")--setup :: IO Config-setup-    -- create config dir- = do-    dir <- getDir-    createDirectoryIfMissing True dir-    -- create config files-    create (configPath dir) $(embedFile "templates/config.ini")-    create (themePath dir) $(embedFile "templates/theme.ini")-    create (bindingsPath dir) $(embedFile "templates/bindings.ini")-    -- get config-    getConfig--create :: FilePath -> ByteString -> IO ()-create path contents = doesFileExist path >>= flip unless (writeFile path contents)--configParser :: IniParser Config-configParser =-    Config <$> General.parser <*> Layout.parser <*> Markdown.parser <*> Trello.parser <*>-    GitHub.parser--getConfig :: IO Config-getConfig = do-    content <- T.readFile =<< (configPath <$> getDir)-    case parseIniFile content configParser of-        Right config -> pure config-        Left s       -> putStrLn (pack $ "config.ini: " <> s) $> defaultConfig--getBindings :: IO Bindings-getBindings = do-    bnds <- bindings <$> (T.readFile =<< (bindingsPath <$> getDir))-    case addMissing <$> (badMapping =<< bnds) of-        Right b -> pure b-        Left err ->-            putStrLn ("bindings.ini: " <> err <> " - using default bindings") $> defaultBindings---- generate theme-generateAttrMap :: IO AttrMap-generateAttrMap = do-    dir <- getDir-    customizedTheme <- loadCustomizations (themePath dir) defaultTheme-    case customizedTheme of-        Right theme -> pure $ themeToAttrMap theme-        Left s      -> putStrLn (pack $ "theme.ini: " <> s) $> themeToAttrMap defaultTheme
− src/IO/Config/General.hs 
@@ -1,30 +0,0 @@-module IO.Config.General-    ( Config-    , defaultConfig-    , parser-    , filename-    , debug-    ) where--import ClassyPrelude--import Data.Ini.Config--import IO.Config.Parser (noEmpty)--data Config = Config-    { filename :: FilePath-    , debug    :: Bool-    }--defaultConfig :: Config-defaultConfig = Config {filename = "taskell.md", debug = False}--filenameP :: SectionParser String-filenameP = maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename"--debugP :: SectionParser Bool-debugP = fieldFlagDef "debug" False--parser :: IniParser Config-parser = fromMaybe defaultConfig <$> sectionMb "general" (Config <$> filenameP <*> debugP)
− src/IO/Config/GitHub.hs 
@@ -1,25 +0,0 @@-module IO.Config.GitHub-    ( Config-    , defaultConfig-    , parser-    , token-    ) where--import ClassyPrelude--import Data.Ini.Config--import IO.HTTP.GitHub (GitHubToken)--data Config = Config-    { token :: Maybe GitHubToken-    }--defaultConfig :: Config-defaultConfig = Config {token = Nothing}--tokenP :: SectionParser (Maybe GitHubToken)-tokenP = fieldMb "token"--parser :: IniParser Config-parser = fromMaybe defaultConfig <$> sectionMb "github" (Config <$> tokenP)
− src/IO/Config/Layout.hs 
@@ -1,54 +0,0 @@-module IO.Config.Layout-    ( Config-    , defaultConfig-    , parser-    , padding-    , columnWidth-    , columnPadding-    , descriptionIndicator-    , statusBar-    ) where--import ClassyPrelude--import Data.Ini.Config--import IO.Config.Parser (noEmpty, parseText)--data Config = Config-    { padding              :: Int-    , columnWidth          :: Int-    , columnPadding        :: Int-    , descriptionIndicator :: Text-    , statusBar            :: Bool-    }--defaultConfig :: Config-defaultConfig =-    Config-    {padding = 1, columnWidth = 30, columnPadding = 3, descriptionIndicator = "≡", statusBar = True}--paddingP :: SectionParser Int-paddingP = fromMaybe (padding defaultConfig) <$> fieldMbOf "padding" number--columnWidthP :: SectionParser Int-columnWidthP = fromMaybe (columnWidth defaultConfig) <$> fieldMbOf "column_width" number--columnPaddingP :: SectionParser Int-columnPaddingP = fromMaybe (columnPadding defaultConfig) <$> fieldMbOf "column_padding" number--descriptionIndicatorP :: SectionParser Text-descriptionIndicatorP =-    fromMaybe (descriptionIndicator defaultConfig) . (noEmpty . parseText =<<) <$>-    fieldMb "description_indicator"--statusBarP :: SectionParser Bool-statusBarP = fieldFlagDef "statusbar" (statusBar defaultConfig)--parser :: IniParser Config-parser =-    fromMaybe defaultConfig <$>-    sectionMb-        "layout"-        (Config <$> paddingP <*> columnWidthP <*> columnPaddingP <*> descriptionIndicatorP <*>-         statusBarP)
− src/IO/Config/Markdown.hs 
@@ -1,66 +0,0 @@-module IO.Config.Markdown-    ( Config(Config)-    , defaultConfig-    , parser-    , titleOutput-    , taskOutput-    , descriptionOutput-    , dueOutput-    , subtaskOutput-    , localTimes-    ) 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-    , localTimes        :: Bool-    }--defaultConfig :: Config-defaultConfig =-    Config-    { titleOutput = "##"-    , taskOutput = "-"-    , descriptionOutput = "    >"-    , dueOutput = "    @"-    , subtaskOutput = "    *"-    , localTimes = False-    }--titleOutputP :: SectionParser Text-titleOutputP = fromMaybe (titleOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "title"--taskOutputP :: SectionParser Text-taskOutputP = fromMaybe (taskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "task"--descriptionOutputP :: SectionParser Text-descriptionOutputP =-    fromMaybe (descriptionOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "summary"--dueOutputP :: SectionParser Text-dueOutputP = fromMaybe (dueOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "due"--subtaskOutputP :: SectionParser Text-subtaskOutputP =-    fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "subtask"--localTimesP :: SectionParser Bool-localTimesP = fieldFlagDef "localTimes" (localTimes defaultConfig)--parser :: IniParser Config-parser =-    fromMaybe defaultConfig <$>-    sectionMb-        "markdown"-        (Config <$> titleOutputP <*> taskOutputP <*> descriptionOutputP <*> dueOutputP <*>-         subtaskOutputP <*>-         localTimesP)
− src/IO/Config/Parser.hs 
@@ -1,12 +0,0 @@-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 
@@ -1,25 +0,0 @@-module IO.Config.Trello-    ( Config-    , defaultConfig-    , parser-    , token-    ) where--import ClassyPrelude--import Data.Ini.Config--import IO.HTTP.Trello (TrelloToken)--data Config = Config-    { token :: Maybe TrelloToken-    }--defaultConfig :: Config-defaultConfig = Config {token = Nothing}--tokenP :: SectionParser (Maybe TrelloToken)-tokenP = fieldMb "token"--parser :: IniParser Config-parser = fromMaybe defaultConfig <$> sectionMb "trello" (Config <$> tokenP)
− src/IO/HTTP/Aeson.hs 
@@ -1,18 +0,0 @@-{-# 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 
@@ -1,171 +0,0 @@-{-# 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.AutomatedCard (automatedCardToTask)-import IO.HTTP.GitHub.Card          (MaybeCard, content_url, maybeCardToTask)-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)-import Data.Taskell.Task  (Task)--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-    pure-        [ ("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  -> pure (getResponseStatusCode response, responses)-        Just lnk -> fetch' responses lnk--fetch :: Text -> ReaderGitHubToken (Int, [ByteString])-fetch = fetch' []--fetchContent :: MaybeCard -> ReaderGitHubToken (Either Text Task)-fetchContent card =-    case maybeCardToTask card of-        Just tsk -> pure $ Right tsk-        Nothing ->-            case card ^. content_url of-                Nothing -> pure $ Left "Could not parse card"-                Just url -> do-                    (_, body) <- fetch url-                    case headMay body of-                        Nothing -> pure $ Left "Could not find card content"-                        Just is ->-                            pure . first parseError $ automatedCardToTask <$> eitherDecodeStrict is--getCards :: Text -> ReaderGitHubToken (Either Text [Task])-getCards url = do-    (status, body) <- fetch url-    case status of-        200 ->-            case concatEithers (eitherDecodeStrict <$> body) of-                Right cards -> do-                    cds <- sequence (fetchContent <$> cards)-                    let (ls, rs) = partitionEithers cds-                    pure $-                        if null ls-                            then Right rs-                            else Left (unlines ls)-                Left err -> pure $ Left (parseError err)-        429 -> pure $ Left "Too many cards"-        _ -> pure . Left $ tshow status <> " error while fetching " <> url--addCard :: Column -> ReaderGitHubToken (Either Text List)-addCard column = do-    cards <- getCards $ column ^. cardsURL-    pure $ columnToList column <$> cards--addCards :: [Column] -> ReaderGitHubToken (Either Text Lists)-addCards columns = (fromList <$>) . sequence <$> traverse addCard columns--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      -> pure $ Left (parseError err)-        404 -> pure . Left $ "Could not find GitHub project ."-        401 -> pure . Left $ "You do not have permission to view GitHub project " <> url-        _ -> pure . 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   -> pure $ 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 pure . Left $ concat ["\nNo projects found for ", identifier, "\n"]-                        else chooseProject projects-                Left err -> pure $ Left (parseError err)-        404 ->-            pure . 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 ->-            pure . Left $-            "You do not have permission to view the GitHub projects for " <> identifier-        _ -> pure . Left $ tshow status <> " error. Cannot fetch projects from GitHub."
− src/IO/HTTP/GitHub/AutomatedCard.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module IO.HTTP.GitHub.AutomatedCard-    ( AutomatedCard(AutomatedCard)-    , automatedCardToTask-    ) where--import ClassyPrelude--import Control.Lens (makeLenses, (^.))--import qualified Data.Taskell.Task      as T (Task, new, setDescription)-import           IO.HTTP.Aeson          (deriveFromJSON)-import           IO.HTTP.GitHub.Utility (cleanUp)--data AutomatedCard = AutomatedCard-    { _title :: Text-    , _body  :: Text-    } deriving (Eq, Show)---- strip underscores from field labels-$(deriveFromJSON ''AutomatedCard)---- create lenses-$(makeLenses ''AutomatedCard)---- operations-automatedCardToTask :: AutomatedCard -> T.Task-automatedCardToTask automatedCard = T.setDescription (cleanUp (automatedCard ^. body)) task-  where-    task = T.new $ cleanUp (automatedCard ^. title)
− src/IO/HTTP/GitHub/Card.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module IO.HTTP.GitHub.Card-    ( MaybeCard(MaybeCard)-    , maybeCardToTask-    , content_url-    ) where--import ClassyPrelude--import Control.Lens (makeLenses, (^.))--import qualified Data.Taskell.Task      as T (Task, new)-import           IO.HTTP.Aeson          (deriveFromJSON)-import           IO.HTTP.GitHub.Utility (cleanUp)--data MaybeCard = MaybeCard-    { _note        :: Maybe Text-    , _content_url :: Maybe Text-    } deriving (Eq, Show)---- strip underscores from field labels-$(deriveFromJSON ''MaybeCard)---- create lenses-$(makeLenses ''MaybeCard)---- operations-maybeCardToTask :: MaybeCard -> Maybe T.Task-maybeCardToTask card = T.new . cleanUp <$> card ^. note
− src/IO/HTTP/GitHub/Column.hs 
@@ -1,35 +0,0 @@-{-# 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 qualified Data.Taskell.List as L (List, create)-import qualified Data.Taskell.Task as T (Task)--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 -> [T.Task] -> L.List-columnToList ls tasks = L.create (ls ^. name) (fromList tasks)
− src/IO/HTTP/GitHub/Project.hs 
@@ -1,29 +0,0 @@-{-# 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/GitHub/Utility.hs 
@@ -1,13 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.HTTP.GitHub.Utility-    ( cleanUp-    ) where--import ClassyPrelude--import Data.Text (replace)--cleanUp :: Text -> Text-cleanUp txt = replace "\r" "" $ replace "\n" " " txt
− src/IO/HTTP/Trello.hs 
@@ -1,105 +0,0 @@-{-# 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)--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-    pure . 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 :: [List] -> Lists-trelloListsToLists ls = fromList $ listToList <$> ls--fetch :: String -> IO (Int, ByteString)-fetch url = do-    request <- parseRequest url-    response <- httpBS request-    pure (getResponseStatusCode response, getResponseBody response)--getChecklist :: TrelloChecklistID -> ReaderTrelloToken (Either Text [ChecklistItem])-getChecklist checklist = do-    url <- checklistURL checklist-    (status, body) <- lift $ fetch url-    pure $-        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 = traverse getChecklist (card ^. idChecklists)--updateList :: List -> ReaderTrelloToken (Either Text List)-updateList l = (setCards l <$>) . sequence <$> traverse updateCard (l ^. cards)--getChecklists :: [List] -> ReaderTrelloToken (Either Text [List])-getChecklists ls = sequence <$> traverse updateList ls--getLists :: TrelloBoardID -> ReaderTrelloToken (Either Text Lists)-getLists board = do-    putStrLn "Fetching from Trello..."-    url <- boardURL board-    (status, body) <- lift $ fetch url-    case status of-        200 ->-            case eitherDecodeStrict body of-                Right raw -> fmap trelloListsToLists <$> getChecklists raw-                Left err  -> pure . Left $ parseError err-        404 ->-            pure . Left $ "Could not find Trello board " <> board <> ". Make sure the ID is correct"-        401 -> pure . Left $ "You do not have permission to view Trello board " <> board-        _ -> pure . Left $ tshow status <> " error. Cannot fetch from Trello."
− src/IO/HTTP/Trello/Card.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module IO.HTTP.Trello.Card-    ( Card-    , idChecklists-    , cardToTask-    , setChecklists-    ) where--import ClassyPrelude--import Control.Lens (makeLenses, (&), (.~), (^.))--import IO.HTTP.Aeson                (deriveFromJSON)-import IO.HTTP.Trello.ChecklistItem (ChecklistItem, checklistItemToSubTask)--import           Data.Taskell.Date (isoToTime)-import qualified Data.Taskell.Task as T (Task, due, new, setDescription, subtasks)--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-cardToTask :: Card -> T.Task-cardToTask card =-    task & T.due .~ isoToTime (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 
@@ -1,41 +0,0 @@-{-# 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 
@@ -1,36 +0,0 @@-{-# 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)--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 :: List -> L.List-listToList ls = L.create (ls ^. name) (fromList $ cardToTask <$> (ls ^. cards))
− src/IO/Keyboard.hs 
@@ -1,78 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.Keyboard-    ( generate-    , defaultBindings-    , badMapping-    , addMissing-    ) where--import ClassyPrelude hiding ((\\))--import Data.Bitraversable (bitraverse)-import Data.List          ((\\))--import qualified Events.Actions.Types as A-import           IO.Keyboard.Types--generate :: Bindings -> Actions -> BoundActions-generate bindings actions =-    mapFromList . catMaybes $ bitraverse bindingToEvent (`lookup` actions) <$> bindings--badMapping :: Bindings -> Either Text Bindings-badMapping bindings =-    if null result-        then Right bindings-        else Left "invalid mapping"-  where-    result = filter ((== A.Nothing) . snd) bindings--addMissing :: Bindings -> Bindings-addMissing bindings = bindings <> replaced-  where-    bnd = A.Nothing : (snd <$> bindings)-    result = A.allActions \\ bnd-    replaced = concat $ replace <$> result--replace :: A.ActionType -> Bindings-replace action = filter ((==) action . snd) defaultBindings--defaultBindings :: Bindings-defaultBindings =-    [ (BChar 'q', A.Quit)-    , (BChar 'u', A.Undo)-    , (BChar 'r', A.Redo)-    , (BChar '/', A.Search)-    , (BChar '!', A.Due)-    , (BChar '?', A.Help)-    , (BChar 'k', A.Previous)-    , (BChar 'j', A.Next)-    , (BChar 'h', A.Left)-    , (BChar 'l', A.Right)-    , (BChar 'G', A.Bottom)-    , (BChar 'g', A.Top)-    , (BChar 'a', A.New)-    , (BChar 'O', A.NewAbove)-    , (BChar 'o', A.NewBelow)-    , (BChar '+', A.Duplicate)-    , (BChar 'e', A.Edit)-    , (BChar 'A', A.Edit)-    , (BChar 'i', A.Edit)-    , (BChar 'C', A.Clear)-    , (BChar 'D', A.Delete)-    , (BKey "Enter", A.Detail)-    , (BChar '@', A.DueDate)-    , (BKey "Backspace", A.ClearDate)-    , (BChar 'K', A.MoveUp)-    , (BChar 'J', A.MoveDown)-    , (BChar 'H', A.MoveLeft)-    , (BChar 'L', A.MoveRight)-    , (BKey "Space", A.Complete)-    , (BChar 'm', A.MoveMenu)-    , (BChar 'N', A.ListNew)-    , (BChar 'E', A.ListEdit)-    , (BChar 'X', A.ListDelete)-    , (BChar '>', A.ListRight)-    , (BChar '<', A.ListLeft)-    ]
− src/IO/Keyboard/Parser.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}--module IO.Keyboard.Parser where--import ClassyPrelude--import Data.Attoparsec.Text--import Utility.Parser--import Events.Actions.Types (ActionType, read)-import IO.Keyboard.Types---- utility functions-commentP :: Parser ()-commentP = lexeme $ skipMany ((char '#' <|> char ';') *> manyTill anyChar endOfLine)--stripComments :: Parser a -> Parser a-stripComments p = lexeme $ commentP *> p <* commentP---- ini parser-keyP :: Parser Binding-keyP = lexeme $ BKey <$> (char '<' *> word <* char '>')--charP :: Parser Binding-charP = lexeme $ BChar <$> anyChar--bindingP :: Parser [Binding]-bindingP = lexeme $ (keyP <|> charP) `sepBy` char ','--lineP :: Parser [(Binding, ActionType)]-lineP =-    stripComments $ do-        name <- read <$> word-        _ <- lexeme $ char '='-        binds <- bindingP-        pure $ (, name) <$> binds--bindingsP :: Parser Bindings-bindingsP = stripComments $ concat <$> many' lineP---- run parser-bindings :: Text -> Either Text Bindings-bindings ini = first (const "Could not parse keyboard bindings.") (parseOnly bindingsP ini)
− src/IO/Keyboard/Types.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.Keyboard.Types where--import ClassyPrelude--import Data.Map.Strict           (Map)-import Graphics.Vty.Input.Events (Event (..), Key (..))--import qualified Events.Actions.Types as A (ActionType)-import           Events.State.Types   (Stateful)--data Binding-    = BChar Char-    | BKey Text-    deriving (Eq, Ord)--type Bindings = [(Binding, A.ActionType)]--type Actions = Map A.ActionType Stateful--type BoundActions = Map Event Stateful--instance Show Binding where-    show (BChar c)      = singleton c-    show (BKey "Up")    = "↑"-    show (BKey "Down")  = "↓"-    show (BKey "Left")  = "←"-    show (BKey "Right") = "→"-    show (BKey name)    = "<" <> unpack name <> ">"--bindingsToText :: Bindings -> A.ActionType -> [Text]-bindingsToText bindings key = tshow . fst <$> toList (filterMap (== key) bindings)--bindingToEvent :: Binding -> Maybe Event-bindingToEvent (BChar char)       = pure $ EvKey (KChar char) []-bindingToEvent (BKey "Space")     = pure $ EvKey (KChar ' ') []-bindingToEvent (BKey "Backspace") = pure $ EvKey KBS []-bindingToEvent (BKey "Enter")     = pure $ EvKey KEnter []-bindingToEvent (BKey "Left")      = pure $ EvKey KLeft []-bindingToEvent (BKey "Right")     = pure $ EvKey KRight []-bindingToEvent (BKey "Up")        = pure $ EvKey KUp []-bindingToEvent (BKey "Down")      = pure $ EvKey KDown []-bindingToEvent _                  = Nothing
− src/IO/Markdown.hs 
@@ -1,8 +0,0 @@-module IO.Markdown-    ( parse-    , serialize-    , MarkdownInfo(MarkdownInfo)-    ) where--import IO.Markdown.Parser     (parse)-import IO.Markdown.Serializer (MarkdownInfo (MarkdownInfo), serialize)
− src/IO/Markdown/Parser.hs 
@@ -1,67 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.Markdown.Parser-    ( parse-    ) where--import ClassyPrelude--import Data.Attoparsec.Text hiding (parse)--import qualified Data.Taskell.Date    as D (Due, textToTime)-import qualified Data.Taskell.List    as L (List, create)-import qualified Data.Taskell.Lists   as LS (Lists)-import qualified Data.Taskell.Subtask as ST (Subtask, new)-import qualified Data.Taskell.Task    as T (Task, create)--import IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput, taskOutput,-                           titleOutput)-import Utility.Parser     (lexeme, line)---- config symbol parsing-type Symbol = (Config -> Text) -> Parser ()--symP :: Config -> Symbol-symP config fn = string (fn config) *> char ' ' $> ()---- utility functions-emptyMay :: (MonoFoldable a) => a -> Maybe a-emptyMay a =-    if null a-        then Nothing-        else Just a---- parsers-subtaskCompleteP :: Parser Bool-subtaskCompleteP = (== 'x') <$> (char '[' *> (char 'x' <|> char ' ') <* char ']' <* char ' ')--subtaskP :: Symbol -> Parser ST.Subtask-subtaskP sym = flip ST.new <$> (sym subtaskOutput *> subtaskCompleteP) <*> line--taskDescriptionP :: Symbol -> Parser (Maybe Text)-taskDescriptionP sym = emptyMay <$> (intercalate "\n" <$> many' (sym descriptionOutput *> line))--dueP :: Symbol -> Parser (Maybe D.Due)-dueP sym = (D.textToTime =<<) <$> optional (sym dueOutput *> line)--taskNameP :: Symbol -> Parser Text-taskNameP sym = sym taskOutput *> line--taskP :: Symbol -> Parser T.Task-taskP sym =-    T.create <$> taskNameP sym <*> dueP sym <*> taskDescriptionP sym <*>-    (fromList <$> many' (subtaskP sym))--listTitleP :: Symbol -> Parser Text-listTitleP sym = lexeme $ sym titleOutput *> line--listP :: Symbol -> Parser L.List-listP sym = L.create <$> listTitleP sym <*> (fromList <$> many' (taskP sym))--markdownP :: Symbol -> Parser LS.Lists-markdownP sym = fromList <$> many1 (listP sym) <* endOfInput---- parse-parse :: Config -> Text -> Either Text LS.Lists-parse config txt = first (const "Could not parse file.") (parseOnly (markdownP (symP config)) txt)
− src/IO/Markdown/Serializer.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.Markdown.Serializer-    ( serialize-    , MarkdownInfo(MarkdownInfo)-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import qualified Data.Text as T (splitOn)--import Data.Time.Zones (TZ)--import           Data.Taskell.Date    (Due, timeToOutput, timeToOutputLocal)-import           Data.Taskell.List    (List, tasks, title)-import           Data.Taskell.Lists   (Lists)-import qualified Data.Taskell.Subtask as ST (Subtask, complete, name)-import qualified Data.Taskell.Task    as T (Task, description, due, name, subtasks)--import IO.Config.Markdown (Config, descriptionOutput, dueOutput, localTimes, subtaskOutput,-                           taskOutput, titleOutput)--data MarkdownInfo = MarkdownInfo-    { mdTZ     :: TZ-    , mdConfig :: Config-    }--type ReaderMarkdown = Reader MarkdownInfo---- utility functions-askConf :: (Config -> a) -> ReaderMarkdown a-askConf fn = fn <$> asks mdConfig--strMay :: (Applicative m) => (a -> m Text) -> Maybe a -> m Text-strMay _ Nothing   = pure ""-strMay fn (Just a) = fn a--space :: Text -> Text -> Text-space symbol txt = symbol <> " " <> txt--timeFn :: ReaderMarkdown (Due -> Text)-timeFn = bool timeToOutput <$> (timeToOutputLocal <$> asks mdTZ) <*> askConf localTimes---- serializers-subtaskCompleteS :: Bool -> Text-subtaskCompleteS True  = "[x]"-subtaskCompleteS False = "[ ]"--subtaskS :: ST.Subtask -> ReaderMarkdown Text-subtaskS st = do-    symbol <- askConf subtaskOutput-    pure $ unwords [symbol, subtaskCompleteS (st ^. ST.complete), st ^. ST.name]--subtasksS :: Seq ST.Subtask -> ReaderMarkdown Text-subtasksS sts = intercalate "\n" <$> sequence (subtaskS <$> sts)--descriptionS :: Text -> ReaderMarkdown Text-descriptionS desc = do-    symbol <- askConf descriptionOutput-    pure . intercalate "\n" $ space symbol <$> T.splitOn "\n" desc--dueS :: Due -> ReaderMarkdown Text-dueS due = do-    symbol <- askConf dueOutput-    fn <- timeFn-    pure $ space symbol (fn due)--nameS :: Text -> ReaderMarkdown Text-nameS desc = space <$> askConf taskOutput <*> pure desc--taskS :: T.Task -> ReaderMarkdown Text-taskS t =-    unlines . filter (/= "") <$>-    sequence-        [ nameS (t ^. T.name)-        , strMay dueS (t ^. T.due)-        , strMay descriptionS (t ^. T.description)-        , subtasksS (t ^. T.subtasks)-        ]--listS :: List -> ReaderMarkdown Text-listS list = do-    symbol <- askConf titleOutput-    taskString <- concat <$> sequence (taskS <$> list ^. tasks)-    pure . space symbol $ concat [list ^. title, "\n\n", taskString]---- serialize-serialize :: Lists -> ReaderMarkdown Text-serialize ls = intercalate "\n" <$> sequence (listS <$> ls)
− src/IO/Taskell.hs 
@@ -1,159 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module IO.Taskell where--import ClassyPrelude--import Control.Monad.Reader (runReader)-import Data.FileEmbed       (embedFile)-import Data.Text.Encoding   (decodeUtf8With)-import System.Directory     (doesFileExist, getCurrentDirectory)--import Data.Time.Zones (TZ)--import Config             (usage, version)-import Data.Taskell.Lists (Lists, analyse, initial)--import           IO.Config         (Config, general, github, markdown, 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 (MarkdownInfo (MarkdownInfo), parse, serialize)--import qualified IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists)-import qualified IO.HTTP.Trello as Trello (TrelloBoardID, getLists)--import UI.CLI (PromptYN (PromptYes), promptYN)--data IOInfo = IOInfo-    { ioTZ     :: TZ-    , ioConfig :: Config-    }--type ReaderConfig a = ReaderT IOInfo IO a--data Next-    = Output Text-    | Error Text-    | Load FilePath-           Lists-    | Exit--parseArgs :: [Text] -> ReaderConfig Next-parseArgs ["-v"]                   = pure $ Output version-parseArgs ["-h"]                   = pure $ 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 <$> asks ioConfig) >>= loadFile-parseArgs _                        = pure $ Error (unlines ["Invalid options", "", usage])--load :: ReaderConfig Next-load = getArgs >>= parseArgs--colonic :: FilePath -> Text -> Text-colonic path = ((pack path <> ": ") <>)--loadFile :: Text -> ReaderConfig Next-loadFile filepath = do-    mPath <- exists filepath-    case mPath of-        Nothing   -> pure Exit-        Just path -> either (Error . colonic path) (Load path) <$> readData path--loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next-loadRemote createFn identifier filepath = do-    let path = unpack filepath-    exists' <- fileExists path-    if exists'-        then pure $ Error (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 either (Error . colonic path) (Output . analyse filepath) <$> readData path-        else pure $ Error (filepath <> " does not exist")--createRemote ::-       (Config -> Maybe token)-    -> Text-    -> (token -> ReaderT token IO (Either Text Lists))-    -> token-    -> FilePath-    -> ReaderConfig Next-createRemote tokenFn missingToken getFn identifier path = do-    config <- asks ioConfig-    tz <- asks ioTZ-    case tokenFn config of-        Nothing -> pure $ Error missingToken-        Just token -> do-            lists <- lift $ runReaderT (getFn identifier) token-            case lists of-                Left txt -> pure $ Error txt-                Right ls ->-                    promptCreate path >>=-                    bool (pure Exit) (Load path ls <$ lift (writeData tz config ls path))--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 pure $ Just path-        else promptCreate path >>= bool (pure Nothing) (Just path <$ createPath path)--fileExists :: FilePath -> ReaderConfig Bool-fileExists path = lift $ doesFileExist path--promptCreate :: FilePath -> ReaderConfig Bool-promptCreate path = do-    cwd <- lift $ pack <$> getCurrentDirectory-    lift $ promptYN PromptYes $ concat ["Create ", cwd, "/", pack path, "?"]---- creates taskell file-createPath :: FilePath -> ReaderConfig ()-createPath path = do-    config <- asks ioConfig-    tz <- asks ioTZ-    lift (writeData tz config initial path)---- writes Tasks to json file-writeData :: TZ -> Config -> Lists -> FilePath -> IO ()-writeData tz config tasks path = void (writeFile path output)-  where-    output = encodeUtf8 $ runReader (serialize tasks) (MarkdownInfo tz (markdown config))---- reads json file-decodeError :: String -> Maybe Word8 -> Maybe Char-decodeError _ _ = Just '\65533'--readData :: FilePath -> ReaderConfig (Either Text Lists)-readData path =-    parse <$> (markdown <$> asks ioConfig) <*> (decodeUtf8With decodeError <$> readFile path)
+ src/Taskell.hs view
@@ -0,0 +1,179 @@+module Taskell+    ( go+    ) where++import ClassyPrelude++import Control.Concurrent (forkIO, threadDelay)++import Control.Lens ((^.))++import Data.Time.Zones (TZ)++import Brick+import Brick.BChan               (BChan, newBChan, writeBChan)+import Graphics.Vty              (Mode (BracketedPaste), defaultConfig, displayBounds, mkVty,+                                  outputIface, setMode, supportsMode)+import Graphics.Vty.Input.Events (Event (..))++import qualified Control.FoldDebounce as Debounce++import Taskell.Data.Lists              (Lists)+import Taskell.Events.Actions          (ActionSets, event, generateActions)+import Taskell.Events.State            (continue, countCurrent, setHeight, setTime)+import Taskell.Events.State.Types      (State, current, io, lists, mode, path, searchTerm, timeZone)+import Taskell.Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..), Mode (..))+import Taskell.IO                      (writeData)+import Taskell.IO.Config               (Config, debugging, generateAttrMap, getBindings, layout)+import Taskell.Types                   (ListIndex (..), TaskIndex (..))+import Taskell.UI.Draw                 (chooseCursor, draw)+import Taskell.UI.Types                (ResourceName (..))++type DebouncedMessage = (Lists, FilePath, TZ)++type DebouncedWrite = DebouncedMessage -> IO ()++type Trigger = Debounce.Trigger DebouncedMessage DebouncedMessage++-- tick+data TaskellEvent =+    Tick++oneSecond :: Int+oneSecond = 1000000++frequency :: Int+frequency = 60 * oneSecond++timer :: BChan TaskellEvent -> IO ()+timer chan =+    void . forkIO . forever $ do+        writeBChan chan Tick+        threadDelay frequency++-- store+store :: Config -> DebouncedMessage -> IO ()+store config (ls, pth, tz) = writeData tz 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, state ^. timeZone)+            Brick.continue $ Taskell.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 = flip const+            , Debounce.init = (initial ^. lists, initial ^. path, initial ^. timeZone)+            }+            Debounce.def+    let send = Debounce.send trigger+    pure (send, trigger)++-- cache clearing+clearCache :: State -> EventM ResourceName ()+clearCache state = do+    let (ListIndex li, TaskIndex ti) = state ^. current+    invalidateCacheEntry (RNList li)+    invalidateCacheEntry (RNTask (ListIndex li, TaskIndex ti))++clearAllTitles :: State -> EventM ResourceName ()+clearAllTitles state = do+    let count = length (state ^. lists)+    let range = [0 .. (count - 1)]+    traverse_ (invalidateCacheEntry . RNList) range+    traverse_ (invalidateCacheEntry . RNTask . (, TaskIndex (-1)) . ListIndex) range++clearList :: State -> EventM ResourceName ()+clearList state = do+    let (ListIndex list, _) = state ^. current+    let count = countCurrent state+    let range = [0 .. (count - 1)]+    invalidateCacheEntry $ RNList list+    traverse_ (invalidateCacheEntry . RNTask . (,) (ListIndex list) . TaskIndex) range++clearDue :: State -> EventM ResourceName ()+clearDue state =+    case state ^. mode of+        Modal (Due dues _) -> do+            let range = [0 .. (length dues + 1)]+            traverse_ (invalidateCacheEntry . RNDue) range+        _ -> pure ()++-- event handling+handleVtyEvent ::+       (DebouncedWrite, Trigger) -> ActionSets -> State -> Event -> EventM ResourceName (Next State)+handleVtyEvent (send, trigger) actions previousState e = do+    let state = event actions e previousState+    when (previousState ^. searchTerm /= state ^. searchTerm) invalidateCache+    case previousState ^. mode of+        (Modal MoveTo)           -> clearAllTitles previousState+        (Insert ITask ICreate _) -> clearList previousState+        _                        -> pure ()+    case state ^. mode of+        Shutdown -> liftIO (Debounce.close trigger) *> Brick.halt state+        (Modal Due {}) -> clearDue state *> next send state+        (Modal MoveTo) -> clearAllTitles state *> next send state+        (Insert ITask ICreate _) -> clearList state *> next send state+        _ -> clearCache previousState *> clearCache state *> next send state++getHeight :: EventM ResourceName Int+getHeight = snd <$> (liftIO . displayBounds =<< outputIface <$> getVtyHandle)++handleEvent ::+       (DebouncedWrite, Trigger)+    -> ActionSets+    -> State+    -> BrickEvent ResourceName TaskellEvent+    -> EventM ResourceName (Next State)+handleEvent _ _ state (AppEvent Tick) = do+    t <- liftIO getCurrentTime+    Brick.continue $ setTime t state+handleEvent _ _ state (VtyEvent (EvResize _ _)) = do+    invalidateCache+    h <- getHeight+    Brick.continue (setHeight h state)+handleEvent db actions state (VtyEvent ev) = handleVtyEvent db actions state ev+handleEvent _ _ state _ = Brick.continue state++-- | Runs when the app starts+--   Adds paste support+appStart :: State -> EventM ResourceName State+appStart state = do+    output <- outputIface <$> getVtyHandle+    when (supportsMode output BracketedPaste) . liftIO $ setMode output BracketedPaste True+    h <- getHeight+    pure (setHeight h state)++-- | Sets up Brick+go :: Config -> State -> IO ()+go config initial = do+    attrMap' <- const <$> generateAttrMap+    -- setup debouncing+    db <- debounce config initial+    -- get bindings+    bindings <- getBindings+    -- setup timer channel+    timerChan <- newBChan 1+    timer timerChan+    -- create app+    let app =+            App+            { appDraw = draw (layout config) bindings (debugging config)+            , appChooseCursor = chooseCursor+            , appHandleEvent = handleEvent db (generateActions bindings)+            , appStartEvent = appStart+            , appAttrMap = attrMap'+            }+    -- start+    let builder = mkVty defaultConfig+    initialVty <- builder+    void $ customMain initialVty builder (Just timerChan) app initial
+ src/Taskell/Config.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.Config where++import ClassyPrelude++import Data.FileEmbed (embedFile)++version :: Text+version = "1.9.3"++usage :: Text+usage = decodeUtf8 $(embedFile "templates/usage.txt")
+ src/Taskell/Data/Date.hs view
@@ -0,0 +1,112 @@+module Taskell.Data.Date+    ( Day+    , Deadline(..)+    , Due(..)+    , timeToText+    , timeToDisplay+    , timeToOutput+    , timeToOutputLocal+    , textToTime+    , inputToTime+    , isoToTime+    , deadline+    ) where++import ClassyPrelude++import Control.Monad.Fail (MonadFail)++import Data.Time.LocalTime (ZonedTime (ZonedTime))+import Data.Time.Zones     (TZ, localTimeToUTCTZ, timeZoneForUTCTime, utcToLocalTimeTZ)++import Data.Time.Calendar (diffDays)+import Data.Time.Format   (FormatTime, ParseTime, iso8601DateFormat)++import Taskell.Data.Date.RelativeParser (parseRelative)+import Taskell.Data.Date.Types          (Deadline (..), Due (..))++-- formats+dateFormat :: String+dateFormat = "%Y-%m-%d"++timeDisplayFormat :: String+timeDisplayFormat = "%Y-%m-%d %H:%M"++timeFormat :: String+timeFormat = "%Y-%m-%d %H:%M %Z"++isoFormat :: String+isoFormat = iso8601DateFormat (Just "%H:%M:%S%Q%Z")++-- utility functions+utcToZonedTime :: TZ -> UTCTime -> ZonedTime+utcToZonedTime tz time = ZonedTime (utcToLocalTimeTZ tz time) (timeZoneForUTCTime tz time)++appendYear :: (FormatTime t, FormatTime s) => String -> t -> s -> String+appendYear txt t1 t2 =+    if format "%Y" t1 == format "%Y" t2+        then txt+        else txt <> " %Y"++-- output+format :: (FormatTime t) => String -> t -> Text+format fmt = pack . formatTime defaultTimeLocale fmt++timeToText :: TZ -> UTCTime -> Due -> Text+timeToText _ now (DueDate day) = format fmt day+  where+    fmt = appendYear "%d-%b" now day+timeToText tz now (DueTime time) = format fmt local+  where+    local = utcToLocalTimeTZ tz time+    fmt = appendYear "%H:%M %d-%b" now local++timeToDisplay :: TZ -> Due -> Text+timeToDisplay _ (DueDate day)   = format dateFormat day+timeToDisplay tz (DueTime time) = format timeDisplayFormat (utcToLocalTimeTZ tz time)++timeToOutput :: Due -> Text+timeToOutput (DueDate day)  = format dateFormat day+timeToOutput (DueTime time) = format timeFormat time++timeToOutputLocal :: TZ -> Due -> Text+timeToOutputLocal _ (DueDate day)   = format dateFormat day+timeToOutputLocal tz (DueTime time) = format timeFormat (utcToZonedTime tz time)++-- input+parseT :: (Monad m, MonadFail m, ParseTime t) => String -> Text -> m t+parseT fmt txt = parseTimeM False defaultTimeLocale fmt (unpack txt)++parseDate :: Text -> Maybe Due+parseDate txt = DueDate <$> parseT dateFormat txt++(<?>) :: Maybe a -> Maybe a -> Maybe a+(<?>) Nothing b = b+(<?>) a _       = a++textToTime :: Text -> Maybe Due+textToTime txt = parseDate txt <?> (DueTime <$> parseT timeFormat txt)++inputToTime :: TZ -> UTCTime -> Text -> Maybe Due+inputToTime tz now txt =+    parseDate txt <?> (DueTime . localTimeToUTCTZ tz <$> parseT timeDisplayFormat txt) <?>+    case parseRelative now txt of+        Right due -> Just due+        Left _    -> Nothing++isoToTime :: Text -> Maybe Due+isoToTime txt = DueTime <$> parseT isoFormat txt++-- deadlines+deadline :: UTCTime -> Due -> Deadline+deadline now date+    | days < 0 = Passed+    | days == 0 = Today+    | days == 1 = Tomorrow+    | days < 7 = ThisWeek+    | otherwise = Plenty+  where+    days =+        case date of+            DueTime t -> diffDays (utctDay t) (utctDay now)+            DueDate d -> diffDays d (utctDay now)
+ src/Taskell/Data/Date/RelativeParser.hs view
@@ -0,0 +1,64 @@+module Taskell.Data.Date.RelativeParser+    ( parseRelative+    ) where++import ClassyPrelude++import Data.Attoparsec.Text++import Data.Time.Clock (addUTCTime)++import Taskell.Data.Date.Types (Due (DueDate, DueTime))+import Taskell.Utility.Parser  (lexeme, only)++-- utility functions+addP :: (Integral a) => Parser a -> UTCTime -> Parser UTCTime+addP p now = ($ now) . addUTCTime . fromIntegral . sum <$> many1 p++-- relative time parsing+minute :: Int+minute = 60++hour :: Int+hour = minute * 60++day :: Int+day = hour * 24++week :: Int+week = day * 7++timePeriodP :: Char -> Parser Int+timePeriodP c = lexeme decimal <* char c++wP :: Parser Int+wP = (* week) <$> timePeriodP 'w'++dP :: Parser Int+dP = (* day) <$> timePeriodP 'd'++hP :: Parser Int+hP = (* hour) <$> timePeriodP 'h'++mP :: Parser Int+mP = (* minute) <$> timePeriodP 'm'++sP :: Parser Int+sP = timePeriodP 's'++timeP :: UTCTime -> Parser (Maybe Due)+timeP now = only . lexeme $ Just . DueTime <$> addP (sP <|> mP <|> hP <|> dP <|> wP) now++-- relative date parsing+dateP :: UTCTime -> Parser (Maybe Due)+dateP now = only . lexeme $ Just . DueDate . utctDay <$> addP (dP <|> wP) now++-- relative parser+relativeP :: UTCTime -> Parser (Maybe Due)+relativeP now = dateP now <|> timeP now++parseRelative :: UTCTime -> Text -> Either Text Due+parseRelative now text =+    case parseOnly (relativeP now) text of+        Right (Just due) -> Right due+        _                -> Left "Could not parse date."
+ src/Taskell/Data/Date/Types.hs view
@@ -0,0 +1,25 @@+module Taskell.Data.Date.Types+    ( Deadline(..)+    , Due(..)+    ) where++import ClassyPrelude++data Due+    = DueTime UTCTime+    | DueDate Day+    deriving (Show, Eq)++instance Ord Due where+    compare (DueTime t) (DueDate d)   = t `compare` UTCTime d 0+    compare (DueDate d) (DueTime t)   = UTCTime d 0 `compare` t+    compare (DueDate d1) (DueDate d2) = d1 `compare` d2+    compare (DueTime t1) (DueTime t2) = t1 `compare` t2++data Deadline+    = Passed+    | Today+    | Tomorrow+    | ThisWeek+    | Plenty+    deriving (Show, Eq)
+ src/Taskell/Data/List.hs view
@@ -0,0 +1,28 @@+module Taskell.Data.List+    ( List+    , Update+    , title+    , tasks+    , create+    , empty+    , due+    , clearDue+    , new+    , count+    , newAt+    , duplicate+    , append+    , prepend+    , extract+    , updateFn+    , update+    , move+    , deleteTask+    , getTask+    , searchFor+    , nextTask+    , prevTask+    , nearest+    ) where++import Taskell.Data.List.Internal
+ src/Taskell/Data/List/Internal.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.Data.List.Internal where++import ClassyPrelude++import Control.Lens (element, makeLenses, (%%~), (%~), (&), (.~), (^.), (^?))++import Data.Sequence as S (adjust', deleteAt, insertAt, update, (<|), (|>))++import qualified Taskell.Data.Seq  as S+import qualified Taskell.Data.Task as T (Task, Update, blank, clearDue, contains, due, duplicate)+import           Taskell.Types     (TaskIndex (TaskIndex))++data List = List+    { _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)++due :: List -> Seq (TaskIndex, T.Task)+due list = catMaybes (filt S.<#> (list ^. tasks))+  where+    filt int task = const (TaskIndex int, task) <$> task ^. T.due++clearDue :: TaskIndex -> Update+clearDue (TaskIndex int) = updateFn int T.clearDue++newAt :: Int -> Update+newAt idx = tasks %~ S.insertAt idx T.blank++duplicate :: Int -> List -> Maybe List+duplicate idx list = do+    task <- T.duplicate <$> getTask idx list+    pure $ list & tasks %~ S.insertAt idx task++append :: T.Task -> Update+append task = tasks %~ (S.|> task)++prepend :: T.Task -> Update+prepend task = tasks %~ (task S.<|)++extract :: Int -> List -> Maybe (List, T.Task)+extract idx list = do+    (xs, x) <- S.extract idx (list ^. tasks)+    pure (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 -> Maybe Text -> List -> Maybe (List, Int)+move current dir term list =+    case term of+        Nothing -> (, bound list (current + dir)) <$> (list & tasks %%~ S.shiftBy current dir)+        Just _ -> do+            idx <- changeTask dir current term list+            (, idx) <$> (list & tasks %%~ S.shiftBy current (idx - current))++deleteTask :: Int -> Update+deleteTask idx = tasks %~ deleteAt idx++getTask :: Int -> List -> Maybe T.Task+getTask idx = (^? tasks . element idx)++searchFor :: Text -> Update+searchFor text = tasks %~ filter (T.contains text)++changeTask :: Int -> Int -> Maybe Text -> List -> Maybe Int+changeTask dir current term list = do+    let next = current + dir+    tsk <- getTask next list+    case term of+        Nothing -> Just next+        Just trm ->+            if T.contains trm tsk+                then Just next+                else changeTask dir next term list++nextTask :: Int -> Maybe Text -> List -> Int+nextTask idx text lst = fromMaybe idx $ changeTask 1 idx text lst++prevTask :: Int -> Maybe Text -> List -> Int+prevTask idx text lst = fromMaybe idx $ changeTask (-1) idx text lst++closest :: Int -> Int -> Int -> Int+closest current previous next =+    if (next - current) < (current - previous)+        then next+        else previous++bound :: List -> Int -> Int+bound lst = S.bound (lst ^. tasks)++nearest' :: Int -> Maybe Text -> List -> Maybe Int+nearest' current term lst = do+    let prev = changeTask (-1) current term lst+    let nxt = changeTask 1 current term lst+    let comp idx = Just $ maybe idx (closest current idx) nxt+    maybe nxt comp prev++nearest :: Int -> Maybe Text -> List -> Int+nearest current term lst = idx+  where+    near = fromMaybe (-1) $ nearest' current term lst+    idx =+        case term of+            Nothing  -> bound lst current+            Just txt -> maybe near (bool near current . T.contains txt) $ getTask current lst
+ src/Taskell/Data/Lists.hs view
@@ -0,0 +1,20 @@+module Taskell.Data.Lists+    ( Lists+    , ListPosition(..)+    , initial+    , updateLists+    , count+    , due+    , clearDue+    , get+    , changeList+    , newList+    , delete+    , exists+    , shiftBy+    , search+    , appendToLast+    , analyse+    ) where++import Taskell.Data.Lists.Internal
+ src/Taskell/Data/Lists/Internal.hs view
@@ -0,0 +1,89 @@+module Taskell.Data.Lists.Internal where++import ClassyPrelude++import Control.Lens  ((^.))+import Data.Sequence as S (adjust', deleteAt, update, (!?), (|>))++import qualified Taskell.Data.List as L (List, Update, append, clearDue, count, due, empty, extract,+                                         prepend, searchFor)+import qualified Taskell.Data.Seq  as S+import qualified Taskell.Data.Task as T (Task, due)+import           Taskell.Types     (ListIndex (ListIndex), Pointer, TaskIndex (TaskIndex))++type Lists = Seq L.List++type Update = Lists -> Lists++data ListPosition+    = Top+    | Bottom++initial :: Lists+initial = fromList [L.empty "To Do", L.empty "Done"]++updateLists :: Int -> L.List -> Update+updateLists = S.update++count :: Int -> Lists -> Int+count idx tasks = maybe 0 L.count (tasks !? idx)++due :: Lists -> Seq (Pointer, T.Task)+due lists = sortOn ((^. T.due) . snd) dues+  where+    format x lst = (\(y, t) -> ((ListIndex x, y), t)) <$> L.due lst+    dues = concat $ format S.<#> lists++clearDue :: Pointer -> Update+clearDue (idx, tsk) = updateFn idx (L.clearDue tsk)++updateFn :: ListIndex -> L.Update -> Update+updateFn (ListIndex idx) fn = adjust' fn idx++get :: Lists -> Int -> Maybe L.List+get = (!?)++changeList :: ListPosition -> Pointer -> Lists -> Int -> Maybe Lists+changeList pos (ListIndex list, TaskIndex idx) tasks dir = do+    let next = list + dir+    let fn =+            case pos of+                Top    -> L.prepend+                Bottom -> L.append+    (from, task) <- L.extract idx =<< tasks !? list -- extract current task+    to <- fn task <$> tasks !? next -- get next list and append task+    pure . updateLists next to $ updateLists list from tasks -- update lists++newList :: Text -> Update+newList title = (|> L.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 = (L.searchFor text <$>)++appendToLast :: T.Task -> Update+appendToLast task lists =+    fromMaybe lists $ do+        let idx = length lists - 1+        list <- L.append task <$> lists !? idx+        pure $ 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/Taskell/Data/Seq.hs view
@@ -0,0 +1,22 @@+module Taskell.Data.Seq where++import ClassyPrelude++import Data.Sequence (deleteAt, insertAt, mapWithIndex, (!?))++(<#>) :: (Int -> a -> b) -> Seq a -> Seq b+(<#>) = mapWithIndex++extract :: Int -> Seq a -> Maybe (Seq a, a)+extract idx xs = (,) (deleteAt idx xs) <$> xs !? idx++shiftBy :: Int -> Int -> Seq a -> Maybe (Seq a)+shiftBy idx dir xs = do+    (a, current) <- extract idx xs+    pure $ insertAt (idx + dir) current a++bound :: Seq a -> Int -> Int+bound s i+    | i < 0 = 0+    | i >= length s = pred (length s)+    | otherwise = i
+ src/Taskell/Data/Subtask.hs view
@@ -0,0 +1,12 @@+module Taskell.Data.Subtask+    ( Subtask+    , Update+    , new+    , blank+    , name+    , complete+    , toggle+    , duplicate+    ) where++import Taskell.Data.Subtask.Internal
+ src/Taskell/Data/Subtask/Internal.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.Data.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++duplicate :: Subtask -> Subtask+duplicate (Subtask n c) = Subtask n c
+ src/Taskell/Data/Task.hs view
@@ -0,0 +1,27 @@+module Taskell.Data.Task+    ( Task+    , Update+    , name+    , description+    , due+    , subtasks+    , blank+    , new+    , create+    , duplicate+    , setDescription+    , appendDescription+    , setDue+    , clearDue+    , getSubtask+    , addSubtask+    , hasSubtasks+    , updateSubtask+    , removeSubtask+    , countSubtasks+    , countCompleteSubtasks+    , contains+    , isBlank+    ) where++import Taskell.Data.Task.Internal
+ src/Taskell/Data/Task/Internal.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.Data.Task.Internal where++import ClassyPrelude++import Control.Lens (ix, makeLenses, (%~), (&), (.~), (?~), (^.), (^?))++import           Data.Sequence        as S (adjust', deleteAt, (|>))+import           Data.Text            (strip)+import           Data.Time.Zones      (TZ)+import           Taskell.Data.Date    (Due (..), inputToTime)+import qualified Taskell.Data.Subtask as ST (Subtask, Update, complete, duplicate, name)++data Task = Task+    { _name        :: Text+    , _description :: Maybe Text+    , _subtasks    :: Seq ST.Subtask+    , _due         :: Maybe Due+    } deriving (Show, Eq)++type Update = Task -> Task++-- create lenses+$(makeLenses ''Task)++-- operations+create :: Text -> Maybe Due -> Maybe Text -> Seq ST.Subtask -> Task+create name' due' description' subtasks' = Task name' description' subtasks' due'++blank :: Task+blank = Task "" Nothing empty Nothing++new :: Text -> Task+new text = blank & (name .~ text)++setDescription :: Text -> Update+setDescription text =+    description .~+    if null (strip text)+        then Nothing+        else 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 :: TZ -> UTCTime -> Text -> Task -> Maybe Task+setDue tz now date task =+    if null date+        then Just (task & due .~ Nothing)+        else (\d -> task & due ?~ d) <$> inputToTime tz now (strip date)++clearDue :: Update+clearDue task = task & due .~ Nothing++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 =+    check (task ^. name) || maybe False check (task ^. description) || not (null sts)+  where+    check = isInfixOf (toLower text) . toLower+    sts = filter check $ (^. ST.name) <$> (task ^. subtasks)++isBlank :: Task -> Bool+isBlank task =+    null (task ^. name) &&+    isNothing (task ^. description) && null (task ^. subtasks) && isNothing (task ^. due)++duplicate :: Task -> Task+duplicate (Task n d st du) = Task n d (ST.duplicate <$> st) du
+ src/Taskell/Events/Actions.hs view
@@ -0,0 +1,67 @@+module Taskell.Events.Actions+    ( event+    , generateActions+    , ActionSets+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Graphics.Vty.Input.Events (Event (..))++import Taskell.Events.State.Types      (State, Stateful, mode)+import Taskell.Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))++import Taskell.IO.Keyboard       (generate)+import Taskell.IO.Keyboard.Types (Bindings, BoundActions)++import qualified Taskell.Events.Actions.Insert       as Insert+import qualified Taskell.Events.Actions.Modal        as Modal+import qualified Taskell.Events.Actions.Modal.Detail as Detail+import qualified Taskell.Events.Actions.Modal.Due    as Due+import qualified Taskell.Events.Actions.Modal.Help   as Help+import qualified Taskell.Events.Actions.Normal       as Normal+import qualified Taskell.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+        _         -> pure state++-- returns new state if successful+event :: ActionSets -> Event -> State -> State+event actions e state = do+    let mEv =+            case state ^. mode of+                Normal                        -> lookup e $ normal actions+                Modal (Detail _ DetailNormal) -> lookup e $ detail actions+                Modal Due {}                  -> lookup e $ due actions+                Modal Help                    -> lookup e $ help actions+                _                             -> Nothing+    fromMaybe state $+        case mEv of+            Nothing -> event' e state+            Just ev -> ev state++data ActionSets = ActionSets+    { normal :: BoundActions+    , detail :: BoundActions+    , help   :: BoundActions+    , due    :: BoundActions+    }++generateActions :: Bindings -> ActionSets+generateActions bindings =+    ActionSets+    { normal = generate bindings Normal.events+    , detail = generate bindings Detail.events+    , help = generate bindings Help.events+    , due = generate bindings Due.events+    }
+ src/Taskell/Events/Actions/Insert.hs view
@@ -0,0 +1,36 @@+module Taskell.Events.Actions.Insert+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((&), (.~), (^.))++import           Graphics.Vty.Input.Events       (Event (EvKey), Key (KEnter, KEsc))+import           Taskell.Events.State+import           Taskell.Events.State.Types+import           Taskell.Events.State.Types.Mode (InsertMode (..), InsertType (..), Mode (Insert))+import qualified Taskell.UI.Draw.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+        _ -> pure 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+        _ -> pure state+event e state =+    pure $+    case state ^. mode of+        Insert iType iMode field -> state & mode .~ Insert iType iMode (F.event e field)+        _                        -> state
+ src/Taskell/Events/Actions/Modal.hs view
@@ -0,0 +1,25 @@+module Taskell.Events.Actions.Modal+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Graphics.Vty.Input.Events+import Taskell.Events.State.Types      (Stateful, mode)+import Taskell.Events.State.Types.Mode (ModalType (..), Mode (Modal))++import qualified Taskell.Events.Actions.Modal.Detail as Detail+import qualified Taskell.Events.Actions.Modal.Due    as Due+import qualified Taskell.Events.Actions.Modal.Help   as Help+import qualified Taskell.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+        Modal Due {}    -> Due.event e s+        _               -> pure s
+ src/Taskell/Events/Actions/Modal/Detail.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedLists #-}++module Taskell.Events.Actions.Modal.Detail+    ( event+    , events+    ) where++import ClassyPrelude++import           Graphics.Vty.Input.Events+import           Taskell.Events.Actions.Types      as A (ActionType (..))+import           Taskell.Events.State              (clearDate, normalMode, quit, store, undo, write)+import           Taskell.Events.State.Modal.Detail as Detail+import           Taskell.Events.State.Types+import           Taskell.Events.State.Types.Mode   (DetailItem (..), DetailMode (..))+import           Taskell.IO.Keyboard.Types         (Actions)+import qualified Taskell.UI.Draw.Field             as F (event)++events :: Actions+events+    -- general+ =+    [ (A.Quit, quit)+    , (A.Undo, (write =<<) . undo)+    , (A.Previous, previousSubtask)+    , (A.Next, nextSubtask)+    , (A.MoveUp, (write =<<) . (up =<<) . store)+    , (A.MoveDown, (write =<<) . (down =<<) . store)+    , (A.New, (Detail.insertMode =<<) . (Detail.lastSubtask =<<) . (Detail.newItem =<<) . store)+    , (A.Edit, (Detail.insertMode =<<) . store)+    , (A.Complete, (write =<<) . (setComplete =<<) . store)+    , (A.Delete, (write =<<) . (Detail.remove =<<) . store)+    , (A.DueDate, (editDue =<<) . store)+    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)+    , (A.Detail, (editDescription =<<) . store)+    ]++normal :: Event -> Stateful+normal (EvKey KEsc _) = normalMode+normal _              = pure++insert :: Event -> Stateful+insert (EvKey KEsc _) s = do+    item <- getCurrentItem s+    case item of+        DetailDescription -> (write =<<) $ finishDescription s+        DetailDate        -> showDetail 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/Taskell/Events/Actions/Modal/Due.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedLists #-}++module Taskell.Events.Actions.Modal.Due+    ( event+    , events+    ) where++import ClassyPrelude++import Graphics.Vty.Input.Events         (Event (EvKey))+import Taskell.Events.Actions.Types      as A (ActionType (..))+import Taskell.Events.State              (normalMode, store, write)+import Taskell.Events.State.Modal.Detail (showDetail)+import Taskell.Events.State.Modal.Due    (clearDate, goto, next, previous)+import Taskell.Events.State.Types        (Stateful)+import Taskell.IO.Keyboard.Types         (Actions)++events :: Actions+events =+    [ (A.Previous, previous)+    , (A.Next, next)+    , (A.Detail, (showDetail =<<) . goto)+    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)+    ]++event :: Event -> Stateful+event (EvKey _ _) = normalMode+event _           = pure
+ src/Taskell/Events/Actions/Modal/Help.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedLists #-}++module Taskell.Events.Actions.Modal.Help+    ( event+    , events+    ) where++import ClassyPrelude+import Graphics.Vty.Input.Events+import Taskell.Events.Actions.Types as A (ActionType (..))+import Taskell.Events.State+import Taskell.Events.State.Types   (Stateful)+import Taskell.IO.Keyboard.Types    (Actions)++events :: Actions+events = [(A.Quit, quit)]++event :: Event -> Stateful+event (EvKey _ _) = normalMode+event _           = pure
+ src/Taskell/Events/Actions/Modal/MoveTo.hs view
@@ -0,0 +1,14 @@+module Taskell.Events.Actions.Modal.MoveTo+    ( event+    ) where++import ClassyPrelude+import Graphics.Vty.Input.Events+import Taskell.Events.State+import Taskell.Events.State.Types (Stateful)++event :: Event -> Stateful+event (EvKey KEsc _)      = normalMode+event (EvKey KEnter _)    = normalMode+event (EvKey (KChar c) _) = (normalMode =<<) . (write =<<) . (moveTo c =<<) . store+event _                   = pure
+ src/Taskell/Events/Actions/Normal.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedLists #-}++module Taskell.Events.Actions.Normal+    ( event+    , events+    ) where++import ClassyPrelude hiding (delete)++import Data.Char                         (isDigit)+import Graphics.Vty.Input.Events+import Taskell.Events.Actions.Types      as A (ActionType (..))+import Taskell.Events.State+import Taskell.Events.State.Modal.Detail (editDue, showDetail)+import Taskell.Events.State.Modal.Due    (showDue)+import Taskell.Events.State.Types        (Stateful)+import Taskell.IO.Keyboard.Types         (Actions)++events :: Actions+events+    -- general+ =+    [ (A.Quit, quit)+    , (A.Undo, (write =<<) . undo)+    , (A.Redo, (write =<<) . redo)+    , (A.Search, searchMode)+    , (A.Help, showHelp)+    , (A.Due, showDue)+        -- navigation+    , (A.Previous, previous)+    , (A.Next, next)+    , (A.Left, left)+    , (A.Right, right)+    , (A.Bottom, bottom)+    , (A.Top, top)+    -- new tasks+    , (A.New, (startCreate =<<) . (newItem =<<) . store)+    , (A.NewAbove, (startCreate =<<) . (above =<<) . store)+    , (A.NewBelow, (startCreate =<<) . (below =<<) . store)+    , (A.Duplicate, (next =<<) . (write =<<) . (duplicate =<<) . store)+    -- editing tasks+    , (A.Edit, (startEdit =<<) . store)+    , (A.Clear, (startEdit =<<) . (clearItem =<<) . store)+    , (A.Delete, (write =<<) . (delete =<<) . store)+    , (A.Detail, showDetail)+    , (A.DueDate, (editDue =<<) . (store =<<) . showDetail)+    , (A.ClearDate, (write =<<) . (clearDate =<<) . store)+    -- moving tasks+    , (A.MoveUp, (write =<<) . (up =<<) . store)+    , (A.MoveDown, (write =<<) . (down =<<) . store)+    , (A.MoveLeftTop, (write =<<) . (top =<<) . (left =<<) . (moveLeftTop =<<) . store)+    , (A.MoveRightTop, (write =<<) . (top =<<) . (right =<<) . (moveRightTop =<<) . store)+    , (A.MoveLeftBottom, (write =<<) . (bottom =<<) . (left =<<) . (moveLeftBottom =<<) . store)+    , (A.MoveRightBottom, (write =<<) . (bottom =<<) . (right =<<) . (moveRightBottom =<<) . store)+    , (A.Complete, (write =<<) . (moveToLast =<<) . (clearDate =<<) . store)+    , (A.MoveMenu, showMoveTo)+    -- lists+    , (A.ListNew, (createListStart =<<) . store)+    , (A.ListEdit, (editListStart =<<) . store)+    , (A.ListDelete, (write =<<) . (deleteCurrentList =<<) . store)+    , (A.ListRight, (write =<<) . (listRight =<<) . store)+    , (A.ListLeft, (write =<<) . (listLeft =<<) . store)+    ]++-- Normal+event :: Event -> Stateful+-- selecting lists+event (EvKey (KChar n) _)+    | isDigit n = selectList n+    | otherwise = pure+event (EvKey KEsc _) = clearSearch+-- fallback+event _ = pure
+ src/Taskell/Events/Actions/Search.hs view
@@ -0,0 +1,21 @@+module Taskell.Events.Actions.Search+    ( event+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import           Graphics.Vty.Input.Events+import           Taskell.Events.State+import           Taskell.Events.State.Types      (Stateful, mode)+import           Taskell.Events.State.Types.Mode (Mode (Search))+import qualified Taskell.UI.Draw.Field           as F (event)++event :: Event -> Stateful+event (EvKey KEsc _) s = clearSearch =<< normalMode s+event (EvKey KEnter _) s = normalMode s+event e s =+    case s ^. mode of+        Search -> appendSearch (F.event e) s+        _      -> pure s
+ src/Taskell/Events/Actions/Types.hs view
@@ -0,0 +1,85 @@+module Taskell.Events.Actions.Types where++import ClassyPrelude hiding (Left, Nothing, Right)++data ActionType+    = Quit+    | Undo+    | Redo+    | Search+    | Due+    | Help+    | Previous+    | Next+    | Left+    | Right+    | Bottom+    | Top+    | New+    | NewAbove+    | NewBelow+    | Duplicate+    | Edit+    | Clear+    | Delete+    | Detail+    | DueDate+    | ClearDate+    | MoveUp+    | MoveDown+    | MoveLeftTop+    | MoveRightTop+    | MoveLeftBottom+    | MoveRightBottom+    | Complete+    | MoveMenu+    | ListNew+    | ListEdit+    | ListDelete+    | ListRight+    | ListLeft+    | Nothing+    deriving (Show, Eq, Ord, Enum)++allActions :: [ActionType]+allActions = [toEnum 0 ..]++read :: Text -> ActionType+read "quit"            = Quit+read "undo"            = Undo+read "redo"            = Redo+read "search"          = Search+read "due"             = Due+read "help"            = Help+read "previous"        = Previous+read "next"            = Next+read "left"            = Left+read "right"           = Right+read "bottom"          = Bottom+read "top"             = Top+read "new"             = New+read "newAbove"        = NewAbove+read "newBelow"        = NewBelow+read "duplicate"       = Duplicate+read "edit"            = Edit+read "clear"           = Clear+read "delete"          = Delete+read "detail"          = Detail+read "dueDate"         = DueDate+read "clearDate"       = ClearDate+read "moveUp"          = MoveUp+read "moveDown"        = MoveDown+read "moveLeftTop"     = MoveLeftTop+read "moveRightTop"    = MoveRightTop+read "moveLeft"        = MoveLeftBottom+read "moveRight"       = MoveRightBottom+read "moveLeftBottom"  = MoveLeftBottom+read "moveRightBottom" = MoveRightBottom+read "complete"        = Complete+read "moveMenu"        = MoveMenu+read "listNew"         = ListNew+read "listEdit"        = ListEdit+read "listDelete"      = ListDelete+read "listRight"       = ListRight+read "listLeft"        = ListLeft+read _                 = Nothing
+ src/Taskell/Events/State.hs view
@@ -0,0 +1,419 @@+module Taskell.Events.State+    -- App+    ( continue+    , write+    , setTime+    , countCurrent+    , setHeight+    -- Taskell.UI.Main+    , normalise+    -- Main+    , create+    -- Taskell.Events.Actions.Normal+    , quit+    , startEdit+    , startCreate+    , createListStart+    , editListStart+    , deleteCurrentList+    , clearItem+    , clearDate+    , above+    , below+    , bottom+    , top+    , previous+    , duplicate+    , next+    , left+    , right+    , up+    , down+    , moveLeftTop+    , moveRightTop+    , moveLeftBottom+    , moveRightBottom+    , moveToLast+    , delete+    , selectList+    , listLeft+    , listRight+    , undo+    , redo+    , store+    , searchMode+    , clearSearch+    , appendSearch+    -- Taskell.Events.Actions.Insert+    , createList+    , removeBlank+    , newItem+    , normalMode+    , finishTask+    , finishListTitle+    -- Taskell.Events.Actions.Modal+    , showHelp+    , showMoveTo+    , moveTo+    , getCurrentList+    , getCurrentTask+    , setCurrentTask+    ) where++import ClassyPrelude hiding (delete)++import Control.Lens ((%~), (&), (.~), (?~), (^.))++import Data.Char       (digitToInt, ord)+import Data.Time.Zones (TZ)++import qualified Taskell.Data.List  as L (List, deleteTask, duplicate, getTask, move, nearest, new,+                                          newAt, nextTask, prevTask, title, update)+import qualified Taskell.Data.Lists as Lists+import           Taskell.Data.Task  (Task, isBlank, name)+import           Taskell.Types++import qualified Taskell.Events.State.History    as History (redo, store, undo)+import           Taskell.Events.State.Types+import           Taskell.Events.State.Types.Mode (InsertMode (..), InsertType (..), ModalType (..),+                                                  Mode (..))+import           Taskell.UI.Draw.Field           (Field, blankField, getText, textToField)++type InternalStateful = State -> State++create :: TZ -> UTCTime -> FilePath -> Lists.Lists -> State+create tz t p ls =+    State+    { _mode = Normal+    , _history = fresh ls+    , _path = p+    , _io = Nothing+    , _height = 0+    , _searchTerm = Nothing+    , _time = t+    , _timeZone = tz+    }++-- app state+quit :: Stateful+quit = pure . (mode .~ Shutdown)++continue :: State -> State+continue = io .~ Nothing++store :: Stateful+store state = pure $ state & history %~ History.store++undo :: Stateful+undo state = pure $ state & history %~ History.undo++redo :: Stateful+redo state = pure $ state & history %~ History.redo++setTime :: UTCTime -> State -> State+setTime t = time .~ t++write :: Stateful+write state = pure $ state & (io ?~ (state ^. lists))++-- createList+createList :: Stateful+createList state =+    pure $+    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 = pure . (mode .~ Insert IList ICreate blankField)++-- editList+editListStart :: Stateful+editListStart state = do+    f <- textToField . (^. L.title) <$> getList state+    pure $ state & mode .~ Insert IList IEdit f++deleteCurrentList :: Stateful+deleteCurrentList state =+    pure . fixIndex . setLists state $ Lists.delete (getCurrentList state) (state ^. lists)++-- insert+getCurrentTask :: State -> Maybe Task+getCurrentTask state = getList state >>= L.getTask (getIndex state)++setCurrentTask :: Task -> Stateful+setCurrentTask task state = setList state . L.update (getIndex state) task <$> getList state++setCurrentTaskText :: Text -> Stateful+setCurrentTaskText text state =+    flip setCurrentTask state =<< (name .~ text) <$> getCurrentTask state++startCreate :: Stateful+startCreate = pure . (mode .~ Insert ITask ICreate blankField)++startEdit :: Stateful+startEdit state = do+    field <- textToField . (^. name) <$> getCurrentTask state+    pure $ state & mode .~ Insert ITask IEdit field++finishTask :: Stateful+finishTask state =+    case state ^. mode of+        Insert ITask iMode f ->+            setCurrentTaskText (getText f) $ state & (mode .~ Insert ITask iMode blankField)+        _ -> pure state++finishListTitle :: Stateful+finishListTitle state =+    case state ^. mode of+        Insert IList iMode f ->+            setCurrentListTitle (getText f) $ state & (mode .~ Insert IList iMode blankField)+        _ -> pure state++normalMode :: Stateful+normalMode = pure . (mode .~ Normal)++addToListAt :: Int -> Stateful+addToListAt offset state = do+    let idx = getIndex state + offset+    fixIndex . setList (setIndex state idx) . L.newAt idx <$> getList state++above :: Stateful+above = addToListAt 0++below :: Stateful+below = addToListAt 1++newItem :: Stateful+newItem state = selectLast . setList state . L.new <$> getList state++duplicate :: Stateful+duplicate state = setList state <$> (L.duplicate (getIndex state) =<< getList state)++clearItem :: Stateful+clearItem = setCurrentTaskText ""++clearDate :: Stateful+clearDate state = pure $ state & lists .~ Lists.clearDue (state ^. current) (state ^. lists)++bottom :: Stateful+bottom = pure . selectLast++selectLast :: InternalStateful+selectLast state = setIndex state (countCurrent state - 1)++top :: Stateful+top = pure . selectFirst++selectFirst :: InternalStateful+selectFirst state = setIndex state (0)++removeBlank :: Stateful+removeBlank state = do+    currentTask <- getCurrentTask state+    (if isBlank currentTask+         then delete+         else pure)+        state++-- moving+--+moveVertical :: Int -> Stateful+moveVertical dir state = do+    (lst, idx) <- L.move (getIndex state) dir (getText <$> state ^. searchTerm) =<< getList state+    pure $ setIndex (setList state lst) idx++up :: Stateful+up = moveVertical (-1)++down :: Stateful+down = moveVertical 1++moveHorizontal :: Int -> Lists.ListPosition -> State -> Maybe State+moveHorizontal idx pos state =+    fixIndex . setLists state <$> Lists.changeList pos (state ^. current) (state ^. lists) idx++moveLeftBottom :: Stateful+moveLeftBottom = moveHorizontal (-1) Lists.Bottom++moveRightBottom :: Stateful+moveRightBottom = moveHorizontal 1 Lists.Bottom++moveLeftTop :: Stateful+moveLeftTop = moveHorizontal (-1) Lists.Top++moveRightTop :: Stateful+moveRightTop = moveHorizontal 1 Lists.Top++moveToLast :: Stateful+moveToLast state =+    if idx == cur+        then pure state+        else moveHorizontal (idx - cur) Lists.Bottom state+  where+    idx = length (state ^. lists) - 1+    cur = getCurrentList state++selectList :: Char -> Stateful+selectList idx state =+    pure $+    (if exists+         then current .~ (ListIndex list, TaskIndex 0)+         else id)+        state+  where+    list = digitToInt idx - 1+    exists = Lists.exists list (state ^. lists)++-- removing+delete :: Stateful+delete state = fixIndex . setList state . L.deleteTask (getIndex state) <$> getList state++-- list and index+countCurrent :: State -> Int+countCurrent state = Lists.count (getCurrentList state) (state ^. lists)++setIndex :: State -> Int -> State+setIndex state idx = state & current .~ (ListIndex (getCurrentList state), TaskIndex idx)++setCurrentList :: State -> Int -> State+setCurrentList state idx = state & current .~ (ListIndex idx, TaskIndex (getIndex state))++getIndex :: State -> Int+getIndex = showTaskIndex . snd . (^. current)++changeTask :: (Int -> Maybe Text -> L.List -> Int) -> Stateful+changeTask fn state = do+    list <- getList state+    let idx = getIndex state+    let term = getText <$> state ^. searchTerm+    pure $ setIndex state (fn idx term list)++next :: Stateful+next = changeTask L.nextTask++previous :: Stateful+previous = changeTask L.prevTask++left :: Stateful+left state =+    pure . fixIndex . setCurrentList state $+    if list > 0+        then pred list+        else 0+  where+    list = getCurrentList state++right :: Stateful+right state =+    pure . fixIndex . setCurrentList state $+    if list < (count - 1)+        then succ list+        else list+  where+    list = getCurrentList state+    count = length (state ^. lists)++fixListIndex :: InternalStateful+fixListIndex state =+    if listIdx+        then state+        else setCurrentList state (length lists' - 1)+  where+    lists' = state ^. lists+    listIdx = Lists.exists (getCurrentList state) lists'++fixIndex :: InternalStateful+fixIndex state =+    case getList state of+        Just list -> setIndex state (L.nearest idx trm list)+        Nothing   -> fixListIndex state+  where+    trm = getText <$> state ^. searchTerm+    idx = getIndex state++-- tasks+getCurrentList :: State -> Int+getCurrentList = showListIndex . fst . (^. current)++getList :: State -> Maybe L.List+getList state = Lists.get (state ^. lists) (getCurrentList state)++setList :: State -> L.List -> State+setList state list = setLists state (Lists.updateLists (getCurrentList state) list (state ^. lists))++setCurrentListTitle :: Text -> Stateful+setCurrentListTitle text state = setList state . (L.title .~ text) <$> getList state++setLists :: State -> Lists.Lists -> State+setLists state lists' = state & lists .~ lists'++moveTo' :: Int -> Stateful+moveTo' li state = do+    let cur = getCurrentList state+    if li == cur || li < 0 || li >= length (state ^. lists)+        then Nothing+        else do+            s <- moveHorizontal (li - cur) Lists.Bottom state+            pure . selectLast $ setCurrentList s li++moveTo :: Char -> Stateful+moveTo char = moveTo' (ord char - ord 'a')++-- move lists+listMove :: Int -> Stateful+listMove offset state = do+    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 = pure . fixIndex $ (state & mode .~ Search) & searchTerm .~ sTerm+  where+    sTerm = pure (fromMaybe blankField (state ^. searchTerm))++clearSearch :: Stateful+clearSearch state = pure $ state & searchTerm .~ Nothing++appendSearch :: (Field -> Field) -> Stateful+appendSearch genField state = do+    let field = fromMaybe blankField (state ^. searchTerm)+    pure . fixIndex $ state & searchTerm .~ pure (genField field)++-- help+showHelp :: Stateful+showHelp = pure . (mode .~ Modal Help)++showMoveTo :: Stateful+showMoveTo state = const (state & mode .~ Modal MoveTo) <$> getCurrentTask state++-- view+setHeight :: Int -> State -> State+setHeight = (.~) height++-- more view - maybe shouldn't be in here...+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
+ src/Taskell/Events/State/History.hs view
@@ -0,0 +1,29 @@+module Taskell.Events.State.History+    ( undo+    , redo+    , store+    ) where++import ClassyPrelude++import Control.Lens (Lens', (&), (.~), (^.))++import Taskell.Events.State.Types (History (History), future, past, present)++λstack :: Lens' (History a) [a] -> History a -> [a]+λstack fn history = history ^. present : (history ^. fn)++store :: History a -> History a+store history = history & past .~ λstack past history & future .~ empty++undo :: History a -> History a+undo history =+    case history ^. past of+        []          -> history+        (moment:xs) -> History xs moment (λstack future history)++redo :: History a -> History a+redo history =+    case history ^. future of+        []          -> history+        (moment:xs) -> History (λstack past history) moment xs
+ src/Taskell/Events/State/Modal/Detail.hs view
@@ -0,0 +1,184 @@+module Taskell.Events.State.Modal.Detail+    ( updateField+    , finishSubtask+    , finishDescription+    , finishDue+    , showDetail+    , getCurrentItem+    , getCurrentMode+    , getField+    , setComplete+    , remove+    , insertMode+    , editDescription+    , editDue+    , newItem+    , nextSubtask+    , previousSubtask+    , lastSubtask+    , up+    , down+    ) where++import ClassyPrelude++import Control.Lens ((&), (.~), (^.))++import           Taskell.Data.Date               (timeToDisplay)+import qualified Taskell.Data.Seq                as S+import qualified Taskell.Data.Subtask            as ST (blank, name, toggle)+import           Taskell.Data.Task               (Task, addSubtask, countSubtasks, description, due,+                                                  getSubtask, removeSubtask, setDescription, setDue,+                                                  subtasks, updateSubtask)+import           Taskell.Events.State            (getCurrentTask, setCurrentTask)+import           Taskell.Events.State.Types      (State, Stateful, mode, time, timeZone)+import           Taskell.Events.State.Types.Mode (DetailItem (..), DetailMode (..),+                                                  ModalType (Detail), Mode (Modal))+import           Taskell.UI.Draw.Field           (Field, blankField, getText, textToField)++updateField :: (Field -> Field) -> Stateful+updateField fieldEvent s =+    pure $+    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 state = do+    let tz = state ^. timeZone+    let now = state ^. time+    text <- getText <$> getField state+    task <- setDue tz now text =<< getCurrentTask state+    setCurrentTask task $ state & mode .~ Modal (Detail (DetailItem 0) DetailNormal)++showDetail :: Stateful+showDetail s = do+    _ <- getCurrentTask s+    let i = fromMaybe 0 $ getCurrentSubtask s+    pure $ 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+    pure $ state & mode .~ Modal (Detail DetailDescription (DetailInsert (textToField summ')))++editDue :: Stateful+editDue state = do+    day <- (^. due) <$> getCurrentTask state+    let tz = state ^. timeZone+    let day' = maybe "" (timeToDisplay tz) day+    pure $ 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)++-- moving tasks+moveVertical :: Int -> Stateful+moveVertical dir state = do+    task <- getCurrentTask state+    let tasks = task ^. subtasks+    i <- getCurrentSubtask state+    shifted <- S.shiftBy i dir tasks+    state' <- setCurrentTask (task & subtasks .~ shifted) state+    changeSubtask dir state'++up :: Stateful+up = moveVertical (-1)++down :: Stateful+down = moveVertical 1
+ src/Taskell/Events/State/Modal/Due.hs view
@@ -0,0 +1,66 @@+module Taskell.Events.State.Modal.Due+    ( showDue+    , clearDate+    , previous+    , next+    , goto+    ) where++import ClassyPrelude++import Control.Lens  ((&), (.~), (^.))+import Data.Sequence ((!?))++import qualified Taskell.Data.Lists              as L (clearDue, due)+import           Taskell.Data.Seq                (bound)+import           Taskell.Data.Task               (Task)+import           Taskell.Events.State.Types      (Stateful, current, lists, mode)+import           Taskell.Events.State.Types.Mode (ModalType (Due), Mode (..))+import           Taskell.Types                   (Pointer)++type DueStateful = Seq (Pointer, Task) -> Int -> Stateful++λfilter :: DueStateful -> Stateful+λfilter fn state =+    case state ^. mode of+        Modal (Due due cur) -> fn due cur state+        _                   -> pure state++λsetMode :: DueStateful+λsetMode due pos state = pure $ state & mode .~ Modal (Due due pos)++λprevious :: DueStateful+λprevious due cur = λsetMode due (bound due (cur - 1))++λnext :: DueStateful+λnext due cur = λsetMode due (bound due (cur + 1))++λgoto :: DueStateful+λgoto due cur state =+    case due !? cur of+        Just (pointer, _) -> pure $ state & current .~ pointer+        Nothing           -> Nothing++λclearDate :: DueStateful+λclearDate due cur state =+    case due !? cur of+        Just (pointer, _) -> do+            let new = L.clearDue pointer (state ^. lists)+            let dues = L.due new+            λsetMode dues (bound dues cur) (state & lists .~ new)+        Nothing -> Nothing++showDue :: Stateful+showDue state = λsetMode (L.due (state ^. lists)) 0 state++previous :: Stateful+previous = λfilter λprevious++next :: Stateful+next = λfilter λnext++goto :: Stateful+goto = λfilter λgoto++clearDate :: Stateful+clearDate = λfilter λclearDate
+ src/Taskell/Events/State/Types.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.Events.State.Types where++import ClassyPrelude++import Control.Lens             (Lens', makeLenses)+import Control.Lens.Combinators (_1, _2)++import Data.Time.Zones (TZ)++import Taskell.Data.Lists    (Lists)+import Taskell.Types         (Pointer, startPointer)+import Taskell.UI.Draw.Field (Field)++import qualified Taskell.Events.State.Types.Mode as M (Mode)++type Moment = (Pointer, Lists)++data History a = History+    { _past    :: [a]+    , _present :: a+    , _future  :: [a]+    } deriving (Eq, Show)++fresh :: Lists -> History Moment+fresh ls = History empty (startPointer, ls) empty++data State = State+    { _mode       :: M.Mode+    , _history    :: History Moment+    , _path       :: FilePath+    , _io         :: Maybe Lists+    , _height     :: Int+    , _searchTerm :: Maybe Field+    , _time       :: UTCTime+    , _timeZone   :: TZ+    } deriving (Eq, Show)++-- create lenses+$(makeLenses ''State)++$(makeLenses ''History)++type Stateful = State -> Maybe State++current :: Lens' State Pointer+current = history . present . _1++lists :: Lens' State Lists+lists = history . present . _2
+ src/Taskell/Events/State/Types/Mode.hs view
@@ -0,0 +1,47 @@+module Taskell.Events.State.Types.Mode where++import ClassyPrelude++import Taskell.Data.Task     (Task)+import Taskell.Types         (Pointer)+import Taskell.UI.Draw.Field (Field)++data DetailMode+    = DetailNormal+    | DetailInsert Field+    deriving (Eq, Show)++data DetailItem+    = DetailItem Int+    | DetailDescription+    | DetailDate+    deriving (Eq, Show)++data ModalType+    = Help+    | MoveTo+    | Due (Seq (Pointer, Task))+          Int+    | 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+    | Shutdown+    deriving (Eq, Show)
+ src/Taskell/IO.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO where++import ClassyPrelude++import Control.Monad.Reader (runReader)+import Data.FileEmbed       (embedFile)+import Data.Text.Encoding   (decodeUtf8With)+import System.Directory     (doesFileExist, getCurrentDirectory)++import Data.Time.Zones (TZ)++import Taskell.Config     (usage, version)+import Taskell.Data.Lists (Lists, analyse, initial)++import           Taskell.IO.Config         (Config, general, github, markdown, trello)+import           Taskell.IO.Config.General (filename)+import qualified Taskell.IO.Config.GitHub  as GitHub (token)+import qualified Taskell.IO.Config.Trello  as Trello (token)++import Taskell.IO.Markdown (MarkdownInfo (MarkdownInfo), parse, serialize)++import qualified Taskell.IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists)+import qualified Taskell.IO.HTTP.Trello as Trello (TrelloBoardID, getLists)++import Taskell.UI.CLI (PromptYN (PromptYes), promptYN)++data IOInfo = IOInfo+    { ioTZ     :: TZ+    , ioConfig :: Config+    }++type ReaderConfig a = ReaderT IOInfo IO a++data Next+    = Output Text+    | Error Text+    | Load FilePath+           Lists+    | Exit++parseArgs :: [Text] -> ReaderConfig Next+parseArgs ["-v"]                   = pure $ Output version+parseArgs ["-h"]                   = pure $ 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 <$> asks ioConfig) >>= loadFile+parseArgs _                        = pure $ Error (unlines ["Invalid options", "", usage])++load :: ReaderConfig Next+load = getArgs >>= parseArgs++colonic :: FilePath -> Text -> Text+colonic path = ((pack path <> ": ") <>)++loadFile :: Text -> ReaderConfig Next+loadFile filepath = do+    mPath <- exists filepath+    case mPath of+        Nothing   -> pure Exit+        Just path -> either (Error . colonic path) (Load path) <$> readData path++loadRemote :: (token -> FilePath -> ReaderConfig Next) -> token -> Text -> ReaderConfig Next+loadRemote createFn identifier filepath = do+    let path = unpack filepath+    exists' <- fileExists path+    if exists'+        then pure $ Error (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 either (Error . colonic path) (Output . analyse filepath) <$> readData path+        else pure $ Error (filepath <> " does not exist")++createRemote ::+       (Config -> Maybe token)+    -> Text+    -> (token -> ReaderT token IO (Either Text Lists))+    -> token+    -> FilePath+    -> ReaderConfig Next+createRemote tokenFn missingToken getFn identifier path = do+    config <- asks ioConfig+    tz <- asks ioTZ+    case tokenFn config of+        Nothing -> pure $ Error missingToken+        Just token -> do+            lists <- lift $ runReaderT (getFn identifier) token+            case lists of+                Left txt -> pure $ Error txt+                Right ls ->+                    promptCreate path >>=+                    bool (pure Exit) (Load path ls <$ lift (writeData tz config ls path))++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 pure $ Just path+        else promptCreate path >>= bool (pure Nothing) (Just path <$ createPath path)++fileExists :: FilePath -> ReaderConfig Bool+fileExists path = lift $ doesFileExist path++promptCreate :: FilePath -> ReaderConfig Bool+promptCreate path = do+    cwd <- lift $ pack <$> getCurrentDirectory+    lift $ promptYN PromptYes $ concat ["Create ", cwd, "/", pack path, "?"]++-- creates taskell file+createPath :: FilePath -> ReaderConfig ()+createPath path = do+    config <- asks ioConfig+    tz <- asks ioTZ+    lift (writeData tz config initial path)++-- writes Tasks to json file+writeData :: TZ -> Config -> Lists -> FilePath -> IO ()+writeData tz config tasks path = void (writeFile path output)+  where+    output = encodeUtf8 $ runReader (serialize tasks) (MarkdownInfo tz (markdown config))++-- reads json file+decodeError :: String -> Maybe Word8 -> Maybe Char+decodeError _ _ = Just '\65533'++readData :: FilePath -> ReaderConfig (Either Text Lists)+readData path =+    parse <$> (markdown <$> asks ioConfig) <*> (decodeUtf8With decodeError <$> readFile path)
+ src/Taskell/IO/Config.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedLists #-}++module Taskell.IO.Config where++import ClassyPrelude++import qualified Data.Text.IO       as T (readFile)+import           System.Directory   (createDirectoryIfMissing, doesDirectoryExist, doesFileExist,+                                     getHomeDirectory)+import           System.Environment (lookupEnv)++import Brick           (AttrMap)+import Brick.Themes    (loadCustomizations, themeToAttrMap)+import Data.FileEmbed  (embedFile)+import Data.Ini.Config++import Taskell.IO.Keyboard        (addMissing, badMapping, defaultBindings)+import Taskell.IO.Keyboard.Parser (bindings)+import Taskell.IO.Keyboard.Types  (Bindings)+import Taskell.UI.Theme           (defaultTheme)++import qualified Taskell.IO.Config.General  as General+import qualified Taskell.IO.Config.GitHub   as GitHub+import qualified Taskell.IO.Config.Layout   as Layout+import qualified Taskell.IO.Config.Markdown as Markdown+import qualified Taskell.IO.Config.Trello   as Trello++data Config = Config+    { general  :: General.Config+    , layout   :: Layout.Config+    , markdown :: Markdown.Config+    , trello   :: Trello.Config+    , github   :: GitHub.Config+    }++debugging :: Config -> Bool+debugging config = General.debug (general config)++defaultConfig :: Config+defaultConfig =+    Config+        General.defaultConfig+        Layout.defaultConfig+        Markdown.defaultConfig+        Trello.defaultConfig+        GitHub.defaultConfig++directoryName :: FilePath+directoryName = "taskell"++legacyConfigPath :: IO FilePath+legacyConfigPath = (</> "." <> directoryName) <$> getHomeDirectory++xdgDefaultConfig :: IO FilePath+xdgDefaultConfig = (</> ".config") <$> getHomeDirectory++xdgConfigPath :: IO FilePath+xdgConfigPath =+    (</> directoryName) <$> (fromMaybe <$> xdgDefaultConfig <*> lookupEnv "XDG_CONFIG_HOME")++getDir :: IO FilePath+getDir = legacyConfigPath >>= doesDirectoryExist >>= bool xdgConfigPath legacyConfigPath++themePath :: FilePath -> FilePath+themePath = (</> "theme.ini")++configPath :: FilePath -> FilePath+configPath = (</> "config.ini")++bindingsPath :: FilePath -> FilePath+bindingsPath = (</> "bindings.ini")++setup :: IO Config+setup+    -- create config dir+ = do+    dir <- getDir+    createDirectoryIfMissing True dir+    -- create config files+    create (configPath dir) $(embedFile "templates/config.ini")+    create (themePath dir) $(embedFile "templates/theme.ini")+    create (bindingsPath dir) $(embedFile "templates/bindings.ini")+    -- get config+    getConfig++create :: FilePath -> ByteString -> IO ()+create path contents = doesFileExist path >>= flip unless (writeFile path contents)++configParser :: IniParser Config+configParser =+    Config <$> General.parser <*> Layout.parser <*> Markdown.parser <*> Trello.parser <*>+    GitHub.parser++getConfig :: IO Config+getConfig = do+    content <- T.readFile =<< (configPath <$> getDir)+    case parseIniFile content configParser of+        Right config -> pure config+        Left s       -> putStrLn (pack $ "config.ini: " <> s) $> defaultConfig++getBindings :: IO Bindings+getBindings = do+    bnds <- bindings <$> (T.readFile =<< (bindingsPath <$> getDir))+    case addMissing <$> (badMapping =<< bnds) of+        Right b -> pure b+        Left err ->+            putStrLn ("bindings.ini: " <> err <> " - using default bindings") $> defaultBindings++-- generate theme+generateAttrMap :: IO AttrMap+generateAttrMap = do+    dir <- getDir+    customizedTheme <- loadCustomizations (themePath dir) defaultTheme+    case customizedTheme of+        Right theme -> pure $ themeToAttrMap theme+        Left s      -> putStrLn (pack $ "theme.ini: " <> s) $> themeToAttrMap defaultTheme
+ src/Taskell/IO/Config/General.hs view
@@ -0,0 +1,30 @@+module Taskell.IO.Config.General+    ( Config+    , defaultConfig+    , parser+    , filename+    , debug+    ) where++import ClassyPrelude++import Data.Ini.Config++import Taskell.IO.Config.Parser (noEmpty)++data Config = Config+    { filename :: FilePath+    , debug    :: Bool+    }++defaultConfig :: Config+defaultConfig = Config {filename = "taskell.md", debug = False}++filenameP :: SectionParser String+filenameP = maybe (filename defaultConfig) unpack . (noEmpty =<<) <$> fieldMb "filename"++debugP :: SectionParser Bool+debugP = fieldFlagDef "debug" False++parser :: IniParser Config+parser = fromMaybe defaultConfig <$> sectionMb "general" (Config <$> filenameP <*> debugP)
+ src/Taskell/IO/Config/GitHub.hs view
@@ -0,0 +1,25 @@+module Taskell.IO.Config.GitHub+    ( Config+    , defaultConfig+    , parser+    , token+    ) where++import ClassyPrelude++import Data.Ini.Config++import Taskell.IO.HTTP.GitHub (GitHubToken)++data Config = Config+    { token :: Maybe GitHubToken+    }++defaultConfig :: Config+defaultConfig = Config {token = Nothing}++tokenP :: SectionParser (Maybe GitHubToken)+tokenP = fieldMb "token"++parser :: IniParser Config+parser = fromMaybe defaultConfig <$> sectionMb "github" (Config <$> tokenP)
+ src/Taskell/IO/Config/Layout.hs view
@@ -0,0 +1,54 @@+module Taskell.IO.Config.Layout+    ( Config+    , defaultConfig+    , parser+    , padding+    , columnWidth+    , columnPadding+    , descriptionIndicator+    , statusBar+    ) where++import ClassyPrelude++import Data.Ini.Config++import Taskell.IO.Config.Parser (noEmpty, parseText)++data Config = Config+    { padding              :: Int+    , columnWidth          :: Int+    , columnPadding        :: Int+    , descriptionIndicator :: Text+    , statusBar            :: Bool+    }++defaultConfig :: Config+defaultConfig =+    Config+    {padding = 1, columnWidth = 30, columnPadding = 3, descriptionIndicator = "≡", statusBar = True}++paddingP :: SectionParser Int+paddingP = fromMaybe (padding defaultConfig) <$> fieldMbOf "padding" number++columnWidthP :: SectionParser Int+columnWidthP = fromMaybe (columnWidth defaultConfig) <$> fieldMbOf "column_width" number++columnPaddingP :: SectionParser Int+columnPaddingP = fromMaybe (columnPadding defaultConfig) <$> fieldMbOf "column_padding" number++descriptionIndicatorP :: SectionParser Text+descriptionIndicatorP =+    fromMaybe (descriptionIndicator defaultConfig) . (noEmpty . parseText =<<) <$>+    fieldMb "description_indicator"++statusBarP :: SectionParser Bool+statusBarP = fieldFlagDef "statusbar" (statusBar defaultConfig)++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "layout"+        (Config <$> paddingP <*> columnWidthP <*> columnPaddingP <*> descriptionIndicatorP <*>+         statusBarP)
+ src/Taskell/IO/Config/Markdown.hs view
@@ -0,0 +1,66 @@+module Taskell.IO.Config.Markdown+    ( Config(Config)+    , defaultConfig+    , parser+    , titleOutput+    , taskOutput+    , descriptionOutput+    , dueOutput+    , subtaskOutput+    , localTimes+    ) where++import ClassyPrelude++import Data.Ini.Config++import Taskell.IO.Config.Parser (noEmpty, parseText)++data Config = Config+    { titleOutput       :: Text+    , taskOutput        :: Text+    , descriptionOutput :: Text+    , dueOutput         :: Text+    , subtaskOutput     :: Text+    , localTimes        :: Bool+    }++defaultConfig :: Config+defaultConfig =+    Config+    { titleOutput = "##"+    , taskOutput = "-"+    , descriptionOutput = "    >"+    , dueOutput = "    @"+    , subtaskOutput = "    *"+    , localTimes = False+    }++titleOutputP :: SectionParser Text+titleOutputP = fromMaybe (titleOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "title"++taskOutputP :: SectionParser Text+taskOutputP = fromMaybe (taskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "task"++descriptionOutputP :: SectionParser Text+descriptionOutputP =+    fromMaybe (descriptionOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "summary"++dueOutputP :: SectionParser Text+dueOutputP = fromMaybe (dueOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "due"++subtaskOutputP :: SectionParser Text+subtaskOutputP =+    fromMaybe (subtaskOutput defaultConfig) . (noEmpty . parseText =<<) <$> fieldMb "subtask"++localTimesP :: SectionParser Bool+localTimesP = fieldFlagDef "localTimes" (localTimes defaultConfig)++parser :: IniParser Config+parser =+    fromMaybe defaultConfig <$>+    sectionMb+        "markdown"+        (Config <$> titleOutputP <*> taskOutputP <*> descriptionOutputP <*> dueOutputP <*>+         subtaskOutputP <*>+         localTimesP)
+ src/Taskell/IO/Config/Parser.hs view
@@ -0,0 +1,12 @@+module Taskell.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/Taskell/IO/Config/Trello.hs view
@@ -0,0 +1,25 @@+module Taskell.IO.Config.Trello+    ( Config+    , defaultConfig+    , parser+    , token+    ) where++import ClassyPrelude++import Data.Ini.Config++import Taskell.IO.HTTP.Trello (TrelloToken)++data Config = Config+    { token :: Maybe TrelloToken+    }++defaultConfig :: Config+defaultConfig = Config {token = Nothing}++tokenP :: SectionParser (Maybe TrelloToken)+tokenP = fieldMb "token"++parser :: IniParser Config+parser = fromMaybe defaultConfig <$> sectionMb "trello" (Config <$> tokenP)
+ src/Taskell/IO/HTTP/Aeson.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.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/Taskell/IO/HTTP/GitHub.hs view
@@ -0,0 +1,161 @@+module Taskell.IO.HTTP.GitHub+    ( GitHubToken+    , GitHubIdentifier+    , getNextLink+    , getLists+    ) where++import ClassyPrelude++import Control.Lens  ((^.))+import Data.Sequence (mapWithIndex, (!?))+import Data.Text     (splitOn, strip)++import Data.Aeson+import Taskell.UI.CLI (prompt)++import Network.HTTP.Client       (requestHeaders)+import Network.HTTP.Simple       (Response, getResponseBody, getResponseHeader,+                                  getResponseStatusCode, httpBS, parseRequest)+import Network.HTTP.Types.Header (HeaderName)++import Taskell.IO.HTTP.Aeson                (parseError)+import Taskell.IO.HTTP.GitHub.AutomatedCard (automatedCardToTask)+import Taskell.IO.HTTP.GitHub.Card          (MaybeCard, content_url, maybeCardToTask)+import Taskell.IO.HTTP.GitHub.Column        (Column, cardsURL, columnToList)+import Taskell.IO.HTTP.GitHub.Project       (Project, columnsURL, name)++import Taskell.Data.List  (List)+import Taskell.Data.Lists (Lists)+import Taskell.Data.Task  (Task)++type GitHubToken = Text++type GitHubIdentifier = Text++type ReaderGitHubToken a = ReaderT GitHubToken IO a++concatEithers :: [Either String [a]] -> Either String [a]+concatEithers vals = bool (Left errs) (Right as) (null errs)+  where+    (errs, as) = bimap unlines concat $ partitionEithers vals++root :: Text+root = "https://api.github.com/"++headers :: ReaderGitHubToken [(HeaderName, ByteString)]+headers = do+    token <- ask+    pure+        [ ("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)++fetchURL :: Text -> ReaderGitHubToken (Response ByteString)+fetchURL url = do+    initialRequest <- lift $ parseRequest (unpack url)+    rHeaders <- headers+    lift . httpBS $ initialRequest {requestHeaders = rHeaders}++fetch' :: [ByteString] -> Text -> ReaderGitHubToken (Int, [ByteString])+fetch' bs url = do+    response <- fetchURL url+    let responses = bs <> [getResponseBody response]+    case getNextLink (getResponseHeader "Link" response) of+        Nothing  -> pure (getResponseStatusCode response, responses)+        Just lnk -> fetch' responses lnk++fetch :: Text -> ReaderGitHubToken (Int, [ByteString])+fetch = fetch' []++fetchContent :: MaybeCard -> ReaderGitHubToken (Either Text Task)+fetchContent card =+    case maybeCardToTask card of+        Just tsk -> pure $ Right tsk+        Nothing ->+            case card ^. content_url of+                Nothing -> pure $ Left "Could not parse card"+                Just url -> do+                    body <- getResponseBody <$> fetchURL url+                    pure . first parseError $ automatedCardToTask <$> eitherDecodeStrict body++getCards :: Text -> ReaderGitHubToken (Either Text [Task])+getCards url = do+    (status, body) <- fetch url+    case status of+        200 ->+            case concatEithers (eitherDecodeStrict <$> body) of+                Right cards -> do+                    cds <- sequence (fetchContent <$> cards)+                    let (ls, rs) = first unlines $ partitionEithers cds+                    pure $ bool (Left ls) (Right rs) (null ls)+                Left err -> pure $ Left (parseError err)+        429 -> pure $ Left "Too many cards"+        _ -> pure . Left $ tshow status <> " error while fetching " <> url++addCard :: Column -> ReaderGitHubToken (Either Text List)+addCard column = do+    cards <- getCards $ column ^. cardsURL+    pure $ columnToList column <$> cards++addCards :: [Column] -> ReaderGitHubToken (Either Text Lists)+addCards columns = (fromList <$>) . sequence <$> traverse addCard columns++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      -> pure $ Left (parseError err)+        404 -> pure . Left $ "Could not find GitHub project ."+        401 -> pure . Left $ "You do not have permission to view GitHub project " <> url+        _ -> pure . 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   -> pure $ 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 pure . Left $ concat ["\nNo projects found for ", identifier, "\n"]+                        else chooseProject projects+                Left err -> pure $ Left (parseError err)+        404 ->+            pure . 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 ->+            pure . Left $+            "You do not have permission to view the GitHub projects for " <> identifier+        _ -> pure . Left $ tshow status <> " error. Cannot fetch projects from GitHub."
+ src/Taskell/IO/HTTP/GitHub/AutomatedCard.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.GitHub.AutomatedCard+    ( AutomatedCard(AutomatedCard)+    , automatedCardToTask+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (^.))++import qualified Taskell.Data.Task              as T (Task, new, setDescription)+import           Taskell.IO.HTTP.Aeson          (deriveFromJSON)+import           Taskell.IO.HTTP.GitHub.Utility (cleanUp)++data AutomatedCard = AutomatedCard+    { _title :: Text+    , _body  :: Text+    } deriving (Eq, Show)++-- strip underscores from field labels+$(deriveFromJSON ''AutomatedCard)++-- create lenses+$(makeLenses ''AutomatedCard)++-- operations+automatedCardToTask :: AutomatedCard -> T.Task+automatedCardToTask automatedCard = T.setDescription (cleanUp (automatedCard ^. body)) task+  where+    task = T.new $ cleanUp (automatedCard ^. title)
+ src/Taskell/IO/HTTP/GitHub/Card.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.GitHub.Card+    ( MaybeCard(MaybeCard)+    , maybeCardToTask+    , content_url+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (^.))++import qualified Taskell.Data.Task              as T (Task, new)+import           Taskell.IO.HTTP.Aeson          (deriveFromJSON)+import           Taskell.IO.HTTP.GitHub.Utility (cleanUp)++data MaybeCard = MaybeCard+    { _note        :: Maybe Text+    , _content_url :: Maybe Text+    } deriving (Eq, Show)++-- strip underscores from field labels+$(deriveFromJSON ''MaybeCard)++-- create lenses+$(makeLenses ''MaybeCard)++-- operations+maybeCardToTask :: MaybeCard -> Maybe T.Task+maybeCardToTask card = T.new . cleanUp <$> card ^. note
+ src/Taskell/IO/HTTP/GitHub/Column.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.GitHub.Column+    ( Column+    , columnToList+    , cardsURL+    ) where++import ClassyPrelude++import Control.Lens (Lens', makeLenses, (^.))++import Taskell.IO.HTTP.Aeson (deriveFromJSON)++import qualified Taskell.Data.List as L (List, create)+import qualified Taskell.Data.Task as T (Task)++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 -> [T.Task] -> L.List+columnToList ls tasks = L.create (ls ^. name) (fromList tasks)
+ src/Taskell/IO/HTTP/GitHub/Project.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.GitHub.Project+    ( Project+    , columnsURL+    , name+    ) where++import ClassyPrelude++import Control.Lens (Lens', makeLenses)++import Taskell.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/Taskell/IO/HTTP/GitHub/Utility.hs view
@@ -0,0 +1,10 @@+module Taskell.IO.HTTP.GitHub.Utility+    ( cleanUp+    ) where++import ClassyPrelude++import Data.Text (replace)++cleanUp :: Text -> Text+cleanUp txt = replace "\r" "" $ replace "\n" " " txt
+ src/Taskell/IO/HTTP/Trello.hs view
@@ -0,0 +1,102 @@+module Taskell.IO.HTTP.Trello+    ( TrelloToken+    , TrelloBoardID+    , getLists+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Aeson+import Network.HTTP.Simple (getResponseBody, getResponseStatusCode, httpBS, parseRequest)++import Taskell.IO.HTTP.Aeson                (parseError)+import Taskell.IO.HTTP.Trello.Card          (Card, idChecklists, setChecklists)+import Taskell.IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems)+import Taskell.IO.HTTP.Trello.List          (List, cards, listToList, setCards)++import Taskell.Data.Lists (Lists)++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+    pure . 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 :: [List] -> Lists+trelloListsToLists ls = fromList $ listToList <$> ls++fetch :: String -> IO (Int, ByteString)+fetch url = do+    request <- parseRequest url+    response <- httpBS request+    pure (getResponseStatusCode response, getResponseBody response)++getChecklist :: TrelloChecklistID -> ReaderTrelloToken (Either Text [ChecklistItem])+getChecklist checklist = do+    url <- checklistURL checklist+    (status, body) <- lift $ fetch url+    pure $+        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 = traverse getChecklist (card ^. idChecklists)++updateList :: List -> ReaderTrelloToken (Either Text List)+updateList l = (setCards l <$>) . sequence <$> traverse updateCard (l ^. cards)++getChecklists :: [List] -> ReaderTrelloToken (Either Text [List])+getChecklists ls = sequence <$> traverse updateList ls++getLists :: TrelloBoardID -> ReaderTrelloToken (Either Text Lists)+getLists board = do+    putStrLn "Fetching from Trello..."+    url <- boardURL board+    (status, body) <- lift $ fetch url+    case status of+        200 ->+            case eitherDecodeStrict body of+                Right raw -> fmap trelloListsToLists <$> getChecklists raw+                Left err  -> pure . Left $ parseError err+        404 ->+            pure . Left $ "Could not find Trello board " <> board <> ". Make sure the ID is correct"+        401 -> pure . Left $ "You do not have permission to view Trello board " <> board+        _ -> pure . Left $ tshow status <> " error. Cannot fetch from Trello."
+ src/Taskell/IO/HTTP/Trello/Card.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.Trello.Card+    ( Card+    , idChecklists+    , cardToTask+    , setChecklists+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (&), (.~), (^.))++import Taskell.IO.HTTP.Aeson                (deriveFromJSON)+import Taskell.IO.HTTP.Trello.ChecklistItem (ChecklistItem, checklistItemToSubTask)++import           Taskell.Data.Date (isoToTime)+import qualified Taskell.Data.Task as T (Task, due, new, setDescription, subtasks)++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+cardToTask :: Card -> T.Task+cardToTask card =+    task & T.due .~ isoToTime (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/Taskell/IO/HTTP/Trello/ChecklistItem.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.Trello.ChecklistItem+    ( ChecklistItem+    , checklistItemToSubTask+    , checkItems+    ) where++import ClassyPrelude++import           Control.Lens          (makeLenses, (^.))+import qualified Taskell.Data.Subtask  as ST (Subtask, new)+import           Taskell.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/Taskell/IO/HTTP/Trello/List.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.HTTP.Trello.List+    ( List+    , cards+    , setCards+    , listToList+    ) where++import ClassyPrelude++import Control.Lens (makeLenses, (&), (.~), (^.))++import Taskell.IO.HTTP.Aeson       (deriveFromJSON)+import Taskell.IO.HTTP.Trello.Card (Card, cardToTask)++import qualified Taskell.Data.List as L (List, create)++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 :: List -> L.List+listToList ls = L.create (ls ^. name) (fromList $ cardToTask <$> (ls ^. cards))
+ src/Taskell/IO/Keyboard.hs view
@@ -0,0 +1,77 @@+module Taskell.IO.Keyboard+    ( generate+    , defaultBindings+    , badMapping+    , addMissing+    ) where++import ClassyPrelude hiding ((\\))++import Data.Bitraversable (bitraverse)+import Data.List          ((\\))++import qualified Taskell.Events.Actions.Types as A+import           Taskell.IO.Keyboard.Types++generate :: Bindings -> Actions -> BoundActions+generate bindings actions =+    mapFromList . catMaybes $ bitraverse bindingToEvent (`lookup` actions) <$> bindings++badMapping :: Bindings -> Either Text Bindings+badMapping bindings =+    if null result+        then Right bindings+        else Left "invalid mapping"+  where+    result = filter ((== A.Nothing) . snd) bindings++addMissing :: Bindings -> Bindings+addMissing bindings = bindings <> replaced+  where+    bnd = A.Nothing : (snd <$> bindings)+    result = A.allActions \\ bnd+    replaced = concat $ replace <$> result++replace :: A.ActionType -> Bindings+replace action = filter ((==) action . snd) defaultBindings++defaultBindings :: Bindings+defaultBindings =+    [ (BChar 'q', A.Quit)+    , (BChar 'u', A.Undo)+    , (BChar 'r', A.Redo)+    , (BChar '/', A.Search)+    , (BChar '!', A.Due)+    , (BChar '?', A.Help)+    , (BChar 'k', A.Previous)+    , (BChar 'j', A.Next)+    , (BChar 'h', A.Left)+    , (BChar 'l', A.Right)+    , (BChar 'G', A.Bottom)+    , (BChar 'g', A.Top)+    , (BChar 'a', A.New)+    , (BChar 'O', A.NewAbove)+    , (BChar 'o', A.NewBelow)+    , (BChar '+', A.Duplicate)+    , (BChar 'e', A.Edit)+    , (BChar 'A', A.Edit)+    , (BChar 'i', A.Edit)+    , (BChar 'C', A.Clear)+    , (BChar 'D', A.Delete)+    , (BKey "Enter", A.Detail)+    , (BChar '@', A.DueDate)+    , (BKey "Backspace", A.ClearDate)+    , (BChar 'K', A.MoveUp)+    , (BChar 'J', A.MoveDown)+    , (BChar '˙', A.MoveLeftTop)+    , (BChar '¬', A.MoveRightTop)+    , (BChar 'H', A.MoveLeftBottom)+    , (BChar 'L', A.MoveRightBottom)+    , (BKey "Space", A.Complete)+    , (BChar 'm', A.MoveMenu)+    , (BChar 'N', A.ListNew)+    , (BChar 'E', A.ListEdit)+    , (BChar 'X', A.ListDelete)+    , (BChar '>', A.ListRight)+    , (BChar '<', A.ListLeft)+    ]
+ src/Taskell/IO/Keyboard/Parser.hs view
@@ -0,0 +1,42 @@+module Taskell.IO.Keyboard.Parser where++import ClassyPrelude++import Data.Attoparsec.Text++import Taskell.Utility.Parser++import Taskell.Events.Actions.Types (ActionType, read)+import Taskell.IO.Keyboard.Types++-- utility functions+commentP :: Parser ()+commentP = lexeme $ skipMany ((char '#' <|> char ';') *> manyTill anyChar endOfLine)++stripComments :: Parser a -> Parser a+stripComments p = lexeme $ commentP *> p <* commentP++-- ini parser+keyP :: Parser Binding+keyP = lexeme $ BKey <$> (char '<' *> word <* char '>')++charP :: Parser Binding+charP = lexeme $ BChar <$> anyChar++bindingP :: Parser [Binding]+bindingP = lexeme $ (keyP <|> charP) `sepBy` char ','++lineP :: Parser [(Binding, ActionType)]+lineP =+    stripComments $ do+        name <- read <$> word+        _ <- lexeme $ char '='+        binds <- bindingP+        pure $ (, name) <$> binds++bindingsP :: Parser Bindings+bindingsP = stripComments $ concat <$> many' lineP++-- run parser+bindings :: Text -> Either Text Bindings+bindings ini = first (const "Could not parse keyboard bindings.") (parseOnly bindingsP ini)
+ src/Taskell/IO/Keyboard/Types.hs view
@@ -0,0 +1,41 @@+module Taskell.IO.Keyboard.Types where++import ClassyPrelude++import Graphics.Vty.Input.Events (Event (..), Key (..))++import qualified Taskell.Events.Actions.Types as A (ActionType)+import           Taskell.Events.State.Types   (Stateful)++data Binding+    = BChar Char+    | BKey Text+    deriving (Eq, Ord)++type Bindings = [(Binding, A.ActionType)]++type Actions = Map A.ActionType Stateful++type BoundActions = Map Event Stateful++instance Show Binding where+    show (BChar c)      = singleton c+    show (BKey "Up")    = "↑"+    show (BKey "Down")  = "↓"+    show (BKey "Left")  = "←"+    show (BKey "Right") = "→"+    show (BKey name)    = "<" <> unpack name <> ">"++bindingsToText :: Bindings -> A.ActionType -> [Text]+bindingsToText bindings key = tshow . fst <$> toList (filterMap (== key) bindings)++bindingToEvent :: Binding -> Maybe Event+bindingToEvent (BChar char)       = pure $ EvKey (KChar char) []+bindingToEvent (BKey "Space")     = pure $ EvKey (KChar ' ') []+bindingToEvent (BKey "Backspace") = pure $ EvKey KBS []+bindingToEvent (BKey "Enter")     = pure $ EvKey KEnter []+bindingToEvent (BKey "Left")      = pure $ EvKey KLeft []+bindingToEvent (BKey "Right")     = pure $ EvKey KRight []+bindingToEvent (BKey "Up")        = pure $ EvKey KUp []+bindingToEvent (BKey "Down")      = pure $ EvKey KDown []+bindingToEvent _                  = Nothing
+ src/Taskell/IO/Markdown.hs view
@@ -0,0 +1,8 @@+module Taskell.IO.Markdown+    ( parse+    , serialize+    , MarkdownInfo(MarkdownInfo)+    ) where++import Taskell.IO.Markdown.Parser     (parse)+import Taskell.IO.Markdown.Serializer (MarkdownInfo (MarkdownInfo), serialize)
+ src/Taskell/IO/Markdown/Parser.hs view
@@ -0,0 +1,64 @@+module Taskell.IO.Markdown.Parser+    ( parse+    ) where++import ClassyPrelude++import Data.Attoparsec.Text hiding (parse)++import qualified Taskell.Data.Date    as D (Due, textToTime)+import qualified Taskell.Data.List    as L (List, create)+import qualified Taskell.Data.Lists   as LS (Lists)+import qualified Taskell.Data.Subtask as ST (Subtask, new)+import qualified Taskell.Data.Task    as T (Task, create)++import Taskell.IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput, taskOutput,+                                   titleOutput)+import Taskell.Utility.Parser     (lexeme, line)++-- config symbol parsing+type Symbol = (Config -> Text) -> Parser ()++symP :: Config -> Symbol+symP config fn = string (fn config) *> char ' ' $> ()++-- utility functions+emptyMay :: (MonoFoldable a) => a -> Maybe a+emptyMay a =+    if null a+        then Nothing+        else Just a++-- parsers+subtaskCompleteP :: Parser Bool+subtaskCompleteP = (== 'x') <$> (char '[' *> (char 'x' <|> char ' ') <* char ']' <* char ' ')++subtaskP :: Symbol -> Parser ST.Subtask+subtaskP sym = flip ST.new <$> (sym subtaskOutput *> subtaskCompleteP) <*> line++taskDescriptionP :: Symbol -> Parser (Maybe Text)+taskDescriptionP sym = emptyMay <$> (intercalate "\n" <$> many' (sym descriptionOutput *> line))++dueP :: Symbol -> Parser (Maybe D.Due)+dueP sym = (D.textToTime =<<) <$> optional (sym dueOutput *> line)++taskNameP :: Symbol -> Parser Text+taskNameP sym = sym taskOutput *> line++taskP :: Symbol -> Parser T.Task+taskP sym =+    T.create <$> taskNameP sym <*> dueP sym <*> taskDescriptionP sym <*>+    (fromList <$> many' (subtaskP sym))++listTitleP :: Symbol -> Parser Text+listTitleP sym = lexeme $ sym titleOutput *> line++listP :: Symbol -> Parser L.List+listP sym = L.create <$> listTitleP sym <*> (fromList <$> many' (taskP sym))++markdownP :: Symbol -> Parser LS.Lists+markdownP sym = fromList <$> many1 (listP sym) <* endOfInput++-- parse+parse :: Config -> Text -> Either Text LS.Lists+parse config txt = first (const "Could not parse file.") (parseOnly (markdownP (symP config)) txt)
+ src/Taskell/IO/Markdown/Serializer.hs view
@@ -0,0 +1,89 @@+module Taskell.IO.Markdown.Serializer+    ( serialize+    , MarkdownInfo(MarkdownInfo)+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import qualified Data.Text as T (splitOn)++import Data.Time.Zones (TZ)++import           Taskell.Data.Date    (Due, timeToOutput, timeToOutputLocal)+import           Taskell.Data.List    (List, tasks, title)+import           Taskell.Data.Lists   (Lists)+import qualified Taskell.Data.Subtask as ST (Subtask, complete, name)+import qualified Taskell.Data.Task    as T (Task, description, due, name, subtasks)++import Taskell.IO.Config.Markdown (Config, descriptionOutput, dueOutput, localTimes, subtaskOutput,+                                   taskOutput, titleOutput)++data MarkdownInfo = MarkdownInfo+    { mdTZ     :: TZ+    , mdConfig :: Config+    }++type ReaderMarkdown = Reader MarkdownInfo++-- utility functions+askConf :: (Config -> a) -> ReaderMarkdown a+askConf fn = fn <$> asks mdConfig++strMay :: (Applicative m) => (a -> m Text) -> Maybe a -> m Text+strMay _ Nothing   = pure ""+strMay fn (Just a) = fn a++space :: Text -> Text -> Text+space symbol txt = symbol <> " " <> txt++timeFn :: ReaderMarkdown (Due -> Text)+timeFn = bool timeToOutput <$> (timeToOutputLocal <$> asks mdTZ) <*> askConf localTimes++-- serializers+subtaskCompleteS :: Bool -> Text+subtaskCompleteS True  = "[x]"+subtaskCompleteS False = "[ ]"++subtaskS :: ST.Subtask -> ReaderMarkdown Text+subtaskS st = do+    symbol <- askConf subtaskOutput+    pure $ unwords [symbol, subtaskCompleteS (st ^. ST.complete), st ^. ST.name]++subtasksS :: Seq ST.Subtask -> ReaderMarkdown Text+subtasksS sts = intercalate "\n" <$> sequence (subtaskS <$> sts)++descriptionS :: Text -> ReaderMarkdown Text+descriptionS desc = do+    symbol <- askConf descriptionOutput+    pure . intercalate "\n" $ space symbol <$> T.splitOn "\n" desc++dueS :: Due -> ReaderMarkdown Text+dueS due = do+    symbol <- askConf dueOutput+    fn <- timeFn+    pure $ space symbol (fn due)++nameS :: Text -> ReaderMarkdown Text+nameS desc = space <$> askConf taskOutput <*> pure desc++taskS :: T.Task -> ReaderMarkdown Text+taskS t =+    unlines . filter (/= "") <$>+    sequence+        [ nameS (t ^. T.name)+        , strMay dueS (t ^. T.due)+        , strMay descriptionS (t ^. T.description)+        , subtasksS (t ^. T.subtasks)+        ]++listS :: List -> ReaderMarkdown Text+listS list = do+    symbol <- askConf titleOutput+    taskString <- concat <$> sequence (taskS <$> list ^. tasks)+    pure . space symbol $ concat [list ^. title, "\n\n", taskString]++-- serialize+serialize :: Lists -> ReaderMarkdown Text+serialize ls = intercalate "\n" <$> sequence (listS <$> ls)
+ src/Taskell/Types.hs view
@@ -0,0 +1,16 @@+module Taskell.Types where++import ClassyPrelude++newtype ListIndex = ListIndex+    { showListIndex :: Int+    } deriving (Show, Eq, Ord)++newtype TaskIndex = TaskIndex+    { showTaskIndex :: Int+    } deriving (Show, Eq, Ord)++type Pointer = (ListIndex, TaskIndex)++startPointer :: Pointer+startPointer = (ListIndex 0, TaskIndex 0)
+ src/Taskell/UI/CLI.hs view
@@ -0,0 +1,21 @@+module Taskell.UI.CLI+    ( prompt+    , promptYN+    , PromptYN(PromptYes)+    ) where++import ClassyPrelude++prompt :: Text -> IO Text+prompt s = do+    putStr $ s <> ": "+    hFlush stdout -- prevents buffering+    getLine++data PromptYN+    = PromptYes+    | PromptNo++promptYN :: PromptYN -> Text -> IO Bool+promptYN PromptYes s = not . flip elem ["n", "no"] . toLower <$> prompt (s <> " (Y/n)")+promptYN PromptNo s  = not . flip elem ["y", "yes"] . toLower <$> prompt (s <> " (y/N)")
+ src/Taskell/UI/Draw.hs view
@@ -0,0 +1,39 @@+module Taskell.UI.Draw+    ( draw+    , chooseCursor+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Control.Monad.Reader (runReader)++import Brick++import Taskell.Events.State            (normalise)+import Taskell.Events.State.Types      (State, mode)+import Taskell.Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))+import Taskell.IO.Config.Layout        (Config)+import Taskell.IO.Keyboard.Types       (Bindings)+import Taskell.UI.Draw.Main            (renderMain)+import Taskell.UI.Draw.Modal           (renderModal)+import Taskell.UI.Draw.Types           (DrawState (DrawState), ReaderDrawState, TWidget)+import Taskell.UI.Types                (ResourceName (..))++-- draw+renderApp :: ReaderDrawState [TWidget]+renderApp = sequence [renderModal, renderMain]++draw :: Config -> Bindings -> Bool -> State -> [TWidget]+draw layout bindings debug state =+    runReader renderApp (DrawState layout bindings debug (normalise state))++-- cursors+chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName)+chooseCursor state =+    case normalise state ^. mode of+        Insert {}                         -> showCursorNamed RNCursor+        Search                            -> showCursorNamed RNCursor+        Modal (Detail _ (DetailInsert _)) -> showCursorNamed RNCursor+        _                                 -> neverShowCursor state
+ src/Taskell/UI/Draw/Field.hs view
@@ -0,0 +1,143 @@+module Taskell.UI.Draw.Field where++import ClassyPrelude++import qualified Data.List as L (scanl1)+import qualified Data.Text as T (splitAt, takeEnd)++import qualified Brick                     as B (Location (Location), Size (Fixed), Widget (Widget),+                                                 availWidth, getContext, render, showCursor, txt,+                                                 vBox)+import qualified Brick.Widgets.Core        as B (textWidth)+import qualified Graphics.Text.Width       as V (safeWcwidth)+import qualified Graphics.Vty.Input.Events as V (Event (..), Key (..))++import qualified Taskell.UI.Types as UI (ResourceName (RNCursor))++data Field = Field+    { _text   :: Text+    , _cursor :: Int+    } deriving (Eq, Show)++blankField :: Field+blankField = Field "" 0++event :: V.Event -> Field -> Field+event (V.EvKey (V.KChar '\t') _) f = f+event (V.EvPaste bs) f             = insertText (decodeUtf8 bs) f+event (V.EvKey V.KBS _) f          = backspace f+event (V.EvKey V.KLeft _) f        = updateCursor (-1) f+event (V.EvKey V.KRight _) f       = updateCursor 1 f+event (V.EvKey (V.KChar char) _) f = insertCharacter char f+event _ f                          = f++updateCursor :: Int -> Field -> Field+updateCursor dir (Field text cursor) = Field text newCursor+  where+    next = cursor + dir+    limit = length text+    newCursor+        | next <= 0 = 0+        | next > limit = limit+        | otherwise = next++backspace :: Field -> Field+backspace (Field text cursor) =+    let (start, end) = T.splitAt cursor text+    in case fromNullable start of+           Nothing     -> Field end cursor+           Just start' -> Field (init start' <> end) (cursor - 1)++insertCharacter :: Char -> Field -> Field+insertCharacter char (Field text cursor) = Field newText newCursor+  where+    (start, end) = T.splitAt cursor text+    newText = snoc start char <> end+    newCursor = cursor + 1++insertText :: Text -> Field -> Field+insertText insert (Field text cursor) = Field newText newCursor+  where+    (start, end) = T.splitAt cursor text+    newText = concat [start, insert, end]+    newCursor = cursor + length insert++widthFold :: [Int] -> Char -> [Int]+widthFold l t = l <> [V.safeWcwidth t]++cursorPosition :: [Text] -> Int -> Int -> (Int, Int)+cursorPosition lns width cursor =+    if x == width+        then (0, y + 1) -- go to next line if at end of line+        else (x, y)+  where+    parts = foldl' widthFold [] <$> lns -- list of list of individual character lengths+    lengths = length <$> parts -- list of line lengths+    cumulative = L.scanl1 (+) lengths -- cumulative total of line lengths+    above = takeWhile (< cursor) cumulative -- lines above the cursor+    y = length above -- number of lines above+    adjustedCursor = cursor - fromMaybe 0 (lastMay above) -- subtract lines above from cursor position+    cumulativeWidths = L.scanl1 (+) <$> index parts y -- get cumulative widths for current line+    x = fromMaybe 0 $ flip index (adjustedCursor - 1) =<< cumulativeWidths++getText :: Field -> Text+getText (Field text _) = text++textToField :: Text -> Field+textToField text = Field text (length text)++field :: Field -> B.Widget UI.ResourceName+field (Field text cursor) =+    B.Widget B.Fixed B.Fixed $ do+        width <- B.availWidth <$> B.getContext+        let (wrapped, offset) = wrap width text+            location = cursorPosition wrapped width (cursor - offset)+        B.render $+            if null text+                then B.showCursor UI.RNCursor (B.Location (0, 0)) $ B.txt " "+                else B.showCursor UI.RNCursor (B.Location location) . B.vBox $ B.txt <$> wrapped++widgetFromMaybe :: B.Widget UI.ResourceName -> Maybe Field -> B.Widget UI.ResourceName+widgetFromMaybe _ (Just f) = field f+widgetFromMaybe w Nothing  = w++textField :: Text -> B.Widget UI.ResourceName+textField text =+    B.Widget B.Fixed B.Fixed $ do+        width <- B.availWidth <$> B.getContext+        let (wrapped, _) = wrap width text+        B.render $+            if null text+                then B.txt "---"+                else B.vBox $ B.txt <$> wrapped++-- wrap+wrap :: Int -> Text -> ([Text], Int)+wrap width = foldl' (combine width) ([""], 0) . spl++spl' :: [Text] -> Char -> [Text]+spl' ts c+    | c == ' ' = ts <> [" "] <> [""]+    | otherwise =+        case fromNullable ts of+            Just ts' -> init ts' <> [snoc (last ts') c]+            Nothing  -> [singleton c]++spl :: Text -> [Text]+spl = foldl' spl' [""]++combine :: Int -> ([Text], Int) -> Text -> ([Text], Int)+combine width (acc, offset) s+    | newline && s == " " = (acc, offset + 1)+    | T.takeEnd 1 l == " " && s == " " = (acc, offset + 1)+    | newline = (acc <> [s], offset)+    | otherwise = (append (l <> s) acc, offset)+  where+    l = maybe "" last (fromNullable acc)+    newline = B.textWidth l + B.textWidth s > width++append :: Text -> [Text] -> [Text]+append s l =+    case fromNullable l of+        Just l' -> init l' <> [s]+        Nothing -> l <> [s]
+ src/Taskell/UI/Draw/Main.hs view
@@ -0,0 +1,26 @@+module Taskell.UI.Draw.Main+    ( renderMain+    ) where++import ClassyPrelude++import Brick+import Control.Lens  ((^.))+import Data.Sequence (mapWithIndex)++import Taskell.Events.State.Types     (lists)+import Taskell.IO.Config.Layout       (padding, statusBar)+import Taskell.UI.Draw.Main.List      (renderList)+import Taskell.UI.Draw.Main.Search    (renderSearch)+import Taskell.UI.Draw.Main.StatusBar (renderStatusBar)+import Taskell.UI.Draw.Types          (DSWidget, DrawState (..))+import Taskell.UI.Types               (ResourceName (..))++renderMain :: DSWidget+renderMain = do+    ls <- (^. lists) <$> asks dsState+    listWidgets <- toList <$> sequence (renderList `mapWithIndex` ls)+    pad <- padding <$> asks dsLayout+    let mainWidget = viewport RNLists Horizontal . padTopBottom pad $ hBox listWidgets+    sb <- bool emptyWidget <$> renderStatusBar <*> (statusBar <$> asks dsLayout)+    renderSearch (mainWidget <=> sb)
+ src/Taskell/UI/Draw/Main/List.hs view
@@ -0,0 +1,89 @@+module Taskell.UI.Draw.Main.List+    ( renderList+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Char     (chr, ord)+import Data.Sequence (mapWithIndex)++import Brick++import Taskell.Data.List          (List, tasks, title)+import Taskell.Events.State.Types (current, mode)+import Taskell.IO.Config.Layout   (columnPadding, columnWidth)+import Taskell.Types              (ListIndex (ListIndex), TaskIndex (TaskIndex))+import Taskell.UI.Draw.Field      (textField, widgetFromMaybe)+import Taskell.UI.Draw.Mode+import Taskell.UI.Draw.Task       (renderTask)+import Taskell.UI.Draw.Types      (DSWidget, DrawState (..), ReaderDrawState)+import Taskell.UI.Theme+import Taskell.UI.Types           (ResourceName (..))++-- | Gets the relevant column prefix - number in normal mode, letter in moveTo+columnPrefix :: Int -> Int -> ReaderDrawState Text+columnPrefix selectedList i = do+    m <- (^. mode) <$> asks dsState+    if moveTo m+        then do+            let col = chr (i + ord 'a')+            pure $+                if i /= selectedList && i >= 0 && i <= 26+                    then singleton col <> ". "+                    else ""+        else do+            let col = i + 1+            pure $+                if col >= 1 && col <= 9+                    then tshow col <> ". "+                    else ""++-- | Renders the title for a list+renderTitle :: Int -> List -> DSWidget+renderTitle listIndex list = do+    (ListIndex selectedList, TaskIndex selectedTask) <- (^. current) <$> asks dsState+    editing <- (selectedList == listIndex &&) . editingTitle . (^. mode) <$> asks dsState+    titleField <- getField . (^. mode) <$> asks dsState+    col <- txt <$> columnPrefix selectedList listIndex+    let text = list ^. title+        attr =+            if selectedList == listIndex+                then titleCurrentAttr+                else titleAttr+        widget = textField text+        widget' = widgetFromMaybe widget titleField+        title' =+            padBottom (Pad 1) . withAttr attr . (col <+>) $+            if editing+                then widget'+                else widget+    pure $+        if editing || selectedList /= listIndex || selectedTask == 0+            then visible title'+            else title'++-- | Renders a list+renderList :: Int -> List -> DSWidget+renderList listIndex list = do+    layout <- dsLayout <$> ask+    eTitle <- editingTitle . (^. mode) <$> asks dsState+    titleWidget <- renderTitle listIndex list+    (ListIndex currentList, _) <- (^. current) <$> asks dsState+    taskWidgets <-+        sequence $+        renderTask (RNTask . (ListIndex listIndex, ) . TaskIndex) listIndex `mapWithIndex`+        (list ^. tasks)+    let widget =+            (if not eTitle+                 then cached (RNList listIndex)+                 else id) .+            padLeftRight (columnPadding layout) .+            hLimit (columnWidth layout) .+            viewport (RNList listIndex) Vertical . vBox . (titleWidget :) $+            toList taskWidgets+    pure $+        if currentList == listIndex+            then visible widget+            else widget
+ src/Taskell/UI/Draw/Main/Search.hs view
@@ -0,0 +1,31 @@+module Taskell.UI.Draw.Main.Search+    ( renderSearch+    ) where++import Brick+import ClassyPrelude+import Control.Lens  ((^.))++import Taskell.Events.State.Types      (mode, searchTerm)+import Taskell.Events.State.Types.Mode (Mode (..))+import Taskell.IO.Config.Layout        (columnPadding)+import Taskell.UI.Draw.Field           (field)+import Taskell.UI.Draw.Types           (DSWidget, DrawState (..))+import Taskell.UI.Theme+import Taskell.UI.Types                (ResourceName (..))++renderSearch :: Widget ResourceName -> DSWidget+renderSearch mainWidget = do+    m <- (^. mode) <$> asks dsState+    term <- (^. searchTerm) <$> asks dsState+    case term of+        Just searchField -> do+            colPad <- columnPadding . dsLayout <$> ask+            let attr =+                    withAttr $+                    case m of+                        Search -> taskCurrentAttr+                        _      -> taskAttr+            let widget = attr . padLeftRight colPad $ txt "/" <+> field searchField+            pure $ mainWidget <=> widget+        _ -> pure mainWidget
+ src/Taskell/UI/Draw/Main/StatusBar.hs view
@@ -0,0 +1,65 @@+module Taskell.UI.Draw.Main.StatusBar+    ( renderStatusBar+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick++import Taskell.Data.Lists         (count)+import Taskell.Events.State.Types (current, lists, mode, path, searchTerm)++import Taskell.Events.State.Types.Mode (ModalType (..), Mode (..))+import Taskell.IO.Config.Layout        (columnPadding)+import Taskell.Types                   (ListIndex (ListIndex), TaskIndex (TaskIndex))+import Taskell.UI.Draw.Field           (Field)+import Taskell.UI.Draw.Types           (DSWidget, DrawState (..), ReaderDrawState)+import Taskell.UI.Theme++getPosition :: ReaderDrawState Text+getPosition = do+    (ListIndex col, TaskIndex pos) <- (^. current) <$> asks dsState+    len <- count col . (^. lists) <$> asks dsState+    let posNorm =+            if len > 0+                then pos + 1+                else 0+    pure $ tshow posNorm <> "/" <> tshow len++modeToText :: Maybe Field -> Mode -> ReaderDrawState Text+modeToText fld md = do+    debug <- asks dsDebug+    pure $+        if debug+            then tshow md+            else case md of+                     Normal ->+                         case fld of+                             Nothing -> "NORMAL"+                             Just _  -> "NORMAL + SEARCH"+                     Insert {} -> "INSERT"+                     Modal Help -> "HELP"+                     Modal MoveTo -> "MOVE"+                     Modal Detail {} -> "DETAIL"+                     Modal Due {} -> "DUE"+                     Search {} -> "SEARCH"+                     _ -> ""++getMode :: ReaderDrawState Text+getMode = do+    state <- asks dsState+    modeToText (state ^. searchTerm) (state ^. mode)++renderStatusBar :: DSWidget+renderStatusBar = do+    topPath <- pack . (^. path) <$> asks dsState+    colPad <- columnPadding <$> asks dsLayout+    posTxt <- getPosition+    modeTxt <- getMode+    let titl = padLeftRight colPad $ txt topPath+    let pos = padRight (Pad colPad) $ txt posTxt+    let md = txt modeTxt+    let bar = padRight Max (titl <+> md) <+> pos+    pure . padTop (Pad 1) $ withAttr statusBarAttr bar
+ src/Taskell/UI/Draw/Modal.hs view
@@ -0,0 +1,44 @@+module Taskell.UI.Draw.Modal+    ( renderModal+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick+import Brick.Widgets.Border+import Brick.Widgets.Center++import Taskell.Events.State.Types      (height, mode)+import Taskell.Events.State.Types.Mode (ModalType (..), Mode (..))+import Taskell.UI.Draw.Field           (textField)+import Taskell.UI.Draw.Modal.Detail    (detail)+import Taskell.UI.Draw.Modal.Due       (due)+import Taskell.UI.Draw.Modal.Help      (help)+import Taskell.UI.Draw.Modal.MoveTo    (moveTo)+import Taskell.UI.Draw.Types           (DSWidget, DrawState (dsState), TWidget)+import Taskell.UI.Theme                (titleAttr)+import Taskell.UI.Types                (ResourceName (..))++surround :: (Text, TWidget) -> DSWidget+surround (title, widget) = do+    ht <- (^. height) <$> asks dsState+    let t = padBottom (Pad 1) . withAttr titleAttr $ textField title+    pure .+        padTopBottom 1 .+        centerLayer .+        border .+        padTopBottom 1 .+        padLeftRight 4 . vLimit (ht - 9) . hLimit 50 . (t <=>) . viewport RNModal Vertical $+        widget++renderModal :: DSWidget+renderModal = do+    md <- (^. mode) <$> asks dsState+    case md of+        Modal Help                 -> surround =<< help+        Modal Detail {}            -> surround =<< detail+        Modal MoveTo               -> surround =<< moveTo+        Modal (Due tasks selected) -> surround =<< due tasks selected+        _                          -> pure emptyWidget
+ src/Taskell/UI/Draw/Modal/Detail.hs view
@@ -0,0 +1,88 @@+module Taskell.UI.Draw.Modal.Detail+    ( detail+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Data.Sequence (mapWithIndex)++import Brick++import Data.Time.Zones (TZ)++import           Taskell.Data.Date                 (deadline, timeToDisplay)+import qualified Taskell.Data.Subtask              as ST (Subtask, complete, name)+import           Taskell.Data.Task                 (Task, description, due, name, subtasks)+import           Taskell.Events.State              (getCurrentTask)+import           Taskell.Events.State.Modal.Detail (getCurrentItem, getField)+import           Taskell.Events.State.Types        (time, timeZone)+import           Taskell.Events.State.Types.Mode   (DetailItem (..))+import           Taskell.UI.Draw.Field             (Field, textField, widgetFromMaybe)+import           Taskell.UI.Draw.Types             (DrawState (..), ModalWidget, TWidget)+import           Taskell.UI.Theme                  (disabledAttr, dlToAttr, subtaskCompleteAttr,+                                                    subtaskCurrentAttr, subtaskIncompleteAttr)++renderSubtask :: Maybe Field -> DetailItem -> Int -> ST.Subtask -> TWidget+renderSubtask f current i subtask = padBottom (Pad 1) $ prefix <+> final+  where+    cur =+        case current of+            DetailItem c -> i == c+            _            -> False+    done = subtask ^. ST.complete+    attr =+        withAttr+            (if cur+                 then subtaskCurrentAttr+                 else (if done+                           then subtaskCompleteAttr+                           else subtaskIncompleteAttr))+    prefix =+        attr . txt $+        if done+            then "[x] "+            else "[ ] "+    widget = textField (subtask ^. ST.name)+    final+        | cur = visible . attr $ widgetFromMaybe widget f+        | otherwise = attr widget++renderSummary :: Maybe Field -> DetailItem -> Task -> TWidget+renderSummary f i task = padTop (Pad 1) $ padBottom (Pad 2) w'+  where+    w = textField $ fromMaybe "No description" (task ^. description)+    w' =+        case i of+            DetailDescription -> visible $ widgetFromMaybe w f+            _                 -> w++renderDate :: TZ -> UTCTime -> Maybe Field -> DetailItem -> Task -> TWidget+renderDate tz now field item task =+    case item of+        DetailDate -> visible $ prefix <+> widgetFromMaybe widget field+        _ ->+            case day of+                Just d  -> prefix <+> withAttr (dlToAttr (deadline now d)) widget+                Nothing -> emptyWidget+  where+    day = task ^. due+    prefix = txt "Due: "+    widget = textField $ maybe "" (timeToDisplay tz) day++detail :: ModalWidget+detail = do+    state <- asks dsState+    let now = state ^. time+    let tz = state ^. timeZone+    pure $+        fromMaybe ("Error", txt "Oops") $ do+            task <- getCurrentTask state+            i <- getCurrentItem state+            let f = getField state+            let sts = task ^. subtasks+                w+                    | null sts = withAttr disabledAttr $ txt "No sub-tasks"+                    | otherwise = vBox . toList $ renderSubtask f i `mapWithIndex` sts+            pure (task ^. name, renderDate tz now f i task <=> renderSummary f i task <=> w)
+ src/Taskell/UI/Draw/Modal/Due.hs view
@@ -0,0 +1,39 @@+module Taskell.UI.Draw.Modal.Due+    ( due+    ) where++import ClassyPrelude++import Brick+import Taskell.Data.Seq ((<#>))++import qualified Taskell.Data.Task     as T (Task)+import           Taskell.Types         (Pointer)+import           Taskell.UI.Draw.Task  (TaskWidget (..), parts)+import           Taskell.UI.Draw.Types (DSWidget, ModalWidget)+import           Taskell.UI.Theme      (taskAttr, taskCurrentAttr)+import           Taskell.UI.Types      (ResourceName (RNDue))++renderTask :: Int -> Int -> T.Task -> DSWidget+renderTask current position task = do+    (TaskWidget text date _ _) <- parts task+    let selected = current == position+    let attr =+            if selected+                then taskCurrentAttr+                else taskAttr+    let shw =+            if selected+                then visible+                else id+    pure . shw . cached (RNDue position) . padBottom (Pad 1) . withAttr attr $ vBox [date, text]++due :: Seq (Pointer, T.Task) -> Int -> ModalWidget+due tasks selected = do+    let items = snd <$> tasks+    widgets <- sequence $ renderTask selected <#> items+    pure+        ( "Due Tasks"+        , if null items+              then txt "No due tasks"+              else vBox $ toList widgets)
+ src/Taskell/UI/Draw/Modal/Help.hs view
@@ -0,0 +1,68 @@+module Taskell.UI.Draw.Modal.Help+    ( help+    ) where++import ClassyPrelude++import Brick+import Data.Text as T (justifyRight)++import Taskell.Events.Actions.Types as A (ActionType (..))+import Taskell.IO.Keyboard.Types    (bindingsToText)++import Taskell.IO.Keyboard.Types (Bindings)+import Taskell.UI.Draw.Field     (textField)+import Taskell.UI.Draw.Types     (DrawState (dsBindings), ModalWidget, TWidget)+import Taskell.UI.Theme          (taskCurrentAttr)++descriptions :: [([ActionType], Text)]+descriptions =+    [ ([A.Help], "Show this list of controls")+    , ([A.Due], "Show tasks with due dates")+    , ([A.Previous, A.Next, A.Left, A.Right], "Move down / up / left / right")+    , ([A.Bottom], "Go to bottom of list")+    , ([A.Top], "Go to top of list")+    , ([A.New], "Add a task")+    , ([A.NewAbove, A.NewBelow], "Add a task above / below")+    , ([A.Duplicate], "Duplicate a task")+    , ([A.Edit], "Edit a task")+    , ([A.Clear], "Change task")+    , ([A.Detail], "Show task details / Edit task description")+    , ([A.DueDate], "Add/edit due date (yyyy-mm-dd)")+    , ([A.ClearDate], "Removes due date")+    , ([A.MoveUp, A.MoveDown], "Shift task down / up")+    , ([A.MoveLeftBottom, A.MoveRightBottom], "Shift task left / right (to bottom of list)")+    , ([A.MoveLeftTop, A.MoveRightTop], "Shift task left / right (to top of list)")+    , ( [A.Complete]+      , "Move task to last list and remove any due dates / Mark subtask as (in)complete")+    , ([A.MoveMenu], "Move task to specific list")+    , ([A.Delete], "Delete task")+    , ([A.Undo], "Undo")+    , ([A.Redo], "Redo")+    , ([A.ListNew], "New list")+    , ([A.ListEdit], "Edit list title")+    , ([A.ListDelete], "Delete list")+    , ([A.ListLeft, A.ListRight], "Move list left / right")+    , ([A.Search], "Search")+    , ([A.Quit], "Quit")+    ]++generate :: Bindings -> [([Text], Text)]+generate bindings = first (intercalate ", " . bindingsToText bindings <$>) <$> descriptions++format :: ([Text], Text) -> (Text, Text)+format = first (intercalate " / ")++line :: Int -> (Text, Text) -> TWidget+line m (l, r) = left <+> right+  where+    left = padRight (Pad 2) . withAttr taskCurrentAttr . txt $ justifyRight m ' ' l+    right = textField r++help :: ModalWidget+help = do+    bindings <- asks dsBindings+    let ls = format <$> generate bindings+    let m = foldl' max 0 $ length . fst <$> ls+    let w = vBox $ line m <$> ls+    pure ("Controls", w)
+ src/Taskell/UI/Draw/Modal/MoveTo.hs view
@@ -0,0 +1,30 @@+module Taskell.UI.Draw.Modal.MoveTo+    ( moveTo+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick++import Taskell.Data.List          (title)+import Taskell.Events.State.Types (current, lists)+import Taskell.Types              (showListIndex)+import Taskell.UI.Draw.Field      (textField)+import Taskell.UI.Draw.Types      (DrawState (dsState), ModalWidget)+import Taskell.UI.Theme           (taskCurrentAttr)++moveTo :: ModalWidget+moveTo = do+    skip <- showListIndex . fst . (^. current) <$> asks dsState+    ls <- toList . (^. lists) <$> asks dsState+    let titles = textField . (^. title) <$> ls+    let letter a =+            padRight (Pad 1) . hBox $+            [txt "[", withAttr taskCurrentAttr $ txt (singleton a), txt "]"]+    let letters = letter <$> ['a' ..]+    let remove i l = take i l <> drop (i + 1) l+    let output (l, t) = l <+> t+    let widget = vBox $ output <$> remove skip (zip letters titles)+    pure ("Move To:", widget)
+ src/Taskell/UI/Draw/Mode.hs view
@@ -0,0 +1,18 @@+module Taskell.UI.Draw.Mode where++import ClassyPrelude++import Taskell.Events.State.Types.Mode (InsertType (..), ModalType (..), Mode (..))+import Taskell.UI.Draw.Field           (Field)++getField :: Mode -> Maybe Field+getField (Insert _ _ f) = Just f+getField _              = Nothing++editingTitle :: Mode -> Bool+editingTitle (Insert IList _ _) = True+editingTitle _                  = False++moveTo :: Mode -> Bool+moveTo (Modal MoveTo) = True+moveTo _              = False
+ src/Taskell/UI/Draw/Task.hs view
@@ -0,0 +1,107 @@+module Taskell.UI.Draw.Task+    ( TaskWidget(..)+    , renderTask+    , parts+    ) where++import ClassyPrelude++import Control.Lens ((^.))++import Brick++import           Taskell.Data.Date          (deadline, timeToText)+import qualified Taskell.Data.Task          as T (Task, contains, countCompleteSubtasks,+                                                  countSubtasks, description, due, hasSubtasks,+                                                  name)+import           Taskell.Events.State.Types (current, mode, searchTerm, time, timeZone)+import           Taskell.IO.Config.Layout   (descriptionIndicator)+import           Taskell.Types              (ListIndex (..), TaskIndex (..))+import           Taskell.UI.Draw.Field      (getText, textField, widgetFromMaybe)+import           Taskell.UI.Draw.Mode+import           Taskell.UI.Draw.Types      (DSWidget, DrawState (..), ReaderDrawState, TWidget)+import           Taskell.UI.Theme+import           Taskell.UI.Types           (ResourceName)++data TaskWidget = TaskWidget+    { textW     :: TWidget+    , dateW     :: TWidget+    , summaryW  :: TWidget+    , subtasksW :: TWidget+    }++-- | Takes a task's 'due' property and renders a date with appropriate styling (e.g. red if overdue)+renderDate :: T.Task -> DSWidget+renderDate task = do+    now <- (^. time) <$> asks dsState+    tz <- (^. timeZone) <$> asks dsState+    pure . fromMaybe emptyWidget $+        (\date -> withAttr (dlToAttr $ deadline now date) (txt $ timeToText tz now date)) <$>+        task ^. T.due++-- | Renders the appropriate completed sub task count e.g. "[2/3]"+renderSubtaskCount :: T.Task -> DSWidget+renderSubtaskCount task =+    pure . fromMaybe emptyWidget $ bool Nothing (Just indicator) (T.hasSubtasks task)+  where+    complete = tshow $ T.countCompleteSubtasks task+    total = tshow $ T.countSubtasks task+    indicator = txt $ concat ["[", complete, "/", total, "]"]++-- | Renders the description indicator+renderDescIndicator :: T.Task -> DSWidget+renderDescIndicator task = do+    indicator <- descriptionIndicator <$> asks dsLayout+    pure . fromMaybe emptyWidget $ const (txt indicator) <$> task ^. T.description -- show the description indicator if one is set++-- | Renders the task text+renderText :: T.Task -> DSWidget+renderText task = pure $ textField (task ^. T.name)++-- | Renders the appropriate indicators: description, sub task count, and due date+indicators :: T.Task -> DSWidget+indicators task = do+    widgets <- sequence (($ task) <$> [renderDescIndicator, renderSubtaskCount, renderDate])+    pure . hBox $ padRight (Pad 1) <$> widgets++-- | The individual parts of a task widget+parts :: T.Task -> ReaderDrawState TaskWidget+parts task =+    TaskWidget <$> renderText task <*> renderDate task <*> renderDescIndicator task <*>+    renderSubtaskCount task++-- | Renders an individual task+renderTask' :: (Int -> ResourceName) -> Int -> Int -> T.Task -> DSWidget+renderTask' rn listIndex taskIndex task = do+    eTitle <- editingTitle . (^. mode) <$> asks dsState -- is the title being edited? (for visibility)+    selected <- (== (ListIndex listIndex, TaskIndex taskIndex)) . (^. current) <$> asks dsState -- is the current task selected?+    taskField <- getField . (^. mode) <$> asks dsState -- get the field, if it's being edited+    after <- indicators task -- get the indicators widget+    widget <- renderText task+    let name = rn taskIndex+        widget' = widgetFromMaybe widget taskField+    pure $+        cached name .+        (if selected && not eTitle+             then visible+             else id) .+        padBottom (Pad 1) .+        (<=> withAttr disabledAttr after) .+        withAttr+            (if selected+                 then taskCurrentAttr+                 else taskAttr) $+        if selected && not eTitle+            then widget'+            else widget++renderTask :: (Int -> ResourceName) -> Int -> Int -> T.Task -> DSWidget+renderTask rn listIndex taskIndex task = do+    searchT <- (getText <$>) . (^. searchTerm) <$> asks dsState+    let taskWidget = renderTask' rn listIndex taskIndex task+    case searchT of+        Nothing -> taskWidget+        Just term ->+            if T.contains term task+                then taskWidget+                else pure emptyWidget
+ src/Taskell/UI/Draw/Types.hs view
@@ -0,0 +1,27 @@+module Taskell.UI.Draw.Types where++import ClassyPrelude++import Brick (Widget)++import Taskell.Events.State.Types (State)+import Taskell.IO.Config.Layout   (Config)+import Taskell.IO.Keyboard.Types  (Bindings)+import Taskell.UI.Types           (ResourceName)++data DrawState = DrawState+    { dsLayout   :: Config+    , dsBindings :: Bindings+    , dsDebug    :: Bool+    , dsState    :: State+    }++-- | Use a Reader to pass around DrawState+type ReaderDrawState = ReaderT DrawState Identity++-- | Aliases for common combinations+type TWidget = Widget ResourceName++type ModalWidget = ReaderDrawState (Text, TWidget)++type DSWidget = ReaderDrawState TWidget
+ src/Taskell/UI/Theme.hs view
@@ -0,0 +1,84 @@+module Taskell.UI.Theme+    ( titleAttr+    , statusBarAttr+    , titleCurrentAttr+    , taskCurrentAttr+    , subtaskCurrentAttr+    , subtaskCompleteAttr+    , subtaskIncompleteAttr+    , taskAttr+    , disabledAttr+    , dlToAttr+    , defaultTheme+    ) where++import Brick        (AttrName, attrName)+import Brick.Themes (Theme, newTheme)+import Brick.Util   (fg, on)+import Graphics.Vty++import Taskell.Data.Date (Deadline (..))++-- attrs+statusBarAttr :: AttrName+statusBarAttr = attrName "statusBar"++titleAttr :: AttrName+titleAttr = attrName "title"++titleCurrentAttr :: AttrName+titleCurrentAttr = attrName "titleCurrent"++taskCurrentAttr :: AttrName+taskCurrentAttr = attrName "taskCurrent"++taskAttr :: AttrName+taskAttr = attrName "task"++subtaskCurrentAttr :: AttrName+subtaskCurrentAttr = attrName "subtaskCurrent"++subtaskCompleteAttr :: AttrName+subtaskCompleteAttr = attrName "subtaskComplete"++subtaskIncompleteAttr :: AttrName+subtaskIncompleteAttr = attrName "subtaskIncomplete"++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+        [ (statusBarAttr, black `on` green)+        , (titleAttr, fg green)+        , (titleCurrentAttr, fg blue)+        , (taskCurrentAttr, fg magenta)+        , (subtaskCurrentAttr, fg magenta)+        , (subtaskIncompleteAttr, fg blue)+        , (subtaskCompleteAttr, fg yellow)+        , (taskCurrentAttr, fg magenta)+        , (disabledAttr, fg yellow)+        , (dlDue, fg red)+        , (dlSoon, fg yellow)+        , (dlFar, fg green)+        ]
+ src/Taskell/UI/Types.hs view
@@ -0,0 +1,14 @@+module Taskell.UI.Types where++import ClassyPrelude (Eq, Int, Ord, Show)++import Taskell.Types (ListIndex, TaskIndex)++data ResourceName+    = RNCursor+    | RNTask (ListIndex, TaskIndex)+    | RNList Int+    | RNLists+    | RNModal+    | RNDue Int+    deriving (Show, Eq, Ord)
+ src/Taskell/Utility/Parser.hs view
@@ -0,0 +1,17 @@+module Taskell.Utility.Parser where++import ClassyPrelude++import Data.Attoparsec.Text++only :: Parser a -> Parser a+only p = p <* endOfInput++lexeme :: Parser a -> Parser a+lexeme p = skipSpace *> p <* skipSpace++line :: Parser Text+line = (takeTill isEndOfLine <* endOfLine) <|> takeText++word :: Parser Text+word = lexeme $ pack <$> many1 letter
− src/Types.hs 
@@ -1,18 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Types where--import ClassyPrelude--newtype ListIndex = ListIndex-    { showListIndex :: Int-    } deriving (Show, Eq, Ord)--newtype TaskIndex = TaskIndex-    { showTaskIndex :: Int-    } deriving (Show, Eq, Ord)--type Pointer = (ListIndex, TaskIndex)--startPointer :: Pointer-startPointer = (ListIndex 0, TaskIndex 0)
− src/UI/CLI.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.CLI-    ( prompt-    , promptYN-    , PromptYN(PromptYes)-    ) where--import ClassyPrelude--prompt :: Text -> IO Text-prompt s = do-    putStr $ s <> ": "-    hFlush stdout -- prevents buffering-    getLine--data PromptYN-    = PromptYes-    | PromptNo--promptYN :: PromptYN -> Text -> IO Bool-promptYN PromptYes s = not . flip elem ["n", "no"] . toLower <$> prompt (s <> " (Y/n)")-promptYN PromptNo s  = not . flip elem ["y", "yes"] . toLower <$> prompt (s <> " (y/N)")
− src/UI/Draw.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Draw-    ( draw-    , chooseCursor-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Control.Monad.Reader (runReader)--import Brick--import Events.State            (normalise)-import Events.State.Types      (State, mode)-import Events.State.Types.Mode (DetailMode (..), ModalType (..), Mode (..))-import IO.Config.Layout        (Config)-import IO.Keyboard.Types       (Bindings)-import UI.Draw.Main            (renderMain)-import UI.Draw.Modal           (renderModal)-import UI.Draw.Types           (DrawState (DrawState), ReaderDrawState, TWidget)-import UI.Types                (ResourceName (..))---- draw-renderApp :: ReaderDrawState [TWidget]-renderApp = sequence [renderModal, renderMain]--draw :: Config -> Bindings -> Bool -> State -> [TWidget]-draw layout bindings debug state =-    runReader renderApp (DrawState layout bindings debug (normalise state))---- cursors-chooseCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName)-chooseCursor state =-    case normalise state ^. mode of-        Insert {}                         -> showCursorNamed RNCursor-        Search                            -> showCursorNamed RNCursor-        Modal (Detail _ (DetailInsert _)) -> showCursorNamed RNCursor-        _                                 -> neverShowCursor state
− src/UI/Draw/Field.hs 
@@ -1,146 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Field where--import ClassyPrelude--import qualified Data.List as L (scanl1)-import qualified Data.Text as T (splitAt, takeEnd)--import qualified Brick                     as B (Location (Location), Size (Fixed), Widget (Widget),-                                                 availWidth, getContext, render, showCursor, txt,-                                                 vBox)-import qualified Brick.Widgets.Core        as B (textWidth)-import qualified Graphics.Text.Width       as V (safeWcwidth)-import qualified Graphics.Vty.Input.Events as V (Event (..), Key (..))--import qualified UI.Types as UI (ResourceName (RNCursor))--data Field = Field-    { _text   :: Text-    , _cursor :: Int-    } deriving (Eq, Show)--blankField :: Field-blankField = Field "" 0--event :: V.Event -> Field -> Field-event (V.EvKey (V.KChar '\t') _) f = f-event (V.EvPaste bs) f             = insertText (decodeUtf8 bs) f-event (V.EvKey V.KBS _) f          = backspace f-event (V.EvKey V.KLeft _) f        = updateCursor (-1) f-event (V.EvKey V.KRight _) f       = updateCursor 1 f-event (V.EvKey (V.KChar char) _) f = insertCharacter char f-event _ f                          = f--updateCursor :: Int -> Field -> Field-updateCursor dir (Field text cursor) = Field text newCursor-  where-    next = cursor + dir-    limit = length text-    newCursor-        | next <= 0 = 0-        | next > limit = limit-        | otherwise = next--backspace :: Field -> Field-backspace (Field text cursor) =-    let (start, end) = T.splitAt cursor text-    in case fromNullable start of-           Nothing     -> Field end cursor-           Just start' -> Field (init start' <> end) (cursor - 1)--insertCharacter :: Char -> Field -> Field-insertCharacter char (Field text cursor) = Field newText newCursor-  where-    (start, end) = T.splitAt cursor text-    newText = snoc start char <> end-    newCursor = cursor + 1--insertText :: Text -> Field -> Field-insertText insert (Field text cursor) = Field newText newCursor-  where-    (start, end) = T.splitAt cursor text-    newText = concat [start, insert, end]-    newCursor = cursor + length insert--widthFold :: [Int] -> Char -> [Int]-widthFold l t = l <> [V.safeWcwidth t]--cursorPosition :: [Text] -> Int -> Int -> (Int, Int)-cursorPosition lns width cursor =-    if x == width-        then (0, y + 1) -- go to next line if at end of line-        else (x, y)-  where-    parts = foldl' widthFold [] <$> lns -- list of list of individual character lengths-    lengths = length <$> parts -- list of line lengths-    cumulative = L.scanl1 (+) lengths -- cumulative total of line lengths-    above = takeWhile (< cursor) cumulative -- lines above the cursor-    y = length above -- number of lines above-    adjustedCursor = cursor - fromMaybe 0 (lastMay above) -- subtract lines above from cursor position-    cumulativeWidths = L.scanl1 (+) <$> index parts y -- get cumulative widths for current line-    x = fromMaybe 0 $ flip index (adjustedCursor - 1) =<< cumulativeWidths--getText :: Field -> Text-getText (Field text _) = text--textToField :: Text -> Field-textToField text = Field text (length text)--field :: Field -> B.Widget UI.ResourceName-field (Field text cursor) =-    B.Widget B.Fixed B.Fixed $ do-        width <- B.availWidth <$> B.getContext-        let (wrapped, offset) = wrap width text-            location = cursorPosition wrapped width (cursor - offset)-        B.render $-            if null text-                then B.showCursor UI.RNCursor (B.Location (0, 0)) $ B.txt " "-                else B.showCursor UI.RNCursor (B.Location location) . B.vBox $ B.txt <$> wrapped--widgetFromMaybe :: B.Widget UI.ResourceName -> Maybe Field -> B.Widget UI.ResourceName-widgetFromMaybe _ (Just f) = field f-widgetFromMaybe w Nothing  = w--textField :: Text -> B.Widget UI.ResourceName-textField text =-    B.Widget B.Fixed B.Fixed $ do-        width <- B.availWidth <$> B.getContext-        let (wrapped, _) = wrap width text-        B.render $-            if null text-                then B.txt "---"-                else B.vBox $ B.txt <$> wrapped---- wrap-wrap :: Int -> Text -> ([Text], Int)-wrap width = foldl' (combine width) ([""], 0) . spl--spl' :: [Text] -> Char -> [Text]-spl' ts c-    | c == ' ' = ts <> [" "] <> [""]-    | otherwise =-        case fromNullable ts of-            Just ts' -> init ts' <> [snoc (last ts') c]-            Nothing  -> [singleton c]--spl :: Text -> [Text]-spl = foldl' spl' [""]--combine :: Int -> ([Text], Int) -> Text -> ([Text], Int)-combine width (acc, offset) s-    | newline && s == " " = (acc, offset + 1)-    | T.takeEnd 1 l == " " && s == " " = (acc, offset + 1)-    | newline = (acc <> [s], offset)-    | otherwise = (append (l <> s) acc, offset)-  where-    l = maybe "" last (fromNullable acc)-    newline = B.textWidth l + B.textWidth s > width--append :: Text -> [Text] -> [Text]-append s l =-    case fromNullable l of-        Just l' -> init l' <> [s]-        Nothing -> l <> [s]
− src/UI/Draw/Main.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Draw.Main-    ( renderMain-    ) where--import ClassyPrelude--import Brick-import Control.Lens  ((^.))-import Data.Sequence (mapWithIndex)--import Events.State.Types     (lists)-import IO.Config.Layout       (padding, statusBar)-import UI.Draw.Main.List      (renderList)-import UI.Draw.Main.Search    (renderSearch)-import UI.Draw.Main.StatusBar (renderStatusBar)-import UI.Draw.Types          (DSWidget, DrawState (..))-import UI.Types               (ResourceName (..))--renderMain :: DSWidget-renderMain = do-    ls <- (^. lists) <$> asks dsState-    listWidgets <- toList <$> sequence (renderList `mapWithIndex` ls)-    pad <- padding <$> asks dsLayout-    let mainWidget = viewport RNLists Horizontal . padTopBottom pad $ hBox listWidgets-    sb <- bool emptyWidget <$> renderStatusBar <*> (statusBar <$> asks dsLayout)-    renderSearch (mainWidget <=> sb)
− src/UI/Draw/Main/List.hs 
@@ -1,93 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}--module UI.Draw.Main.List-    ( renderList-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Data.Char     (chr, ord)-import Data.Sequence (mapWithIndex)--import Brick--import Data.Taskell.List  (List, tasks, title)-import Events.State.Types (current, mode)-import IO.Config.Layout   (columnPadding, columnWidth)-import Types              (ListIndex (ListIndex), TaskIndex (TaskIndex))-import UI.Draw.Field      (textField, widgetFromMaybe)-import UI.Draw.Mode-import UI.Draw.Task       (renderTask)-import UI.Draw.Types      (DSWidget, DrawState (..), ReaderDrawState)-import UI.Theme-import UI.Types           (ResourceName (..))---- | Gets the relevant column prefix - number in normal mode, letter in moveTo-columnPrefix :: Int -> Int -> ReaderDrawState Text-columnPrefix selectedList i = do-    m <- (^. mode) <$> asks dsState-    if moveTo m-        then do-            let col = chr (i + ord 'a')-            pure $-                if i /= selectedList && i >= 0 && i <= 26-                    then singleton col <> ". "-                    else ""-        else do-            let col = i + 1-            pure $-                if col >= 1 && col <= 9-                    then tshow col <> ". "-                    else ""---- | Renders the title for a list-renderTitle :: Int -> List -> DSWidget-renderTitle listIndex list = do-    (ListIndex selectedList, TaskIndex selectedTask) <- (^. current) <$> asks dsState-    editing <- (selectedList == listIndex &&) . editingTitle . (^. mode) <$> asks dsState-    titleField <- getField . (^. mode) <$> asks dsState-    col <- txt <$> columnPrefix selectedList listIndex-    let text = list ^. title-        attr =-            if selectedList == listIndex-                then titleCurrentAttr-                else titleAttr-        widget = textField text-        widget' = widgetFromMaybe widget titleField-        title' =-            padBottom (Pad 1) . withAttr attr . (col <+>) $-            if editing-                then widget'-                else widget-    pure $-        if editing || selectedList /= listIndex || selectedTask == 0-            then visible title'-            else title'---- | Renders a list-renderList :: Int -> List -> DSWidget-renderList listIndex list = do-    layout <- dsLayout <$> ask-    eTitle <- editingTitle . (^. mode) <$> asks dsState-    titleWidget <- renderTitle listIndex list-    (ListIndex currentList, _) <- (^. current) <$> asks dsState-    taskWidgets <--        sequence $-        renderTask (RNTask . (ListIndex listIndex, ) . TaskIndex) listIndex `mapWithIndex`-        (list ^. tasks)-    let widget =-            (if not eTitle-                 then cached (RNList listIndex)-                 else id) .-            padLeftRight (columnPadding layout) .-            hLimit (columnWidth layout) .-            viewport (RNList listIndex) Vertical . vBox . (titleWidget :) $-            toList taskWidgets-    pure $-        if currentList == listIndex-            then visible widget-            else widget
− src/UI/Draw/Main/Search.hs 
@@ -1,34 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Main.Search-    ( renderSearch-    ) where--import Brick-import ClassyPrelude-import Control.Lens  ((^.))--import Events.State.Types      (mode, searchTerm)-import Events.State.Types.Mode (Mode (..))-import IO.Config.Layout        (columnPadding)-import UI.Draw.Field           (field)-import UI.Draw.Types           (DSWidget, DrawState (..))-import UI.Theme-import UI.Types                (ResourceName (..))--renderSearch :: Widget ResourceName -> DSWidget-renderSearch mainWidget = do-    m <- (^. mode) <$> asks dsState-    term <- (^. searchTerm) <$> asks dsState-    case term of-        Just searchField -> do-            colPad <- columnPadding . dsLayout <$> ask-            let attr =-                    withAttr $-                    case m of-                        Search -> taskCurrentAttr-                        _      -> taskAttr-            let widget = attr . padLeftRight colPad $ txt "/" <+> field searchField-            pure $ mainWidget <=> widget-        _ -> pure mainWidget
− src/UI/Draw/Main/StatusBar.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-}--module UI.Draw.Main.StatusBar-    ( renderStatusBar-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Brick--import Data.Taskell.Lists (count)-import Events.State.Types (current, lists, mode, path, searchTerm)--import Events.State.Types.Mode (ModalType (..), Mode (..))-import IO.Config.Layout        (columnPadding)-import Types                   (ListIndex (ListIndex), TaskIndex (TaskIndex))-import UI.Draw.Field           (Field)-import UI.Draw.Types           (DSWidget, DrawState (..), ReaderDrawState)-import UI.Theme--getPosition :: ReaderDrawState Text-getPosition = do-    (ListIndex col, TaskIndex pos) <- (^. current) <$> asks dsState-    len <- count col . (^. lists) <$> asks dsState-    let posNorm =-            if len > 0-                then pos + 1-                else 0-    pure $ tshow posNorm <> "/" <> tshow len--modeToText :: Maybe Field -> Mode -> ReaderDrawState Text-modeToText fld md = do-    debug <- asks dsDebug-    pure $-        if debug-            then tshow md-            else case md of-                     Normal ->-                         case fld of-                             Nothing -> "NORMAL"-                             Just _  -> "NORMAL + SEARCH"-                     Insert {} -> "INSERT"-                     Modal Help -> "HELP"-                     Modal MoveTo -> "MOVE"-                     Modal Detail {} -> "DETAIL"-                     Modal Due {} -> "DUE"-                     Search {} -> "SEARCH"-                     _ -> ""--getMode :: ReaderDrawState Text-getMode = do-    state <- asks dsState-    modeToText (state ^. searchTerm) (state ^. mode)--renderStatusBar :: DSWidget-renderStatusBar = do-    topPath <- pack . (^. path) <$> asks dsState-    colPad <- columnPadding <$> asks dsLayout-    posTxt <- getPosition-    modeTxt <- getMode-    let titl = padLeftRight colPad $ txt topPath-    let pos = padRight (Pad colPad) $ txt posTxt-    let md = txt modeTxt-    let bar = padRight Max (titl <+> md) <+> pos-    pure . padTop (Pad 1) $ withAttr statusBarAttr bar
− src/UI/Draw/Modal.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Draw.Modal-    ( renderModal-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Brick-import Brick.Widgets.Border-import Brick.Widgets.Center--import Events.State.Types      (height, mode)-import Events.State.Types.Mode (ModalType (..), Mode (..))-import UI.Draw.Field           (textField)-import UI.Draw.Modal.Detail    (detail)-import UI.Draw.Modal.Due       (due)-import UI.Draw.Modal.Help      (help)-import UI.Draw.Modal.MoveTo    (moveTo)-import UI.Draw.Types           (DSWidget, DrawState (dsState), TWidget)-import UI.Theme                (titleAttr)-import UI.Types                (ResourceName (..))--surround :: (Text, TWidget) -> DSWidget-surround (title, widget) = do-    ht <- (^. height) <$> asks dsState-    let t = padBottom (Pad 1) . withAttr titleAttr $ textField title-    pure .-        padTopBottom 1 .-        centerLayer .-        border .-        padTopBottom 1 .-        padLeftRight 4 . vLimit (ht - 9) . hLimit 50 . (t <=>) . viewport RNModal Vertical $-        widget--renderModal :: DSWidget-renderModal = do-    md <- (^. mode) <$> asks dsState-    case md of-        Modal Help                 -> surround =<< help-        Modal Detail {}            -> surround =<< detail-        Modal MoveTo               -> surround =<< moveTo-        Modal (Due tasks selected) -> surround =<< due tasks selected-        _                          -> pure emptyWidget
− src/UI/Draw/Modal/Detail.hs 
@@ -1,90 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Modal.Detail-    ( detail-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Data.Sequence (mapWithIndex)--import Brick--import Data.Time.Zones (TZ)--import           Data.Taskell.Date         (deadline, timeToDisplay)-import qualified Data.Taskell.Subtask      as ST (Subtask, complete, name)-import           Data.Taskell.Task         (Task, description, due, name, subtasks)-import           Events.State              (getCurrentTask)-import           Events.State.Modal.Detail (getCurrentItem, getField)-import           Events.State.Types        (time, timeZone)-import           Events.State.Types.Mode   (DetailItem (..))-import           UI.Draw.Field             (Field, textField, widgetFromMaybe)-import           UI.Draw.Types             (DrawState (..), ModalWidget, TWidget)-import           UI.Theme                  (disabledAttr, dlToAttr, taskCurrentAttr,-                                            titleCurrentAttr)--renderSubtask :: Maybe Field -> DetailItem -> Int -> ST.Subtask -> TWidget-renderSubtask f current i subtask = padBottom (Pad 1) $ prefix <+> final-  where-    cur =-        case current of-            DetailItem c -> i == c-            _            -> False-    done = subtask ^. ST.complete-    attr =-        withAttr-            (if cur-                 then taskCurrentAttr-                 else titleCurrentAttr)-    prefix =-        attr . txt $-        if done-            then "[x] "-            else "[ ] "-    widget = textField (subtask ^. ST.name)-    final-        | cur = visible . attr $ widgetFromMaybe widget f-        | not done = attr widget-        | otherwise = widget--renderSummary :: Maybe Field -> DetailItem -> Task -> TWidget-renderSummary f i task = padTop (Pad 1) $ padBottom (Pad 2) w'-  where-    w = textField $ fromMaybe "No description" (task ^. description)-    w' =-        case i of-            DetailDescription -> visible $ widgetFromMaybe w f-            _                 -> w--renderDate :: TZ -> UTCTime -> Maybe Field -> DetailItem -> Task -> TWidget-renderDate tz now field item task =-    case item of-        DetailDate -> visible $ prefix <+> widgetFromMaybe widget field-        _ ->-            case day of-                Just d  -> prefix <+> withAttr (dlToAttr (deadline now d)) widget-                Nothing -> emptyWidget-  where-    day = task ^. due-    prefix = txt "Due: "-    widget = textField $ maybe "" (timeToDisplay tz) day--detail :: ModalWidget-detail = do-    state <- asks dsState-    let now = state ^. time-    let tz = state ^. timeZone-    pure $-        fromMaybe ("Error", txt "Oops") $ do-            task <- getCurrentTask state-            i <- getCurrentItem state-            let f = getField state-            let sts = task ^. subtasks-                w-                    | null sts = withAttr disabledAttr $ txt "No sub-tasks"-                    | otherwise = vBox . toList $ renderSubtask f i `mapWithIndex` sts-            pure (task ^. name, renderDate tz now f i task <=> renderSummary f i task <=> w)
− src/UI/Draw/Modal/Due.hs 
@@ -1,42 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Modal.Due-    ( due-    ) where--import ClassyPrelude--import Brick-import Data.Taskell.Seq ((<#>))--import qualified Data.Taskell.Task as T (Task)-import           Types             (Pointer)-import           UI.Draw.Task      (TaskWidget (..), parts)-import           UI.Draw.Types     (DSWidget, ModalWidget)-import           UI.Theme          (taskAttr, taskCurrentAttr)-import           UI.Types          (ResourceName (RNDue))--renderTask :: Int -> Int -> T.Task -> DSWidget-renderTask current position task = do-    (TaskWidget text date _ _) <- parts task-    let selected = current == position-    let attr =-            if selected-                then taskCurrentAttr-                else taskAttr-    let shw =-            if selected-                then visible-                else id-    pure . shw . cached (RNDue position) . padBottom (Pad 1) . withAttr attr $ vBox [date, text]--due :: Seq (Pointer, T.Task) -> Int -> ModalWidget-due tasks selected = do-    let items = snd <$> tasks-    widgets <- sequence $ renderTask selected <#> items-    pure-        ( "Due Tasks"-        , if null items-              then txt "No due tasks"-              else vBox $ toList widgets)
− src/UI/Draw/Modal/Help.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Modal.Help-    ( help-    ) where--import ClassyPrelude--import Brick-import Data.Text as T (justifyRight)--import Events.Actions.Types as A (ActionType (..))-import IO.Keyboard.Types    (bindingsToText)--import IO.Keyboard.Types (Bindings)-import UI.Draw.Field     (textField)-import UI.Draw.Types     (DrawState (dsBindings), ModalWidget, TWidget)-import UI.Theme          (taskCurrentAttr)--descriptions :: [([ActionType], Text)]-descriptions =-    [ ([A.Help], "Show this list of controls")-    , ([A.Due], "Show tasks with due dates")-    , ([A.Previous, A.Next, A.Left, A.Right], "Move down / up / left / right")-    , ([A.Bottom], "Go to bottom of list")-    , ([A.Top], "Go to top of list")-    , ([A.New], "Add a task")-    , ([A.NewAbove, A.NewBelow], "Add a task above / below")-    , ([A.Duplicate], "Duplicate a task")-    , ([A.Edit], "Edit a task")-    , ([A.Clear], "Change task")-    , ([A.Detail], "Show task details / Edit task description")-    , ([A.DueDate], "Add/edit due date (yyyy-mm-dd)")-    , ([A.ClearDate], "Removes due date")-    , ([A.MoveUp, A.MoveDown], "Shift task down / up")-    , ([A.MoveLeft, A.MoveRight], "Shift task left / right")-    , ( [A.Complete]-      , "Move task to last list and remove any due dates / Mark subtask as (in)complete")-    , ([A.MoveMenu], "Move task to specific list")-    , ([A.Delete], "Delete task")-    , ([A.Undo], "Undo")-    , ([A.Redo], "Redo")-    , ([A.ListNew], "New list")-    , ([A.ListEdit], "Edit list title")-    , ([A.ListDelete], "Delete list")-    , ([A.ListLeft, A.ListRight], "Move list left / right")-    , ([A.Search], "Search")-    , ([A.Quit], "Quit")-    ]--generate :: Bindings -> [([Text], Text)]-generate bindings = first (intercalate ", " . bindingsToText bindings <$>) <$> descriptions--format :: ([Text], Text) -> (Text, Text)-format = first (intercalate " / ")--line :: Int -> (Text, Text) -> TWidget-line m (l, r) = left <+> right-  where-    left = padRight (Pad 2) . withAttr taskCurrentAttr . txt $ justifyRight m ' ' l-    right = textField r--help :: ModalWidget-help = do-    bindings <- asks dsBindings-    let ls = format <$> generate bindings-    let m = foldl' max 0 $ length . fst <$> ls-    let w = vBox $ line m <$> ls-    pure ("Controls", w)
− src/UI/Draw/Modal/MoveTo.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Modal.MoveTo-    ( moveTo-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Brick--import Data.Taskell.List  (title)-import Events.State.Types (current, lists)-import Types              (showListIndex)-import UI.Draw.Field      (textField)-import UI.Draw.Types      (DrawState (dsState), ModalWidget)-import UI.Theme           (taskCurrentAttr)--moveTo :: ModalWidget-moveTo = do-    skip <- showListIndex . fst . (^. current) <$> asks dsState-    ls <- toList . (^. lists) <$> asks dsState-    let titles = textField . (^. title) <$> ls-    let letter a =-            padRight (Pad 1) . hBox $-            [txt "[", withAttr taskCurrentAttr $ txt (singleton a), txt "]"]-    let letters = letter <$> ['a' ..]-    let remove i l = take i l <> drop (i + 1) l-    let output (l, t) = l <+> t-    let widget = vBox $ output <$> remove skip (zip letters titles)-    pure ("Move To:", widget)
− src/UI/Draw/Mode.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Draw.Mode where--import ClassyPrelude--import Events.State.Types.Mode (InsertType (..), ModalType (..), Mode (..))-import UI.Draw.Field           (Field)--getField :: Mode -> Maybe Field-getField (Insert _ _ f) = Just f-getField _              = Nothing--editingTitle :: Mode -> Bool-editingTitle (Insert IList _ _) = True-editingTitle _                  = False--moveTo :: Mode -> Bool-moveTo (Modal MoveTo) = True-moveTo _              = False
− src/UI/Draw/Task.hs 
@@ -1,109 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.Draw.Task-    ( TaskWidget(..)-    , renderTask-    , parts-    ) where--import ClassyPrelude--import Control.Lens ((^.))--import Brick--import           Data.Taskell.Date  (deadline, timeToText)-import qualified Data.Taskell.Task  as T (Task, contains, countCompleteSubtasks, countSubtasks,-                                          description, due, hasSubtasks, name)-import           Events.State.Types (current, mode, searchTerm, time, timeZone)-import           IO.Config.Layout   (descriptionIndicator)-import           Types              (ListIndex (..), TaskIndex (..))-import           UI.Draw.Field      (getText, textField, widgetFromMaybe)-import           UI.Draw.Mode-import           UI.Draw.Types      (DSWidget, DrawState (..), ReaderDrawState, TWidget)-import           UI.Theme-import           UI.Types           (ResourceName)--data TaskWidget = TaskWidget-    { textW     :: TWidget-    , dateW     :: TWidget-    , summaryW  :: TWidget-    , subtasksW :: TWidget-    }---- | Takes a task's 'due' property and renders a date with appropriate styling (e.g. red if overdue)-renderDate :: T.Task -> DSWidget-renderDate task = do-    now <- (^. time) <$> asks dsState-    tz <- (^. timeZone) <$> asks dsState-    pure . fromMaybe emptyWidget $-        (\date -> withAttr (dlToAttr $ deadline now date) (txt $ timeToText tz now date)) <$>-        task ^. T.due---- | Renders the appropriate completed sub task count e.g. "[2/3]"-renderSubtaskCount :: T.Task -> DSWidget-renderSubtaskCount task =-    pure . fromMaybe emptyWidget $ bool Nothing (Just indicator) (T.hasSubtasks task)-  where-    complete = tshow $ T.countCompleteSubtasks task-    total = tshow $ T.countSubtasks task-    indicator = txt $ concat ["[", complete, "/", total, "]"]---- | Renders the description indicator-renderDescIndicator :: T.Task -> DSWidget-renderDescIndicator task = do-    indicator <- descriptionIndicator <$> asks dsLayout-    pure . fromMaybe emptyWidget $ const (txt indicator) <$> task ^. T.description -- show the description indicator if one is set---- | Renders the task text-renderText :: T.Task -> DSWidget-renderText task = pure $ textField (task ^. T.name)---- | Renders the appropriate indicators: description, sub task count, and due date-indicators :: T.Task -> DSWidget-indicators task = do-    widgets <- sequence (($ task) <$> [renderDescIndicator, renderSubtaskCount, renderDate])-    pure . hBox $ padRight (Pad 1) <$> widgets---- | The individual parts of a task widget-parts :: T.Task -> ReaderDrawState TaskWidget-parts task =-    TaskWidget <$> renderText task <*> renderDate task <*> renderDescIndicator task <*>-    renderSubtaskCount task---- | Renders an individual task-renderTask' :: (Int -> ResourceName) -> Int -> Int -> T.Task -> DSWidget-renderTask' rn listIndex taskIndex task = do-    eTitle <- editingTitle . (^. mode) <$> asks dsState -- is the title being edited? (for visibility)-    selected <- (== (ListIndex listIndex, TaskIndex taskIndex)) . (^. current) <$> asks dsState -- is the current task selected?-    taskField <- getField . (^. mode) <$> asks dsState -- get the field, if it's being edited-    after <- indicators task -- get the indicators widget-    widget <- renderText task-    let name = rn taskIndex-        widget' = widgetFromMaybe widget taskField-    pure $-        cached name .-        (if selected && not eTitle-             then visible-             else id) .-        padBottom (Pad 1) .-        (<=> withAttr disabledAttr after) .-        withAttr-            (if selected-                 then taskCurrentAttr-                 else taskAttr) $-        if selected && not eTitle-            then widget'-            else widget--renderTask :: (Int -> ResourceName) -> Int -> Int -> T.Task -> DSWidget-renderTask rn listIndex taskIndex task = do-    searchT <- (getText <$>) . (^. searchTerm) <$> asks dsState-    let taskWidget = renderTask' rn listIndex taskIndex task-    case searchT of-        Nothing -> taskWidget-        Just term ->-            if T.contains term task-                then taskWidget-                else pure emptyWidget
− src/UI/Draw/Types.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Draw.Types where--import ClassyPrelude--import Brick (Widget)--import Events.State.Types (State)-import IO.Config.Layout   (Config)-import IO.Keyboard.Types  (Bindings)-import UI.Types           (ResourceName)--data DrawState = DrawState-    { dsLayout   :: Config-    , dsBindings :: Bindings-    , dsDebug    :: Bool-    , dsState    :: State-    }---- | Use a Reader to pass around DrawState-type ReaderDrawState = ReaderT DrawState Identity---- | Aliases for common combinations-type TWidget = Widget ResourceName--type ModalWidget = ReaderDrawState (Text, TWidget)--type DSWidget = ReaderDrawState TWidget
− src/UI/Theme.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Theme-    ( titleAttr-    , statusBarAttr-    , titleCurrentAttr-    , taskCurrentAttr-    , taskAttr-    , disabledAttr-    , dlToAttr-    , defaultTheme-    ) where--import Brick        (AttrName, attrName)-import Brick.Themes (Theme, newTheme)-import Brick.Util   (fg, on)-import Graphics.Vty--import Data.Taskell.Date (Deadline (..))---- attrs-statusBarAttr :: AttrName-statusBarAttr = attrName "statusBar"--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-        [ (statusBarAttr, black `on` green)-        , (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 
@@ -1,16 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module UI.Types where--import ClassyPrelude (Eq, Int, Ord, Show)--import Types (ListIndex, TaskIndex)--data ResourceName-    = RNCursor-    | RNTask (ListIndex, TaskIndex)-    | RNList Int-    | RNLists-    | RNModal-    | RNDue Int-    deriving (Show, Eq, Ord)
− src/Utility/Parser.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}--module Utility.Parser where--import ClassyPrelude--import Data.Attoparsec.Text--only :: Parser a -> Parser a-only p = p <* endOfInput--lexeme :: Parser a -> Parser a-lexeme p = skipSpace *> p <* skipSpace--line :: Parser Text-line = (takeTill isEndOfLine <* endOfLine) <|> takeText--word :: Parser Text-word = lexeme $ pack <$> many1 letter
taskell.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell-version: 1.9.2.0+version: 1.9.3.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales@@ -22,6 +22,9 @@     templates/theme.ini     templates/trello-token.txt     templates/usage.txt+    test/Taskell/IO/data/trello-checklists.json+    test/Taskell/IO/data/trello.json+    test/Taskell/IO/Keyboard/data/bindings.ini  source-repository head     type: git@@ -29,106 +32,107 @@  library     exposed-modules:-        App-        Events.State-        IO.Config-        IO.Taskell-        Data.Taskell.Date-        Data.Taskell.Date.RelativeParser-        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.Actions.Types-        Events.State.History-        Events.State.Types-        Events.State.Types.Mode-        IO.Config.Markdown-        IO.Markdown.Parser-        IO.Markdown.Serializer-        IO.HTTP.GitHub-        IO.HTTP.GitHub.Card-        IO.HTTP.Trello.List-        IO.HTTP.Trello.ChecklistItem-        IO.Keyboard-        IO.Keyboard.Parser-        IO.Keyboard.Types-        UI.Draw.Field-        Types+        Taskell+        Taskell.Events.State+        Taskell.IO.Config+        Taskell.IO+        Taskell.Data.Date+        Taskell.Data.Date.RelativeParser+        Taskell.Data.List+        Taskell.Data.List.Internal+        Taskell.Data.Lists+        Taskell.Data.Lists.Internal+        Taskell.Data.Seq+        Taskell.Data.Subtask+        Taskell.Data.Subtask.Internal+        Taskell.Data.Task+        Taskell.Data.Task.Internal+        Taskell.Events.Actions.Types+        Taskell.Events.State.History+        Taskell.Events.State.Types+        Taskell.Events.State.Types.Mode+        Taskell.IO.Config.Markdown+        Taskell.IO.Markdown.Parser+        Taskell.IO.Markdown.Serializer+        Taskell.IO.HTTP.GitHub+        Taskell.IO.HTTP.GitHub.Card+        Taskell.IO.HTTP.Trello.List+        Taskell.IO.HTTP.Trello.ChecklistItem+        Taskell.IO.Keyboard+        Taskell.IO.Keyboard.Parser+        Taskell.IO.Keyboard.Types+        Taskell.UI.Draw.Field+        Taskell.Types     hs-source-dirs: src     other-modules:-        Config-        Data.Taskell.Date.Types-        Events.Actions-        Events.Actions.Insert-        Events.Actions.Modal-        Events.Actions.Modal.Detail-        Events.Actions.Modal.Due-        Events.Actions.Modal.Help-        Events.Actions.Modal.MoveTo-        Events.Actions.Normal-        Events.Actions.Search-        Events.State.Modal.Detail-        Events.State.Modal.Due-        IO.Config.General-        IO.Config.GitHub-        IO.Config.Layout-        IO.Config.Parser-        IO.Config.Trello-        IO.HTTP.Aeson-        IO.HTTP.GitHub.AutomatedCard-        IO.HTTP.GitHub.Column-        IO.HTTP.GitHub.Project-        IO.HTTP.GitHub.Utility-        IO.HTTP.Trello-        IO.HTTP.Trello.Card-        IO.Markdown-        UI.CLI-        UI.Draw-        UI.Draw.Main-        UI.Draw.Main.List-        UI.Draw.Main.Search-        UI.Draw.Main.StatusBar-        UI.Draw.Modal-        UI.Draw.Modal.Detail-        UI.Draw.Modal.Due-        UI.Draw.Modal.Help-        UI.Draw.Modal.MoveTo-        UI.Draw.Mode-        UI.Draw.Task-        UI.Draw.Types-        UI.Theme-        UI.Types-        Utility.Parser+        Taskell.Config+        Taskell.Data.Date.Types+        Taskell.Events.Actions+        Taskell.Events.Actions.Insert+        Taskell.Events.Actions.Modal+        Taskell.Events.Actions.Modal.Detail+        Taskell.Events.Actions.Modal.Due+        Taskell.Events.Actions.Modal.Help+        Taskell.Events.Actions.Modal.MoveTo+        Taskell.Events.Actions.Normal+        Taskell.Events.Actions.Search+        Taskell.Events.State.Modal.Detail+        Taskell.Events.State.Modal.Due+        Taskell.IO.Config.General+        Taskell.IO.Config.GitHub+        Taskell.IO.Config.Layout+        Taskell.IO.Config.Parser+        Taskell.IO.Config.Trello+        Taskell.IO.HTTP.Aeson+        Taskell.IO.HTTP.GitHub.AutomatedCard+        Taskell.IO.HTTP.GitHub.Column+        Taskell.IO.HTTP.GitHub.Project+        Taskell.IO.HTTP.GitHub.Utility+        Taskell.IO.HTTP.Trello+        Taskell.IO.HTTP.Trello.Card+        Taskell.IO.Markdown+        Taskell.UI.CLI+        Taskell.UI.Draw+        Taskell.UI.Draw.Main+        Taskell.UI.Draw.Main.List+        Taskell.UI.Draw.Main.Search+        Taskell.UI.Draw.Main.StatusBar+        Taskell.UI.Draw.Modal+        Taskell.UI.Draw.Modal.Detail+        Taskell.UI.Draw.Modal.Due+        Taskell.UI.Draw.Modal.Help+        Taskell.UI.Draw.Modal.MoveTo+        Taskell.UI.Draw.Mode+        Taskell.UI.Draw.Task+        Taskell.UI.Draw.Types+        Taskell.UI.Theme+        Taskell.UI.Types+        Taskell.Utility.Parser         Paths_taskell     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude+                        TupleSections LambdaCase RankNTypes     build-depends:-        aeson >=1.4.5.0 && <1.5,+        aeson >=1.4.6.0 && <1.5,         attoparsec >=0.13.2.3 && <0.14,-        base >=4.12.0.0 && <=5,-        brick ==0.50.*,-        bytestring >=0.10.8.2 && <0.11,+        base >=4.13.0.0 && <=5,+        brick ==0.52.*,+        bytestring >=0.10.10.0 && <0.11,         classy-prelude >=1.5.0 && <1.6,         config-ini >=0.2.4.0 && <0.3,-        containers >=0.6.0.1 && <0.7,-        directory >=1.3.3.0 && <1.4,-        file-embed >=0.0.11 && <0.1,+        containers >=0.6.2.1 && <0.7,+        directory >=1.3.4.0 && <1.4,+        file-embed >=0.0.11.1 && <0.1,         fold-debounce >=0.2.0.9 && <0.3,         http-client >=0.6.4 && <0.7,         http-conduit >=2.3.7.3 && <2.4,         http-types >=0.12.3 && <0.13,-        lens >=4.17.1 && <4.18,+        lens >=4.18.1 && <4.19,         mtl >=2.2.2 && <2.3,-        template-haskell >=2.14.0.0 && <2.15,-        text >=1.2.3.1 && <1.3,-        time >=1.8.0.2 && <1.9,-        tz >=0.1.3.2 && <0.2,+        template-haskell >=2.15.0.0 && <2.16,+        text >=1.2.4.0 && <1.3,+        time >=1.9.3 && <1.10,+        tz >=0.1.3.3 && <0.2,         vty ==5.26.*  executable taskell@@ -138,48 +142,50 @@         Paths_taskell     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude+                        TupleSections LambdaCase RankNTypes     ghc-options: -threaded -rtsopts -with-rtsopts=-N     build-depends:-        base >=4.12.0.0 && <4.13,+        base >=4.13.0.0 && <4.14,         classy-prelude >=1.5.0 && <1.6,         taskell -any,-        tz >=0.1.3.2 && <0.2+        tz >=0.1.3.3 && <0.2  test-suite taskell-test     type: exitcode-stdio-1.0     main-is: Spec.hs     hs-source-dirs: test     other-modules:-        Data.Taskell.Date.RelativeParserTest-        Data.Taskell.DateTest-        Data.Taskell.ListNavigationTest-        Data.Taskell.ListsTest-        Data.Taskell.ListTest-        Data.Taskell.SeqTest-        Data.Taskell.SubtaskTest-        Data.Taskell.TaskTest-        Events.State.HistoryTest-        Events.StateTest-        IO.GitHub.CardsTest-        IO.GitHubTest-        IO.Keyboard.ParserTest-        IO.Keyboard.TypesTest-        IO.KeyboardTest-        IO.Markdown.ParserTest-        IO.Markdown.SerializerTest-        IO.TrelloTest-        UI.FieldTest+        Taskell.Data.Date.RelativeParserTest+        Taskell.Data.DateTest+        Taskell.Data.ListNavigationTest+        Taskell.Data.ListsTest+        Taskell.Data.ListTest+        Taskell.Data.SeqTest+        Taskell.Data.SubtaskTest+        Taskell.Data.TaskTest+        Taskell.Events.State.HistoryTest+        Taskell.Events.StateTest+        Taskell.IO.GitHub.CardsTest+        Taskell.IO.GitHubTest+        Taskell.IO.Keyboard.ParserTest+        Taskell.IO.Keyboard.TypesTest+        Taskell.IO.KeyboardTest+        Taskell.IO.Markdown.ParserTest+        Taskell.IO.Markdown.SerializerTest+        Taskell.IO.TrelloTest+        Taskell.UI.FieldTest         Paths_taskell     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude+                        TupleSections LambdaCase RankNTypes     ghc-options: -threaded -rtsopts -with-rtsopts=-N     build-depends:-        aeson >=1.4.5.0 && <1.5,-        base >=4.12.0.0 && <4.13,+        aeson >=1.4.6.0 && <1.5,+        base >=4.13.0.0 && <4.14,         classy-prelude >=1.5.0 && <1.6,-        containers >=0.6.0.1 && <0.7,-        file-embed >=0.0.11 && <0.1,-        lens >=4.17.1 && <4.18,+        containers >=0.6.2.1 && <0.7,+        file-embed >=0.0.11.1 && <0.1,+        lens >=4.18.1 && <4.19,         mtl >=2.2.2 && <2.3,         raw-strings-qq ==1.1.*,         taskell -any,@@ -187,7 +193,7 @@         tasty-discover >=4.2.1 && <4.3,         tasty-expected-failure >=0.11.1.2 && <0.12,         tasty-hunit >=0.10.0.2 && <0.11,-        text >=1.2.3.1 && <1.3,-        time >=1.8.0.2 && <1.9,-        tz >=0.1.3.2 && <0.2,+        text >=1.2.4.0 && <1.3,+        time >=1.9.3 && <1.10,+        tz >=0.1.3.3 && <0.2,         vty ==5.26.*
templates/bindings.ini view
@@ -31,9 +31,17 @@ # moving tasks moveUp = K moveDown = J-moveLeft = H-moveRight = L+# move to top of previous list+moveLeftTop = ˙+# move to top of next list+moveRightTop = ¬+# move to bottom of previous list+moveLeftBottom = H+# move to bottom of next list+moveRightBottom = L+# move to bottom of last list complete = <Space>+# select a list to move to moveMenu = m  # lists
templates/theme.ini view
@@ -13,5 +13,13 @@ ; current task taskCurrent.fg = magenta +; subtasks+; selected+subtaskCurrent.fg = magenta+; incomplete+subtaskIncomplete.fg = blue+; complete+subtaskComplete.fg = yellow+ ; disabled disabled.fg = yellow
− test/Data/Taskell/Date/RelativeParserTest.hs 
@@ -1,79 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Taskell.Date.RelativeParserTest-    ( test_relative_parser-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Data.Time.Calendar (fromGregorian)-import Data.Time.Clock    (secondsToDiffTime)--import Data.Taskell.Date                (Due (DueDate, DueTime))-import Data.Taskell.Date.RelativeParser (parseRelative)--toTime :: (Integer, Int, Int) -> Integer -> Due-toTime (y, m, d) seconds = DueTime $ UTCTime (fromGregorian y m d) (secondsToDiffTime seconds)--toDay :: (Integer, Int, Int) -> Due-toDay (y, m, d) = DueDate $ fromGregorian y m d---- 08:53:03 18th December 2019-time :: UTCTime-time = UTCTime (fromGregorian 2019 12 18) 31983---- tests-test_relative_parser :: TestTree-test_relative_parser =-    testGroup-        "Data.Taskell.Date.RelativeParser"-        [ testCase-              "Second"-              (assertEqual-                   "Adds a second"-                   (Right (toTime (2019, 12, 18) 31984))-                   (parseRelative time "1s"))-        , testCase-              "Minute"-              (assertEqual-                   "Adds a minute"-                   (Right (toTime (2019, 12, 18) 32043))-                   (parseRelative time "1m"))-        , testCase-              "Hour"-              (assertEqual-                   "Adds an hour"-                   (Right (toTime (2019, 12, 18) 35583))-                   (parseRelative time "1h"))-        , testCase-              "Day"-              (assertEqual "Adds a day" (Right (toDay (2019, 12, 19))) (parseRelative time "1d"))-        , testCase-              "Days"-              (assertEqual "Adds 29 days" (Right (toDay (2020, 1, 16))) (parseRelative time "29 d"))-        , testCase-              "Week"-              (assertEqual "Adds a week" (Right (toDay (2019, 12, 25))) (parseRelative time "1w "))-        , testCase-              "Mix"-              (assertEqual-                   "Adds 1 week 2 days and 29 seconds"-                   (Right (toTime (2019, 12, 27) 32012))-                   (parseRelative time " 1 w 2d 29 s "))-        , testCase-              "Mix out of order"-              (assertEqual-                   "Adds 1 week 2 days and 29 seconds"-                   (Right (toTime (2019, 12, 27) 32012))-                   (parseRelative time " 2d 1 w 29 s"))-        , testCase-              "invalid format"-              (assertEqual "Error" (Left "Could not parse date.") (parseRelative time "18/12/2019"))-        , testCase-              "invalid numbers"-              (assertEqual "Error" (Left "Could not parse date.") (parseRelative time "2019-39-59"))-        ]
− test/Data/Taskell/DateTest.hs 
@@ -1,246 +0,0 @@-{-# 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-import Data.Time.Zones     (utcTZ)-import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel)--testDate :: UTCTime-testDate = UTCTime (fromGregorian 2018 5 18) (secondsToDiffTime 0)---- sorting test data-sort1 :: Due-sort1 = DueTime (UTCTime (fromGregorian 2017 2 4) 0)--sort2 :: Due-sort2 = DueDate (fromGregorian 2016 12 15)--sort3 :: Due-sort3 = DueTime (UTCTime (fromGregorian 2020 8 9) 44000)--sort4 :: Due-sort4 = DueDate (fromGregorian 2019 8 30)---- tests-test_date :: TestTree-test_date =-    testGroup-        "Data.Taskell.Date"-        [ testCase-              "Sorting"-              (assertEqual-                   "Sorted in date order"-                   [sort2, sort1, sort4, sort3]-                   (sort [sort1, sort2, sort3, sort4]))-        , testGroup-              "Date Output"-              [ testGroup-                    "timeToDisplay"-                    [ testCase-                          "timeToDisplay time"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18 00:00"-                               (timeToDisplay utcTZ (DueTime testDate)))-                    , testCase-                          "timeToDisplay time - non-utc"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-17 20:00"-                               (timeToDisplay (tzByLabel America__New_York) (DueTime testDate)))-                    , testCase-                          "timeToDisplay date"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18"-                               (timeToDisplay utcTZ (DueDate (fromGregorian 2018 05 18))))-                    ]-              , testGroup-                    "timeToOutput"-                    [ testCase-                          "timeToOutput time"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18 00:00 UTC"-                               (timeToOutput (DueTime testDate)))-                    , testCase-                          "timeToOutput date"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18"-                               (timeToOutput (DueDate (fromGregorian 2018 05 18))))-                    ]-              , testGroup-                    "timeToOutputLocal"-                    [ testCase-                          "timeToOutputLocal time"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18 00:00 UTC"-                               (timeToOutputLocal utcTZ (DueTime testDate)))-                    , testCase-                          "timeToOutputLocal time - non-utc"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-17 20:00 EDT"-                               (timeToOutputLocal (tzByLabel America__New_York) (DueTime testDate)))-                    , testCase-                          "timeToOutputLocal date"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18"-                               (timeToOutputLocal utcTZ (DueDate (fromGregorian 2018 05 18))))-                    , testCase-                          "timeToOutputLocal date - non-utc"-                          (assertEqual-                               "Date in yyyy-mm-dd format"-                               "2018-05-18"-                               (timeToOutputLocal-                                    (tzByLabel America__New_York)-                                    (DueDate (fromGregorian 2018 05 18))))-                    ]-              , testGroup-                    "timeToText"-                    [ testCase-                          "time"-                          (assertEqual-                               "Date in 18-May format"-                               "00:00 18-May"-                               (timeToText utcTZ testDate (DueTime testDate)))-                    , testCase-                          "time - non-utc"-                          (assertEqual-                               "Date in 17-May format"-                               "20:00 17-May"-                               (timeToText (tzByLabel America__New_York) testDate (DueTime testDate)))-                    , testCase-                          "same year"-                          (assertEqual-                               "Date in 18-May format"-                               "18-May"-                               (timeToText utcTZ testDate (DueDate (fromGregorian 2018 5 18))))-                    , testCase-                          "different year"-                          (assertEqual-                               "Date in 18-May 2019 format"-                               "18-May 2019"-                               (timeToText utcTZ testDate (DueDate (fromGregorian 2019 5 18))))-                    , testCase-                          "different year"-                          (assertEqual-                               "Date in 18-May 2017 format"-                               "18-May 2017"-                               (timeToText utcTZ testDate (DueDate (fromGregorian 2017 5 18))))-                    ]-              ]-        , testGroup-              "Input"-              [ testGroup-                    "textToTime"-                    [ testCase-                          "simple date"-                          (assertEqual-                               "A valid Day"-                               (DueDate <$> fromGregorianValid 2018 05 18)-                               (textToTime "2018-05-18"))-                    , testCase-                          "simple time"-                          (assertEqual-                               "A valid time"-                               (DueTime . flip UTCTime 64800 <$> fromGregorianValid 2018 05 18)-                               (textToTime "2018-05-18 18:00 UTC"))-                    , testCase-                          "time with timezone"-                          (assertEqual-                               "A valid time"-                               (DueTime . flip UTCTime 0 <$> fromGregorianValid 2018 05 18)-                               (textToTime "2018-05-17 20:00 EDT"))-                    ]-              , testGroup-                    "inputToTime"-                    [ testCase-                          "simple date"-                          (assertEqual-                               "A valid Day"-                               (DueDate <$> fromGregorianValid 2018 05 18)-                               (inputToTime utcTZ testDate "2018-05-18"))-                    , testCase-                          "simple time"-                          (assertEqual-                               "A valid time"-                               (DueTime . flip UTCTime 64800 <$> fromGregorianValid 2018 05 18)-                               (inputToTime utcTZ testDate "2018-05-18 18:00"))-                    , testCase-                          "time with timezone"-                          (assertEqual-                               "A valid time"-                               (DueTime . flip UTCTime 79200 <$> fromGregorianValid 2018 05 18)-                               (inputToTime-                                    (tzByLabel America__New_York)-                                    testDate-                                    "2018-05-18 18:00"))-                    , testCase-                          "relative time - seconds"-                          (assertEqual-                               "Adds 7 seconds"-                               (DueTime . flip UTCTime 7 <$> fromGregorianValid 2018 05 18)-                               (inputToTime utcTZ testDate "7s"))-                    , testCase-                          "relative time - days"-                          (assertEqual-                               "Adds 29 days, 12 hours"-                               (DueTime . flip UTCTime 43200 <$> fromGregorianValid 2018 06 16)-                               (inputToTime utcTZ testDate "29 d 12h"))-                    , testCase-                          "relative time - weeks"-                          (assertEqual-                               "Adds four weeks, two days, 12 hours"-                               (DueTime . flip UTCTime 43200 <$> fromGregorianValid 2018 06 17)-                               (inputToTime utcTZ testDate "4w 2d 12h"))-                    ]-              , testCase-                    "isoToTime"-                    (assertEqual-                         "Gives back time"-                         (Just (DueTime (UTCTime (fromGregorian 2020 8 11) 82800)))-                         (isoToTime "2020-08-11T23:00:00.000Z"))-              ]-        , testGroup-              "deadline"-              [ testCase-                    "Plenty"-                    (assertEqual-                         "Plenty of time"-                         Plenty-                         (deadline testDate (DueDate (fromGregorian 2018 05 28))))-              , testCase-                    "ThisWeek"-                    (assertEqual-                         "This week"-                         ThisWeek-                         (deadline testDate (DueDate (fromGregorian 2018 05 24))))-              , testCase-                    "Tomorrow"-                    (assertEqual-                         "Tomorrow"-                         Tomorrow-                         (deadline testDate (DueDate (fromGregorian 2018 05 19))))-              , testCase "Today" (assertEqual "Today" Today (deadline testDate (DueTime testDate)))-              , testCase-                    "Passed"-                    (assertEqual-                         "Passed"-                         Passed-                         (deadline testDate (DueDate (fromGregorian 2018 05 17))))-              ]-        ]
− test/Data/Taskell/ListNavigationTest.hs 
@@ -1,81 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Taskell.ListNavigationTest-    ( test_listNav-    ) where--import ClassyPrelude as CP--import Test.Tasty-import Test.Tasty.HUnit--import           Data.Taskell.List.Internal as L-import qualified Data.Taskell.Task          as T (Task, new)--taskSeq :: Seq T.Task-taskSeq =-    fromList-        [ T.new "Hello"-        , T.new "Blah"-        , T.new "Fish"-        , T.new "Spoons"-        , T.new "Hello Again!"-        , T.new "Computers"-        ]--list :: List-list = List "Populated" taskSeq---- tests-test_listNav :: TestTree-test_listNav =-    testGroup-        "Data.Taskell.List Navigation"-        [ testGroup-              "next"-              [ testCase "no term" (assertEqual "1" 1 (L.nextTask 0 Nothing list))-              , testCase "with term" (assertEqual "4" 4 (L.nextTask 0 (Just "Hello") list))-              , testCase-                    "with term - no match"-                    (assertEqual "0" 0 (L.nextTask 0 (Just "Wombat") list))-              ]-        , testGroup-              "prev"-              [ testCase "no term" (assertEqual "0" 0 (L.prevTask 1 Nothing list))-              , testCase "with term" (assertEqual "0" 0 (L.prevTask 4 (Just "Hello") list))-              , testCase-                    "with term - no match"-                    (assertEqual "4" 4 (L.prevTask 4 (Just "Wombat") list))-              ]-        , testGroup-              "nearest"-              [ testCase "no term" (assertEqual "same task" 2 (L.nearest 2 Nothing list))-              , testCase "term matches" (assertEqual "same task" 2 (L.nearest 2 (Just "ish") list))-              , testCase "term after" (assertEqual "next task" 3 (L.nearest 2 (Just "oons") list))-              , testCase-                    "term before"-                    (assertEqual "previous task" 3 (L.nearest 5 (Just "oons") list))-              , testCase-                    "term both - before closer"-                    (assertEqual "previous task" 0 (L.nearest 2 (Just "Hello") list))-              , testCase-                    "term both - after closer"-                    (assertEqual "next task" 4 (L.nearest 3 (Just "Hello") list))-              , testCase-                    "no matches"-                    (assertEqual "nothing" (-1) (L.nearest 3 (Just "Penguins") list))-              , testCase-                    "nothing to match"-                    (assertEqual "nothing" 3 (L.nearest (-1) (Just "Spoon") list))-              , testCase-                    "nothing with no term"-                    (assertEqual "nothing" 0 (L.nearest (-1) Nothing list))-              , testCase-                    "out of bounds with no term"-                    (assertEqual "nothing" 5 (L.nearest 50 Nothing list))-              , testCase-                    "out of bounds by 1 with no term"-                    (assertEqual "nothing" 5 (L.nearest 6 Nothing list))-              ]-        ]
− test/Data/Taskell/ListTest.hs 
@@ -1,191 +0,0 @@-{-# 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"])-                              , 2))-                         (move 1 1 Nothing populatedList))-              , testCase-                    "down"-                    (assertEqual-                         "List with moved item"-                         (Just-                              ( List-                                    "Populated"-                                    (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])-                              , 0))-                         (move 1 (-1) Nothing populatedList))-              , testCase-                    "up - out of bounds"-                    (assertEqual-                         "List with moved item"-                         (Just-                              ( List-                                    "Populated"-                                    (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])-                              , 2))-                         (move 1 10 Nothing populatedList))-              , testCase-                    "down - out of bounds"-                    (assertEqual-                         "List with moved item"-                         (Just-                              ( List-                                    "Populated"-                                    (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])-                              , 0))-                         (move 1 (-10) Nothing populatedList))-              , testCase-                    "up - with search"-                    (assertEqual-                         "List with moved item"-                         (Just-                              ( List-                                    "Populated"-                                    (fromList [T.new "Blah", T.new "Fish", T.new "Hello"])-                              , 2))-                         (move 0 1 (Just "Fish") populatedList))-              , testCase-                    "down - with search"-                    (assertEqual-                         "List with moved item"-                         (Just-                              ( List-                                    "Populated"-                                    (fromList [T.new "Fish", T.new "Hello", T.new "Blah"])-                              , 0))-                         (move 2 (-1) (Just "Hello") populatedList))-              ]-        , testCase-              "deleteTask"-              (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-                         "Hello and Blah"-                         (List "Populated" (fromList [T.new "Hello", T.new "Blah"]))-                         (searchFor "l" populatedList))-              , testCase-                    "case-insensitive"-                    (assertEqual-                         "Hello"-                         (List "Populated" (fromList [T.new "Hello"]))-                         (searchFor "hello" populatedList))-              , testCase-                    "doesn't exist"-                    (assertEqual-                         "Empty list"-                         (List "Populated" CP.empty)-                         (searchFor "FFF" populatedList))-              ]-        ]
− test/Data/Taskell/ListsTest.hs 
@@ -1,236 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Data.Taskell.ListsTest-    ( test_lists-    ) where--import ClassyPrelude hiding (delete)--import Test.Tasty-import Test.Tasty.HUnit--import Control.Lens ((.~))--import           Data.Taskell.Date           (textToTime)-import qualified Data.Taskell.List           as L-import           Data.Taskell.Lists.Internal-import qualified Data.Taskell.Task           as T-import           Types                       (ListIndex (ListIndex), TaskIndex (TaskIndex))---- test data-list1, list2, list3 :: L.List-list1 =-    foldl'-        (flip L.append)-        (L.empty "List 1")-        [T.new "One", (T.due .~ textToTime "2019-08-14") (T.new "Two"), T.new "Three"]--list2 =-    foldl'-        (flip L.append)-        (L.empty "List 2")-        [T.new "1", T.new "2", (T.due .~ textToTime "2018-12-03") (T.new "3")]--list3 =-    foldl'-        (flip L.append)-        (L.empty "List 3")-        [(T.due .~ textToTime "2019-04-05") (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.due .~ textToTime "2018-12-03") (T.new "3")]-                                   , foldl'-                                         (flip L.append)-                                         (L.empty "List 3")-                                         [ (T.due .~ textToTime "2019-04-05") (T.new "01")-                                         , T.new "10"-                                         , T.new "11"-                                         , T.new "2"-                                         ]-                                   ]))-                         (changeList (ListIndex 1, TaskIndex 1) testLists 1))-              , testCase-                    "left"-                    (assertEqual-                         "Returns updated lists"-                         (Just-                              (fromList-                                   [ foldl'-                                         (flip L.append)-                                         (L.empty "List 1")-                                         [ T.new "One"-                                         , (T.due .~ textToTime "2019-08-14") (T.new "Two")-                                         , T.new "Three"-                                         , T.new "2"-                                         ]-                                   , foldl'-                                         (flip L.append)-                                         (L.empty "List 2")-                                         [T.new "1", (T.due .~ textToTime "2018-12-03") (T.new "3")]-                                   , list3-                                   ]))-                         (changeList (ListIndex 1, TaskIndex 1) testLists (-1)))-              , testCase-                    "out of bounds list"-                    (assertEqual-                         "Nothing"-                         Nothing-                         (changeList (ListIndex 5, TaskIndex 1) testLists 1))-              , testCase-                    "out of bounds task"-                    (assertEqual-                         "Nothing"-                         Nothing-                         (changeList (ListIndex 1, TaskIndex 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.due .~ textToTime "2019-04-05") (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))-        , testCase-              "due"-              (assertEqual-                   "returns just due list"-                   (fromList-                        [ ( (ListIndex 1, TaskIndex 2)-                          , (T.due .~ textToTime "2018-12-03") (T.new "3"))-                        , ( (ListIndex 2, TaskIndex 0)-                          , (T.due .~ textToTime "2019-04-05") (T.new "01"))-                        , ( (ListIndex 0, TaskIndex 1)-                          , (T.due .~ textToTime "2019-08-14") (T.new "Two"))-                        ])-                   (due testLists))-        ]
− test/Data/Taskell/SeqTest.hs 
@@ -1,95 +0,0 @@-{-# 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 
@@ -1,45 +0,0 @@-{-# 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 
@@ -1,203 +0,0 @@-{-# 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.Calendar (fromGregorianValid)--import           Data.Taskell.Date          (Due (DueDate))-import qualified Data.Taskell.Subtask       as ST (name, new)-import           Data.Taskell.Task.Internal--desc :: Maybe Text-desc = Just "A very boring description"--testTask :: Task-testTask =-    Task-    { _name = "Test"-    , _description = desc-    , _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"-                              desc-                              (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"-                              desc-                              (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"-                              desc-                              (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"-                              desc-                              (fromList [ST.new "One" True, ST.new "Three" False])-                              Nothing)-                         (removeSubtask 1 testTask))-              , testCase-                    "doesn't exist"-                    (assertEqual-                         "Returns task"-                         (Task-                              "Test"-                              desc-                              (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-                    "case-insensitive"-                    (assertEqual "Find sub-task" True (contains "ONE" testTask))-              , testCase-                    "case-insensitive"-                    (assertEqual "Find sub-task" True (contains "two" testTask))-              , testCase "missing" (assertEqual "Find sub-task" False (contains "Fish" testTask))-              , testCase-                    "description"-                    (assertEqual "Finds in description" True (contains "boring" testTask))-              , testCase-                    "not in description"-                    (assertEqual "Doesn't find" False (contains "escapades" 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 (DueDate <$> (fromGregorianValid 2018 05 18)))))-              ]-        ]
− test/Events/State/HistoryTest.hs 
@@ -1,98 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module Events.State.HistoryTest-    ( test_history-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Events.State.History-import Events.State.Types--make :: [Integer] -> Integer -> [Integer] -> History Integer-make = History--testHistory :: History Integer-testHistory = make empty 0 empty---- tests-test_history :: TestTree-test_history =-    testGroup-        "Events.State.History"-        [ testGroup-              "undo"-              [ testCase "empty" (assertEqual "Nothing changes" testHistory (undo testHistory))-              , testCase-                    "one undo"-                    (assertEqual "Goes back" (make empty 0 [1]) (undo $ make [0] 1 empty))-              , testCase-                    "two undo"-                    (assertEqual-                         "Goes back"-                         (make empty 0 [1, 2])-                         (undo . undo $ make [1, 0] 2 empty))-              , testCase-                    "three undo"-                    (assertEqual-                         "Goes back"-                         (make empty 0 [1, 2, 3])-                         (undo . undo . undo $ make [2, 1, 0] 3 empty))-              ]-        , testGroup-              "redo"-              [ testCase "empty" (assertEqual "Nothing changes" testHistory (redo testHistory))-              , testCase-                    "one redo"-                    (assertEqual "Goes forward" (make [0] 1 empty) (redo $ make empty 0 [1]))-              , testCase-                    "two redo"-                    (assertEqual-                         "Goes forward"-                         (make [1, 0] 2 empty)-                         (redo . redo $ make empty 0 [1, 2]))-              , testCase-                    "three redo"-                    (assertEqual-                         "Goes forward"-                         (make [2, 1, 0] 3 empty)-                         (redo . redo . redo $ make empty 0 [1, 2, 3]))-              ]-        , testGroup-              "mix"-              [ testCase-                    "empty"-                    (assertEqual-                         "Nothing changes"-                         testHistory-                         (undo . redo . undo . redo . undo $ testHistory))-              , testCase-                    "redo undo"-                    (assertEqual-                         "Nothing changes"-                         (make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10])-                         (undo . redo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))-              , testCase-                    "undo redo"-                    (assertEqual-                         "Nothing changes"-                         (make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10])-                         (redo . undo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))-              ]-        , testGroup-              "store"-              [ testCase-                    "empty"-                    (assertEqual "Stores current value" (make [0] 0 empty) (store testHistory))-              , testCase-                    "undo store redo"-                    (assertEqual-                         "Clears redo"-                         (make [4, 3, 2, 1, 0] 4 empty)-                         (redo . store . undo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))-              ]-        ]
− test/Events/StateTest.hs 
@@ -1,132 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}--module Events.StateTest-    ( test_state-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Control.Lens ((&), (.~), (^.))--import Data.Time.Clock (secondsToDiffTime)-import Data.Time.Zones (utcTZ)--import qualified Data.Sequence           as S (lookup)-import qualified Data.Taskell.List       as L (append, empty)-import qualified Data.Taskell.Task       as T (new)-import           Events.State-import           Events.State.Types-import           Events.State.Types.Mode-import           Types                   (ListIndex (ListIndex), TaskIndex (TaskIndex))--mockTime :: UTCTime-mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)--testState :: State-testState =-    State-    { _mode = Normal-    , _history = fresh empty-    , _path = "test.md"-    , _io = Nothing-    , _height = 0-    , _searchTerm = Nothing-    , _time = mockTime-    , _timeZone = utcTZ-    }--moveToState :: State-moveToState =-    State-    { _mode = Modal MoveTo-    , _history =-          History-          { _past = empty-          , _present =-                ( (ListIndex 4, TaskIndex 0)-                , [ 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"-                  ])-          , _future = empty-          }-    , _path = "test.md"-    , _io = Nothing-    , _height = 0-    , _searchTerm = Nothing-    , _time = mockTime-    , _timeZone = utcTZ-    }---- 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/GitHub/CardsTest.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.GitHub.CardsTest-    ( test_cards-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Data.Aeson--import IO.HTTP.GitHub.Card (MaybeCard (MaybeCard))--decodeCards :: Text -> Either String [MaybeCard]-decodeCards txt = eitherDecodeStrict $ encodeUtf8 txt---- tests-test_cards :: TestTree-test_cards =-    testGroup-        "IO.HTTP.GitHub.Card"-        [ testCase-              "parses basic card"-              (assertEqual-                   "Gives back card"-                   (Right [MaybeCard (Just "blah") Nothing])-                   (decodeCards "[{\"note\": \"blah\"}]"))-        , testCase-              "parses basic card"-              (assertEqual-                   "Gives back card"-                   (Right-                        [MaybeCard Nothing (Just "https://api.github.com/projects/columns/7850783")])-                   (decodeCards-                        "[{\"note\": null, \"content_url\": \"https://api.github.com/projects/columns/7850783\"}]"))-        ]
− test/IO/GitHubTest.hs 
@@ -1,48 +0,0 @@-{-# 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/Keyboard/ParserTest.hs 
@@ -1,95 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}--module IO.Keyboard.ParserTest-    ( test_parser-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Data.FileEmbed    (embedFile)-import Text.RawString.QQ (r)--import qualified Events.Actions.Types as A-import           IO.Keyboard.Parser   (bindings)-import           IO.Keyboard.Types--basic :: Text-basic = "quit = q"--basicResult :: Bindings-basicResult = [(BChar 'q', A.Quit)]--basicMulti :: Text-basicMulti =-    [r|-        quit = q-        detail = <Enter>-    |]--basicMultiResult :: Bindings-basicMultiResult = [(BChar 'q', A.Quit), (BKey "Enter", A.Detail)]--ini :: Text-ini = decodeUtf8 $(embedFile "test/IO/Keyboard/data/bindings.ini")--iniResult :: Bindings-iniResult =-    [ (BChar 'q', A.Quit)-    , (BChar 'u', A.Undo)-    , (BChar 'r', A.Redo)-    , (BChar '/', A.Search)-    , (BChar '?', A.Help)-    , (BChar '!', A.Due)-    , (BChar 'k', A.Previous)-    , (BChar 'j', A.Next)-    , (BChar 'h', A.Left)-    , (BChar 'l', A.Right)-    , (BChar 'G', A.Bottom)-    , (BChar 'a', A.New)-    , (BChar 'O', A.NewAbove)-    , (BChar 'o', A.NewBelow)-    , (BChar '+', A.Duplicate)-    , (BChar 'e', A.Edit)-    , (BChar 'A', A.Edit)-    , (BChar 'i', A.Edit)-    , (BChar 'C', A.Clear)-    , (BChar 'D', A.Delete)-    , (BKey "Enter", A.Detail)-    , (BChar '@', A.DueDate)-    , (BKey "Backspace", A.ClearDate)-    , (BChar 'K', A.MoveUp)-    , (BChar 'J', A.MoveDown)-    , (BChar 'H', A.MoveLeft)-    , (BChar 'L', A.MoveRight)-    , (BKey "Space", A.Complete)-    , (BChar 'm', A.MoveMenu)-    , (BChar 'N', A.ListNew)-    , (BChar 'E', A.ListEdit)-    , (BChar 'X', A.ListDelete)-    , (BChar '>', A.ListRight)-    , (BChar '<', A.ListLeft)-    ]--comma :: Text-comma = "quit = ,"--commaResult :: Bindings-commaResult = [(BChar ',', A.Quit)]--test_parser :: TestTree-test_parser =-    testGroup-        "IO.Keyboard.Parser"-        [ testCase "basic" (assertEqual "Parses quit" (Right basicResult) (bindings basic))-        , testCase-              "basic multiline"-              (assertEqual "Parses both" (Right basicMultiResult) (bindings basicMulti))-        , testCase "full ini file" (assertEqual "Parses all" (Right iniResult) (bindings ini))-        , testCase "comma" (assertEqual "Parses comma" (Right commaResult) (bindings comma))-        ]
− test/IO/Keyboard/TypesTest.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module IO.Keyboard.TypesTest-    ( test_types-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import qualified Events.Actions.Types as A (ActionType (..))-import           IO.Keyboard          (addMissing, badMapping, defaultBindings)-import           IO.Keyboard.Types    (Binding (..), Bindings)--notFull :: Bindings-notFull = [(BChar 'œ', A.Quit), (BChar 'U', A.Undo)]--notFullResult :: Bindings-notFullResult =-    [ (BChar 'œ', A.Quit)-    , (BChar 'U', A.Undo)-    , (BChar 'r', A.Redo)-    , (BChar '/', A.Search)-    , (BChar '!', A.Due)-    , (BChar '?', A.Help)-    , (BChar 'k', A.Previous)-    , (BChar 'j', A.Next)-    , (BChar 'h', A.Left)-    , (BChar 'l', A.Right)-    , (BChar 'G', A.Bottom)-    , (BChar 'g', A.Top)-    , (BChar 'a', A.New)-    , (BChar 'O', A.NewAbove)-    , (BChar 'o', A.NewBelow)-    , (BChar '+', A.Duplicate)-    , (BChar 'e', A.Edit)-    , (BChar 'A', A.Edit)-    , (BChar 'i', A.Edit)-    , (BChar 'C', A.Clear)-    , (BChar 'D', A.Delete)-    , (BKey "Enter", A.Detail)-    , (BChar '@', A.DueDate)-    , (BKey "Backspace", A.ClearDate)-    , (BChar 'K', A.MoveUp)-    , (BChar 'J', A.MoveDown)-    , (BChar 'H', A.MoveLeft)-    , (BChar 'L', A.MoveRight)-    , (BKey "Space", A.Complete)-    , (BChar 'm', A.MoveMenu)-    , (BChar 'N', A.ListNew)-    , (BChar 'E', A.ListEdit)-    , (BChar 'X', A.ListDelete)-    , (BChar '>', A.ListRight)-    , (BChar '<', A.ListLeft)-    ]--bad :: Bindings-bad = [(BChar 'q', A.Quit), (BChar 'u', A.Nothing), (BChar '>', A.Nothing), (BChar '<', A.ListLeft)]---- tests-test_types :: TestTree-test_types =-    testGroup-        "Events.Actions.Types"-        [ testCase-              "not missing"-              (assertEqual "Finds no missing items" defaultBindings (addMissing defaultBindings))-        , testCase-              "not missing"-              (assertEqual "Finds missing items" notFullResult (addMissing notFull))-        , testCase-              "bad mapping"-              (assertEqual "Finds bad mapping" (Left "invalid mapping") (badMapping bad))-        ]
− test/IO/KeyboardTest.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}--module IO.KeyboardTest-    ( test_keyboard-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Control.Lens ((.~))--import Data.Time.Clock (secondsToDiffTime)-import Data.Time.Zones (utcTZ)--import Data.Taskell.Lists.Internal (initial)-import Events.Actions.Types        as A-import Events.State                (create, quit)-import Events.State.Types          (State, Stateful, mode)-import Events.State.Types.Mode     (Mode (Shutdown))-import Graphics.Vty.Input.Events   (Event (..), Key (..))-import IO.Keyboard                 (generate)-import IO.Keyboard.Types--mockTime :: UTCTime-mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)--tester :: BoundActions -> Event -> Stateful-tester actions ev state = lookup ev actions >>= ($ state)--cleanState :: State-cleanState = create utcTZ mockTime "taskell.md" initial--basicBindings :: Bindings-basicBindings = [(BChar 'q', A.Quit)]--basicActions :: Actions-basicActions = [(A.Quit, quit)]--basicResult :: Maybe State-basicResult = Just $ (mode .~ Shutdown) cleanState--test_keyboard :: TestTree-test_keyboard =-    testGroup-        "IO.Keyboard"-        [ testCase-              "generate"-              (assertEqual-                   "Parses basic"-                   basicResult-                   (tester (generate basicBindings basicActions) (EvKey (KChar 'q') []) cleanState))-        ]
− test/IO/Markdown/ParserTest.hs 
@@ -1,214 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module IO.Markdown.ParserTest-    ( test_parser-    ) where--import ClassyPrelude--import Test.Tasty--import Test.Tasty.HUnit--import Control.Lens   ((&), (.~))-import Data.FileEmbed (embedFile)--import Data.Taskell.Date  (textToTime)-import Data.Taskell.List  (create)-import Data.Taskell.Lists (Lists, analyse, appendToLast, newList)--import qualified Data.Taskell.Subtask as ST (new)-import           Data.Taskell.Task    (Task, addSubtask, due, new, setDescription)-import           IO.Config.Markdown   (Config (Config), defaultConfig, descriptionOutput, dueOutput,-                                       localTimes, subtaskOutput, taskOutput, titleOutput)-import           IO.Markdown.Parser   (parse)---- error message-err :: Either Text Lists-err = Left "Could not parse file."---- complete taskell file-file :: Text-file = decodeUtf8 $(embedFile "test/IO/data/roadmap.md")---- alternative markdown configs-alternativeConfig :: Config-alternativeConfig =-    Config-    { titleOutput = "##"-    , taskOutput = "###"-    , descriptionOutput = ">"-    , dueOutput = "@"-    , subtaskOutput = "-"-    , localTimes = True-    }---- useful records-task :: Task-task = new "Test Item"--list :: Lists-list = newList "Test" empty--listWithItem :: Lists-listWithItem = appendToLast task list--multiList :: Lists-multiList =-    fromList-        [create "Test" (fromList [new "Test Item"]), create "Test 2" (fromList [new "Test Item 2"])]--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 = task & due .~ textToTime "2018-04-12"--listWithDueDateItem :: Lists-listWithDueDateItem = appendToLast taskWithDueDate list---- tests-test_parser :: TestTree-test_parser =-    testGroup-        "IO.Markdown"-        [ testGroup-              "Default Format"-              [ testCase-                    "List Title"-                    (assertEqual "One list" (Right list) (parse defaultConfig "## Test"))-              , testCase-                    "List item"-                    (assertEqual-                         "List item"-                         (Right listWithItem)-                         (parse defaultConfig "## Test\n\n- Test Item"))-              , testCase-                    "Multiple Lists"-                    (assertEqual-                         "List item"-                         (Right multiList)-                         (parse defaultConfig "## Test\n\n- Test Item\n\n## Test 2\n\n- Test Item 2"))-              , testCase-                    "Summary"-                    (assertEqual-                         "Summary"-                         (Right listWithSummaryItem)-                         (parse defaultConfig "## Test\n\n- Test Item\n    > Summary"))-              , testCase-                    "List Item with multi-line Summary"-                    (assertEqual-                         "List item with a summary"-                         (Right listWithMultiLineSummaryItem)-                         (parse-                              defaultConfig-                              "## Test\n\n- Test Item\n    > Summary Line 1\n    > Summary Line 2"))-              , testCase-                    "Due Date"-                    (assertEqual-                         "Due Date"-                         (Right listWithDueDateItem)-                         (parse defaultConfig "## Test\n\n- Test Item\n    @ 2018-04-12"))-              , testCase-                    "Sub-Task"-                    (assertEqual-                         "List item with Sub-Task"-                         (Right (makeSubTask "Blah" False))-                         (parse defaultConfig "## Test\n\n- Test Item\n    * [ ] Blah"))-              , testCase-                    "Complete Sub-Task"-                    (assertEqual-                         "List item with Sub-Task"-                         (Right (makeSubTask "Blah" True))-                         (parse defaultConfig "## Test\n\n- Test Item\n    * [x] Blah"))-              ]-        , testGroup-              "Alternative Format"-              [ testCase-                    "List Title"-                    (assertEqual "One list" (Right list) (parse alternativeConfig "## Test"))-              , testCase-                    "List item"-                    (assertEqual-                         "List item"-                         (Right listWithItem)-                         (parse alternativeConfig "## Test\n\n### Test Item"))-              , testCase-                    "Multiple Lists"-                    (assertEqual-                         "List item"-                         (Right multiList)-                         (parse-                              alternativeConfig-                              "## Test\n\n### Test Item\n\n## Test 2\n\n### Test Item 2"))-              , testCase-                    "Summary"-                    (assertEqual-                         "Summary"-                         (Right listWithSummaryItem)-                         (parse alternativeConfig "## Test\n\n### Test Item\n> Summary"))-              , testCase-                    "List Item with multi-line Summary"-                    (assertEqual-                         "List item with a summary"-                         (Right listWithMultiLineSummaryItem)-                         (parse-                              alternativeConfig-                              "## Test\n\n### Test Item\n> Summary Line 1\n> Summary Line 2"))-              , testCase-                    "Due Date"-                    (assertEqual-                         "Due Date"-                         (Right listWithDueDateItem)-                         (parse alternativeConfig "## Test\n\n### Test Item\n@ 2018-04-12"))-              , testCase-                    "Sub-Task"-                    (assertEqual-                         "List item with Sub-Task"-                         (Right (makeSubTask "Blah" False))-                         (parse alternativeConfig "## Test\n\n### Test Item\n- [ ] Blah"))-              , testCase-                    "Complete Sub-Task"-                    (assertEqual-                         "List item with Sub-Task"-                         (Right (makeSubTask "Blah" True))-                         (parse alternativeConfig "## Test\n\n### Test Item\n- [x] Blah"))-              ]-        , testGroup-              "Errors"-              [ testCase "Blank line" (assertEqual "Parse Error" err (parse defaultConfig ""))-              , testCase-                    "Just spaces"-                    (assertEqual "Parse Error" err (parse defaultConfig "        "))-              , testCase-                    "Just whitespace"-                    (assertEqual "Parse Error" err (parse defaultConfig "  \n  \n \t    "))-              , testCase "Error" (assertEqual "Parse Error" err (parse defaultConfig "Test"))-              , testCase-                    "List item without list"-                    (assertEqual "Parse Error" err (parse defaultConfig "- Test Item"))-              , testCase-                    "Sub task without list item"-                    (assertEqual "Parse Error" err (parse defaultConfig "## Test\n    * Blah"))-              ]-        , testCase-              "File"-              (assertEqual-                   "Parses whole file"-                   (Right "test\nLists: 6\nTasks: 202")-                   (analyse "test" <$> parse defaultConfig file))-        ]
− test/IO/Markdown/SerializerTest.hs 
@@ -1,194 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}--module IO.Markdown.SerializerTest-    ( test_serializer-    ) where--import ClassyPrelude--import Test.Tasty-import Test.Tasty.HUnit--import Control.Lens         ((&), (.~))-import Control.Monad.Reader (runReader)-import Data.FileEmbed       (embedFile)--import Data.Time.Zones     (utcTZ)-import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel)--import           Data.Taskell.Date      (textToTime)-import qualified Data.Taskell.List      as L (append, empty)-import           Data.Taskell.Lists     (Lists, appendToLast, newList)-import qualified Data.Taskell.Subtask   as ST (new)-import           Data.Taskell.Task      (Task, addSubtask, due, new, setDescription)-import           IO.Config.Markdown     (Config (..), defaultConfig)-import           IO.Markdown.Parser     (parse)-import           IO.Markdown.Serializer (MarkdownInfo (MarkdownInfo), serialize)---- complete taskell file-file :: Text-file = decodeUtf8 $(embedFile "test/IO/data/roadmap.md")---- alternative markdown configs-alternativeConfig :: Config-alternativeConfig =-    Config-    { titleOutput = "##"-    , taskOutput = "###"-    , descriptionOutput = ">"-    , dueOutput = "@"-    , subtaskOutput = "-"-    , localTimes = True-    }---- useful records-task :: Task-task = new "Test Item"--list :: Lists-list = newList "Test" empty--lists :: Lists-lists = fromList [L.append task (L.empty "To Do"), L.append (new "Fish") (L.empty "Done")]--listWithItem :: Lists-listWithItem = appendToLast task list--makeSubTask :: Text -> Bool -> Lists-makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list--makeSubTasks :: [Text] -> Bool -> Lists-makeSubTasks ts b = appendToLast (foldr addSubtask task subtasks) list-  where-    subtasks = flip ST.new b <$> ts--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 = task & due .~ textToTime "2018-04-12"--listWithDueDateItem :: Lists-listWithDueDateItem = appendToLast taskWithDueDate list--taskWithDueTime :: Task-taskWithDueTime = task & due .~ textToTime "2018-04-12 12:00 UTC"--listWithDueTimeItem :: Lists-listWithDueTimeItem = appendToLast taskWithDueTime list---- reader-defaultReader :: MarkdownInfo-defaultReader = MarkdownInfo utcTZ defaultConfig--alternativeReader :: MarkdownInfo-alternativeReader = MarkdownInfo utcTZ alternativeConfig---- simplify tests-serialize' :: MarkdownInfo -> Lists -> Text-serialize' md ls = runReader (serialize ls) md---- tests-test_serializer :: TestTree-test_serializer =-    testGroup-        "IO.Markdown"-        [ testGroup-              "Serialisation"-              [ testGroup-                    "Default Format"-                    [ testCase-                          "Standard lists"-                          (assertEqual-                               "Markdown formatted output"-                               "## To Do\n\n- Test Item\n\n## Done\n\n- Fish\n"-                               (serialize' defaultReader lists))-                    , testCase-                          "Standard list"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n- Test Item\n"-                               (serialize' defaultReader listWithItem))-                    , testCase-                          "Standard list with summary"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n- Test Item\n    > Summary\n"-                               (serialize' defaultReader listWithSummaryItem))-                    , testCase-                          "Standard list with date"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n- Test Item\n    @ 2018-04-12\n"-                               (serialize' defaultReader listWithDueDateItem))-                    , testCase-                          "Standard list with date - timezone"-                          (assertEqual-                               "Use UTC timezone"-                               "## Test\n\n- Test Item\n    @ 2018-04-12 12:00 UTC\n"-                               (serialize'-                                    (MarkdownInfo (tzByLabel America__New_York) defaultConfig)-                                    listWithDueTimeItem))-                    , testCase-                          "Standard list with sub-task"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n- Test Item\n    * [x] Blah\n"-                               (serialize' defaultReader (makeSubTask "Blah" True)))-                    , testCase-                          "Standard list with sub-tasks"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n- Test Item\n    * [x] Blah\n    * [x] Cow\n    * [x] Spoon\n"-                               (serialize'-                                    defaultReader-                                    (makeSubTasks ["Spoon", "Cow", "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"-                               (serialize' defaultReader listWithMultiLineSummaryItem))-                    ]-              , testGroup-                    "Alternative Format"-                    [ testCase-                          "Standard list"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n### Test Item\n"-                               (serialize' alternativeReader listWithItem))-                    , testCase-                          "Standard list with sub-task"-                          (assertEqual-                               "Markdown formatted output"-                               "## Test\n\n### Test Item\n- [ ] Blah\n"-                               (serialize' alternativeReader (makeSubTask "Blah" False)))-                    , testCase-                          "Standard list with date - timezone"-                          (assertEqual-                               "Uses local timezone"-                               "## Test\n\n### Test Item\n@ 2018-04-12 08:00 EDT\n"-                               (serialize'-                                    (MarkdownInfo (tzByLabel America__New_York) alternativeConfig)-                                    listWithDueTimeItem))-                    ]-              ]-        , testCase-              "Parse then serialize"-              (assertEqual-                   "Returns same text"-                   (Right file)-                   (serialize' defaultReader <$> parse defaultConfig file))-        ]
− test/IO/TrelloTest.hs 
@@ -1,42 +0,0 @@-{-# 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 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 :: TestTree-test_trello =-    testGroup-        "IO.Trello"-        [ testCase-              "Lists"-              (assertEqual "Parses list JSON" (Just 5) (length . (listToList <$>) <$> json))-        , testCase-              "Checklists"-              (assertEqual-                   "Parses checklist JSON"-                   (Just 5)-                   (length . (checklistItemToSubTask <$>) <$> checklistJson))-        ]
+ test/Taskell/Data/Date/RelativeParserTest.hs view
@@ -0,0 +1,75 @@+module Taskell.Data.Date.RelativeParserTest+    ( test_relative_parser+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Time.Clock (secondsToDiffTime)++import Taskell.Data.Date                (Due (DueDate, DueTime))+import Taskell.Data.Date.RelativeParser (parseRelative)++toTime :: (Integer, Int, Int) -> Integer -> Due+toTime (y, m, d) seconds = DueTime $ UTCTime (fromGregorian y m d) (secondsToDiffTime seconds)++toDay :: (Integer, Int, Int) -> Due+toDay (y, m, d) = DueDate $ fromGregorian y m d++-- 08:53:03 18th December 2019+time :: UTCTime+time = UTCTime (fromGregorian 2019 12 18) 31983++-- tests+test_relative_parser :: TestTree+test_relative_parser =+    testGroup+        "Data.Taskell.Date.RelativeParser"+        [ testCase+              "Second"+              (assertEqual+                   "Adds a second"+                   (Right (toTime (2019, 12, 18) 31984))+                   (parseRelative time "1s"))+        , testCase+              "Minute"+              (assertEqual+                   "Adds a minute"+                   (Right (toTime (2019, 12, 18) 32043))+                   (parseRelative time "1m"))+        , testCase+              "Hour"+              (assertEqual+                   "Adds an hour"+                   (Right (toTime (2019, 12, 18) 35583))+                   (parseRelative time "1h"))+        , testCase+              "Day"+              (assertEqual "Adds a day" (Right (toDay (2019, 12, 19))) (parseRelative time "1d"))+        , testCase+              "Days"+              (assertEqual "Adds 29 days" (Right (toDay (2020, 1, 16))) (parseRelative time "29 d"))+        , testCase+              "Week"+              (assertEqual "Adds a week" (Right (toDay (2019, 12, 25))) (parseRelative time "1w "))+        , testCase+              "Mix"+              (assertEqual+                   "Adds 1 week 2 days and 29 seconds"+                   (Right (toTime (2019, 12, 27) 32012))+                   (parseRelative time " 1 w 2d 29 s "))+        , testCase+              "Mix out of order"+              (assertEqual+                   "Adds 1 week 2 days and 29 seconds"+                   (Right (toTime (2019, 12, 27) 32012))+                   (parseRelative time " 2d 1 w 29 s"))+        , testCase+              "invalid format"+              (assertEqual "Error" (Left "Could not parse date.") (parseRelative time "18/12/2019"))+        , testCase+              "invalid numbers"+              (assertEqual "Error" (Left "Could not parse date.") (parseRelative time "2019-39-59"))+        ]
+ test/Taskell/Data/DateTest.hs view
@@ -0,0 +1,243 @@+module Taskell.Data.DateTest+    ( test_date+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Time+import Data.Time.Zones     (utcTZ)+import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel)+import Taskell.Data.Date++testDate :: UTCTime+testDate = UTCTime (fromGregorian 2018 5 18) (secondsToDiffTime 0)++-- sorting test data+sort1 :: Due+sort1 = DueTime (UTCTime (fromGregorian 2017 2 4) 0)++sort2 :: Due+sort2 = DueDate (fromGregorian 2016 12 15)++sort3 :: Due+sort3 = DueTime (UTCTime (fromGregorian 2020 8 9) 44000)++sort4 :: Due+sort4 = DueDate (fromGregorian 2019 8 30)++-- tests+test_date :: TestTree+test_date =+    testGroup+        "Data.Taskell.Date"+        [ testCase+              "Sorting"+              (assertEqual+                   "Sorted in date order"+                   [sort2, sort1, sort4, sort3]+                   (sort [sort1, sort2, sort3, sort4]))+        , testGroup+              "Date Output"+              [ testGroup+                    "timeToDisplay"+                    [ testCase+                          "timeToDisplay time"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18 00:00"+                               (timeToDisplay utcTZ (DueTime testDate)))+                    , testCase+                          "timeToDisplay time - non-utc"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-17 20:00"+                               (timeToDisplay (tzByLabel America__New_York) (DueTime testDate)))+                    , testCase+                          "timeToDisplay date"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToDisplay utcTZ (DueDate (fromGregorian 2018 05 18))))+                    ]+              , testGroup+                    "timeToOutput"+                    [ testCase+                          "timeToOutput time"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18 00:00 UTC"+                               (timeToOutput (DueTime testDate)))+                    , testCase+                          "timeToOutput date"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToOutput (DueDate (fromGregorian 2018 05 18))))+                    ]+              , testGroup+                    "timeToOutputLocal"+                    [ testCase+                          "timeToOutputLocal time"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18 00:00 UTC"+                               (timeToOutputLocal utcTZ (DueTime testDate)))+                    , testCase+                          "timeToOutputLocal time - non-utc"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-17 20:00 EDT"+                               (timeToOutputLocal (tzByLabel America__New_York) (DueTime testDate)))+                    , testCase+                          "timeToOutputLocal date"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToOutputLocal utcTZ (DueDate (fromGregorian 2018 05 18))))+                    , testCase+                          "timeToOutputLocal date - non-utc"+                          (assertEqual+                               "Date in yyyy-mm-dd format"+                               "2018-05-18"+                               (timeToOutputLocal+                                    (tzByLabel America__New_York)+                                    (DueDate (fromGregorian 2018 05 18))))+                    ]+              , testGroup+                    "timeToText"+                    [ testCase+                          "time"+                          (assertEqual+                               "Date in 18-May format"+                               "00:00 18-May"+                               (timeToText utcTZ testDate (DueTime testDate)))+                    , testCase+                          "time - non-utc"+                          (assertEqual+                               "Date in 17-May format"+                               "20:00 17-May"+                               (timeToText (tzByLabel America__New_York) testDate (DueTime testDate)))+                    , testCase+                          "same year"+                          (assertEqual+                               "Date in 18-May format"+                               "18-May"+                               (timeToText utcTZ testDate (DueDate (fromGregorian 2018 5 18))))+                    , testCase+                          "different year"+                          (assertEqual+                               "Date in 18-May 2019 format"+                               "18-May 2019"+                               (timeToText utcTZ testDate (DueDate (fromGregorian 2019 5 18))))+                    , testCase+                          "different year"+                          (assertEqual+                               "Date in 18-May 2017 format"+                               "18-May 2017"+                               (timeToText utcTZ testDate (DueDate (fromGregorian 2017 5 18))))+                    ]+              ]+        , testGroup+              "Input"+              [ testGroup+                    "textToTime"+                    [ testCase+                          "simple date"+                          (assertEqual+                               "A valid Day"+                               (DueDate <$> fromGregorianValid 2018 05 18)+                               (textToTime "2018-05-18"))+                    , testCase+                          "simple time"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 64800 <$> fromGregorianValid 2018 05 18)+                               (textToTime "2018-05-18 18:00 UTC"))+                    , testCase+                          "time with timezone"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 0 <$> fromGregorianValid 2018 05 18)+                               (textToTime "2018-05-17 20:00 EDT"))+                    ]+              , testGroup+                    "inputToTime"+                    [ testCase+                          "simple date"+                          (assertEqual+                               "A valid Day"+                               (DueDate <$> fromGregorianValid 2018 05 18)+                               (inputToTime utcTZ testDate "2018-05-18"))+                    , testCase+                          "simple time"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 64800 <$> fromGregorianValid 2018 05 18)+                               (inputToTime utcTZ testDate "2018-05-18 18:00"))+                    , testCase+                          "time with timezone"+                          (assertEqual+                               "A valid time"+                               (DueTime . flip UTCTime 79200 <$> fromGregorianValid 2018 05 18)+                               (inputToTime+                                    (tzByLabel America__New_York)+                                    testDate+                                    "2018-05-18 18:00"))+                    , testCase+                          "relative time - seconds"+                          (assertEqual+                               "Adds 7 seconds"+                               (DueTime . flip UTCTime 7 <$> fromGregorianValid 2018 05 18)+                               (inputToTime utcTZ testDate "7s"))+                    , testCase+                          "relative time - days"+                          (assertEqual+                               "Adds 29 days, 12 hours"+                               (DueTime . flip UTCTime 43200 <$> fromGregorianValid 2018 06 16)+                               (inputToTime utcTZ testDate "29 d 12h"))+                    , testCase+                          "relative time - weeks"+                          (assertEqual+                               "Adds four weeks, two days, 12 hours"+                               (DueTime . flip UTCTime 43200 <$> fromGregorianValid 2018 06 17)+                               (inputToTime utcTZ testDate "4w 2d 12h"))+                    ]+              , testCase+                    "isoToTime"+                    (assertEqual+                         "Gives back time"+                         (Just (DueTime (UTCTime (fromGregorian 2020 8 11) 82800)))+                         (isoToTime "2020-08-11T23:00:00.000Z"))+              ]+        , testGroup+              "deadline"+              [ testCase+                    "Plenty"+                    (assertEqual+                         "Plenty of time"+                         Plenty+                         (deadline testDate (DueDate (fromGregorian 2018 05 28))))+              , testCase+                    "ThisWeek"+                    (assertEqual+                         "This week"+                         ThisWeek+                         (deadline testDate (DueDate (fromGregorian 2018 05 24))))+              , testCase+                    "Tomorrow"+                    (assertEqual+                         "Tomorrow"+                         Tomorrow+                         (deadline testDate (DueDate (fromGregorian 2018 05 19))))+              , testCase "Today" (assertEqual "Today" Today (deadline testDate (DueTime testDate)))+              , testCase+                    "Passed"+                    (assertEqual+                         "Passed"+                         Passed+                         (deadline testDate (DueDate (fromGregorian 2018 05 17))))+              ]+        ]
+ test/Taskell/Data/ListNavigationTest.hs view
@@ -0,0 +1,78 @@+module Taskell.Data.ListNavigationTest+    ( test_listNav+    ) where++import ClassyPrelude as CP++import Test.Tasty+import Test.Tasty.HUnit++import           Taskell.Data.List.Internal as L+import qualified Taskell.Data.Task          as T (Task, new)++taskSeq :: Seq T.Task+taskSeq =+    fromList+        [ T.new "Hello"+        , T.new "Blah"+        , T.new "Fish"+        , T.new "Spoons"+        , T.new "Hello Again!"+        , T.new "Computers"+        ]++list :: List+list = List "Populated" taskSeq++-- tests+test_listNav :: TestTree+test_listNav =+    testGroup+        "Data.Taskell.List Navigation"+        [ testGroup+              "next"+              [ testCase "no term" (assertEqual "1" 1 (L.nextTask 0 Nothing list))+              , testCase "with term" (assertEqual "4" 4 (L.nextTask 0 (Just "Hello") list))+              , testCase+                    "with term - no match"+                    (assertEqual "0" 0 (L.nextTask 0 (Just "Wombat") list))+              ]+        , testGroup+              "prev"+              [ testCase "no term" (assertEqual "0" 0 (L.prevTask 1 Nothing list))+              , testCase "with term" (assertEqual "0" 0 (L.prevTask 4 (Just "Hello") list))+              , testCase+                    "with term - no match"+                    (assertEqual "4" 4 (L.prevTask 4 (Just "Wombat") list))+              ]+        , testGroup+              "nearest"+              [ testCase "no term" (assertEqual "same task" 2 (L.nearest 2 Nothing list))+              , testCase "term matches" (assertEqual "same task" 2 (L.nearest 2 (Just "ish") list))+              , testCase "term after" (assertEqual "next task" 3 (L.nearest 2 (Just "oons") list))+              , testCase+                    "term before"+                    (assertEqual "previous task" 3 (L.nearest 5 (Just "oons") list))+              , testCase+                    "term both - before closer"+                    (assertEqual "previous task" 0 (L.nearest 2 (Just "Hello") list))+              , testCase+                    "term both - after closer"+                    (assertEqual "next task" 4 (L.nearest 3 (Just "Hello") list))+              , testCase+                    "no matches"+                    (assertEqual "nothing" (-1) (L.nearest 3 (Just "Penguins") list))+              , testCase+                    "nothing to match"+                    (assertEqual "nothing" 3 (L.nearest (-1) (Just "Spoon") list))+              , testCase+                    "nothing with no term"+                    (assertEqual "nothing" 0 (L.nearest (-1) Nothing list))+              , testCase+                    "out of bounds with no term"+                    (assertEqual "nothing" 5 (L.nearest 50 Nothing list))+              , testCase+                    "out of bounds by 1 with no term"+                    (assertEqual "nothing" 5 (L.nearest 6 Nothing list))+              ]+        ]
+ test/Taskell/Data/ListTest.hs view
@@ -0,0 +1,188 @@+module Taskell.Data.ListTest+    ( test_list+    ) where++import ClassyPrelude as CP++import Control.Lens ((.~))++import Test.Tasty+import Test.Tasty.HUnit++import           Taskell.Data.List.Internal as L+import qualified Taskell.Data.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"])+                              , 2))+                         (move 1 1 Nothing populatedList))+              , testCase+                    "down"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])+                              , 0))+                         (move 1 (-1) Nothing populatedList))+              , testCase+                    "up - out of bounds"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Hello", T.new "Fish", T.new "Blah"])+                              , 2))+                         (move 1 10 Nothing populatedList))+              , testCase+                    "down - out of bounds"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Blah", T.new "Hello", T.new "Fish"])+                              , 0))+                         (move 1 (-10) Nothing populatedList))+              , testCase+                    "up - with search"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Blah", T.new "Fish", T.new "Hello"])+                              , 2))+                         (move 0 1 (Just "Fish") populatedList))+              , testCase+                    "down - with search"+                    (assertEqual+                         "List with moved item"+                         (Just+                              ( List+                                    "Populated"+                                    (fromList [T.new "Fish", T.new "Hello", T.new "Blah"])+                              , 0))+                         (move 2 (-1) (Just "Hello") populatedList))+              ]+        , testCase+              "deleteTask"+              (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+                         "Hello and Blah"+                         (List "Populated" (fromList [T.new "Hello", T.new "Blah"]))+                         (searchFor "l" populatedList))+              , testCase+                    "case-insensitive"+                    (assertEqual+                         "Hello"+                         (List "Populated" (fromList [T.new "Hello"]))+                         (searchFor "hello" populatedList))+              , testCase+                    "doesn't exist"+                    (assertEqual+                         "Empty list"+                         (List "Populated" CP.empty)+                         (searchFor "FFF" populatedList))+              ]+        ]
+ test/Taskell/Data/ListsTest.hs view
@@ -0,0 +1,233 @@+module Taskell.Data.ListsTest+    ( test_lists+    ) where++import ClassyPrelude hiding (delete)++import Test.Tasty+import Test.Tasty.HUnit++import Control.Lens ((.~))++import           Taskell.Data.Date           (textToTime)+import qualified Taskell.Data.List           as L+import           Taskell.Data.Lists.Internal+import qualified Taskell.Data.Task           as T+import           Taskell.Types               (ListIndex (ListIndex), TaskIndex (TaskIndex))++-- test data+list1, list2, list3 :: L.List+list1 =+    foldl'+        (flip L.append)+        (L.empty "List 1")+        [T.new "One", (T.due .~ textToTime "2019-08-14") (T.new "Two"), T.new "Three"]++list2 =+    foldl'+        (flip L.append)+        (L.empty "List 2")+        [T.new "1", T.new "2", (T.due .~ textToTime "2018-12-03") (T.new "3")]++list3 =+    foldl'+        (flip L.append)+        (L.empty "List 3")+        [(T.due .~ textToTime "2019-04-05") (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.due .~ textToTime "2018-12-03") (T.new "3")]+                                   , foldl'+                                         (flip L.append)+                                         (L.empty "List 3")+                                         [ (T.due .~ textToTime "2019-04-05") (T.new "01")+                                         , T.new "10"+                                         , T.new "11"+                                         , T.new "2"+                                         ]+                                   ]))+                         (changeList Bottom (ListIndex 1, TaskIndex 1) testLists 1))+              , testCase+                    "left"+                    (assertEqual+                         "Returns updated lists"+                         (Just+                              (fromList+                                   [ foldl'+                                         (flip L.append)+                                         (L.empty "List 1")+                                         [ T.new "One"+                                         , (T.due .~ textToTime "2019-08-14") (T.new "Two")+                                         , T.new "Three"+                                         , T.new "2"+                                         ]+                                   , foldl'+                                         (flip L.append)+                                         (L.empty "List 2")+                                         [T.new "1", (T.due .~ textToTime "2018-12-03") (T.new "3")]+                                   , list3+                                   ]))+                         (changeList Bottom (ListIndex 1, TaskIndex 1) testLists (-1)))+              , testCase+                    "out of bounds list"+                    (assertEqual+                         "Nothing"+                         Nothing+                         (changeList Bottom (ListIndex 5, TaskIndex 1) testLists 1))+              , testCase+                    "out of bounds task"+                    (assertEqual+                         "Nothing"+                         Nothing+                         (changeList Bottom (ListIndex 1, TaskIndex 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.due .~ textToTime "2019-04-05") (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))+        , testCase+              "due"+              (assertEqual+                   "returns just due list"+                   (fromList+                        [ ( (ListIndex 1, TaskIndex 2)+                          , (T.due .~ textToTime "2018-12-03") (T.new "3"))+                        , ( (ListIndex 2, TaskIndex 0)+                          , (T.due .~ textToTime "2019-04-05") (T.new "01"))+                        , ( (ListIndex 0, TaskIndex 1)+                          , (T.due .~ textToTime "2019-08-14") (T.new "Two"))+                        ])+                   (due testLists))+        ]
+ test/Taskell/Data/SeqTest.hs view
@@ -0,0 +1,92 @@+module Taskell.Data.SeqTest+    ( test_seq+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Taskell.Data.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/Taskell/Data/SubtaskTest.hs view
@@ -0,0 +1,42 @@+module Taskell.Data.SubtaskTest+    ( test_subtask+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Taskell.Data.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/Taskell/Data/TaskTest.hs view
@@ -0,0 +1,200 @@+module Taskell.Data.TaskTest+    ( test_task+    ) where++import ClassyPrelude++import Control.Lens ((.~))++import Test.Tasty+import Test.Tasty.HUnit++import Data.Time.Calendar (fromGregorianValid)++import           Taskell.Data.Date          (Due (DueDate))+import qualified Taskell.Data.Subtask       as ST (name, new)+import           Taskell.Data.Task.Internal++desc :: Maybe Text+desc = Just "A very boring description"++testTask :: Task+testTask =+    Task+    { _name = "Test"+    , _description = desc+    , _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"+                              desc+                              (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"+                              desc+                              (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"+                              desc+                              (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"+                              desc+                              (fromList [ST.new "One" True, ST.new "Three" False])+                              Nothing)+                         (removeSubtask 1 testTask))+              , testCase+                    "doesn't exist"+                    (assertEqual+                         "Returns task"+                         (Task+                              "Test"+                              desc+                              (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+                    "case-insensitive"+                    (assertEqual "Find sub-task" True (contains "ONE" testTask))+              , testCase+                    "case-insensitive"+                    (assertEqual "Find sub-task" True (contains "two" testTask))+              , testCase "missing" (assertEqual "Find sub-task" False (contains "Fish" testTask))+              , testCase+                    "description"+                    (assertEqual "Finds in description" True (contains "boring" testTask))+              , testCase+                    "not in description"+                    (assertEqual "Doesn't find" False (contains "escapades" 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 (DueDate <$> (fromGregorianValid 2018 05 18)))))+              ]+        ]
+ test/Taskell/Events/State/HistoryTest.hs view
@@ -0,0 +1,95 @@+module Taskell.Events.State.HistoryTest+    ( test_history+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Taskell.Events.State.History+import Taskell.Events.State.Types++make :: [Integer] -> Integer -> [Integer] -> History Integer+make = History++testHistory :: History Integer+testHistory = make empty 0 empty++-- tests+test_history :: TestTree+test_history =+    testGroup+        "Events.State.History"+        [ testGroup+              "undo"+              [ testCase "empty" (assertEqual "Nothing changes" testHistory (undo testHistory))+              , testCase+                    "one undo"+                    (assertEqual "Goes back" (make empty 0 [1]) (undo $ make [0] 1 empty))+              , testCase+                    "two undo"+                    (assertEqual+                         "Goes back"+                         (make empty 0 [1, 2])+                         (undo . undo $ make [1, 0] 2 empty))+              , testCase+                    "three undo"+                    (assertEqual+                         "Goes back"+                         (make empty 0 [1, 2, 3])+                         (undo . undo . undo $ make [2, 1, 0] 3 empty))+              ]+        , testGroup+              "redo"+              [ testCase "empty" (assertEqual "Nothing changes" testHistory (redo testHistory))+              , testCase+                    "one redo"+                    (assertEqual "Goes forward" (make [0] 1 empty) (redo $ make empty 0 [1]))+              , testCase+                    "two redo"+                    (assertEqual+                         "Goes forward"+                         (make [1, 0] 2 empty)+                         (redo . redo $ make empty 0 [1, 2]))+              , testCase+                    "three redo"+                    (assertEqual+                         "Goes forward"+                         (make [2, 1, 0] 3 empty)+                         (redo . redo . redo $ make empty 0 [1, 2, 3]))+              ]+        , testGroup+              "mix"+              [ testCase+                    "empty"+                    (assertEqual+                         "Nothing changes"+                         testHistory+                         (undo . redo . undo . redo . undo $ testHistory))+              , testCase+                    "redo undo"+                    (assertEqual+                         "Nothing changes"+                         (make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10])+                         (undo . redo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))+              , testCase+                    "undo redo"+                    (assertEqual+                         "Nothing changes"+                         (make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10])+                         (redo . undo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))+              ]+        , testGroup+              "store"+              [ testCase+                    "empty"+                    (assertEqual "Stores current value" (make [0] 0 empty) (store testHistory))+              , testCase+                    "undo store redo"+                    (assertEqual+                         "Clears redo"+                         (make [4, 3, 2, 1, 0] 4 empty)+                         (redo . store . undo $ make [4, 3, 2, 1, 0] 5 [6, 7, 8, 9, 10]))+              ]+        ]
+ test/Taskell/Events/StateTest.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedLists #-}++module Taskell.Events.StateTest+    ( test_state+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Control.Lens ((&), (.~), (^.))++import Data.Time.Clock (secondsToDiffTime)+import Data.Time.Zones (utcTZ)++import qualified Data.Sequence                   as S (lookup)+import qualified Taskell.Data.List               as L (append, empty)+import qualified Taskell.Data.Task               as T (new)+import           Taskell.Events.State+import           Taskell.Events.State.Types+import           Taskell.Events.State.Types.Mode+import           Taskell.Types                   (ListIndex (ListIndex), TaskIndex (TaskIndex))++mockTime :: UTCTime+mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)++testState :: State+testState =+    State+    { _mode = Normal+    , _history = fresh empty+    , _path = "test.md"+    , _io = Nothing+    , _height = 0+    , _searchTerm = Nothing+    , _time = mockTime+    , _timeZone = utcTZ+    }++moveToState :: State+moveToState =+    State+    { _mode = Modal MoveTo+    , _history =+          History+          { _past = empty+          , _present =+                ( (ListIndex 4, TaskIndex 0)+                , [ 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"+                  ])+          , _future = empty+          }+    , _path = "test.md"+    , _io = Nothing+    , _height = 0+    , _searchTerm = Nothing+    , _time = mockTime+    , _timeZone = utcTZ+    }++-- 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/Taskell/IO/GitHub/CardsTest.hs view
@@ -0,0 +1,36 @@+module Taskell.IO.GitHub.CardsTest+    ( test_cards+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.Aeson++import Taskell.IO.HTTP.GitHub.Card (MaybeCard (MaybeCard))++decodeCards :: Text -> Either String [MaybeCard]+decodeCards txt = eitherDecodeStrict $ encodeUtf8 txt++-- tests+test_cards :: TestTree+test_cards =+    testGroup+        "IO.HTTP.GitHub.Card"+        [ testCase+              "parses basic card"+              (assertEqual+                   "Gives back card"+                   (Right [MaybeCard (Just "blah") Nothing])+                   (decodeCards "[{\"note\": \"blah\"}]"))+        , testCase+              "parses basic card"+              (assertEqual+                   "Gives back card"+                   (Right+                        [MaybeCard Nothing (Just "https://api.github.com/projects/columns/7850783")])+                   (decodeCards+                        "[{\"note\": null, \"content_url\": \"https://api.github.com/projects/columns/7850783\"}]"))+        ]
+ test/Taskell/IO/GitHubTest.hs view
@@ -0,0 +1,45 @@+module Taskell.IO.GitHubTest+    ( test_github+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Taskell.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/Taskell/IO/Keyboard/ParserTest.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Taskell.IO.Keyboard.ParserTest+    ( test_parser+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.FileEmbed    (embedFile)+import Text.RawString.QQ (r)++import qualified Taskell.Events.Actions.Types as A+import           Taskell.IO.Keyboard.Parser   (bindings)+import           Taskell.IO.Keyboard.Types++basic :: Text+basic = "quit = q"++basicResult :: Bindings+basicResult = [(BChar 'q', A.Quit)]++basicMulti :: Text+basicMulti =+    [r|+        quit = q+        detail = <Enter>+    |]++basicMultiResult :: Bindings+basicMultiResult = [(BChar 'q', A.Quit), (BKey "Enter", A.Detail)]++ini :: Text+ini = decodeUtf8 $(embedFile "test/Taskell/IO/Keyboard/data/bindings.ini")++iniResult :: Bindings+iniResult =+    [ (BChar 'q', A.Quit)+    , (BChar 'u', A.Undo)+    , (BChar 'r', A.Redo)+    , (BChar '/', A.Search)+    , (BChar '?', A.Help)+    , (BChar '!', A.Due)+    , (BChar 'k', A.Previous)+    , (BChar 'j', A.Next)+    , (BChar 'h', A.Left)+    , (BChar 'l', A.Right)+    , (BChar 'G', A.Bottom)+    , (BChar 'a', A.New)+    , (BChar 'O', A.NewAbove)+    , (BChar 'o', A.NewBelow)+    , (BChar '+', A.Duplicate)+    , (BChar 'e', A.Edit)+    , (BChar 'A', A.Edit)+    , (BChar 'i', A.Edit)+    , (BChar 'C', A.Clear)+    , (BChar 'D', A.Delete)+    , (BKey "Enter", A.Detail)+    , (BChar '@', A.DueDate)+    , (BKey "Backspace", A.ClearDate)+    , (BChar 'K', A.MoveUp)+    , (BChar 'J', A.MoveDown)+    , (BChar 'H', A.MoveLeftBottom)+    , (BChar 'L', A.MoveRightBottom)+    , (BKey "Space", A.Complete)+    , (BChar 'm', A.MoveMenu)+    , (BChar 'N', A.ListNew)+    , (BChar 'E', A.ListEdit)+    , (BChar 'X', A.ListDelete)+    , (BChar '>', A.ListRight)+    , (BChar '<', A.ListLeft)+    ]++comma :: Text+comma = "quit = ,"++commaResult :: Bindings+commaResult = [(BChar ',', A.Quit)]++test_parser :: TestTree+test_parser =+    testGroup+        "IO.Keyboard.Parser"+        [ testCase "basic" (assertEqual "Parses quit" (Right basicResult) (bindings basic))+        , testCase+              "basic multiline"+              (assertEqual "Parses both" (Right basicMultiResult) (bindings basicMulti))+        , testCase "full ini file" (assertEqual "Parses all" (Right iniResult) (bindings ini))+        , testCase "comma" (assertEqual "Parses comma" (Right commaResult) (bindings comma))+        ]
+ test/Taskell/IO/Keyboard/TypesTest.hs view
@@ -0,0 +1,37 @@+module Taskell.IO.Keyboard.TypesTest+    ( test_types+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import qualified Taskell.Events.Actions.Types as A (ActionType (..))+import           Taskell.IO.Keyboard          (addMissing, badMapping, defaultBindings)+import           Taskell.IO.Keyboard.Types    (Binding (..), Bindings)++notFull :: Bindings+notFull = [(BChar 'œ', A.Quit), (BChar 'U', A.Undo)]++notFullResult :: Bindings+notFullResult = notFull <> (drop 2 defaultBindings)++bad :: Bindings+bad = [(BChar 'q', A.Quit), (BChar 'u', A.Nothing), (BChar '>', A.Nothing), (BChar '<', A.ListLeft)]++-- tests+test_types :: TestTree+test_types =+    testGroup+        "Events.Actions.Types"+        [ testCase+              "not missing"+              (assertEqual "Finds no missing items" defaultBindings (addMissing defaultBindings))+        , testCase+              "not missing"+              (assertEqual "Finds missing items" notFullResult (addMissing notFull))+        , testCase+              "bad mapping"+              (assertEqual "Finds bad mapping" (Left "invalid mapping") (badMapping bad))+        ]
+ test/Taskell/IO/Keyboard/data/bindings.ini view
@@ -0,0 +1,43 @@+# general+quit = q+undo = u+redo = r+search = /+help = ?+due = !++# navigation+previous = k+next = j+left = h+right = l+bottom = G++# new tasks+new = a+newAbove = O+newBelow = o+duplicate = +++# editing tasks+edit = e, A, i+clear = C+delete = D+detail = <Enter>+dueDate = @+clearDate = <Backspace>++# moving tasks+moveUp = K+moveDown = J+moveLeft = H+moveRight = L+complete = <Space>+moveMenu = m++# lists+listNew = N+listEdit = E+listDelete = X+listRight = >+listLeft = <
+ test/Taskell/IO/KeyboardTest.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedLists #-}++module Taskell.IO.KeyboardTest+    ( test_keyboard+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Control.Lens ((.~))++import Data.Time.Clock (secondsToDiffTime)+import Data.Time.Zones (utcTZ)++import Graphics.Vty.Input.Events       (Event (..), Key (..))+import Taskell.Data.Lists.Internal     (initial)+import Taskell.Events.Actions.Types    as A+import Taskell.Events.State            (create, quit)+import Taskell.Events.State.Types      (State, Stateful, mode)+import Taskell.Events.State.Types.Mode (Mode (Shutdown))+import Taskell.IO.Keyboard             (generate)+import Taskell.IO.Keyboard.Types++mockTime :: UTCTime+mockTime = UTCTime (ModifiedJulianDay 20) (secondsToDiffTime 0)++tester :: BoundActions -> Event -> Stateful+tester actions ev state = lookup ev actions >>= ($ state)++cleanState :: State+cleanState = create utcTZ mockTime "taskell.md" initial++basicBindings :: Bindings+basicBindings = [(BChar 'q', A.Quit)]++basicActions :: Actions+basicActions = [(A.Quit, quit)]++basicResult :: Maybe State+basicResult = Just $ (mode .~ Shutdown) cleanState++test_keyboard :: TestTree+test_keyboard =+    testGroup+        "IO.Keyboard"+        [ testCase+              "generate"+              (assertEqual+                   "Parses basic"+                   basicResult+                   (tester (generate basicBindings basicActions) (EvKey (KChar 'q') []) cleanState))+        ]
+ test/Taskell/IO/Markdown/ParserTest.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.Markdown.ParserTest+    ( test_parser+    ) where++import ClassyPrelude++import Test.Tasty++import Test.Tasty.HUnit++import Control.Lens   ((&), (.~))+import Data.FileEmbed (embedFile)++import Taskell.Data.Date  (textToTime)+import Taskell.Data.List  (create)+import Taskell.Data.Lists (Lists, analyse, appendToLast, newList)++import qualified Taskell.Data.Subtask       as ST (new)+import           Taskell.Data.Task          (Task, addSubtask, due, new, setDescription)+import           Taskell.IO.Config.Markdown (Config (Config), defaultConfig, descriptionOutput,+                                             dueOutput, localTimes, subtaskOutput, taskOutput,+                                             titleOutput)+import           Taskell.IO.Markdown.Parser (parse)++-- error message+err :: Either Text Lists+err = Left "Could not parse file."++-- complete taskell file+file :: Text+file = decodeUtf8 $(embedFile "test/Taskell/IO/data/roadmap.md")++-- alternative markdown configs+alternativeConfig :: Config+alternativeConfig =+    Config+    { titleOutput = "##"+    , taskOutput = "###"+    , descriptionOutput = ">"+    , dueOutput = "@"+    , subtaskOutput = "-"+    , localTimes = True+    }++-- useful records+task :: Task+task = new "Test Item"++list :: Lists+list = newList "Test" empty++listWithItem :: Lists+listWithItem = appendToLast task list++multiList :: Lists+multiList =+    fromList+        [create "Test" (fromList [new "Test Item"]), create "Test 2" (fromList [new "Test Item 2"])]++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 = task & due .~ textToTime "2018-04-12"++listWithDueDateItem :: Lists+listWithDueDateItem = appendToLast taskWithDueDate list++-- tests+test_parser :: TestTree+test_parser =+    testGroup+        "IO.Markdown"+        [ testGroup+              "Default Format"+              [ testCase+                    "List Title"+                    (assertEqual "One list" (Right list) (parse defaultConfig "## Test"))+              , testCase+                    "List item"+                    (assertEqual+                         "List item"+                         (Right listWithItem)+                         (parse defaultConfig "## Test\n\n- Test Item"))+              , testCase+                    "Multiple Lists"+                    (assertEqual+                         "List item"+                         (Right multiList)+                         (parse defaultConfig "## Test\n\n- Test Item\n\n## Test 2\n\n- Test Item 2"))+              , testCase+                    "Summary"+                    (assertEqual+                         "Summary"+                         (Right listWithSummaryItem)+                         (parse defaultConfig "## Test\n\n- Test Item\n    > Summary"))+              , testCase+                    "List Item with multi-line Summary"+                    (assertEqual+                         "List item with a summary"+                         (Right listWithMultiLineSummaryItem)+                         (parse+                              defaultConfig+                              "## Test\n\n- Test Item\n    > Summary Line 1\n    > Summary Line 2"))+              , testCase+                    "Due Date"+                    (assertEqual+                         "Due Date"+                         (Right listWithDueDateItem)+                         (parse defaultConfig "## Test\n\n- Test Item\n    @ 2018-04-12"))+              , testCase+                    "Sub-Task"+                    (assertEqual+                         "List item with Sub-Task"+                         (Right (makeSubTask "Blah" False))+                         (parse defaultConfig "## Test\n\n- Test Item\n    * [ ] Blah"))+              , testCase+                    "Complete Sub-Task"+                    (assertEqual+                         "List item with Sub-Task"+                         (Right (makeSubTask "Blah" True))+                         (parse defaultConfig "## Test\n\n- Test Item\n    * [x] Blah"))+              ]+        , testGroup+              "Alternative Format"+              [ testCase+                    "List Title"+                    (assertEqual "One list" (Right list) (parse alternativeConfig "## Test"))+              , testCase+                    "List item"+                    (assertEqual+                         "List item"+                         (Right listWithItem)+                         (parse alternativeConfig "## Test\n\n### Test Item"))+              , testCase+                    "Multiple Lists"+                    (assertEqual+                         "List item"+                         (Right multiList)+                         (parse+                              alternativeConfig+                              "## Test\n\n### Test Item\n\n## Test 2\n\n### Test Item 2"))+              , testCase+                    "Summary"+                    (assertEqual+                         "Summary"+                         (Right listWithSummaryItem)+                         (parse alternativeConfig "## Test\n\n### Test Item\n> Summary"))+              , testCase+                    "List Item with multi-line Summary"+                    (assertEqual+                         "List item with a summary"+                         (Right listWithMultiLineSummaryItem)+                         (parse+                              alternativeConfig+                              "## Test\n\n### Test Item\n> Summary Line 1\n> Summary Line 2"))+              , testCase+                    "Due Date"+                    (assertEqual+                         "Due Date"+                         (Right listWithDueDateItem)+                         (parse alternativeConfig "## Test\n\n### Test Item\n@ 2018-04-12"))+              , testCase+                    "Sub-Task"+                    (assertEqual+                         "List item with Sub-Task"+                         (Right (makeSubTask "Blah" False))+                         (parse alternativeConfig "## Test\n\n### Test Item\n- [ ] Blah"))+              , testCase+                    "Complete Sub-Task"+                    (assertEqual+                         "List item with Sub-Task"+                         (Right (makeSubTask "Blah" True))+                         (parse alternativeConfig "## Test\n\n### Test Item\n- [x] Blah"))+              ]+        , testGroup+              "Errors"+              [ testCase "Blank line" (assertEqual "Parse Error" err (parse defaultConfig ""))+              , testCase+                    "Just spaces"+                    (assertEqual "Parse Error" err (parse defaultConfig "        "))+              , testCase+                    "Just whitespace"+                    (assertEqual "Parse Error" err (parse defaultConfig "  \n  \n \t    "))+              , testCase "Error" (assertEqual "Parse Error" err (parse defaultConfig "Test"))+              , testCase+                    "List item without list"+                    (assertEqual "Parse Error" err (parse defaultConfig "- Test Item"))+              , testCase+                    "Sub task without list item"+                    (assertEqual "Parse Error" err (parse defaultConfig "## Test\n    * Blah"))+              ]+        , testCase+              "File"+              (assertEqual+                   "Parses whole file"+                   (Right "test\nLists: 6\nTasks: 202")+                   (analyse "test" <$> parse defaultConfig file))+        ]
+ test/Taskell/IO/Markdown/SerializerTest.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.IO.Markdown.SerializerTest+    ( test_serializer+    ) where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Control.Lens         ((&), (.~))+import Control.Monad.Reader (runReader)+import Data.FileEmbed       (embedFile)++import Data.Time.Zones     (utcTZ)+import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel)++import           Taskell.Data.Date              (textToTime)+import qualified Taskell.Data.List              as L (append, empty)+import           Taskell.Data.Lists             (Lists, appendToLast, newList)+import qualified Taskell.Data.Subtask           as ST (new)+import           Taskell.Data.Task              (Task, addSubtask, due, new, setDescription)+import           Taskell.IO.Config.Markdown     (Config (..), defaultConfig)+import           Taskell.IO.Markdown.Parser     (parse)+import           Taskell.IO.Markdown.Serializer (MarkdownInfo (MarkdownInfo), serialize)++-- complete taskell file+file :: Text+file = decodeUtf8 $(embedFile "test/Taskell/IO/data/roadmap.md")++-- alternative markdown configs+alternativeConfig :: Config+alternativeConfig =+    Config+    { titleOutput = "##"+    , taskOutput = "###"+    , descriptionOutput = ">"+    , dueOutput = "@"+    , subtaskOutput = "-"+    , localTimes = True+    }++-- useful records+task :: Task+task = new "Test Item"++list :: Lists+list = newList "Test" empty++lists :: Lists+lists = fromList [L.append task (L.empty "To Do"), L.append (new "Fish") (L.empty "Done")]++listWithItem :: Lists+listWithItem = appendToLast task list++makeSubTask :: Text -> Bool -> Lists+makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list++makeSubTasks :: [Text] -> Bool -> Lists+makeSubTasks ts b = appendToLast (foldr addSubtask task subtasks) list+  where+    subtasks = flip ST.new b <$> ts++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 = task & due .~ textToTime "2018-04-12"++listWithDueDateItem :: Lists+listWithDueDateItem = appendToLast taskWithDueDate list++taskWithDueTime :: Task+taskWithDueTime = task & due .~ textToTime "2018-04-12 12:00 UTC"++listWithDueTimeItem :: Lists+listWithDueTimeItem = appendToLast taskWithDueTime list++-- reader+defaultReader :: MarkdownInfo+defaultReader = MarkdownInfo utcTZ defaultConfig++alternativeReader :: MarkdownInfo+alternativeReader = MarkdownInfo utcTZ alternativeConfig++-- simplify tests+serialize' :: MarkdownInfo -> Lists -> Text+serialize' md ls = runReader (serialize ls) md++-- tests+test_serializer :: TestTree+test_serializer =+    testGroup+        "IO.Markdown"+        [ testGroup+              "Serialisation"+              [ testGroup+                    "Default Format"+                    [ testCase+                          "Standard lists"+                          (assertEqual+                               "Markdown formatted output"+                               "## To Do\n\n- Test Item\n\n## Done\n\n- Fish\n"+                               (serialize' defaultReader lists))+                    , testCase+                          "Standard list"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n"+                               (serialize' defaultReader listWithItem))+                    , testCase+                          "Standard list with summary"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    > Summary\n"+                               (serialize' defaultReader listWithSummaryItem))+                    , testCase+                          "Standard list with date"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    @ 2018-04-12\n"+                               (serialize' defaultReader listWithDueDateItem))+                    , testCase+                          "Standard list with date - timezone"+                          (assertEqual+                               "Use UTC timezone"+                               "## Test\n\n- Test Item\n    @ 2018-04-12 12:00 UTC\n"+                               (serialize'+                                    (MarkdownInfo (tzByLabel America__New_York) defaultConfig)+                                    listWithDueTimeItem))+                    , testCase+                          "Standard list with sub-task"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    * [x] Blah\n"+                               (serialize' defaultReader (makeSubTask "Blah" True)))+                    , testCase+                          "Standard list with sub-tasks"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n- Test Item\n    * [x] Blah\n    * [x] Cow\n    * [x] Spoon\n"+                               (serialize'+                                    defaultReader+                                    (makeSubTasks ["Spoon", "Cow", "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"+                               (serialize' defaultReader listWithMultiLineSummaryItem))+                    ]+              , testGroup+                    "Alternative Format"+                    [ testCase+                          "Standard list"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n### Test Item\n"+                               (serialize' alternativeReader listWithItem))+                    , testCase+                          "Standard list with sub-task"+                          (assertEqual+                               "Markdown formatted output"+                               "## Test\n\n### Test Item\n- [ ] Blah\n"+                               (serialize' alternativeReader (makeSubTask "Blah" False)))+                    , testCase+                          "Standard list with date - timezone"+                          (assertEqual+                               "Uses local timezone"+                               "## Test\n\n### Test Item\n@ 2018-04-12 08:00 EDT\n"+                               (serialize'+                                    (MarkdownInfo (tzByLabel America__New_York) alternativeConfig)+                                    listWithDueTimeItem))+                    ]+              ]+        , testCase+              "Parse then serialize"+              (assertEqual+                   "Returns same text"+                   (Right file)+                   (serialize' defaultReader <$> parse defaultConfig file))+        ]
+ test/Taskell/IO/TrelloTest.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}++module Taskell.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 Taskell.IO.HTTP.Trello.ChecklistItem (ChecklistItem, checkItems, checklistItemToSubTask)+import Taskell.IO.HTTP.Trello.List          (List, listToList)++json :: Maybe [List]+json = decodeStrict $(embedFile "test/Taskell/IO/data/trello.json")++checklistJson :: Maybe [ChecklistItem]+checklistJson =+    (^. checkItems) <$> decodeStrict $(embedFile "test/Taskell/IO/data/trello-checklists.json")++-- tests+test_trello :: TestTree+test_trello =+    testGroup+        "IO.Trello"+        [ testCase+              "Lists"+              (assertEqual "Parses list JSON" (Just 5) (length . (listToList <$>) <$> json))+        , testCase+              "Checklists"+              (assertEqual+                   "Parses checklist JSON"+                   (Just 5)+                   (length . (checklistItemToSubTask <$>) <$> checklistJson))+        ]
+ test/Taskell/IO/data/trello-checklists.json view
@@ -0,0 +1,35 @@+{+  "id": "5b04450ff88a64205bf04939",+  "checkItems": [+    {+      "state": "incomplete",+      "idChecklist": "5b04450ff88a64205bf04939",+      "id": "5b044511abc222721a03a478",+      "name": "Sub-item 1"+    },+    {+      "state": "incomplete",+      "idChecklist": "5b04450ff88a64205bf04939",+      "id": "5b0445123561ce689e3827b4",+      "name": "Sub-item 2"+    },+    {+      "state": "incomplete",+      "idChecklist": "5b04450ff88a64205bf04939",+      "id": "5b044513fe0a46480d6bcc87",+      "name": "Sub-item 3"+    },+    {+      "state": "incomplete",+      "idChecklist": "5b04450ff88a64205bf04939",+      "id": "5b04451489b89cde3b7a3af1",+      "name": "Sub-item 4"+    },+    {+      "state": "incomplete",+      "idChecklist": "5b04450ff88a64205bf04939",+      "id": "5b044516152060b914e3fa2f",+      "name": "Sub-item 5"+    }+  ]+}
+ test/Taskell/IO/data/trello.json view
@@ -0,0 +1,146 @@+[+  {+    "id": "5b04449b124fd7d02a6700ac",+    "name": "List 1",+    "cards": [+      {+        "id": "5b0444a892cac8a91ce4ac63",+        "name": "Item 1",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444aa28c4fade8972564a",+        "name": "Item 2",+        "desc": "",+        "due": null,+        "idChecklists": [+          "5b04450ff88a64205bf04939",+          "5b0445196d92125a52c5af19",+          "5b044524cd09c4cfcf17a7e1"+        ]+      },+      {+        "id": "5b0444acb5d32e68affe0fbc",+        "name": "Item 3",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444bba2b49880d3cf5ef4",+        "name": "Item 4",+        "desc": "",+        "due": null,+        "idChecklists": []+      }+    ]+  },+  {+    "id": "5b04449c4a149b7886795834",+    "name": "List 2",+    "cards": [+      {+        "id": "5b0444be54ac75e4315f8c75",+        "name": "Item 1",+        "desc": "",+        "due": null,+        "idChecklists": [+          "5b0444def123ada312ce7b61"+        ]+      },+      {+        "id": "5b0444bfcf2ae87de87efff6",+        "name": "Item 2",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444c05b48f5803fb6fbe6",+        "name": "Item 3",+        "desc": "",+        "due": null,+        "idChecklists": []+      }+    ]+  },+  {+    "id": "5b04449e55eeab1a57d78284",+    "name": "List 3",+    "cards": [+      {+        "id": "5b0444c56eb336a91504b5e4",+        "name": "Item 1",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444c60af8bc226f9efcd9",+        "name": "Item 2",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444c875057fa8ab6e516c",+        "name": "Item 3",+        "desc": "",+        "due": null,+        "idChecklists": [+          "5b0444f2ac1dcba5f3803f70",+          "5b0444fcaafc8fd6f5a49071"+        ]+      },+      {+        "id": "5b0444ca8650ff18224ea71d",+        "name": "Item 4",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444cc368a78a8bded6c90",+        "name": "Item 5",+        "desc": "",+        "due": null,+        "idChecklists": []+      }+    ]+  },+  {+    "id": "5b0444a16c17cd686e07b76c",+    "name": "List 4",+    "cards": [+      {+        "id": "5b0444d02e30881629179287",+        "name": "Item 1",+        "desc": "",+        "due": null,+        "idChecklists": []+      }+    ]+  },+  {+    "id": "5b0444a4a3565ea909f506ee",+    "name": "List 5",+    "cards": [+      {+        "id": "5b0444d34f5a66ec48672bdb",+        "name": "Item 1",+        "desc": "",+        "due": null,+        "idChecklists": []+      },+      {+        "id": "5b0444d522f50607e73595b1",+        "name": "Item 2",+        "desc": "",+        "due": null,+        "idChecklists": []+      }+    ]+  }+]
+ test/Taskell/UI/FieldTest.hs view
@@ -0,0 +1,171 @@+module Taskell.UI.FieldTest+    ( test_field+    ) where++import ClassyPrelude++import Taskell.UI.Draw.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.Draw.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+                    "Triple line"+                    (assertEqual+                         "Should wrap to correct position"+                         (11, 2)+                         (cursorPosition'+                              "Artichoke penguin astronaut wombat artichoke penguin astronaut wombat"+                              64))+              , testCase+                    "Long words with space"+                    (assertEqual+                         "Should ignore the space when counting"+                         (16, 1)+                         (cursorPosition' "Blah fish wombat monkey sponge catpult arsonist" 47))+              , testCase+                    "Multibyte string single line"+                    (assertEqual "Should move in twos" (4, 0) (cursorPosition' "乤乭亍乫" 2))+              , testCase+                    "Multibyte string multi-line"+                    (assertEqual+                         "Should move in twos"+                         (4, 1)+                         (cursorPosition' "乤乭亍乫 乤乭亍乫 乤乭亍乫 乤乭亍乫" 17))+              ]+        ]
− test/UI/FieldTest.hs 
@@ -1,174 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}--module UI.FieldTest-    ( test_field-    ) where--import ClassyPrelude--import UI.Draw.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.Draw.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-                    "Triple line"-                    (assertEqual-                         "Should wrap to correct position"-                         (11, 2)-                         (cursorPosition'-                              "Artichoke penguin astronaut wombat artichoke penguin astronaut wombat"-                              64))-              , testCase-                    "Long words with space"-                    (assertEqual-                         "Should ignore the space when counting"-                         (16, 1)-                         (cursorPosition' "Blah fish wombat monkey sponge catpult arsonist" 47))-              , testCase-                    "Multibyte string single line"-                    (assertEqual "Should move in twos" (4, 0) (cursorPosition' "乤乭亍乫" 2))-              , testCase-                    "Multibyte string multi-line"-                    (assertEqual-                         "Should move in twos"-                         (4, 1)-                         (cursorPosition' "乤乭亍乫 乤乭亍乫 乤乭亍乫 乤乭亍乫" 17))-              ]-        ]