simple.hs

module Main where

main :: IO ()
main = do
  let initialList = []
  interactWithUser initialList

type Item = String
type Items = [Item]

data Command = Quit
             | DisplayItems
             | AddItem String
             | RemoveItem Int
             | Help

type Error = String

parseCommand :: String -> Either Error Command
parseCommand line = case words line of
  ["quit"] -> Right Quit
  ["items"] -> Right DisplayItems
  "add" : item -> Right $ AddItem $ unwords item
  "remove" : i -> Right $ RemoveItem $ read $ unwords i
  ["help"] -> Right Help
  _ -> Left "Unknown command"

addItem :: Item -> Items -> Items
addItem = (:)

displayItems :: Items -> String
displayItems = unlines . map ("- " ++)

removeItem :: Int -> Items -> Either Error Items
removeItem i items
  | i < 0 || i >= length items = Left "Out of range"
  | otherwise = Right result
  where (front, back) = splitAt (i + 1) items
        result = init front ++ back

interactWithUser :: Items -> IO ()
interactWithUser items = do
  line <- getLine
  case parseCommand line of
    Right DisplayItems -> do
      putStrLn $ displayItems items
      interactWithUser items

    Right (AddItem item) -> do
      let newItems = addItem item items
      putStrLn "Added"
      interactWithUser newItems

    Right (RemoveItem i) ->
      case removeItem i items of
        Right newItems -> do
          putStrLn $ "Removed " ++ items !! i
          interactWithUser newItems
        Left err -> do
          putStrLn err
          interactWithUser items


    Right Quit -> return ()

    Right Help -> do
      putStrLn "Commands:"
      putStrLn "help"
      putStrLn "items"
      putStrLn "add"
      putStrLn "quit"
      interactWithUser items

    Left err -> do
      putStrLn $ "Error: " ++ err
      interactWithUser items