first attempt at multiple lists

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 ()

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)]

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) 

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)

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
 

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,65 +36,52 @@ 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
 
 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,46 +92,25 @@ 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
     where c = countCurrent s - 1
           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

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)

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

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