From 1e47a7754ca38bd1a6c74765d8378caf68ce4619 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 26 Mar 2017 21:10:42 +0200 Subject: Separate client and server watch --- src/client/Dialog.elm | 165 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 src/client/Dialog.elm (limited to 'src/client/Dialog.elm') diff --git a/src/client/Dialog.elm b/src/client/Dialog.elm new file mode 100644 index 0000000..a7e059a --- /dev/null +++ b/src/client/Dialog.elm @@ -0,0 +1,165 @@ +module Dialog exposing + ( Msg(..) + , Model + , Config + , init + , update + , view + ) + +import Platform.Cmd exposing (Cmd) +import Task exposing (Task) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +-- Model + +type alias Model model modelMsg msg = + { config : Maybe (Config model msg) + , mapMsg : Msg model modelMsg msg -> msg + , model : model + } + +type alias Config model msg = + { className : String + , title : String + , body : model -> Html msg + , confirm : String + , confirmMsg : model -> msg + , undo : String + } + +init : model -> (Msg model modelMsg msg -> msg) -> Model model modelMsg msg +init model mapMsg = + { config = Nothing + , mapMsg = mapMsg + , model = model + } + +-- Update + +type Msg model modelMsg msg = + NoOp + | Update modelMsg + | UpdateAndClose msg + | OpenWithUpdate (Config model msg) modelMsg + | Open (Config model msg) + | Close + +update : (modelMsg -> model -> (model, Cmd modelMsg)) -> Msg model modelMsg msg -> model -> Model model modelMsg msg -> (Model model modelMsg msg, Cmd msg) +update updateModel msg baseModel model = + case msg of + NoOp -> + ( model + , Cmd.none + ) + + Update modelMsg -> + case updateModel modelMsg baseModel of + (newModel, effects) -> + ( { model | model = newModel } + , Cmd.map (model.mapMsg << Update) effects + ) + + UpdateAndClose msg -> + ( { model | config = Nothing } + , Task.perform (always msg) (Task.succeed msg) + ) + + OpenWithUpdate config modelMsg -> + case updateModel modelMsg baseModel of + (newModel, effects) -> + ( { model + | model = newModel + , config = Just config + } + , Cmd.map (model.mapMsg << Update) effects + ) + + Open config -> + ( { model | config = Just config } + , Cmd.none + ) + + Close -> + ( { model | config = Nothing } + , Cmd.none + ) + +-- View + +view : Model model modelMsg msg -> Html msg +view { mapMsg, config, model } = + let isVisible = + case config of + Just _ -> True + Nothing -> False + in div + [ class "dialog" ] + [ curtain mapMsg isVisible + , case config of + Nothing -> + text "" + Just c -> + dialog model mapMsg c + ] + +curtain : (Msg model modelMsg msg -> msg) -> Bool -> Html msg +curtain mapMsg isVisible = + div + [ class "curtain" + , style + [ ("position", "fixed") + , ("top", "0") + , ("left", "0") + , ("width", "100%") + , ("height", "100%") + , ("background-color", "rgba(0, 0, 0, 0.5)") + , ("z-index", if isVisible then "1000" else "-1") + , ("opacity", if isVisible then "1" else "0") + , ("transition", "all 0.2s ease") + ] + , onClick (mapMsg Close) + ] + [] + +dialog : model -> (Msg model modelMsg msg -> msg) -> Config model msg -> Html msg +dialog model mapMsg { className, title, body, confirm, confirmMsg, undo } = + div + [ class ("content " ++ className) + , style + [ ("position", "fixed") + , ("top", "25%") + , ("left", "50%") + , ("transform", "translate(-50%, -25%)") + , ("z-index", "1000") + , ("background-color", "white") + , ("padding", "20px") + , ("border-radius", "5px") + , ("box-shadow", "0px 0px 15px rgba(0, 0, 0, 0.5)") + ] + ] + [ h1 [] [ text title ] + , body model + , div + [ style + [ ("float", "right") + ] + ] + [ button + [ class "confirm" + , onClick (confirmMsg model) + , style + [ ("margin-right", "15px") + ] + ] + [ text confirm ] + , button + [ class "undo" + , onClick (mapMsg Close) + ] + [ text undo ] + ] + ] -- cgit v1.2.3