This is an alternative site for discovering Elm packages. You may be looking for the official Elm package site instead.
1.0.0

Devcard

Devcard

type alias BasicConfig model msg context = { model : model , update : msg -> model -> model , view : context -> model -> Html msg }
type alias Config model msg context = { model : context -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) , view : context -> model -> Html msg , subscriptions : model -> Sub msg }
type alias Devcard model msg context = Program Flags (Model model msg context) (Msg msg context)
basicDevcard : CardContext context -> BasicConfig model msg context -> Devcard model msg context
devcard : CardContext context -> Config model msg context -> Devcard model msg context
staticDevcard : CardContext context -> (context -> Html Never) -> Devcard () Never context
module Devcard exposing (BasicConfig, Config, Devcard, basicDevcard, devcard, staticDevcard)

{-|


# Devcard

@docs BasicConfig, Config, Devcard, basicDevcard, devcard, staticDevcard

-}

import Devcard.Context as Context exposing (CardContext)
import Html exposing (Html)
import Html.Attributes
import Html.Events
import Random
import Task
import Time exposing (Time)


{-| -}
type alias Model sub subMsg context =
    { flags : Flags
    , context : CardContext context
    , state : State sub subMsg context
    , footer : Bool
    , config : Config sub subMsg context
    }


{-| -}
type State sub subMsg context
    = Loading
    | Loaded
        { sub : sub
        , contextValue : context
        , msgs : List subMsg
        }


{-| -}
type Msg subMsg context
    = SubMsg subMsg
    | ContextMsg context
    | ToggleFooter
    | Tick Time


{-| -}
type alias Devcard model msg context =
    Program Flags (Model model msg context) (Msg msg context)


{-| -}
type alias BasicConfig model msg context =
    { model : model
    , update : msg -> model -> model
    , view : context -> model -> Html msg
    }


{-| -}
type alias Config model msg context =
    { model : context -> ( model, Cmd msg )
    , update : msg -> model -> ( model, Cmd msg )
    , view : context -> model -> Html msg
    , subscriptions : model -> Sub msg
    }


{-| -}
staticDevcard : CardContext context -> (context -> Html Never) -> Devcard () Never context
staticDevcard context f =
    devcard
        context
        { model = always ( (), Cmd.none )
        , update = \_ m -> ( m, Cmd.none )
        , view = \c _ -> f c
        , subscriptions = always Sub.none
        }


{-| -}
basicDevcard : CardContext context -> BasicConfig model msg context -> Devcard model msg context
basicDevcard context config =
    devcard context
        { model = always ( config.model, Cmd.none )
        , update = \msg model -> ( config.update msg model, Cmd.none )
        , view = config.view
        , subscriptions = always Sub.none
        }


{-| -}
devcard : CardContext context -> Config model msg context -> Devcard model msg context
devcard context config =
    Html.programWithFlags
        { init = init context config
        , update = update
        , view = view
        , subscriptions = subscriptions
        }


{-| -}
type alias Flags =
    { name : String
    }


{-| -}
init : CardContext context -> Config sub subMsg context -> Flags -> ( Model sub subMsg context, Cmd (Msg subMsg context) )
init context config flags =
    ( { flags = flags
      , config = config
      , context = context
      , footer = False
      , state = Loading
      }
    , Time.now |> Task.perform Tick
    )


{-| -}
subscriptions : Model sub subMsg context -> Sub (Msg subMsg context)
subscriptions model =
    case model.state of
        Loading ->
            Sub.none

        Loaded inner ->
            model.config.subscriptions inner.sub
                |> Sub.map SubMsg


{-| -}
update : Msg subMsg context -> Model sub subMsg context -> ( Model sub subMsg context, Cmd (Msg subMsg context) )
update msg model =
    case msg of
        SubMsg m ->
            case model.state of
                Loaded inner ->
                    let
                        ( newSub, newSubMsgs ) =
                            model.config.update m inner.sub

                        newInner =
                            { inner | sub = newSub, msgs = m :: inner.msgs }
                    in
                    ( { model | state = Loaded newInner }
                    , Cmd.map SubMsg newSubMsgs
                    )

                _ ->
                    ( model, Cmd.none )

        ContextMsg newContext ->
            case model.state of
                Loaded inner ->
                    ( { model | state = Loaded { inner | contextValue = newContext } }
                    , Cmd.none
                    )

                _ ->
                    ( model, Cmd.none )

        ToggleFooter ->
            ( { model | footer = not model.footer }
            , Cmd.none
            )

        Tick time ->
            let
                seed =
                    Random.initialSeed (round time)

                contextValue =
                    Context.initialize model.context seed

                ( subModel, subMsgs ) =
                    model.config.model contextValue
            in
            ( { model
                | state =
                    Loaded
                        { sub = subModel
                        , contextValue = contextValue
                        , msgs = []
                        }
              }
            , Cmd.map SubMsg subMsgs
            )


{-| -}
view : Model model subMsg context -> Html (Msg subMsg context)
view model =
    case model.state of
        Loading ->
            Html.div []
                [ Html.div [ Html.Attributes.class "devcard-header" ]
                    [ Html.h1 []
                        [ Html.a [ Html.Attributes.href ("/" ++ model.flags.name) ] [ Html.text model.flags.name ] ]
                    ]
                , Html.div [ Html.Attributes.class "devcard-body" ]
                    [ Html.text "Loading..."
                    ]
                ]

        Loaded inner ->
            Html.div []
                [ Html.div [ Html.Attributes.class "devcard-header" ]
                    [ Html.div
                        [ Html.Attributes.style [ ( "float", "right" ) ] ]
                        [ Context.view model.context inner.contextValue |> Html.map ContextMsg ]
                    , Html.h1 []
                        [ Html.a [ Html.Attributes.href ("/" ++ model.flags.name) ] [ Html.text model.flags.name ] ]
                    ]
                , Html.div [ Html.Attributes.class "devcard-body" ]
                    [ model.config.view inner.contextValue inner.sub |> Html.map SubMsg
                    ]
                , Html.div [ Html.Attributes.class "devcard-footer" ] <|
                    if model.footer then
                        [ toggleFooterButton
                        , Html.h4 [] [ Html.text "State" ]
                        , Html.pre []
                            [ Html.text (toString inner.sub) ]
                        , Html.hr []
                            []
                        , Html.h4 [] [ Html.text "Events" ]
                        , Html.pre []
                            [ inner.msgs
                                |> List.map toString
                                |> String.join "\n"
                                |> Html.text
                            ]
                        ]
                    else
                        [ toggleFooterButton ]
                ]


{-| -}
toggleFooterButton : Html (Msg subMsg context)
toggleFooterButton =
    Html.button
        [ Html.Events.onClick ToggleFooter
        , Html.Attributes.class "toggle-button"
        ]
        [ Html.text "Toggle footer"
        ]