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.

• πάντα ῥεῖ: I can't really spot code duplication there, there seems to be no refactorable boiler plate code.
• corvus_192: @πάνταῥεῖ They have a similar structure, but use different functions. That's why I'm asking.
• πάντα ῥεῖ: I'm not a haskell expert, but similar structures of pieces of code cannot be refactored successfully, unless the language provides a feature of generic template functions. May be that could be a way to go. But as mentioned, I don't know really for haskell.

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
 ]