Last active
December 3, 2025 20:11
-
-
Save chrisdone-artificial/e2d458fee9bdbe6dbb21dbdae8fc4f35 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