Return to Revisions

Inline things used only once, use library combinators, particularly to eliminate explicit recursion.

import System.Exit (exitSuccess)
import Control.Monad.State
import Control.Monad.Trans.Maybe
import Safe.Exact (splitAtExactMay)
import Safe (fromJustNote)
type TodoList = [String]
type Todo = StateT TodoList IO
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"
options :: [(Char, String, Todo ())]
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
 ]
desperately :: Monad m => MaybeT m a -> m a
desperately = fmap (fromJustNote "desperately") . runMaybeT . asum . repeat
say = liftIO . putStrLn
hear = liftIO getLine