Decode Problem

Decode.elm

module Main exposing (main)

import Browser
import Html exposing (Html, button, div, text)
import Html.Events exposing (onClick)

import Dict

import Json.Decode as D
import Json.Encode as E


type Msg = NoOp


type LayerModel 
    = LayerModelFoo { foo : Bool }
    | LayerModelBar { bar : Int }
    
    
    
type alias Model = 
    List { index: Int, model : LayerModel }

    
update : Msg -> Model -> Model
update msg model = model
            
            
encode : Model -> E.Value
encode models = 
    E.list 
        (\m ->
            E.object 
              [ ( "def"
                , E.string <| case m.model of 
                        LayerModelFoo _ -> "foo"
                        LayerModelBar _ -> "bar"    
                )
              , ( "index", E.int m.index )
              , ( "model"
                , case m.model of 
                        LayerModelFoo fooModel -> encodeFoo fooModel
                        LayerModelBar barModel -> encodeBar barModel
                )
              ] 
        )
        models
        
        
encodeFoo : { foo : Bool } -> E.Value
encodeFoo { foo } = 
    E.object 
        [ ( "foo", E.bool foo ) ]
        
        
encodeBar : { bar : Int } -> E.Value
encodeBar { bar } = 
    E.object 
        [ ( "bar", E.int bar ) ]        
        
        
decode : D.Decoder Model
decode =
    let 
        createModel 
            decoder 
            index
            layerModel =
                { index = index, model = layerModel }
    in            
        D.list 
            (D.field "def" D.string
               |> D.andThen 
                   (\defId -> 
                       case Dict.get defId registry of
                           Just layerDecoder -> 
                               D.map2 (createModel layerDecoder)
                                   (D.field "index" D.int)
                                   (D.field "model" layerDecoder)
                           Nothing ->
                               D.fail <| "unknown Def ID " ++ defId                                   
                   )
            )

            
decodeFoo : D.Decoder { foo : Bool }
decodeFoo =
    D.field "foo" D.bool 
        |> D.map (\b -> { foo = b })          
        
        
decodeBar : D.Decoder { bar : Int }
decodeBar =
    D.field "bar" D.int 
        |> D.map (\i -> { bar = i })        


view : Model -> Html Msg
view model =
    let 
        encodedModel = encode model |> E.encode 0
    in    
        div 
            [ ]
            [ encodedModel |> text 
            , case D.decodeString decode encodedModel of
                    Ok v -> encode v |> E.encode 2 |> text
                    Err err -> D.errorToString err |> text
            ]


registry : Dict.Dict String (D.Decoder LayerModel)
registry =
    Dict.empty
        |> Dict.insert "foo" (decodeFoo |> D.map LayerModelFoo)
        |> Dict.insert "bar" (decodeBar |> D.map LayerModelBar)
        


main : Program () Model Msg
main =
    Browser.sandbox
        { init = 
            [ { index = 2, model = LayerModelFoo { foo = True } } 
            , { index = 4, model = LayerModelBar { bar = 42 } }
            ]
        , view = view
        , update = update
        }