Monadic style JSON decoding with Unison Abilities!

decoders.u.hs

expect! : Either e a -> {Exception e} a
expect! = cases
  Left e -> raise e
  Right a -> a

identity : Decode Value
identity =
  Decode (v -> Right v)

(~>) : Value -> Text -> {Exception Text} Value
v ~> field =
  match v with
    Dictionary map ->
      match Map.lookup field map with
        None -> raise ("field `" ++ field ++ "` not found in dictionary")
        Some val -> val
    _ -> raise "the value provided was not a dictionary"

decode! : Decode a -> Value -> {Exception Text} a
decode! d val =
  expect! (Either.mapLeft pretty (Decode.run d val))

parse : (Value -> {Exception Text} a) -> Text -> Either Text a
parse decoder jsonText =
  match Unipar.run parseValue jsonText with
    Left e -> Left e
    Right value -> Exception.toEither '(decoder value)

each : (Value -> {Exception Text} a) -> Value -> {Exception Text} [a]
each decoder value =
  match value with
    Array elements ->
      List.map decoder elements
    _ -> raise "the value provided was not an array"

endpoint = "{\"total\": 2, \"users\": [ {\"id\": 0, \"name\": \"Admin\", \"likes\": [ \"cooking\", \"managing\" ]}, {\"id\": 1, \"name\": \"Alice\", \"likes\": [ \"cooking\", \"programming\" ]} ]}"

type User =
  { id : Int
  , name : Text
  , hobbies : [Hobby]
  }

type Response =
  { total : Int
  , users : [User]
  }

unique type Hobby = Cooking | Managing | Programming

parseEndpoint : Value -> {Exception Text} Response
parseEndpoint v = let
  total = decode! int (v ~> "total")
  users = each parseUser (v ~> "users")
  Response.Response total users

parseHobby : Value -> {Exception Text} Hobby
parseHobby =
  decode! (oneOf
            [ s "cooking" ==> Hobby.Cooking
            , s "managing" ==> Hobby.Managing
            , s "programming" ==> Hobby.Programming
            ])

parseUser v = let
  id = decode! int (v ~> "id")
  name = decode! string (v ~> "name")
  hobbies = each parseHobby (v ~> "likes")
  User.User id name hobbies

> parse parseEndpoint endpoint