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