Lightbox.elm

Lightbox.elm

import Html exposing (..)
import Html.Attributes as Attr
import Html.Events exposing (onClick)


main = 
  Html.program
    { init = (initialModel, Cmd.none) 
    , view = view
    , update = update
    , subscriptions = (\x -> Sub.none)
    }

-- recursive type
type View = View (Model -> Html Msg)

type Msg 
  = UpdateLightbox View
  | HideLightbox
  
type alias Model = 
  { lightbox : Maybe View
  , lightboxVisible: Bool
  }
 
initialModel : Model
initialModel = 
  { lightbox = Nothing
  , lightboxVisible = False
  }

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = 
  case msg of 
    UpdateLightbox view ->
      { model | lightbox = (Just view), lightboxVisible = True } ! []
    HideLightbox -> 
      { model | lightboxVisible = False } ! []
 
view : Model -> Html Msg
view model = 
  div [] 
    -- I like this library http://package.elm-lang.org/packages/elm-community/html-extra/2.2.0/Html-Events-Extra
    -- To prevent default on the initial click
    [  a [ onClick (UpdateLightbox (View test)) ] [ text "Click for lightbox" ]
    ,  lightbox model
    ]
    
lightbox : Model -> Html Msg 
lightbox model = 
  let link = a [ onClick HideLightbox ] [ text "X" ]
      content = 
        case model.lightbox of 
          Nothing -> 
            text "No Content" 
          Just view ->
            case view of 
              View viewFunc ->
                viewFunc model
  in
      div [ Attr.class "lightbox", style model.lightboxVisible ] [ link, content ]
 
style : Bool -> Html.Attribute msg 
style visible =  
  case visible of 
    True ->
      Attr.style [ ("visibility", "visible"), ("opacity", "1") ]
    False ->
      Attr.style [ ("visibility", "hidden"), ("opacity", "0") ]

-- lightbox view content
test : Model -> Html Msg
test model =
  div []
    [ h1 [] [ text "Test Lightbox" ] ]