I should probably publish this as a library. The API is not perfect but it’s reasonable, and it’s quite a compact way to define encoding and decoding.
I would really love some feedback.
Ellie: https://ellie-app.com/8hS7BwxpJa1/0
module Main exposing (main)
import Dict exposing (Dict)
import Html exposing (Html)
import Json.Decode as JD exposing (Decoder)
import Json.Encode as JE exposing (Value)
import Set exposing (Set)
type alias ObjectSimpleFields =
{ a : String
, b : Int
, c : List Float
, d : MyList Bool
}
type MyList a
= Empty
| Cons a (MyList a)
objectSimpleFieldsMeta : Meta ObjectSimpleFields
objectSimpleFieldsMeta =
object ObjectSimpleFields
|> field "a" .a string
|> field "b" .b int
|> field "c" .c (list float)
|> field "d" .d (mylist bool)
|> build
mylist : Meta a -> Meta (MyList a)
mylist e =
let
matchEmpty e =
case e of
Empty ->
Just ()
_ ->
Nothing
matchCons e =
case e of
Cons x xs ->
Just ( x, xs )
_ ->
Nothing
in
adt
[ alternative0 matchEmpty Empty
, alternative2 matchCons Cons e (lazy (\_ -> mylist e))
]
exampleObject : ObjectSimpleFields
exampleObject =
{ a = "a"
, b = 0
, c = [ -1.3 ]
, d = Cons False Empty
}
main : Html msg
main =
let
(Meta { encode, decode }) =
objectSimpleFieldsMeta
encoded =
encode exampleObject
decoded =
JD.decodeValue decode encoded
in
Html.span []
[ Html.text "Encoded: "
, Html.text <| toString encoded
, Html.text " decoded: "
, case decoded of
Ok v ->
Html.text <| toString v
Err e ->
String.split "\n" e
|> List.map Html.text
|> List.intersperse (Html.br [] [])
|> Html.span []
]
type Meta a
= Meta
{ encode : a -> Value
, decode : Decoder a
}
string : Meta String
string =
Meta
{ encode = JE.string
, decode = JD.string
}
int : Meta Int
int =
Meta
{ encode = JE.int
, decode = JD.int
}
float : Meta Float
float =
Meta
{ encode = JE.float
, decode = JD.float
}
bool : Meta Bool
bool =
Meta
{ encode = JE.bool
, decode = JD.bool
}
list : Meta a -> Meta (List a)
list =
bimap
(\e -> JE.list << List.map e)
JD.list
dict : Meta a -> Meta (Dict String a)
dict =
bimap
(\e -> JE.object << Dict.toList << Dict.map (always e))
JD.dict
set : Meta comparable -> Meta (Set comparable)
set =
bimap
(\e -> JE.list << List.map e << Set.toList)
(JD.map Set.fromList << JD.list)
bimap : ((a -> Value) -> b -> Value) -> (Decoder a -> Decoder b) -> Meta a -> Meta b
bimap menc mdec (Meta meta) =
Meta
{ encode = menc meta.encode
, decode = mdec meta.decode
}
type ObjectMeta a b
= ObjectMeta
{ encode : a -> List ( String, Value )
, decode : Decoder b
}
object : b -> ObjectMeta a b
object ctor =
ObjectMeta
{ encode = always []
, decode = JD.succeed ctor
}
field : String -> (a -> f) -> Meta f -> ObjectMeta a (f -> b) -> ObjectMeta a b
field name getter (Meta meta) (ObjectMeta ometa) =
ObjectMeta
{ encode = \v -> ( name, meta.encode <| getter v ) :: ometa.encode v
, decode = JD.map2 (\f x -> f x) ometa.decode (JD.field name meta.decode)
}
build : ObjectMeta a a -> Meta a
build (ObjectMeta ometa) =
Meta
{ encode = JE.object << ometa.encode
, decode = ometa.decode
}
type AlternativeMeta a
= AlternativeMeta
{ encode : a -> Maybe (List Value)
, decode : Decoder a
}
apply : Decoder a -> Decoder (a -> b) -> Decoder b
apply =
JD.map2 (|>)
alternative : (a -> Maybe b) -> (b -> List Value) -> Decoder a -> AlternativeMeta a
alternative match toList ctor =
AlternativeMeta
{ encode = match >> Maybe.map toList
, decode = ctor
}
alternative0 : (a -> Maybe ()) -> a -> AlternativeMeta a
alternative0 match ctor =
alternative match (always []) (JD.succeed ctor)
alternative1 : (a -> Maybe b) -> (b -> a) -> Meta b -> AlternativeMeta a
alternative1 match ctor (Meta p1) =
alternative
match
(\v1 -> [ p1.encode v1 ])
(JD.succeed ctor
|> apply (JD.field "0" p1.decode)
)
alternative2 : (a -> Maybe ( b, c )) -> (b -> c -> a) -> Meta b -> Meta c -> AlternativeMeta a
alternative2 match ctor (Meta p1) (Meta p2) =
alternative
match
(\( v1, v2 ) -> [ p1.encode v1, p2.encode v2 ])
(JD.succeed ctor
|> apply (JD.field "0" p1.decode)
|> apply (JD.field "1" p2.decode)
)
adt : List (AlternativeMeta a) -> Meta a
adt alternatives =
let
maybeEncode : a -> Int -> AlternativeMeta a -> Maybe ( Int, List Value )
maybeEncode e i (AlternativeMeta { encode }) =
encode e |> Maybe.map (\v -> ( i, v ))
aencode e =
alternatives
|> List.indexedMap (maybeEncode e)
|> List.filterMap identity
|> List.head
|> Maybe.map
(\( i, v ) ->
JE.object
[ ( "tag", JE.int i )
, ( "values", JE.list v )
]
)
|> Maybe.withDefault JE.null
adecode =
JD.field "tag" JD.int
|> JD.andThen
(\tag ->
case List.drop tag alternatives of
[] ->
JD.fail <| "Wrong tag, got " ++ toString tag
(AlternativeMeta { decode }) :: _ ->
JD.field "values" decode
)
in
Meta
{ encode = aencode
, decode = adecode
}
lazy : (() -> Meta a) -> Meta a
lazy f =
Meta
{ encode =
\v ->
let
(Meta { encode }) =
f ()
in
encode v
, decode =
JD.lazy
(\l ->
let
(Meta { decode }) =
f l
in
decode
)
}