-
-
Save chrisdone/60563152945ebb794cdd30fddbe46cb2 to your computer and use it in GitHub Desktop.
todo.hell
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
| data Todo = Todo { | |
| id :: Text, | |
| created :: UTCTime, | |
| title :: Text, | |
| description :: Text, | |
| priority :: Int | |
| } | |
| data Command | |
| = Add Main.Todo | |
| | Remove Text | |
| | List | |
| todoOpt = \created -> | |
| (\id title description priority -> Main.Todo{id,title,description,priority,created}) | |
| <$> Options.strOption (Option.long "id") | |
| <*> Options.strOption (Option.long "title") | |
| <*> Options.strOption (Option.long "description") | |
| <*> Functor.fmap (Maybe.maybe 3 Function.id . Int.readMaybe) (Options.strOption (Option.long "priority")) | |
| parseAdd = \now -> Main.Add <$> Main.todoOpt now | |
| parseRemove = Main.Remove <$> Options.strArgument (Argument.metavar "ID" <> Argument.help "Todo ID") | |
| parseList = Applicative.pure Main.List | |
| cmdParser = \now -> | |
| Options.hsubparser | |
| ( Options.command "add" (Options.info (Main.parseAdd now) (Options.progDesc "Add a todo item")) | |
| <> Options.command "remove" (Options.info Main.parseRemove Options.fullDesc) | |
| <> Options.command "list" (Options.info Main.parseList Options.fullDesc) | |
| ) | |
| main = do | |
| now <- UTCTime.getCurrentTime | |
| let opts = Options.info (Main.cmdParser now <**> Options.helper) Options.fullDesc | |
| cmd <- Options.execParser opts | |
| case cmd of | |
| Add f -> do | |
| items <- Main.loadTodos | |
| Main.saveTodos $ List.cons f items | |
| Remove id -> do | |
| items <- Main.loadTodos | |
| Main.saveTodos $ List.filter (\item -> Bool.not $ Eq.eq id $ Record.get @"id" item) items | |
| List -> do | |
| items <- Main.loadTodos | |
| ByteString.hPutStr IO.stdout $ Json.encode $ Json.Array $ Vector.fromList $ List.map Main.todoToJson items | |
| -- Convert a Todo to a JSON Value | |
| todoToJson = \todo -> | |
| Json.Object $ Map.fromList [ | |
| ("created", Json.String $ UTCTime.iso8601Show $ Record.get @"created" todo), | |
| ("title", Json.String $ Record.get @"title" todo), | |
| ("id", Json.String $ Record.get @"id" todo), | |
| ("description", Json.String $ Record.get @"description" todo), | |
| ("priority", Json.Number $ Double.fromInt $ Record.get @"priority" todo) | |
| ] | |
| -- Parse a JSON Value to Maybe Todo | |
| jsonToTodo = \o -> | |
| case o of | |
| Json.Object obj -> do | |
| createdVal <- Map.lookup "created" obj | |
| titleVal <- Map.lookup "title" obj | |
| idVal <- Map.lookup "id" obj | |
| descVal <- Map.lookup "description" obj | |
| priorityVal <- Map.lookup "priority" obj | |
| created <- case createdVal of | |
| Json.String s -> UTCTime.iso8601ParseM s | |
| _ -> Maybe.Nothing | |
| title <- case titleVal of | |
| Json.String s -> Maybe.Just s | |
| _ -> Maybe.Nothing | |
| id <- case idVal of | |
| Json.String s -> Maybe.Just s | |
| _ -> Maybe.Nothing | |
| description <- case descVal of | |
| Json.String s -> Maybe.Just s | |
| _ -> Maybe.Nothing | |
| priority <- case priorityVal of | |
| Json.Number n -> Int.readMaybe $ Double.showFFloat (Maybe.Just 0) n "" | |
| _ -> Maybe.Nothing | |
| Maybe.Just $ Main.Todo { | |
| id, | |
| created, | |
| title, | |
| description, | |
| priority | |
| } | |
| _ -> Maybe.Nothing | |
| -- Save a list of Todos to todos.json file | |
| saveTodos = \todos -> do | |
| let jsonArray = Json.Array $ Vector.fromList $ List.map Main.todoToJson todos | |
| let encoded = Json.encode jsonArray | |
| ByteString.writeFile "todos.json" encoded | |
| -- Load todos from todos.json file | |
| loadTodos :: IO [Main.Todo] = do | |
| exists <- Directory.doesFileExist "todos.json" | |
| if exists | |
| then do | |
| contents <- ByteString.readFile "todos.json" | |
| case Json.decode contents of | |
| Maybe.Just j -> | |
| case j of | |
| Json.Array values -> do | |
| IO.pure $ Maybe.mapMaybe Main.jsonToTodo $ Vector.toList values | |
| _ -> IO.pure [] | |
| _ -> IO.pure [] | |
| else IO.pure [] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment