jon/elm/Main.elm

module Main exposing (..)

import Browser
import Dict exposing (Dict)
import Html exposing (..)
import Html.Attributes exposing
    ( checked
    , disabled
    , style
    , type_
    , value
    )
import Html.Events exposing (..)
import Http
import Json.Decode as Dec
import Json.Decode.Pipeline exposing (..)
import Json.Encode as Enc
import Set exposing (Set)

main = Browser.document
    { init = \() -> init
    , subscriptions = \_ -> Sub.none
    , update = update
    , view = \outerState -> { title = "jon",  body = [ view outerState ] }
    }

getOverviewItems : Int -> Cmd Msg
getOverviewItems location = Http.post
    { url = "/rpc/getOverviewItems"
    , body = Http.jsonBody <| Enc.object
        [ ("location", Enc.int location)
        ]
    , expect = Http.expectJson RcvOverview <| Dec.list decodeOI
    }

rpc : { func : String, args : Enc.Value, expect : Dec.Decoder a } -> (Result Http.Error a -> b) -> Cmd b
rpc { func, args, expect } mkMsg = Http.post
    { url = "/rpc/" ++ func
    , body = Http.jsonBody args
    , expect = Http.expectJson mkMsg expect
    }

getLocations : Cmd Msg
getLocations = rpc
    { func = "getLocations"
    , args = Enc.object []
    , expect = Dec.list (Dec.succeed Location
        |> required "id" Dec.int
        |> required "name" Dec.string)
    } RcvLocations

adjustInventory : Int -> Int -> String -> Cmd Msg
adjustInventory itemId adjustment description = Http.post
    { url = "/rpc/adjustInventory"
    , body = Http.jsonBody <| Enc.object
        [ ("item", Enc.int itemId)
        , ("amount", Enc.int adjustment)
        , ("description", Enc.string description)
        ]
    , expect = Http.expectWhatever (\_ -> RcvOther)
    }

type alias InventoryTransferDTO = { from : Int, to : Int, amount : Int }

transferInventory : List InventoryTransferDTO -> Cmd Msg
transferInventory transfers = Http.post
    { url = "/rpc/transferInventory"
    , body = Http.jsonBody (Enc.object
        [ ("transfers", Enc.list encodeTransfer transfers)
        ])
    , expect = Http.expectWhatever (\_ -> RcvOther)
    }

encodeTransfer t = Enc.object
    [ ("from", Enc.int t.from)
    , ("to", Enc.int t.to)
    , ("amount", Enc.int t.amount)
    ]

disableItems : List Int -> Cmd Msg
disableItems ids = Http.post
    { url = "/rpc/disableItems"
    , body = Http.jsonBody (Enc.object
        [ ("items", Enc.list Enc.int ids)
        ])
    , expect = Http.expectWhatever (\_ -> RcvOther)
    }

deleteSnack : Int -> Cmd Msg
deleteSnack snack = Http.post
   { url = "/rpc/deleteSnack"
    , body = Http.jsonBody (Enc.object
        [ ("snack", Enc.int snack)
        ])
    , expect = Http.expectWhatever (\_ -> RcvOther)
    }

decodeOI = Dec.succeed OverviewItem
    |> requiredAt ["item", "id"] Dec.int
    |> requiredAt ["item", "barcode"] Dec.string
    |> requiredAt ["item", "name"] Dec.string
    |> requiredAt ["overview", "unitsLeft"] Dec.int
    |> requiredAt ["item", "unitPrice"] Dec.float
    |> requiredAt ["item", "bought"] Dec.string
    |> requiredAt ["overview", "activeMappings"] Dec.int
    |> requiredAt ["item", "group"] Dec.int
    |> requiredAt ["overview", "groupName"] Dec.string

getSnacksByItem : OverviewItem -> Cmd Msg
getSnacksByItem item = rpc
    { func = "getSnacksByItemId"
    , args = Enc.object
        [ ("item", Enc.int item.id)
        ]
    , expect = Dec.list decodeSnack
    } (RcvSnacks item)

type alias Snack =
    { id : Int
    , name : String
    , barcode : String
    , price : Float
    , location : Int
    , taxGroup : Int
    }

decodeSnack = Dec.succeed Snack
    |> required "id" Dec.int
    |> required "name" Dec.string
    |> required "barcode" Dec.string
    |> required "price" Dec.float
    |> required "location" Dec.int
    |> required "taxGroup" Dec.int

type alias OverviewItem =
    { id : Int
    , barcode : String
    , name : String
    , unitsLeft : Int
    , price : Float
    , bought : String
    , activeMappings : Int
    , groupId : Int
    , groupName : String
    }

type alias Location =
    { id : Int
    , name : String
    }

type OuterState
    = LoadingLocations
    | LocationSelector (List Location)
    | Initialized { locations : List Location, location : Location } State

type State
    = Overview
        { selectedItems : Set Int
        , desiredInventory : Dict Int Int
        , overviewItems : List OverviewItem
        }
    | ViewingItem
        { item : OverviewItem
        , snacks : List Snack
        }

type Msg
    = SelectLocation Location
    | SelectItem Int Bool
    | ChangeLocation
    | SetDesiredInventory Int String
    | TransferInventory Int
    | GoBack
    -- RPC calls
    | CallDisableItems (List Int)
    | CallAdjustInventory Int Int String
    | CallGetSnacksById OverviewItem
    | CallDeleteSnack Int
    -- Responses
    | RcvLocations (Result Http.Error (List Location))
    | RcvOverview (Result Http.Error (List OverviewItem))
    | RcvSnacks OverviewItem (Result Http.Error (List Snack))
    | RcvOther

init = (LoadingLocations, getLocations)

update msg outerState = case msg of
    CallAdjustInventory item amount desc -> (outerState, adjustInventory item amount desc)
    CallDisableItems items -> (outerState, disableItems items)
    CallGetSnacksById item -> (outerState, getSnacksByItem item)
    CallDeleteSnack snack -> (outerState, deleteSnack snack)
    _ -> case outerState of
        LoadingLocations -> case msg of
            RcvLocations (Ok locations) ->
                (LocationSelector locations, Cmd.none)
            _ ->
                (outerState, Cmd.none)
        LocationSelector locations -> case msg of
            SelectLocation location ->
                (Initialized { locations = locations, location = location } <| Overview
                    { selectedItems = Set.empty
                    , desiredInventory = Dict.empty
                    , overviewItems = []
                    }
                , getOverviewItems location.id
                )
            _ ->
                (outerState, Cmd.none)
        Initialized global state -> case msg of
            ChangeLocation ->
                (LocationSelector global.locations, Cmd.none)
            _ ->
                let
                    (newState, cmd) = stateMachine msg global state
                in
                    (Initialized global newState, cmd)

stateMachine msg global state = case state of
    Overview model -> case msg of
        RcvOverview (Ok overviewItems) ->
            (Overview
                { selectedItems = Set.empty
                , desiredInventory = Dict.empty
                , overviewItems = overviewItems
                }
            , Cmd.none
            )
        RcvSnacks item (Ok snacks) ->
            (ViewingItem { item = item, snacks = snacks }, Cmd.none)
        RcvOther ->
            (state, getOverviewItems global.location.id)
        SelectItem itemId selected ->
            (Overview { model | selectedItems = setSelect itemId selected model.selectedItems }, Cmd.none)
        SetDesiredInventory itemId invStr -> case String.toInt invStr of
            Just inv ->
                (Overview { model | desiredInventory = Dict.insert itemId inv model.desiredInventory }, Cmd.none)
            Nothing ->
                (state, Cmd.none)
        TransferInventory targetId ->
            let
                transfers =
                    model.overviewItems
                    |> List.filterMap (\oi ->
                        if Set.member oi.id model.selectedItems
                        then Just { from = oi.id, to = targetId, amount = oi.unitsLeft }
                        else Nothing)
            in
                (state, transferInventory transfers)
        _ ->
            (state, Cmd.none)
    ViewingItem { item } -> case msg of
        GoBack ->
            (Overview { selectedItems = Set.empty, desiredInventory = Dict.empty, overviewItems = [] }, getOverviewItems global.location.id)
        RcvSnacks item_ (Ok snacks) ->
            (ViewingItem { item = item_, snacks = snacks }, Cmd.none)
        RcvOther ->
            (state, getSnacksByItem item)
        _ ->
            (state, Cmd.none)

view outerState = case outerState of
    LoadingLocations -> progress [] []
    LocationSelector locations ->
        let
            viewLocationButton location =
                button [ onClick <| SelectLocation location ] [ text location.name ]
        in
            div []
                [ p [] [ text "Raum auswählen:" ]
                , div [] <| List.map viewLocationButton locations
                ]
    Initialized global state ->
        div []
            [ h2 []
                [ text <| "Inventar " ++ global.location.name ++ " "
                , button [ onClick ChangeLocation ] [ text "Raum ändern" ]
                ]
            , viewState global state
            ]

viewState global state = case state of
    Overview { selectedItems, desiredInventory, overviewItems } ->
        let
            header = tableCells th <| List.map text [ "", "ID", "Artikel", "EAN", "Preis", "Kaufdatum", "Snackeinträge", "Inventar", "Aktionen" ]
            viewOverviewItem oi =
                let
                    adjustedInventory = Maybe.withDefault oi.unitsLeft <| Dict.get oi.id desiredInventory
                    mkAdjustInventoryMsg itemId adjustment =
                        if adjustment > 0
                        then CallAdjustInventory itemId adjustment "Gewinn"
                        else CallAdjustInventory itemId adjustment "Verlust"
                    viewAdjustedInventory adjustment =
                        if adjustment == 0
                        then ""
                        else if adjustment > 0
                        then "(+" ++ String.fromInt adjustment ++ ")"
                        else "(" ++ String.fromInt adjustment ++ ")"
                    
                    sumSelected =
                        overviewItems
                        |> List.filter (\x -> Set.member x.id selectedItems)
                        |> List.map .unitsLeft
                        |> List.sum
                in
                    tableCells td
                        [ input
                            [ type_ "checkbox"
                            , onCheck <| SelectItem oi.id
                            , checked <| Set.member oi.id selectedItems
                            ] []
                        , text <| String.fromInt oi.id
                        , text oi.name
                        , code [] [ text oi.barcode ]
                        , text <| showEuros oi.price
                        , text <| Tuple.first <| splitAt 'T' oi.bought
                        , text <| String.fromInt oi.activeMappings
                        , input
                            [ type_ "number"
                            , onInput <| SetDesiredInventory oi.id
                            , value <| String.fromInt adjustedInventory
                            , style "width" "5em"
                            ] []
                        , div []
                            [ button
                                (if adjustedInventory == oi.unitsLeft
                                    then [ disabled True ]
                                    else [ onClick <| mkAdjustInventoryMsg oi.id <| adjustedInventory - oi.unitsLeft ])
                                [ text <| "Inventar korrigieren" ++ viewAdjustedInventory (adjustedInventory - oi.unitsLeft) ]
                            , button
                                (if oi.unitsLeft /= 0
                                    then [ disabled True ]
                                    else [ onClick <| CallDisableItems [oi.id] ])
                                [ text "Eintrag deaktivieren" ]
                            , button
                                (if Set.member oi.id selectedItems || sumSelected == 0
                                    then [ disabled True ]
                                    else [ onClick <| TransferInventory oi.id ])
                                [ text <| String.fromInt sumSelected ++ " Einheiten umbuchen" ]
                            , button [ onClick <| CallGetSnacksById oi ] [ text "Anzeigen" ]
                            ]
                        ]
        in
            div []
                [ table [] <| [header] ++ List.map viewOverviewItem overviewItems
                ]
    ViewingItem { item, snacks } ->
        let
            header = tableCells th <| List.map text [ "ID", "Artikel", "Barcode", "Bruttoverkaufspreis", "Aktionen" ]
            viewSnack snack = tableCells td
                [ text <| String.fromInt snack.id
                , text snack.name
                , code [] [ text snack.barcode ]
                , text <| showEuros snack.price ++ " (+" ++ showEuros (roundTo 2 <| snack.price - item.price) ++ ")"
                , div []
                    [ button [ onClick <| CallDeleteSnack snack.id ] [ text "Deaktivieren" ]
                    ]
                ]
            itemProp label value = tr []
                [ th [ style "text-align" "left" ] [ text label ]
                , td [] value
                ]
        in
            div []
                [ button [ onClick GoBack ] [ text "Zurück" ]
                , fieldset []
                    [ legend [] [ text <| "Inventareintrag " ++ String.fromInt item.id ]
                    , table []
                        [ tbody []
                            [ itemProp "ID" [ text <| String.fromInt item.id ]
                            , itemProp "EAN" [ code [] [ text item.barcode ] ]
                            , itemProp "Artikel" [ text item.name ]
                            , itemProp "Gruppe" [ text <| item.groupName ++ " (" ++ String.fromInt item.groupId ++ ")" ]
                            , itemProp "Inventar" [ text <| String.fromInt item.unitsLeft ]
                            , itemProp "Kaufdatum" [ text <| Tuple.first <| splitAt 'T' item.bought ]
                            , itemProp "Nettoeinkaufspreis" [ text <| showEuros item.price ]
                            ]
                        ]
                    ]
                , h3 [] [ text "Snacks" ]
                , table []
                    [ thead [] [ header ]
                    , tbody [] <| List.map viewSnack snacks
                    ]
                ]

-- utils

tableCells f =
    let
        mkTd elem = f [] [ elem ]
    in
        tr [] << List.map mkTd

setSelect elem state =
    (if state then Set.insert else Set.remove) elem

splitAt : Char -> String -> (String, String)
splitAt delim str =
    let
        locate c s = case String.uncons s of
            Nothing -> 0
            Just (x, xs) ->
                if x == c then
                    0
                else
                    1 + locate c xs

        firstOcc = locate delim str
    in
        (String.slice 0 firstOcc str, String.slice (firstOcc + 1) (String.length str) str)

showEuros : Float -> String
showEuros x =
    let
        (whole, fractional) = splitAt '.' (String.fromFloat x)
    in
        whole ++ "," ++ String.slice 0 2 (fractional ++ "00") ++ "€"

roundTo : Int -> Float -> Float
roundTo decimals x =
    let
        m = toFloat <| 10^decimals
    in
        toFloat (round (x * m)) / m