gluon 0.18.2

A static, type inferred programming language for application embedding
Documentation
//! JSON deserialization
//!
//! _This module is only available if gluon is compiled with the `serialization` feature._

let { Value } = import! std.json
let prim = import! std.json.prim

let { Result, ? } = import! std.result
let std_map @ { Map, ? } = import! std.map
let { id } = import! std.function
let float = import! std.float

let functor = import! std.functor
let { (*>), (<*), wrap } = import! std.applicative
let { Alternative, (<|>) } = import! std.alternative
let { flat_map } = import! std.monad
let { for } = import! std.traversable
let { ? } = import! std.array


type Error = String
type Deserializer i a = i -> Result Error { value : a, input : i }

/// Deserializer which extracts the data from the `Value` type
type ValueDeserializer a = Deserializer Value a

let error_msg = id

let deserializer : Deserializer i a -> Deserializer i a = id

let functor : Functor (Deserializer i) = {
    map = \f m ->
        deserializer
            (\input ->
                do a = deserializer m input
                Ok { value = f a.value, input = a.input }),
}

let applicative : Applicative (Deserializer i) = {
    functor,

    apply = \f m ->
        deserializer
            (\input ->
                do g = deserializer f input
                do a = deserializer m g.input
                Ok { value = g.value a.value, input = a.input }),

    wrap = \value -> deserializer (\input -> Ok { value, input }),
}

let alternative : Alternative (Deserializer i) = {
    applicative,

    empty = deserializer (\stream -> Err (error_msg "empty")),

    or = \l r ->
        deserializer
            (\stream ->
                match deserializer l stream with
                | Ok a -> Ok a
                | Err _ -> deserializer r stream),
}

let monad : Monad (Deserializer i) = {
    applicative,

    flat_map = \f m ->
        deserializer
            (\input ->
                do a = deserializer m input
                deserializer (f a.value) a.input),
}

/// Deserializes a `Bool`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, bool, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with bool "true") (Ok True)
/// assert_eq (deserialize_with bool "123") (Err "Expected bool")
/// ```
let bool : ValueDeserializer Bool = \input ->
    match input with
    | Bool i -> Ok { value = i, input }
    | _ -> Err (error_msg "Expected bool")

/// Deserializes a `Float`
///
/// Note that the deserializer will "integers" such as 123 as floats
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, float, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with float "123.45") (Ok 123.45)
/// seq assert_eq (deserialize_with float "123") (Ok 123.0)
/// assert_eq (deserialize_with float "true") (Err "Expected float")
/// ```
let float : ValueDeserializer Float = \input ->
    match input with
    | Int i -> Ok { value = float.from_int i, input }
    | Float f -> Ok { value = f, input }
    | _ -> Err (error_msg "Expected float")

/// Deserializes an `Int`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, int, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with int "123") (Ok 123)
/// assert_eq (deserialize_with int "true") (Err "Expected integer")
/// ```
let int : ValueDeserializer Int = \input ->
    match input with
    | Int i -> Ok { value = i, input }
    | _ -> Err (error_msg "Expected integer")

/// Deserializes a `String`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, string, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with string "\"abc\"") (Ok "abc")
/// assert_eq (deserialize_with string "true") (Err "Expected string")
/// ```
let string : ValueDeserializer String = \input ->
    match input with
    | String s -> Ok { value = s, input }
    | _ -> Err (error_msg "Expected string")

/// Deserializes an `Array` of `a`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, array, int, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { ? } = import! std.array
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with (array int) "[123, 456]") (Ok [123, 456])
/// assert_eq (deserialize_with (array int) "[123, \"\"]") (Err "Expected integer")
/// ```
let array a : ValueDeserializer a -> ValueDeserializer (Array a) = \input ->
    match input with
    | Array xs ->
        do value =
            for
                xs
                (\v ->
                    do state = a v
                    Ok state.value)
        Ok { value, input }
    | _ -> Err (error_msg "Expected array")

/// Deserializes an `Option` of `a`.
///
/// `null` maps to `None` and all other values to `a`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, option, int, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { ? } = import! std.array
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with (option int) "123") (Ok (Some 123))
/// seq assert_eq (deserialize_with (option int) "null") (Ok None)
/// assert_eq (deserialize_with (option int) "\"\"") (Err "Expected integer")
/// ```
let option a : ValueDeserializer a -> ValueDeserializer (Option a) = \input ->
    match input with
    | Null -> Ok { value = None, input }
    | _ -> (functor.map Some a) input

/// Deserializes the field `name` of an object using `a`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, field, int, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { ? } = import! std.array
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq (deserialize_with (field "test" int) "{ \"test\": 123 }") (Ok 123)
/// assert_eq (deserialize_with (field "test" int) "{ \"abc\": 123 }") (Err "Expected field `test`")
/// ```
let field name a : String -> ValueDeserializer a -> ValueDeserializer a = \input ->
    match input with
    | Object o ->
        match std_map.find name o with
        | Some value ->
            do state = a value
            Ok { value = state.value, input }
        | None -> Err (error_msg ("Expected field `" ++ name ++ "`"))
    | _ -> Err (error_msg "Expected map")

/// Deserializes the a `Map String a`
///
/// ```
/// let { ? } = import! std.effect
/// let { Value, map, int, deserialize_with } = import! std.json.de
/// let { Result, ? } = import! std.result
/// let { singleton, ? } = import! std.map
/// let { (<>) } = import! std.semigroup
/// let { assert_eq, ? } = import! std.test
///
/// seq assert_eq
///     (deserialize_with (map int) r#"{ "test": 123, "test2": 0 }"#)
///     (Ok (singleton "test" 123 <> singleton "test2" 0))
/// assert_eq (deserialize_with (map int) r#"{ "abc": "" }"#) (Err "Expected integer")
/// ```
let map a : ValueDeserializer a -> ValueDeserializer (Map String a) = \input ->
    match input with
    | Object xs ->
        let f = \key value ->
            do state = a value
            Ok state.value
        do value = std_map.traverse_with_key f xs
        Ok { value, input }
    | _ -> Err (error_msg "Expected map")

/// Deserializes a `Value`
let value : ValueDeserializer Value = \input -> Ok { value = input, input }

#[implicit]
type Deserialize a = { deserializer : ValueDeserializer a }

let deserializer ?d : [Deserialize a] -> ValueDeserializer a = d.deserializer

let deserialize_with de input : ValueDeserializer a -> String -> Result Error a =
    do value = prim.deserialize input
    do state = de value
    Ok state.value

/// Runs the deserializer `de` on `input`
/// Produces a value of type `a` if deserialization was successful
let deserialize ?de input : [Deserialize a] -> String -> Result Error a =
    deserialize_with de.deserializer input

let run ?de value : [Deserialize a] -> Value -> Result Error a =
    do state = de.deserializer value
    Ok state.value

let bool_deserializer : Deserialize Bool = { deserializer = bool }

let int_deserializer : Deserialize Int = { deserializer = int }

let float_deserializer : Deserialize Float = { deserializer = float }

let string_deserializer : Deserialize String = { deserializer = string }

let value_deserializer : Deserialize Value = { deserializer = value }

let option_deserializer : [Deserialize a] -> Deserialize (Option a) =
    { deserializer = option deserializer }

let list @ { List } = import! std.list
let list_deserializer : [Deserialize a] -> Deserialize (List a) =
    { deserializer = functor.map list.of (array deserializer) }

let array_deserializer : [Deserialize a] -> Deserialize (Array a) =
    { deserializer = array deserializer }

let { Map } = import! std.map
let map_deserializer : [Deserialize a] -> Deserialize (Map String a) =
    { deserializer = map deserializer }

{
    Value,
    Error,
    Deserializer,
    ValueDeserializer,
    Deserialize,

    functor,
    applicative,
    alternative,
    monad,

    bool,
    int,
    float,
    string,
    array,
    field,
    map,
    option,
    value,

    deserialize,
    deserialize_with,
    run,

    deserializer,

    bool_deserializer,
    int_deserializer,
    string_deserializer,
    float_deserializer,
    value_deserializer,
    option_deserializer,
    list_deserializer,
    array_deserializer,
    map_deserializer,
}