Haskell Todo list CLI

taskmanager.hs

import           Data.List
import           Prelude          hiding (id, pure)
import           System.Directory
import           System.Exit
import           System.IO
import           System.IO.Error
import           System.Process
import           Text.Read

data Route
  = All
  | Active
  | Completed
  deriving (Show, Read)

data Action
  = Usage
  | Add String
  | Toggle Int
  | Edit Int
         String
  | Delete Int
  | View Route
  | Quit
  deriving (Show, Read)

data Task = Task
  { text      :: String
  , id        :: Int
  , completed :: Bool
  } deriving (Show, Read)

data State = State
  { route :: Route
  , uid   :: Int
  , tasks :: [Task]
  } deriving (Show, Read)

type Effect = IO ()

emptyState :: State
emptyState = State {uid = 0, route = All, tasks = []}

main = do
  homeDirectory <- getHomeDirectory
  let filePath = homeDirectory ++ "/.taskmanagerState.hs" in do
    maybeSerializedState <- readFileMaybe filePath
    case maybeSerializedState of
      Nothing -> do
        repl filePath (putStrLn $ "Failed to load \"" ++ filePath ++ "\". Will create file after first action.") emptyState
      Just serializedState ->
        case (readMaybe serializedState) of
          Just state -> repl filePath noOp state
          Nothing -> do
            repl filePath (putStrLn $ "Failed to parse state at \"" ++ filePath ++ "\". Corrupted file?") emptyState




readFileMaybe :: FilePath -> IO (Maybe String)
readFileMaybe filePath =
    tryIOError (readFile filePath) >>= handler
        where handler (Right contents) = return (Just contents)
              handler (Left _)         = return Nothing

repl :: FilePath -> Effect -> State -> Effect
repl filePath effect state = do
  system "clear"
  effect
  putStrLn $ "Using: " ++ filePath
  putStrLn $ view state
  putStr "Enter an action: "
  line <- getLine
  case (readMaybe line) of
    Just action ->
      let (updated, effect) = update action state
      in do writeFile filePath (show updated)
            repl filePath effect updated
    Nothing -> do
      repl filePath (putStrLn $ "Unrecognized action: " ++ line ++ "\n" ++ usage) state

usage =
  unlines
    [ "Usage:"
    , "\tAdd \"Learn Haskell\" (double quotes necessary)"
    , "\tToggle 0 (mark as complete / incomplete)"
    , "\tEdit 0 \"Updated task name\" (double quotes necessary)"
    , "\tDelete 0"
    , "\tView All / Active / Completed"
    , "\tQuit"
    ]

view :: State -> String
view state
  | length (tasks state) == 0 = "No tasks!\n" ++ usage
  | otherwise =
    let filtered = (filterState state)
    in (show (route filtered) ++ " tasks") ++
       "\n" ++ (intercalate "\n" $ map viewTask $ tasks filtered)

viewTask :: Task -> String
viewTask task =
  (show $ id task) ++
  " " ++
  (text task) ++
  (if (completed task)
     then " ✔"
     else "")

filterState :: State -> State
filterState state =
  case (route state) of
    All       -> state
    Active    -> state {tasks = filter (not . completed) (tasks state)}
    Completed -> state {tasks = filter completed (tasks state)}

update :: Action -> State -> (State, Effect)
update action state =
  case action of
    Add text -> pure $ add text state
    Toggle id' -> pure state {tasks = updateId id' toggle (tasks state)}
    Edit id' text -> pure state {tasks = updateId id' (edit text) (tasks state)}
    Delete id' -> pure state {tasks = deleteId id' (tasks state)}
    View All -> pure state {route = All}
    View Active -> pure state {route = Active}
    View Completed -> pure state {route = Completed}
    Usage -> (state, putStrLn usage)
    Quit -> (state, exitSuccess)

noOp :: IO ()
noOp = return ()

pure :: State -> (State, Effect)
pure state = (state, noOp)

add :: String -> State -> State
add text state =
  state
  { uid = (uid state) + 1
  , tasks =
      (tasks state) ++ [Task {text = text, completed = False, id = (uid state)}]
  }

edit :: String -> Task -> Task
edit text task = task {text = text}

toggle :: Task -> Task
toggle task = task {completed = (not $ completed task)}

updateId :: Int -> (Task -> Task) -> [Task] -> [Task]
updateId id' update tasks = map updateIfTarget tasks
  where
    updateIfTarget task
      | (id task) == id' = update task
      | otherwise = task

deleteId :: Int -> [Task] -> [Task]
deleteId id' tasks = filter ((/= id') . id) tasks