module Main exposing (..) import Browser import Browser.Navigation as Nav import Bulma as B import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Json.Encode as E import Page exposing (Page) import Route exposing (..) import Session exposing (..) import Svg.Attributes import Url -- Main main : Program () Model Msg main = Browser.application { init = init , view = view , update = update , subscriptions = subscriptions , onUrlChange = UrlChanged , onUrlRequest = LinkClicked } -- Model type alias Model = { navbar : Navbar , page : Page } type alias Navbar = { menuOpen : Bool , navKey : Nav.Key } initNavbar key = Navbar False key type alias HasPage r = { r | page : Page } setPage : Page -> HasPage r -> HasPage r setPage page model = { model | page = page } init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init _ url key = let _ = Debug.log "init with url" (Debug.toString url) in ( { navbar = initNavbar key , page = Page.Loading } , Session.init SessionLoaded key ) -- VIEW view : Model -> Browser.Document Msg view model = let ( title, header, content ) = Page.view model.page in { title = title , body = viewHeaderBar header.title header.links model.navbar :: List.map (Html.map PageMsg) content } -- HEADER SECTION navLink icon linkText url = a [ class "navbar-item", href url ] [ B.icon { icon = icon, ratio = Just "fa-1x", size = Just "is-medium" } , span [] [ text linkText ] ] viewHeaderBar : String -> List (Html Msg) -> Navbar -> Html Msg viewHeaderBar navbarTitle navbarLinks navbar = nav [ class "navbar container is-transparent is-spaced " ] [ div [ class "navbar-brand" ] [ p [ class "navbar-item" ] [ B.icon { icon = "fab fa-d-and-d" , size = Just "is-medium" , ratio = Just "fa-2x" } , span [ class "title is-4" , style "padding-left" "0.4em" ] [ text navbarTitle ] ] , a [ class "navbar-burger" , classList [ ( "is-active", navbar.menuOpen ) ] , onClick SwitchMenuOpen ] [ span [ attribute "aria-hidden" "true" ] [] , span [ attribute "aria-hidden" "true" ] [] , span [ attribute "aria-hidden" "true" ] [] ] ] , div [ class "navbar-menu" , classList [ ( "is-active", navbar.menuOpen ) ] ] [ div [ class "navbar-end" ] navbarLinks ] ] -- UPDATE type Msg = UrlChanged Url.Url | LinkClicked Browser.UrlRequest | SessionLoaded (Result String Session) | PageMsg Page.PageMsg | SwitchMenuOpen update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case ( msg, model.page ) of ( SessionLoaded session, _ ) -> case session of Ok logged -> let ( page, cmd ) = Page.initHome logged in ( model |> setPage page, Cmd.map PageMsg cmd ) Err error -> let _ = Debug.log "SessionLoaded Error" error in ( model |> setPage Page.About, Cmd.none ) ( LinkClicked urlRequest, _ ) -> case urlRequest of Browser.Internal url -> let _ = Debug.log "internal url request" (Debug.toString url) in ( model, Nav.pushUrl model.navbar.navKey (Url.toString url) ) Browser.External href -> ( model, Cmd.none ) ( UrlChanged url, from ) -> -- Handle routing according to current page case Route.fromUrl url of Just Route.Merchant -> let ( shopPage, cmd ) = Page.gotoShop from in ( model |> setPage shopPage, Cmd.map PageMsg cmd ) Just Route.Home -> let ( shopPage, cmd ) = Page.gotoHome from in ( model |> setPage shopPage, Cmd.map PageMsg cmd ) Just Route.GroupChest -> let ( page, cmd ) = Page.gotoGroupChest from in ( model |> setPage page, Cmd.map PageMsg cmd ) {- ( Just route, Page.Admin admin ) -> Admin.routeChanged route admin |> updatePage Page.Admin GotAdminMsg model -} _ -> ( model |> setPage Page.About, Cmd.none ) ( SwitchMenuOpen, _ ) -> ( { model | navbar = Navbar (not model.navbar.menuOpen) model.navbar.navKey }, Cmd.none ) ( PageMsg pageMsg, page ) -> let ( newPage, cmd ) = Page.update pageMsg page in ( { model | page = newPage } , Cmd.map PageMsg cmd ) -- SUBSCRIPTIONS -- subscriptions : Model -> Sub Msg subscriptions _ = Sub.none