todo.hell

todo.hell

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 []