+++ /dev/null
-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