Debugging loops


#1

I’m tring to write a “metaprogramming” library for Elm.

The big idea is creating a Meta a type that describes how a type a is built.

One of the things that can be created from a Meta a type is a form: something of type a -> Html a.

During the implementation I got stuck because I’ve done something wrong somewhere and the browser process gets stuck at 100% and never recovers.

How does one debug this kind of errors? It’s probably an infinite loop, but I don’t know where to start debugging.

The loop can be reproduced by choosing a different value for the select.

Any additional feedback is obviously welcome!

Main.elm

module Main exposing (main)

import Html exposing (Html)
import Json.Decode as JD
import Pairs exposing (..)


type Adt
    = Left String
    | Right Int


cata : (String -> o) -> (Int -> o) -> Adt -> o
cata lf rf v =
    case v of
        Left l ->
            lf l

        Right r ->
            rf r


adtMeta : Meta Adt
adtMeta =
    adt cata cata
        |> alternative1 "Left" Left string
        |> alternative1 "Right" Right int
        |> buildAdt (\_ -> Left "")


init : ( Model, Cmd Msg )
init =
    let
        model =
            Right -1
    in
    ( model, Cmd.none )


type alias Model =
    Adt


type alias Msg =
    Adt


main : Program Never Model Msg
main =
    Html.program
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        }


update : Msg -> Model -> ( Model, Cmd Msg )
update msg _ =
    ( msg, Cmd.none )


subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.none


view : Model -> Html Msg
view model =
    let
        encoded =
            encoder adtMeta model

        decoded =
            JD.decodeValue (decoder adtMeta) 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 []
        , form adtMeta model
        ]

Pairs.elm

module Pairs
    exposing
        ( Meta
        , ObjectMeta
        , adt
        , alternative0
        , alternative1
        , alternative2
        , array
        , bool
        , buildAdt
        , buildObject
        , decoder
        , default
        , description
        , dict
        , encoder
        , field
        , float
        , form
        , int
        , object
        , string
        )

import Array exposing (Array)
import Dict exposing (Dict)
import Html exposing (Html)
import Json.Decode as JD exposing (Decoder)
import Json.Encode as JE exposing (Value)
import Pairs.Form as Form


type Meta a
    = Meta
        { encoder : a -> Value
        , decoder : () -> Decoder a
        , description : () -> Description
        , form : a -> Html a
        , default : () -> a
        }


decoder : Meta a -> Decoder a
decoder (Meta m) =
    m.decoder ()


encoder : Meta a -> a -> Value
encoder (Meta m) =
    m.encoder


description : Meta a -> Description
description (Meta m) =
    m.description ()


form : Meta a -> a -> Html a
form (Meta m) =
    m.form


default : Meta a -> a
default (Meta m) =
    m.default ()


type Description
    = Bool
    | Float
    | Int
    | String
    | Array Description
    | Dict Description
    | Tuple Description Description
    | Adt (Dict String (Array Description))
    | Recursive (Description -> Description)
    | Object (Dict String Description)



--Base


string : Meta String
string =
    Meta
        { encoder = JE.string
        , decoder = \_ -> JD.string
        , description = \_ -> String
        , form = Form.string
        , default = \_ -> ""
        }


int : Meta Int
int =
    Meta
        { encoder = JE.int
        , decoder = \_ -> JD.int
        , description = \_ -> Int
        , form = Form.int
        , default = \_ -> 0
        }


float : Meta Float
float =
    Meta
        { encoder = JE.float
        , decoder = \_ -> JD.float
        , description = \_ -> Float
        , form = Form.float
        , default = \_ -> 0.0
        }


bool : Meta Bool
bool =
    Meta
        { encoder = JE.bool
        , decoder = \_ -> JD.bool
        , description = \_ -> Bool
        , form = Form.bool
        , default = \_ -> False
        }



-- Composite


array : Meta a -> Meta (Array a)
array meta =
    Meta
        { encoder = \v -> JE.array <| Array.map (encoder meta) <| v
        , decoder = \_ -> JD.array <| decoder meta
        , description = \_ -> Array <| description meta
        , form = Form.array (form meta) (default meta)
        , default = \_ -> Array.empty
        }


dict : Meta a -> Meta (Dict String a)
dict meta =
    Meta
        { encoder = \v -> JE.object <| Dict.toList <| Dict.map (always <| encoder meta) v
        , decoder = \_ -> JD.dict <| decoder meta
        , description = \_ -> Dict <| description meta
        , form = \model -> form meta |> Debug.crash "unfinished"
        , default = \_ -> Dict.empty
        }



--RECORDS


type ObjectMeta a b
    = ObjectMeta
        { encoder : a -> List ( String, Value )
        , decoder : () -> Decoder b
        , description : () -> Dict String Description
        , form : a -> List (Html b)
        , partial : a -> b
        , default : () -> b
        }


object : b -> ObjectMeta a b
object ctor =
    ObjectMeta
        { encoder = \_ -> []
        , decoder = \_ -> JD.succeed ctor
        , description = \_ -> Dict.empty
        , form = \_ -> []
        , partial = \_ -> ctor
        , default = \_ -> ctor
        }


field : String -> (a -> f) -> Meta f -> ObjectMeta a (f -> b) -> ObjectMeta a b
field name getter meta (ObjectMeta ometa) =
    ObjectMeta
        { encoder = \v -> ( name, encoder meta <| getter v ) :: ometa.encoder v
        , decoder = \_ -> JD.map2 (\f x -> f x) (ometa.decoder ()) (JD.field name (decoder meta))
        , description = \_ -> Dict.insert name (description meta) (ometa.description ())
        , form = Form.field name getter ometa.form ometa.partial (form meta)
        , partial = \model -> ometa.partial model <| getter model
        , default = \_ -> ometa.default () (default meta)
        }


buildObject : ObjectMeta a a -> Meta a
buildObject (ObjectMeta { encoder, decoder, description, form, default }) =
    Meta
        { encoder = \v -> JE.object <| encoder v
        , decoder = decoder
        , description = \_ -> Object <| description ()
        , form = Form.object form
        , default = default
        }



--ADT


type AdtMeta cata fcata v
    = AdtMeta
        { cata : cata
        , decoder : String -> Decoder v -> Decoder v
        , description : () -> Dict String (Array Description)
        , fcata : fcata
        , formOptions : Dict String (() -> v)
        }


adt : cata -> fcata -> AdtMeta cata fcata v
adt cata fcata =
    AdtMeta
        { cata = cata
        , decoder = \_ -> identity
        , description = \_ -> Dict.empty
        , fcata = fcata
        , formOptions = Dict.empty
        }



{- alternative :
   String
   -> ((List ( String, Value ) -> Value) -> a)
   -> ((List (Html v) -> Html v) -> b)
   -> Decoder v
   -> List Description
   -> (() -> v)
   -> AdtMeta (a -> c) (( String, b ) -> d) v
   -> AdtMeta c d v
-}


alternative :
    String
    -> ((List ( String, Value ) -> Value) -> a)
    -> ((List (Html v) -> ( String, Html v )) -> b)
    -> Decoder v
    -> List Description
    -> (() -> v)
    -> AdtMeta (a -> c) (b -> d) v
    -> AdtMeta c d v
alternative name cataPiece formPiece decoderPiece descs default (AdtMeta { cata, fcata, decoder, description, formOptions }) =
    let
        enc v =
            JE.object
                [ ( "tag", JE.string name )
                , ( "value", JE.object v )
                ]

        form children =
            ( name, Html.div [] children )

        decoder tag orElse =
            if tag == name then
                decoderPiece
            else
                decoder tag orElse
    in
    AdtMeta
        { cata = cata <| cataPiece enc
        , decoder = decoder
        , description = \_ -> Dict.insert name (Array.fromList descs) <| description ()
        , fcata = fcata <| formPiece form
        , formOptions = Dict.insert name default formOptions
        }


alternative0 :
    String
    -> v
    -> AdtMeta (Value -> b) (( String, Html v ) -> c) v
    -> AdtMeta b c v
alternative0 name ctor =
    alternative name
        (\c -> c [])
        (\c -> c [])
        (JD.succeed ctor)
        []
        (\_ -> ctor)


alternative1 :
    String
    -> (a -> v)
    -> Meta a
    -> AdtMeta ((a -> Value) -> b) ((a -> ( String, Html v )) -> c) v
    -> AdtMeta b c v
alternative1 name ctor m1 =
    alternative name
        (\c v -> c [ ( "0", encoder m1 v ) ])
        (\c v -> c [ Html.map ctor <| form m1 v ])
        (JD.map ctor (JD.field "0" <| decoder m1))
        [ description m1 ]
        (\_ -> ctor <| default m1)


alternative2 :
    String
    -> (a -> b -> v)
    -> Meta a
    -> Meta b
    -> AdtMeta ((a -> b -> Value) -> c) ((a -> b -> ( String, Html v )) -> d) v
    -> AdtMeta c d v
alternative2 name ctor m1 m2 =
    alternative name
        (\c v1 v2 -> c [ ( "0", encoder m1 v1 ), ( "1", encoder m2 v2 ) ])
        (\c v1 v2 ->
            c
                [ Html.map (\v1_ -> ctor v1_ v2) <| form m1 v1
                , Html.map (\v2_ -> ctor v1 v2_) <| form m2 v2
                ]
        )
        (JD.map2 ctor (JD.field "0" <| decoder m1) (JD.field "1" <| decoder m2))
        [ description m1, description m2 ]
        (\_ -> ctor (default m1) (default m2))


buildAdt : (() -> a) -> AdtMeta (a -> Value) (a -> ( String, Html a )) a -> Meta a
buildAdt default (AdtMeta { cata, decoder, description, fcata, formOptions }) =
    Meta
        { encoder = cata
        , decoder =
            \_ ->
                JD.field "tag" JD.string
                    |> JD.andThen
                        (\tag ->
                            let
                                error =
                                    "tag " ++ toString tag ++ "did not match"
                            in
                            JD.field "value" <| decoder tag <| JD.fail error
                        )
        , description = \_ -> Adt <| description ()
        , form = Form.adt formOptions fcata
        , default = default
        }

Pairs/Form.elm

module Pairs.Form
    exposing
        ( adt
        , array
        , bool
        , field
        , float
        , int
        , object
        , string
        )

import Array exposing (Array)
import Dict exposing (Dict)
import Html as H exposing (Html)
import Html.Attributes as HA
import Html.Events as HE


type alias Form a =
    a -> Html a


int : Form Int
int model =
    H.input
        [ HA.type_ "number"
        , HE.onInput (String.toInt >> Result.withDefault model)
        , HA.value <| toString model
        ]
        []


string : Form String
string model =
    H.input
        [ HA.type_ "text"
        , HE.onInput identity
        , HA.value model
        ]
        []


float : Form Float
float model =
    H.input
        [ HA.type_ "number"
        , HE.onInput (String.toFloat >> Result.withDefault model)
        , HA.value <| toString model
        ]
        []


bool : Form Bool
bool model =
    H.input
        [ HA.type_ "checkbox"
        , HE.onCheck identity
        , HA.checked model
        ]
        []


arrayRemove : Int -> Array a -> Array a
arrayRemove i a =
    if i <= 0 then
        Array.slice 1 (Array.length a) a
    else if i >= (Array.length a - 1) then
        Array.slice 0 (Array.length a - 1) a
    else
        Array.append (Array.slice 0 i a) (Array.slice i (Array.length a) a)


array : Form a -> a -> Form (Array a)
array form default model =
    let
        row i e =
            H.li []
                [ H.map (\e_ -> Array.set i e_ model) <| form e
                , H.button
                    [ HE.onClick (arrayRemove i model) ]
                    [ H.text "Delete" ]
                ]

        existing =
            model
                |> Array.toList
                |> List.indexedMap row

        add =
            H.button
                [ HE.onClick (Array.push default model) ]
                [ H.text "Add new" ]
    in
    H.ul [] (existing ++ [ add ])



--field : a -> List (Html b)


field :
    String
    -> (a -> f)
    -> (a -> List (Html (f -> b)))
    -> (a -> f -> b)
    -> (f -> Html f)
    -> a
    -> List (Html b)
field name getter oform partial form model =
    let
        init : List (Html b)
        init =
            oform model
                |> List.map (H.map <| \b -> b (getter model))

        label : Html x
        label =
            H.label [] [ H.text name ]

        cell : Html b
        cell =
            H.map (partial model) <| form (getter model)

        row : Html b
        row =
            H.tr []
                [ H.td [] [ label ]
                , H.td [] [ cell ]
                ]
    in
    init ++ [ row ]


object : (a -> List (Html a)) -> Form a
object form model =
    H.table [] <| form model


adt : Dict String (() -> v) -> (v -> ( String, Html v )) -> Form v
adt options form model =
    let
        option name =
            H.option
                [ HA.value name, HA.selected <| name == selected ]
                [ H.text name ]

        ( selected, inner ) =
            form model
    in
    H.table []
        [ H.tr []
            [ H.td []
                [ H.select
                    [ HE.onInput
                        (\n ->
                            case Dict.get n options of
                                Just def ->
                                    def ()

                                Nothing ->
                                    model
                        )
                    ]
                  <|
                    List.map option (Dict.keys options)
                ]
            ]
        , H.tr []
            [ H.td []
                [ inner
                ]
            ]
        ]

#2

The first thing I would try is to trigger the loop and then click pause in the Chrome developer tools.

For more detailed feedback on a message board like this, it would be good to isolate the problem in as few lines as possible.


#3

Yes! That did the trick!

Sorry for the code dump, as I said I wasn’t looking for a solution to the loop (in that case I would have minified the code), just for hints on how to debug these problems in general. Will avoid code dumps in the future anyway.


#4

This topic was automatically closed 10 days after the last reply. New replies are no longer allowed.