Created
March 14, 2018 17:48
-
-
Save tjweir/bdf96161b19b2ac0d0eedf9a9590839f to your computer and use it in GitHub Desktop.
https://soupi.github.io/rfc/writing_simple_haskell/ - typed as I read the tutorial.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
data Command | |
= QuitApp | |
| DisplayItems | |
| Help | |
| AddItem String | |
| Complete Int | |
type Item = String | |
type Items = [Item] | |
addItem :: Item -> Items -> Items | |
addItem item items = item : items | |
removeItem :: Int -> Items -> Either String Items | |
removeItem reverseIndex allItems = | |
impl (length allItems - reverseIndex) allItems | |
where | |
impl index items = | |
case (index, items) of | |
(0, item : rest) -> | |
Right rest | |
(n, []) -> | |
Left "Index out of bounds" | |
(n, item : rest) -> | |
case impl (n - 1) rest of | |
Right newItems -> | |
Right (item : newItems) | |
Left errMsg -> | |
Left errMsg | |
displayItems :: Items -> String | |
displayItems items = | |
let | |
displayItem index item = show index ++ ": " ++ item | |
reversedList = reverse items | |
displayedItemsList = zipWith displayItem [1..] reversedList | |
in | |
unlines displayedItemsList | |
parseCommand :: String -> Either String Command | |
parseCommand line = case words line of | |
["quit"] -> Right QuitApp | |
["items"] -> Right DisplayItems | |
["help"] -> Right Help | |
["complete", idxStr] -> | |
if all (\c -> elem c "0123456789") idxStr | |
then Right (Complete (read idxStr)) | |
else Left "Invalid index" | |
"add" : "-" : item -> Right (AddItem (unwords item)) | |
_ -> Left "Unknown command, try 'help'" | |
interactWithUser :: Items -> IO () | |
interactWithUser items = do | |
line <- getLine | |
case parseCommand line of | |
Right DisplayItems -> do | |
putStrLn "Current Items:" | |
putStrLn (displayItems items) | |
interactWithUser items | |
Right (AddItem item) -> do | |
let newItems = addItem item items | |
putStrLn "Item added.\n" | |
interactWithUser newItems | |
Right QuitApp -> do | |
pure () | |
Right Help -> do | |
putStrLn "Commands: items, help, quit, add - <item to add>" | |
interactWithUser items | |
Right (Complete index) -> do | |
let result = removeItem index items | |
case result of | |
Left errMsg -> do | |
putStrLn ("Error: " ++ errMsg) | |
interactWithUser items | |
Right newItems -> do | |
putStrLn "Item complete." | |
interactWithUser newItems | |
Left errorMessage -> do | |
interactWithUser items | |
main :: IO () | |
main = do | |
putStrLn " --| TODO |-- " | |
putStrLn "Commands: items, help, quit, add - <item to add>" | |
let initialList = [] | |
interactWithUser initialList | |
putStrLn "Thanks, see you soon!" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment