From 292b6b0a20869c0e3a97ccee024b17316e459ce7 Mon Sep 17 00:00:00 2001 From: Mark Wales Date: Wed, 22 Nov 2017 14:23:26 +0000 Subject: [PATCH] first attempt at multiple lists --- app/Main.hs | 4 +- src/Data/Taskell/AllTasks.hs | 9 +++ src/Data/Taskell/Task.hs | 52 +---------------- src/Data/Taskell/Tasks.hs | 37 ++++++++++++ src/Flow/Actions.hs | 3 - src/Flow/State.hs | 110 +++++++++++++---------------------- src/Persistence/Taskell.hs | 13 +++-- src/UI/List.hs | 2 +- src/UI/Main.hs | 13 +++-- src/UI/Task.hs | 8 +-- taskell.cabal | 4 +- taskell.json | 62 +++++++++++--------- 12 files changed, 146 insertions(+), 171 deletions(-) create mode 100644 src/Data/Taskell/AllTasks.hs create mode 100644 src/Data/Taskell/Tasks.hs diff --git a/app/Main.hs b/app/Main.hs index 125e3007..bf21ca21 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,7 @@ module Main where import Render (render) -import Flow.State (initial, setTasks) +import Flow.State (create, setTasks) import Persistence.Taskell (exists, readJSON) import Data.Bool @@ -11,7 +11,7 @@ quitIfFalseOtherwise = bool $ return () -- read JSON then render start :: IO () -start = readJSON >>= render . setTasks initial +start = readJSON >>= render . create -- if taskell.json exists/created then start main :: IO () diff --git a/src/Data/Taskell/AllTasks.hs b/src/Data/Taskell/AllTasks.hs new file mode 100644 index 00000000..9500bcfc --- /dev/null +++ b/src/Data/Taskell/AllTasks.hs @@ -0,0 +1,9 @@ +module Data.Taskell.AllTasks where + +import Data.Map.Strict (Map, fromList) +import Data.Taskell.Tasks (Tasks, empty) + +type AllTasks = Map String Tasks + +initial :: AllTasks +initial = fromList [("To Do", empty), ("Done", empty)] diff --git a/src/Data/Taskell/Task.hs b/src/Data/Taskell/Task.hs index 4ba1f158..37801e21 100644 --- a/src/Data/Taskell/Task.hs +++ b/src/Data/Taskell/Task.hs @@ -3,24 +3,17 @@ module Data.Taskell.Task where import GHC.Generics (Generic) -import Data.Maybe (fromMaybe) import Data.Aeson (FromJSON, ToJSON) -import Prelude hiding (splitAt, drop) -import Data.Sequence (Seq, (><), (|>), (!?), fromList, insertAt, deleteAt, splitAt, drop) -data Task = Task { - description :: String, - completed :: Bool +newtype Task = Task { + description :: String } deriving (Generic, Show, Eq) instance ToJSON Task instance FromJSON Task blank :: Task -blank = Task { description = "", completed = False } - -swap :: Task -> Task -swap t = t { completed = not (completed t) } +blank = Task { description = "" } append :: Char -> Task -> Task append c t = t { description = description t ++ [c] } @@ -29,42 +22,3 @@ backspace :: Task -> Task backspace t = t { description = d' } where d = description t d' = if not (null d) then init d else d - --- a list of tasks -type Tasks = Seq Task - -empty :: Tasks -empty = fromList [] - -extract :: Int -> Tasks -> Maybe (Tasks, Task) -extract i ts = do - c <- ts !? i - let a = deleteAt i ts - return (a, c) - -update' :: Int -> (Task -> Task) -> Tasks -> Maybe Tasks -update' i fn ts = do - let (a, b) = splitAt i ts - current <- b !? 0 - let b' = drop 1 b - return ((a |> fn current) >< b') - -update :: Int -> (Task -> Task) -> Tasks -> Tasks -update i fn ts = fromMaybe ts (update' i fn ts) - -move' :: Int -> Int -> Tasks -> Maybe Tasks -move' from dir ts = do - current <- ts !? from - let r = deleteAt from ts - return (insertAt (from + dir) current r) - -move :: Int -> Int -> Tasks -> Tasks -move from dir ts = fromMaybe ts (move' from dir ts) - -reduce :: (Tasks, Tasks) -> Task -> (Tasks, Tasks) -reduce (todo, done) t - | completed t = (todo, done |> t) - | otherwise = (todo |> t, done) - -split :: Tasks -> (Tasks, Tasks) -split = foldl reduce (empty, empty) diff --git a/src/Data/Taskell/Tasks.hs b/src/Data/Taskell/Tasks.hs new file mode 100644 index 00000000..cfbef587 --- /dev/null +++ b/src/Data/Taskell/Tasks.hs @@ -0,0 +1,37 @@ +module Data.Taskell.Tasks where + +import Data.Maybe (fromMaybe) +import Prelude hiding (splitAt, drop) +import Data.Sequence (Seq, (><), (|>), (!?), fromList, insertAt, deleteAt, splitAt, drop) + +import Data.Taskell.Task (Task) + +type Tasks = Seq Task + +empty :: Tasks +empty = fromList [] + +extract :: Int -> Tasks -> Maybe (Tasks, Task) +extract i ts = do + c <- ts !? i + let a = deleteAt i ts + return (a, c) + +update' :: Int -> (Task -> Task) -> Tasks -> Maybe Tasks +update' i fn ts = do + let (a, b) = splitAt i ts + current <- b !? 0 + let b' = drop 1 b + return ((a |> fn current) >< b') + +update :: Int -> (Task -> Task) -> Tasks -> Tasks +update i fn ts = fromMaybe ts (update' i fn ts) + +move' :: Int -> Int -> Tasks -> Maybe Tasks +move' from dir ts = do + current <- ts !? from + let r = deleteAt from ts + return (insertAt (from + dir) current r) + +move :: Int -> Int -> Tasks -> Tasks +move from dir ts = fromMaybe ts (move' from dir ts) diff --git a/src/Flow/Actions.hs b/src/Flow/Actions.hs index cecedc04..d21e0ae2 100644 --- a/src/Flow/Actions.hs +++ b/src/Flow/Actions.hs @@ -26,9 +26,6 @@ event' (EvKey (KChar 'J') _) = down -- removing items event' (EvKey (KChar 'D') _) = delete --- toggle -event' (EvKey (KChar ' ') _) = toggleCompleted - -- fallback event' _ = id diff --git a/src/Flow/State.hs b/src/Flow/State.hs index ff16f8a5..3dccbf61 100644 --- a/src/Flow/State.hs +++ b/src/Flow/State.hs @@ -1,24 +1,28 @@ module Flow.State where -import Data.Taskell.Task import Data.Maybe (fromMaybe) import Data.Sequence ((><), (|>), deleteAt) +import Data.Map.Strict ((!), (!?), insert, keys) + +import Data.Taskell.Task +import Data.Taskell.Tasks +import Data.Taskell.AllTasks -data CurrentList = ToDo | Done deriving (Show, Eq) -data Mode = Command | Insert | Shutdown deriving (Show); +data Mode = Command | Insert | Shutdown deriving (Show) data State = State { mode :: Mode, - tasks :: (Tasks, Tasks), -- the todo and done tasks - current :: (CurrentList, Int) -- the list and index + tasks :: AllTasks, + current :: (String, Int) } deriving (Show) -initial :: State -initial = State { +create :: AllTasks -> State +create ts = State { mode = Command, - tasks = (empty, empty), - current = (ToDo, 0) + tasks = ts, + current = (k, 0) } + where k = head $ keys ts -- app state quit :: State -> State @@ -32,15 +36,7 @@ finishInsert :: State -> State finishInsert s = s { mode = Command } newItem :: State -> State -newItem s = setToDo indexed (getToDo indexed |> blank) - where listed = setList s ToDo - indexed = setIndex listed (count ToDo listed) - -change :: (Task -> Task) -> State -> State -change fn s = case getList s of - ToDo -> setToDo s $ update' $ getToDo s - Done -> setDone s $ update' $ getDone s - where update' = update (getIndex s) fn +newItem s = setList s (getList s |> blank) insertBS :: State -> State insertBS = change backspace @@ -48,49 +44,44 @@ insertBS = change backspace insertCurrent :: Char -> State -> State insertCurrent = change . append +change :: (Task -> Task) -> State -> State +change fn s = setList s $ update (getIndex s) fn $ getList s + -- moving up :: State -> State -up s = previous $ case getList s of - ToDo -> setToDo s (m (getToDo s)) - Done -> setDone s (m (getDone s)) +up s = previous $ setList s (m (getList s)) where m = move (getIndex s) (-1) down :: State -> State -down s = next $ case getList s of - ToDo -> setToDo s (m (getToDo s)) - Done -> setDone s (m (getDone s)) +down s = next $ setList s (m (getList s)) where m = move (getIndex s) 1 -- removing delete :: State -> State -delete s = case getList s of - ToDo -> setToDo s (deleteAt (getIndex s) (getToDo s)) - Done -> setDone s (deleteAt (getIndex s) (getDone s)) +delete s = setList s (deleteAt (getIndex s) (getList s)) -- list and index -count :: CurrentList -> State -> Int -count ToDo = length . getToDo -count Done = length . getDone +count :: String -> State -> Int +count k s = case getTasks s !? k of + Just ts -> length ts + Nothing -> 0 countCurrent :: State -> Int -countCurrent s = count (getList s) s +countCurrent s = count (getCurrentList s) s setIndex :: State -> Int -> State -setIndex s i = s { current = (getList s, i) } +setIndex s i = s { current = (getCurrentList s, i) } -setList :: State -> CurrentList -> State -setList s l = s { current = (l, getIndex s) } +setCurrentList :: State -> String -> State +setCurrentList s l = s { current = (l, getIndex s) } getIndex :: State -> Int getIndex = snd . current -getList :: State -> CurrentList -getList = fst . current - next :: State -> State next s = setIndex s i' where - list = getList s + list = getCurrentList s i = getIndex s c = count list s i' = if i < (c - 1) then succ i else i @@ -101,9 +92,7 @@ previous s = setIndex s i' i' = if i > 0 then pred i else 0 switch :: State -> State -switch s = fixIndex $ case getList s of - ToDo -> setList s Done - Done -> setList s ToDo +switch = id fixIndex :: State -> State fixIndex s = if getIndex s > c then setIndex s c' else s @@ -111,36 +100,17 @@ fixIndex s = if getIndex s > c then setIndex s c' else s c' = if c < 0 then 0 else c -- tasks -getDone :: State -> Tasks -getDone = snd . tasks - -getToDo :: State -> Tasks -getToDo = fst . tasks - -setDone :: State -> Tasks -> State -setDone s ts = s { tasks = (getToDo s, ts) } - -setToDo :: State -> Tasks -> State -setToDo s ts = s { tasks = (ts, getDone s) } - -setTasks :: State -> Tasks -> State -setTasks s ts = s { tasks = split ts } +getCurrentList :: State -> String +getCurrentList = fst . current -getTasks :: State -> Tasks -getTasks s = uncurry (><) (tasks s) +getList :: State -> Tasks +getList s = tasks s ! getCurrentList s -- not safe --- completed -toggle :: (State -> Tasks, State -> Tasks) -> (State -> Tasks -> State, State -> Tasks -> State) -> State -> Maybe State -toggle (fromGet, toGet) (fromSet, toSet) s = do - (removed, current) <- extract (getIndex s) (fromGet s) - let updated = toSet s (toGet s |> swap current) - let final = fromSet updated removed - return $ fixIndex final +setList :: State -> Tasks -> State +setList s ts = setTasks s $ insert (getCurrentList s) ts (tasks s) -toggleCompleted' :: State -> Maybe State -toggleCompleted' s = case getList s of - ToDo -> toggle (getToDo, getDone) (setToDo, setDone) s - Done -> toggle (getDone, getToDo) (setDone, setToDo) s +setTasks :: State -> AllTasks -> State +setTasks s ts = s { tasks = ts } -toggleCompleted :: State -> State -toggleCompleted s = fromMaybe s (toggleCompleted' s) +getTasks :: State -> AllTasks +getTasks = tasks diff --git a/src/Persistence/Taskell.hs b/src/Persistence/Taskell.hs index 0cf09b15..70b36a15 100644 --- a/src/Persistence/Taskell.hs +++ b/src/Persistence/Taskell.hs @@ -4,10 +4,11 @@ import System.Directory import Data.Aeson import Data.Aeson.Encode.Pretty import Data.Maybe (fromMaybe) +import Data.Map.Strict (empty) import qualified Data.ByteString.Lazy as BS import UI.CLI (promptYN) -import Data.Taskell.Task (Tasks, empty) +import Data.Taskell.AllTasks (AllTasks, initial) path :: FilePath path = "taskell.json" @@ -25,16 +26,16 @@ promptCreate False = do -- creates taskell file createPath :: IO () -createPath = writeFile path "[]" +createPath = writeJSON initial -- writes Tasks to json file -writeJSON :: Tasks -> IO () +writeJSON :: AllTasks -> IO () writeJSON tasks = BS.writeFile "taskell.json" $ encodePretty tasks -- reads json file -readJSON :: IO Tasks +readJSON :: IO AllTasks readJSON = jsonToTasks <$> BS.readFile path -- returns tasks or an empty list -jsonToTasks :: BS.ByteString -> Tasks -jsonToTasks s = fromMaybe empty (decode s :: Maybe Tasks) +jsonToTasks :: BS.ByteString -> AllTasks +jsonToTasks s = fromMaybe initial (decode s :: Maybe AllTasks) diff --git a/src/UI/List.hs b/src/UI/List.hs index 1bc06752..48bd0927 100644 --- a/src/UI/List.hs +++ b/src/UI/List.hs @@ -5,7 +5,7 @@ import Data.Foldable (toList) import Graphics.Vty import UI.Task (present) -import Data.Taskell.Task (Tasks) +import Data.Taskell.Tasks (Tasks) attrTitle :: Attr attrTitle = defAttr `withForeColor` green diff --git a/src/UI/Main.hs b/src/UI/Main.hs index e8bf22b6..ab9a0e16 100644 --- a/src/UI/Main.hs +++ b/src/UI/Main.hs @@ -1,7 +1,8 @@ module UI.Main where import Graphics.Vty -import Flow.State +import Flow.State (State, tasks, getIndex, getCurrentList) +import Data.Map.Strict (mapWithKey, elems) import UI.List (list) attrTitle :: Attr @@ -19,8 +20,8 @@ title = marginBottom $ string attrTitle "[Taskell]" -- draws the screen pic :: State -> Picture -pic s = picForImage $ title <-> todo <|> marginLeft done - where - i = getIndex s - todo = list "To Do" (getList s == ToDo) i (getToDo s) - done = list "Done" (getList s == Done) i (getDone s) +pic s = picForImage $ title <-> foldr1 (<|>) (elems lists) + where ts = tasks s + i = getIndex s + l = getCurrentList s + lists = mapWithKey (\k t -> list k (l == k) i t) ts diff --git a/src/UI/Task.hs b/src/UI/Task.hs index 3868cb72..d2a280bf 100644 --- a/src/UI/Task.hs +++ b/src/UI/Task.hs @@ -7,16 +7,12 @@ import Data.Taskell.Task attrTask :: Attr attrTask = defAttr `withForeColor` magenta -attrDone :: Attr -attrDone = defAttr `withStyle` dim - attrCurrent :: Attr attrCurrent = defAttr `withForeColor` blue -- style a task present :: Bool -> Int -> Int -> Task -> Image -present current index i t = string style' ("• " ++ s) +present current index i t = string style ("• " ++ s) where s = description t - style = if completed t then attrDone else attrTask - style' = if current && index == i then attrCurrent else style + style = if current && index == i then attrCurrent else attrTask diff --git a/taskell.cabal b/taskell.cabal index 0c2b1105..89c5a560 100644 --- a/taskell.cabal +++ b/taskell.cabal @@ -15,9 +15,9 @@ cabal-version: >=1.10 library hs-source-dirs: src - , src/UI - , src/Data exposed-modules: Data.Taskell.Task + , Data.Taskell.Tasks + , Data.Taskell.AllTasks , Flow.Actions , Flow.State , Persistence.Taskell diff --git a/taskell.json b/taskell.json index fb6d155c..37ba9b88 100644 --- a/taskell.json +++ b/taskell.json @@ -1,70 +1,80 @@ { - "To Do": [ + "Done": [ { - "description": "Create new list with `l`" + "description": "`a` to add" }, { - "description": "Move between lists with `0-9`" + "description": "`e` to edit" }, { - "description": "Move between lists with `m`" + "description": "`Space` to mark complete" }, { - "description": "Cursor support" + "description": "`j`/`k`/`up`/`down` to move up/down list" }, { - "description": "Better layout (maybe use brick?)" + "description": "`h`/`l`/`Left`/`Right` to move between lists" }, { - "description": "Scrolling long lists" + "description": "`q` to quit" }, { - "description": "Add tags/labels" + "description": "Create taskell.json if doesn't exist" }, { - "description": "Filter by tag/label" + "description": "Move items up/down" }, { - "description": "Undo with `u`" - }, + "description": "Delete with `D`" + } + ], + "Bugs": [ { - "description": "Run with any correctly formatted json file" + "description": "Order of lists is wrong" }, { - "description": "`o` to open a file" + "description": "Can't switch lists" }, { - "description": "Wrap lines" + "description": "No padding on lists" } ], - - "Done": [ + "To Do": [ { - "description": "`a` to add" + "description": "Create new list with `l`" }, { - "description": "`e` to edit" + "description": "Move between lists with `0-9`" }, { - "description": "`Space` to mark complete" + "description": "Move between lists with `m`" }, { - "description": "`j`/`k`/`up`/`down` to move up/down list" + "description": "Cursor support" }, { - "description": "`h`/`l`/`Left`/`Right` to move between lists" + "description": "Better layout (maybe use brick?)" }, { - "description": "`q` to quit" + "description": "Scrolling long lists" }, { - "description": "Create taskell.json if doesn't exist" + "description": "Add tags/labels" }, { - "description": "Move items up/down" + "description": "Filter by tag/label" }, { - "description": "Delete with `D`" + "description": "Undo with `u`" + }, + { + "description": "Run with any correctly formatted json file" + }, + { + "description": "`o` to open a file" + }, + { + "description": "Wrap lines" } ] -} +} \ No newline at end of file