lootalot-client/src/Main.elm

module Main exposing (..)

import Browser
import Browser.Navigation as Nav
import Url
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Svg.Attributes
import Url.Parser as P exposing (Parser, (</>), oneOf, s)
import Set exposing (Set)
import Json.Encode as E

import Api exposing (Player, Loot, Wealth, Item, Claim, Claims)
import Modes exposing (ViewMode)

-- Main

main : Program () Model Msg
main =
    Browser.application
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        , onUrlChange = UrlChanged
        , onUrlRequest = LinkClicked
        }

-- Model

type alias Selection = Set Int

type alias State =
    { navKey : Nav.Key
    , route : Route
    , error : String
    , menuOpen : Bool
    , selection : Maybe Selection
    , activeMode : Maybe ViewMode
    }

type alias Model =
    { state : State
    , player: Player
    , claims : Claims
    , notification : Maybe String
    , loot: Maybe Loot
    , groupLoot : Maybe Loot
    , merchantItems : Maybe Loot
    }

init : () -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
    let
        route = case P.parse routeParser url of
                    Just r -> r
                    Nothing -> PlayerChest
    in
        ( Model
              (State key route "" False Nothing Nothing)
              Api.blankPlayer
              []
              Nothing
              Nothing
              Nothing
              Nothing
        , fetchInitialData 0)


fetchInitialData : Int -> Cmd Msg
fetchInitialData playerId =
    Cmd.batch
        [ initPlayer playerId
        , Cmd.map ApiMsg <| Api.fetchLoot Api.OfShop
        , Cmd.map ApiMsg <| Api.fetchLoot Api.OfGroup
        ]

initPlayer id =
    Cmd.batch
        [ Cmd.map ApiMsg <| Api.fetchPlayer id
        , Cmd.map ApiMsg <| Api.fetchLoot (Api.OfPlayer id)
        , Cmd.map ApiMsg <| Api.fetchClaims id
        ]

-- UPDATE

type Msg
    = LinkClicked Browser.UrlRequest
    | UrlChanged Url.Url
    | ApiMsg Api.Msg
    | PlayerChanged Int
    | LootViewItemSwitched Int
    | ModeSwitched (Maybe ViewMode)
    | ConfirmAction
    | UndoLastAction
    | ClearNotification

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        LinkClicked urlRequest ->
            case urlRequest of
                Browser.Internal url ->
                    ( model, Nav.pushUrl model.state.navKey (Url.toString url) )

                Browser.External href ->
                    ( setError ("External request '" ++ href ++ "'") model
                    , Cmd.none )

        UrlChanged url ->
            let
                route = P.parse routeParser url
                state = model.state
            in
                case route of
                    Just page ->
                        { model | state = { state | route = page }}
                            |> update (case page of
                                           -- Directly enter add mode on NewLoot view
                                           NewLoot -> ModeSwitched (Just Modes.Add)
                                           other -> ModeSwitched Nothing
                                      )

                    Nothing ->
                        ( setError "Invalid route" model, Cmd.none )

        PlayerChanged newId ->
            ( { model | player = Api.blankPlayer }, initPlayer newId )

        ApiMsg apiMsg -> case apiMsg of
            Api.GotActionResult response ->
                case response of
                    Ok result ->
                        let
                            updates = Maybe.withDefault [] result.updates
                            notification = result.notification
                            errors = Maybe.withDefault "" result.errors
                        in
                            List.foldl applyUpdate model updates
                                |> setNotification notification
                                |> setError errors
                                |> update (ModeSwitched Nothing)
                    Err r -> (setError (Debug.toString r) model, Cmd.none)

            Api.GotPlayer result ->
                case result of
                    Ok player ->
                        ( { model | player = player }
                        , Cmd.none
                        )
                    Err error ->
                        ( setError ("Fetching player... " ++ Debug.toString error) model
                        , Cmd.none
                        )

            Api.GotClaims id result ->
                case result of
                    Ok claims -> ( { model | claims = List.filter (\c -> c.player_id == id) claims}, Cmd.none )
                    Err error -> ( setError ("Fetching claims..." ++ Debug.toString error) model, Cmd.none)

            Api.GotLoot dest result ->
                case result of
                    Ok loot ->
                        ( case dest of
                            Api.OfPlayer _ -> { model | loot = Just loot}
                            Api.OfGroup -> { model | groupLoot = Just loot}
                            Api.OfShop -> { model | merchantItems = Just loot}
                        , Cmd.none
                        )
                    Err error ->
                        ( setError ("Fetching loot... " ++ Debug.toString error) model
                        , Cmd.none
                        )

        LootViewItemSwitched id ->
            let
                state = model.state
            in
            ( { model | state =
                    { state | selection = Debug.log "new selection"
                                <| switchSelectionState id state.selection }}
            , Cmd.none )

        ModeSwitched newMode ->
            let
                state = model.state
            in
            ( { model | state =
                    { state | activeMode = newMode
                            , selection =
                                case newMode of
                                    Nothing ->
                                        Nothing

                                    Just Modes.Grab -> -- Currently claimed object are initially selected
                                        Just ( Set.fromList <| List.map (\c -> c.loot_id) model.claims)

                                    Just others ->
                                        Just Set.empty
                    }}
            , Cmd.none )

        ConfirmAction ->
            case model.state.activeMode of
                Nothing ->
                    update (ModeSwitched Nothing) model

                Just mode ->
                    let items = targetItemsFor mode model
                                |> List.filter (itemInSelection model.state.selection)
                    in
                    ( model
                    , Cmd.map ApiMsg
                        <| Api.sendRequest
                            mode
                            (String.fromInt model.player.id)
                            items
                    )

        UndoLastAction ->
            (model, Cmd.map ApiMsg <| Api.undoLastAction model.player.id)

        ClearNotification ->
            ( { model | notification = Nothing }, Cmd.none )

setNotification : Maybe String -> Model -> Model
setNotification notification model =
    { model | notification = notification }

targetItemsFor : ViewMode -> Model -> List Item
targetItemsFor mode model =
    case mode of
        Modes.Add -> []
        Modes.Buy -> Maybe.withDefault [] model.merchantItems
        Modes.Sell ->Maybe.withDefault [] model.loot
        Modes.Grab -> Maybe.withDefault [] model.groupLoot

-- DbUpdates always refer to the active player's loot
applyUpdate : Api.Update -> Model -> Model
applyUpdate u model =
    case u of
        Api.ItemRemoved item -> { model | loot = Just
                                  <| List.filter (\i -> i.id /= item.id)
                                  <| Maybe.withDefault [] model.loot }
        Api.ItemAdded item -> { model | loot = Just
                                <| item :: Maybe.withDefault [] model.loot }
        Api.WealthUpdated diff ->
            let
                player = model.player
                wealth = player.wealth
            in
            { model | player = { player | wealth =
                    (Wealth
                         (wealth.cp + diff.cp)
                         (wealth.sp + diff.sp)
                         (wealth.gp + diff.gp)
                         (wealth.pp + diff.pp)
                    )}}
        Api.ClaimAdded _ -> model
        Api.ClaimRemoved _ -> model


-- ERRORS

setError : String -> Model -> Model
setError error model =
    let
        state = model.state
    in
        { model | state =
                { state | error = error }}


-- STATE Utils

switchSelectionState : Int -> Maybe Selection -> Maybe Selection
switchSelectionState id selection =
    case selection of
        Just s ->
            Just <| case Set.member id s of
                        True -> Set.remove id s
                        False -> Set.insert id s
        Nothing -> Debug.log "ignore switchSelectionState" Nothing

-- SUBSCRIPTIONS
--
subscriptions : Model -> Sub Msg
subscriptions _ =
    Sub.none


---
-- VIEWS
---

actionButton msg t icon color =
    button [ class <| "button level-item is-" ++ color
           , onClick msg ]
        [ span [ class "icon" ] [ i [ Svg.Attributes.class <| "fas fa-" ++ icon ] [] ]
        , p [] [text t]
        ]

controlsWhenModeActive : ViewMode -> List (Html Msg)
controlsWhenModeActive mode =
          [ actionButton (ConfirmAction) "Valider" "check" "primary"
          , actionButton (ModeSwitched Nothing) "Annuler" "times" "danger"
          ]

controlsWhenRoute : Route -> List (Html Msg)
controlsWhenRoute route =
    case route of
        PlayerChest -> [actionButton (ModeSwitched (Just Modes.Sell)) "Vendre" "coins" "danger"]
        GroupLoot -> [actionButton (ModeSwitched (Just Modes.Grab)) "Demander" "praying-hands" "primary"]
        Merchant -> [actionButton (ModeSwitched (Just Modes.Buy)) "Acheter" "coins" "success"]
        NewLoot -> [actionButton (ModeSwitched (Just Modes.Add)) "Nouveau loot" "plus" "primary"]
   
view : Model -> Browser.Document Msg
view model =
    let
        -- What do we show inside the chest ?
        (header, shownLoot) =
            case model.state.route of
                PlayerChest ->
                    ("Mon coffre", Maybe.withDefault [] model.loot)
                GroupLoot ->
                    ("Coffre de groupe", Maybe.withDefault [] model.groupLoot)
                Merchant ->
                    ("Marchand", Maybe.withDefault [] model.merchantItems)
                NewLoot ->
                    ("Nouveau trésor :)", [] )

        {- Dynamic renderers for ViewMode

            Header controls are inserted in the PlayerBar
            and rowControls to the right side of every item rows
        -}
        (headerControls, rowControls) =
            case model.state.activeMode of
                Just mode ->
                    ( controlsWhenModeActive mode, Just (rowControlsForMode mode isSelected))
                Nothing -> -- Buttons to enter mode
                    ( actionButton UndoLastAction "Annuler action" "backspace" "danger"
                      :: controlsWhenRoute model.state.route
                    -- Claim controls for Group chest
                    , case model.state.route of
                        GroupLoot -> Just (renderIfClaimed <| itemInClaims model.claims)
                        _ -> Nothing
                    )

        -- TODO: should we extract the Maybe conversion
        --       and represent cannotSelect with Nothing ??
        isSelected =
            itemInSelection model.state.selection
    in
    { title = "Loot-a-lot in ELM"
    , body =
        [ viewHeaderBar model
        , viewPlayerBar model.player model.notification headerControls
        , article [class "section container"]
                  [ p [class "heading"] [text header]
                  , viewSearchBar
                  , viewChest isSelected rowControls shownLoot
                  ]
        , hr [] []
        , section [class "container"] [viewDebugSection model]
        ]
    }

viewNotification : Maybe String -> Html Msg
viewNotification notification =
    case notification of
        Just t -> div [ class "notification is-success is-marginless"]
                      [ button [class "delete", onClick ClearNotification ] []
                      , text t ]
        Nothing -> text ""

-- LOOT Views

itemInSelection : Maybe Selection -> Item -> Bool
itemInSelection selection item =
    Maybe.map (Set.member item.id) selection
        |> Maybe.withDefault False

itemInClaims : List Claim -> Item -> Bool
itemInClaims claims item =
    List.any (\c -> c.loot_id == item.id) claims

renderIfClaimed : (Item -> Bool) -> Item -> Html Msg
renderIfClaimed isClaimed item =
    case isClaimed item of
        True ->  renderIcon "fas fa-praying-hands" "1x"
        False -> text ""

viewChest : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Loot -> Html Msg
viewChest isSelected rowControls items =
    table [ class "table is-fullwidth is-hoverable"]
        [ thead [ class "table-header" ]
                 [ th [] [ text "Nom" ] ]
        , tbody [] <| List.map (viewItemTableRow isSelected rowControls) items
        ]

-- Renders controls for a specific mode
rowControlsForMode : ViewMode -> (Item -> Bool) -> Item -> Html Msg
rowControlsForMode mode isSelected item =
    let
        itemInfo = case mode of
            Modes.Buy -> p [class "level-item"] [ text (String.fromInt item.base_price ++ "po")]
            Modes.Sell -> p [class "level-item"] [ text (String.fromFloat (toFloat item.base_price / 2) ++ "po")]
            Modes.Grab -> p [class "level-item"] [ text "Grab" ]
            Modes.Add -> p [class "level-item"] [ text "New !" ]
    in
    div [ class "level-right" ]
        <| itemInfo
        :: if Modes.canSelectIn mode then
             [input [ class "checkbox level-item"
                   , type_ "checkbox"
                   , checked <| isSelected item
                   , onCheck (\v -> LootViewItemSwitched item.id)
                   ] [] ]
         else
             []


viewItemTableRow : (Item -> Bool) -> Maybe (Item -> Html Msg) -> Item -> Html Msg
viewItemTableRow isSelected rowControls item =
    tr  [ classList [ ("is-selected", isSelected item) ] ]
        [ td []
            [ label [ class "level checkbox" ]
                  <| div [ class "level-left" ]
                         [ p [class "level-item"] [ text item.name ]]
                    :: case rowControls of
                              Just render -> List.singleton (render item)
                              Nothing -> []
            ]
        ]

-- DEBUG SECTION

viewDebugSection : Model -> Html Msg
viewDebugSection model =
    div [class "panel is-danger"]
        [ p [class "panel-heading"] [text "Debug"]
        , debugSwitchPlayers
        , p [class "panel-block has-text-danger"] [text model.state.error]
        , p [class "panel-block"] [text ("Route : " ++ Debug.toString model.state.route)]
        , p [class "panel-block"] [text ("Active Mode : " ++ Debug.toString model.state.activeMode)]
        , p [class "panel-block"] [text ("Selection : " ++ Debug.toString model.state.selection)]
        , p [class "panel-block"] [text ("Claims : " ++ Debug.toString model.claims)]
        , p []  debugSandbox
        ]

stackedIcon name =
    span [class "icon is-medium"]
        [ span [ class "fa-stack" ]
              [ i [ class "fas fa-circle fa-stack-2x" ] []
              , i [ class (name ++ " fa-inverse fa-stack-1x") ] []
              , text ""
              ]
        ]

debugSandbox =
    [ stackedIcon "fas fa-coins"
    , stackedIcon "fab fa-d-and-d"
    , stackedIcon "fas fa-praying-hands"
    , stackedIcon "fas fa-gem"
    , stackedIcon "fas fa-pen"
    , stackedIcon "fas fa-percentage"
    , stackedIcon "fas fa-store-alt"
    , stackedIcon "fas fa-cart-plus"
    , stackedIcon "fas fa-angry"
    , stackedIcon "fas fa-plus"
    , stackedIcon "fas fa-tools"
    , stackedIcon "fas fa-search"
    ]

debugSwitchPlayers : Html Msg
debugSwitchPlayers =
    div [ class "panel-tabs" ]
        [ a [ onClick (PlayerChanged 0) ] [text "Groupe"]
        , a [ onClick (PlayerChanged 1) ] [text "Lomion"]
        , a [ onClick (PlayerChanged 2) ] [text "Fefi"]
        ]


renderIcon name size =
    span [ class <| "icon is-medium"]
         [ i [ class <| name ++ " fa-" ++ size] [] ]


-- HEADER SECTION

viewHeaderBar : Model -> Html Msg
viewHeaderBar model =
    nav [ class "navbar container", class "is-info" ]
        [ div [ class "navbar-brand" ]
              [ a [ class "navbar-item", href "/"]
                  [ renderIcon "fab fa-d-and-d" "2x"
                  , span [] [ text model.player.name ]
                  ]
              , a [class "navbar-burger is-active"]
                  [ span [attribute "aria-hidden" "true"] []
                  , span [attribute "aria-hidden" "true"] []
                  , span [attribute "aria-hidden" "true"] []
                  ]
              ]
        , div [ class "navbar-menu is-active" ]
              [ div [class "navbar-end"]
                    [ a [class "navbar-item", href "/marchand"]
                        [ renderIcon "fas fa-store-alt" "1x"
                        , span [] [text "Marchand"]
                        ]
                    , a
                          [ class "navbar-item"
                          , href (if model.player.id == 0
                                  then
                                      "/nouveau-tresor"
                                  else
                                      "/coffre")
                          ]
                          [ renderIcon "fas fa-gem" "1x"
                          , span [] [text (if model.player.id == 0 then "Nouveau loot" else "Coffre de groupe")]
                          ]
                    ]
              ]

        ]

-- PLAYER BAR

viewPlayerBar : Player -> Maybe String -> List (Html Msg)-> Html Msg
viewPlayerBar player notification actionControls =
    section [ class "level container is-mobile box" ]
        [ div [class "level-left"]
               ([div [ class "level-item" ]
                    [ span [ class "icon is-large" ]
                            [ i [ class "fas fa-2x fa-piggy-bank" ] [] ]]
                ]
                ++ (viewWealth player.wealth)
                ++ (if player.debt > 0 then
                        [div [class "level-item"]
                            [p [class "heading is-size-4 has-text-danger"]
                                [text ("Dette : " ++ (String.fromInt player.debt) ++ "po")]
                            ]]
                    else
                        []
                   )
               )
        , viewNotification notification
        , div [class "level-right"] actionControls
        ]


viewWealth : Wealth -> List (Html Msg)
viewWealth wealth =
    [ showWealthField "pp" <| String.fromInt wealth.pp
    , showWealthField "gp" <| String.padLeft 2 '0' <| String.fromInt wealth.gp
    , showWealthField "sp" <| String.fromInt wealth.sp
    , showWealthField "cp" <| String.fromInt wealth.cp
    ]

showWealthField : String -> String -> Html Msg
showWealthField name value =
    div [ class "level-item" ]
        [ p [class "has-text-right"] [ strong [ class "heading is-marginless"] [text name]
               , span [ class <| "is-size-4" ] [ text value ]
               ]
        ]

-- Search Bar

viewSearchBar : Html Msg
viewSearchBar =
    input [class "input"] []

---
-- ROUTES
---

type Route
    = PlayerChest
    | Merchant
    | GroupLoot
    | NewLoot

routeParser : Parser (Route -> a) a
routeParser =
    oneOf
        [ P.map GroupLoot (P.s "coffre")
        , P.map PlayerChest P.top
        , P.map Merchant (P.s "marchand")
        , P.map NewLoot (P.s "nouveau-tresor")
        ]