Haskell command line todo list

Question

I've implemented a command line todo list in Haskell. I've run hlint and build with -Wall, but is there anything else I can improve?

module Main where

import Control.Applicative ((<$>))
import Prelude.Unicode
import System.IO (IOMode(ReadMode, WriteMode), utf8, hClose, hGetContents, hPutStr, hSetEncoding, openFile)
import System.IO.Error (tryIOError)
import Text.Read (readMaybe)

type TodoList = [String]

options :: [(Char, String, Maybe (TodoList -> IO TodoList))]
options =
    [ ('c', "create new item", Just createItem)
    , ('d', "delete item", Just deleteItem)
    , ('x', "delete everything", Just . const $ return [])
    , ('l', "load file", Just loadFile)
    , ('s', "save to file", Just saveToFile)
    , ('q', "quit", Nothing)
    ]

main :: IO ()
main = do
    putStrLn "TODO-LIST\n"
    _ <- loop []
    return ()

loop :: TodoList -> IO TodoList
loop todos = do
    putStrLn "----------------------------"
    putStrLn "You have to do these things:"
    putStrLn ∘ unlines $ zipWith (\i e -> show i ++ ": " ++ show e) ([0..] :: [Integer]) todos
    input <- askForInput
    case filter (\(c, _, _) -> c == input) options of
        [(_, _, action)] -> case action of
            Nothing   -> return todos
            Just func -> func todos >>= loop
        _                -> putStrLn "action not found" >> loop todos

askForInput :: IO Char
askForInput = do
    putStrLn "Select an action"
    putStrLn ∘ unlines $ map (\(char, desc, _) -> char : ") " ++ desc) options
    line <- getLine
    case line of
        [c] -> return c
        _   -> askForInput

createItem :: TodoList -> IO TodoList
createItem todos = do
    putStrLn "enter a description of the new item:"
    (: todos) <$> getLine

deleteItem :: TodoList -> IO TodoList
deleteItem todos = do
    putStrLn "enter the number of the item you want to delete"
    line <- getLine
    case readMaybe line of
        Nothing -> deleteItem todos
        Just n  -> case removeAt n todos of
            Nothing  -> deleteItem todos
            Just val -> return val
    where
        removeAt :: Int -> [a] -> Maybe [a]
        removeAt n _ | n < 0 = Nothing
        removeAt _ []        = Nothing
        removeAt 0 (_:xs)    = Just xs
        removeAt n (x:xs)    = (x :) <$> removeAt (n-1) xs

loadFile :: TodoList -> IO TodoList
loadFile todos = do
    putStrLn "enter the file you want to load"
    line <- getLine
    eitherExOrFile <- tryIOError $ openFile line ReadMode
    case eitherExOrFile of
        Left _     -> loadFile todos
        Right file -> do
            hSetEncoding file utf8
            eitherExOrContents <- tryIOError $ hGetContents file
            case eitherExOrContents of
                Left _        -> loadFile todos
                Right content -> return (todos ++ lines content)

saveToFile :: TodoList -> IO TodoList
saveToFile todos = do
    putStrLn "enter the filename to save your todolist. The file will be overwritten."
    line <- getLine
    eitherExOrFile <- tryIOError $ openFile line WriteMode
    case eitherExOrFile of
        Left _     -> saveToFile todos
        Right file -> do
            hSetEncoding file utf8
            result <- tryIOError . hPutStr file $ unlines todos
            case result of
                Left _  -> putStrLn "couldn't write to file"
                Right _ -> hClose file
            return todos

I'm a little bit worried about the code duplication in readFile / saveToFile and the nested case of.

Answer 1

The general idea is to use library code, particularly to eliminate explicit recursion, and inline things used only once.

MaybeT abstracts computations that can fail and abort at some point, and allows you to bind into pattern matches that fail the computation if they don't match.

desperately abstracts retrying them until they work, using MaybeTs Alternative instance.

StateT abstracts computations that carry around a piece of state to read and write to.

forever defeats the need for loop to manually loop.

Contrary to that comment, abstraction is kinda Haskell's thing.

import System.Exit (exitSuccess)
import Control.Monad.State
import Control.Monad.Trans.Maybe
import Safe (fromJustNote)

type TodoList = [String]

main :: IO ()
main = do
    putStrLn "TODO-LIST\n"
    (`evalStateT` []) $ forever $ do
        say "----------------------------"
        say "You have to do these things:"
        say ∘ unlines ∘ zipWith (\i e -> show i ++ ": " ++ show e) ([0..] :: [Integer]) =<< get
        input <- desperately $ do
            say "Select an action"
            say ∘ unlines $ map (\(char, desc, _) -> char : ") " ++ desc) options
            [c] <- hear
            return c
        case find (\(c, _, _) -> c == input) options of
            Just (_, _, action) -> action
            _ -> say "action not found"

desperately :: Monad m => MaybeT m a -> m a
desperately = fmap (fromJustNote "desperately") . runMaybeT . asum . repeat

say = liftIO . putStrLn
hear = liftIO getLine

To bring main's last lines closer in method with the rest of your code, you could do Just (_, _, action) <- find (\(c, _, _) -> c == input) options and put another desperately to the right of forever. (Or runMaybeT, because the forever repeats everything anyway, but that's kinda incidental.)

When you implement a transformation of a simple partial algorithm into a safe one, chances are safe's already got something, here splitAtExactMay.

(,,) in its prefix form allows me to not close each option with a multi-line closing bracket, and shuddup indentation blocks split code into units just as well as names do, and then you don't need to choose names for everything. Each option even already lists a description of what it does!

import Safe.Exact (splitAtExactMay) -- goes at the top of the file, but relevant here

options :: [(Char, String, StateT TodoList IO ())]
options =
    [ (,,) 'c' "create new item" $ do
        say "enter a description of the new item:"
        hear >>= modify . (:)
    , (,,) 'd' "delete item" $ desperately $ do
        say "enter the number of the item you want to delete"
        Just n <- readMaybe <$> hear
        Just (before, _ : after) <- gets $ splitAtExactMay n
        put $ before ++ after
    , (,,) 'x' "delete everything" $ put []
    , (,,) 'l' "load file" $ desperately $ do
        say "enter the file you want to load"
        line <- hear
        Right file <- liftIO $ tryIOError $ openFile line ReadMode
        liftIO $ hSetEncoding file utf8
        Right content <- liftIO $ tryIOError $ hGetContents file
        modify (++ lines content)
    , (,,) 's' "save to file" $ desperately $ do
        say "enter the filename to save your todolist. The file will be overwritten."
        line <- hear
        Right file <- liftIO $ tryIOError $ openFile line WriteMode
        liftIO $ hSetEncoding file utf8
        result <- liftIO . tryIOError . hPutStr file . unlines =<< get
        case result of
            Left _  -> say "couldn't write to file"
            Right _ -> liftIO $ hClose file
    , (,,) 'q' "quit" exitSuccess
    ]