Fix typo

elm/Main.elm

@@ -1,8 +1,15 @@
 module Main exposing (..)
 
 import Browser
+import Dict exposing (Dict)
 import Html exposing (..)
-import Html.Attributes exposing (..)
+import Html.Attributes exposing
+    ( checked
+    , disabled
+    , style
+    , type_
+    , value
+    )
 import Html.Events exposing (..)
 import Http
 import Json.Decode as Dec
@@ -10,40 +17,58 @@ import Json.Decode.Pipeline exposing (..)
 import Json.Encode as Enc
 import Set exposing (Set)
 
-main = Browser.element
-    { init = \() -> (init, getUnsoundBarcodes loc)
+main = Browser.document
+    { init = \() -> init
     , subscriptions = \_ -> Sub.none
     , update = update
-    , view = view
+    , view = \outerState -> { title = "jon",  body = [ view outerState ] }
     }
 
-getUnsoundBarcodes : Int -> Cmd Msg
-getUnsoundBarcodes location = Http.post
-    { url = "/rpc/getUnsoundBarcodes"
-    , body = Http.jsonBody (Enc.object [("location", Enc.int location)])
-    , expect = Http.expectJson RcvUnsoundBarcodes <| Dec.list (Dec.map3 UnsoundBarcode
-        (Dec.field "barcode" Dec.string)
-        (Dec.field "name" Dec.string)
-        (Dec.field "entries" Dec.int))
+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
     }
 
-getActiveItems : String -> Int -> Cmd Msg
-getActiveItems barcode location = Http.post
-    { url = "/rpc/getActiveItems"
-    , body = Http.jsonBody (Enc.object
-        [ ("barcode", Enc.string barcode)
-        , ("location", Enc.int location)
-        ])
-    , expect = Http.expectJson (RcvActiveItems barcode) <| 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
     }
 
-transferInventory : List { from : Int, to : Int, amount : Int } -> Cmd Msg
+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 RcvTransferResponse
+    , expect = Http.expectWhatever (\_ -> RcvOther)
     }
 
 encodeTransfer t = Enc.object
@@ -58,7 +83,16 @@ disableItems ids = Http.post
     , body = Http.jsonBody (Enc.object
         [ ("items", Enc.list Enc.int ids)
         ])
-    , expect = Http.expectWhatever RcvDisableItemResponse
+    , 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
@@ -69,13 +103,35 @@ decodeOI = Dec.succeed OverviewItem
     |> 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
 
-type alias UnsoundBarcode =
-    { barcode : 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
-    , entries : Int
+    , 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
@@ -84,118 +140,286 @@ type alias OverviewItem =
     , price : Float
     , bought : String
     , activeMappings : Int
+    , groupId : Int
+    , groupName : String
     }
 
-type Model
-    = Init
-    | UBList (List UnsoundBarcode)
-    | Overview String (Set Int) (List OverviewItem)
+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
-    = RcvUnsoundBarcodes (Result Http.Error (List UnsoundBarcode))
-    | GetActiveItems String Int
-    | RcvActiveItems String (Result Http.Error (List OverviewItem))
-    | SetSelected Int Bool
-    | TransferInventory (List { amount : Int, from : Int, to : Int })
-    | RcvTransferResponse (Result Http.Error ())
-    | DisableItem Int
-    | RcvDisableItemResponse (Result Http.Error ())
+    = 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 = Init
-loc = 2
+init = (LoadingLocations, getLocations)
 
-update msg model = case model of
-    Init -> case msg of
-        RcvUnsoundBarcodes (Ok ubs) -> (UBList ubs, Cmd.none)
-        _ -> (model, Cmd.none)
-    UBList _ -> case msg of
-        GetActiveItems barcode location -> (model, getActiveItems barcode location)
-        RcvActiveItems barcode (Ok ois) -> (Overview barcode (Set.empty) ois, Cmd.none)
-        _ -> (model, Cmd.none)
-    Overview barcode selectedItems ois -> case msg of
-        SetSelected id checked -> (Overview barcode ((if checked then Set.insert else Set.remove) id selectedItems) ois, Cmd.none)
-        TransferInventory transfers -> (model, transferInventory transfers)
-        RcvTransferResponse _ -> (model, getActiveItems barcode loc)
-        RcvActiveItems barcode_ (Ok ois_) -> (Overview barcode_ (Set.empty) ois_, Cmd.none)
-        DisableItem id -> (model, disableItems [id])
-        RcvDisableItemResponse _ -> (model, getActiveItems barcode loc)
-        GoBack -> (model, getUnsoundBarcodes loc)
-        RcvUnsoundBarcodes (Ok ubs) -> (UBList ubs, Cmd.none)
-        _ -> (model, Cmd.none)
+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)
 
-view model = case model of
-    Init -> h1 [] [ text "It works!" ]
-    UBList ubs -> viewUBList ubs
-    Overview barcode selectedItems ois -> viewOverview barcode selectedItems ois
+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)
 
-viewUBList ubs =
-    let
-        header = tr []
-            [ th [] [ text "Barcode" ]
-            , th [] [ text "Artikel" ]
-            , th [] [ text "Einträge" ]
-            , th [] [ text "Aktionen" ]
-            ]
-        viewUB ub = tr []
-            [ td [] [ text ub.barcode ]
-            , td [] [ text ub.name ]
-            , td [] [ text <| String.fromInt ub.entries ]
-            , td [] [ button [ onClick (GetActiveItems ub.barcode loc) ] [ text "Einträge ansehen" ] ]
-            ]
-    in
-        table [] ([header] ++ List.map viewUB ubs)
-
-viewOverview : String -> Set Int -> List OverviewItem -> Html Msg
-viewOverview barcode selectedItems ois =
-    let
-        sumSelected =
-            List.sum
-            <| List.map (\oi -> oi.unitsLeft)
-            <| List.filter (\oi -> Set.member oi.id selectedItems) ois
-
-        header = tr []
-            [ th [] []
-            , th [] [ text "ID" ]
-            , th [] [ text "Barcode" ]
-            , th [] [ text "Artikel" ]
-            , th [] [ text "Kaufdatum" ]
-            , th [] [ text "Inventar (Soll)" ]
-            , th [] [ text "Preis" ]
-            , th [] [ text "Snackeinträge" ]
-            , th [] [ text "Aktionen" ]
-            ]
-        viewOI oi = tr []
-            [ th [] [ input [ type_ "checkbox", onCheck <| SetSelected oi.id, selected <| Set.member oi.id selectedItems ] [] ]
-            , td [] [ text <| String.fromInt oi.id ]
-            , td [] [ text oi.barcode ]
-            , td [] [ text oi.name ]
-            , td [] [ text oi.bought ]
-            , td [] [ text <| String.fromInt oi.unitsLeft ]
-            , td [] [ text <| String.fromFloat oi.price ]
-            , td [] [ text <| String.fromInt oi.activeMappings ]
-            , td [] (viewButtons oi)
-            ]
-        viewButtons oi =
-            [ button
-                [ disabled <| Set.member oi.id selectedItems || sumSelected == 0
-                , onClick <| mkTransferMessage selectedItems oi.id
+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
                 ]
-                [ text <| String.fromInt sumSelected ++ " Einträge umbuchen" ]
-            , button
-                [ disabled <| oi.unitsLeft /= 0 || oi.activeMappings /= 0
-                , onClick <| DisableItem oi.id
-                ]
-                [ text "Eintrag deaktivieren" ]
-            ]
-        mkTransferMessage fromIds toId =
-            TransferInventory
-            <| List.map (\oi -> { amount = oi.unitsLeft, from = oi.id, to = toId })
-            <| List.filter (\oi -> Set.member oi.id fromIds) ois
-
-    in
+    Initialized global state ->
         div []
-            [ button [ onClick GoBack ] [ text "Zurück" ]
-            , h2 [] [ text barcode ]
-            , table [] ([header] ++ List.map viewOI ois)
+            [ 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

src/Jon/Garfield/Queries.hs

@@ -68,6 +68,17 @@ locations
     :: Q Postgres GarfieldDb s (LocationT (QExpr Postgres s))
 locations = all_ garfieldDb.locations
 
+getSnacksByItemId
+    :: InventoryItemId
+    -> Q Postgres GarfieldDb s (SnackT (QExpr Postgres s))
+getSnacksByItemId item = do
+    im <- all_ garfieldDb.inventoryMap
+    sn <- related_ garfieldDb.snacks im.snackId
+    sa <- oneToOne_ garfieldDb.snacksAvailable (.snackId) sn 
+    guard_ $ im.inventoryId ==. val_ item
+    guard_ $ sa.available
+    pure sn
+
 -- Inserts
 
 runInserts
@@ -76,6 +87,14 @@ runInserts
     -> IO ()
 runInserts conn is = runBeamPostgresDebug putStrLn conn $ mapM_ runInsert is
 
+adjustInventory
+    :: InventoryItemId
+    -> Int64
+    -> Text
+    -> SqlInsert Postgres CorrectionT
+adjustInventory item amount desc = insert garfieldDb.inventoryCorrections $
+    insertExpressions [Correction (val_ item) default_ (val_ amount) (val_ desc)]
+
 transfer
     :: InventoryItemId -- ^ to
     -> InventoryItemId -- ^ from

src/Jon/Garfield/Types.hs

@@ -20,6 +20,9 @@ module Jon.Garfield.Types
     , InventoryItemGroup
     , InventoryItemGroupId
     , InventoryItemGroupT(..)
+    , InventoryMap
+    , InventoryMapId
+    , InventoryMapT(..)
     , TaxGroup
     , TaxGroupId
     , TaxGroupT(..)
@@ -32,6 +35,9 @@ module Jon.Garfield.Types
     , Snack
     , SnackId
     , SnackT(..)
+    , SnackAvailable
+    , SnackAvailableId
+    , SnackAvailableT(..)
     , Sale
     , SaleId
     , SaleT(..)
@@ -43,16 +49,18 @@ module Jon.Garfield.Types
     , mkInventoryItemId
     , mkTaxGroupId
     , mkLocationId
-    , mkSnackId
     , mkSaleId
+    , mkSnackId
+    , mkSnackAvailableId
     , mkUserId
     , unOverviewId
     , unInventoryItemId
     , unInventoryItemGroupId
     , unTaxGroupId
     , unLocationId
-    , unSnackId
     , unSaleId
+    , unSnackId
+    , unSnackAvailableId
     , unUserId
     ) where
 
@@ -97,6 +105,8 @@ data GarfieldDb f = GarfieldDb
     , snacks               :: f (TableEntity SnackT)
     , sales                :: f (TableEntity SaleT)
     , users                :: f (TableEntity UserT)
+    , inventoryMap         :: f (TableEntity InventoryMapT)
+    , snacksAvailable      :: f (TableEntity SnackAvailableT)
     } deriving (Generic, Database be)
 
 setGarfieldEntityName name = setEntitySchema (Just "garfield") <> setEntityName name
@@ -168,6 +178,14 @@ garfieldDb = defaultDbSettings `withDbModification`
             , alwaysSendBalanceMail = "always_send_balance_mail"
             , sendHistoryMail       = "send_history_mail"
             }
+        , inventoryMap = setGarfieldEntityName "inventory_map" <> modifyTableFields tableModification
+            { inventoryId = InventoryItemId "inventory_id"
+            , snackId     = SnackId "snack_id"
+            }
+        , snacksAvailable = setGarfieldEntityName "snacks_available" <> modifyTableFields tableModification
+            { snackId   = SnackId "snack_id"
+            , available = "snack_available"
+            }
         }
 
 -- Views
@@ -311,11 +329,11 @@ instance Table CorrectionT where
 data SnackT f = Snack
     { id            :: C f Int32
     , name          :: C f Text
-    , barcode       :: C f Text
+    , barcode       :: C (Nullable f) Text
     , price         :: C f Scientific
     , location      :: PrimaryKey LocationT f
     -- , snackModifiedBy :: PrimaryKey UserT f
-    , timestamp     :: C f UTCTime
+    , timestamp     :: C (Nullable f) UTCTime
     , taxGroup      :: PrimaryKey TaxGroupT f
     } deriving (Beamable, Generic)
 
@@ -382,3 +400,40 @@ instance Table UserT where
     data PrimaryKey UserT f
         = UserId { unUserId :: C f Int32 } deriving (Beamable, Generic)
     primaryKey = UserId . (.id)
+
+
+data InventoryMapT f = InventoryMap
+    { inventoryId :: PrimaryKey InventoryItemT f
+    , snackId     :: PrimaryKey SnackT f
+    } deriving (Beamable, Generic)
+
+type InventoryMap = InventoryMapT Identity
+type InventoryMapId = PrimaryKey InventoryMapT Identity
+
+deriving instance Show InventoryMap
+deriving instance Show InventoryMapId
+
+instance Table InventoryMapT where
+    data PrimaryKey InventoryMapT f
+        = InventoryMapId deriving (Beamable, Generic)
+    primaryKey _ = InventoryMapId
+
+
+data SnackAvailableT f = SnackAvailable
+    { snackId   :: PrimaryKey SnackT f
+    , available :: C f Bool
+    } deriving (Beamable, Generic)
+
+type SnackAvailable = SnackAvailableT Identity
+type SnackAvailableId = PrimaryKey SnackAvailableT Identity
+
+mkSnackAvailableId :: SnackId -> SnackAvailableId
+mkSnackAvailableId = SnackAvailableId
+
+deriving instance Show SnackAvailable
+deriving instance Show SnackAvailableId
+
+instance Table SnackAvailableT where
+    data PrimaryKey SnackAvailableT f
+        = SnackAvailableId { unSnackAvailableId :: PrimaryKey SnackT f } deriving (Beamable, Generic)
+    primaryKey = SnackAvailableId . (.snackId)

src/Jon/Server.hs

@@ -45,6 +45,8 @@ type JonAPI =
                                     :> Post '[JSON] [OverviewItemDTO]
         :<|> "getLocations"         :> Summary "Get a list of all locations"
                                     :> Post '[JSON] [Location]
+        :<|> "adjustInventory"      :> ReqBody '[JSON] AdjustInventoryP
+                                    :> PostNoContent
         :<|> "transferInventory"    :> Summary "Transfer inventory between items"
                                     :> Description "If `amount` is negative, its absolute value is transferred in the opposite direction."
                                     :> ReqBody '[JSON] TransferInventoryP
@@ -59,9 +61,15 @@ type SnackAPI =
              "createSnack"          :> Summary "Create a snack"
                                     :> ReqBody '[JSON] CreateSnackP
                                     :> Post '[JSON] SnackId
+        :<|> "getSnacksByItemId"    :> Summary "Get active snacks by item id"
+                                    :> ReqBody '[JSON] GetSnacksByItemIdP
+                                    :> Post '[JSON] [Snack]
         :<|> "updateSnack"          :> Summary "Update a snack"
                                     :> ReqBody '[JSON] UpdateSnackP
                                     :> Post '[JSON] SnackId
+        :<|> "deleteSnack"          :> Summary "Delete a snack"
+                                    :> ReqBody '[JSON] DeleteSnackP
+                                    :> PostNoContent
 
 data GetUnsoundBarcodesP = GetUnsoundBarcodesP
     { location :: LocationId
@@ -90,6 +98,12 @@ data GetActiveItemsP = GetActiveItemsP
     , location :: LocationId
     } deriving (Generic, FromJSON, ToSchema)
 
+data AdjustInventoryP = AdjustInventoryP
+    { item        :: InventoryItemId
+    , amount      :: Int64
+    , description :: Text
+    } deriving (Generic, FromJSON, ToSchema)
+
 data TransferInventoryP = TransferInventoryP
     { transfers :: [InventoryTransferDTO]
     } deriving (Generic, FromJSON, ToSchema)
@@ -112,6 +126,10 @@ data CreateSnackP = CreateSnackP
     , location :: LocationId
     } deriving (Generic, FromJSON, ToSchema)
 
+data GetSnacksByItemIdP = GetSnacksByItemIdP
+    { item :: InventoryItemId
+    } deriving (Generic, FromJSON, ToSchema)
+
 data UpdateSnackP = UpdateSnackP
     { snack    :: SnackId
     , name     :: Text
@@ -120,6 +138,10 @@ data UpdateSnackP = UpdateSnackP
     , taxGroup :: TaxGroupId
     } deriving (Generic, FromJSON, ToSchema)
 
+data DeleteSnackP = DeleteSnackP
+    { snack :: SnackId
+    } deriving (Generic, FromJSON, ToSchema)
+
 -- Orphan instances for database types
 -- needed for serialization and swagger doc
 
@@ -165,6 +187,9 @@ deriving instance ToSchema InventoryItem
 deriving instance ToJSON Location
 deriving instance ToSchema Location
 
+deriving instance ToJSON Snack
+deriving instance ToSchema Snack
+
 -- server
 
 server :: Connection -> Server JonAPI
@@ -173,10 +198,13 @@ server conn =
     :<|> getOverviewItems
     :<|> getActiveItems
     :<|> getLocations
+    :<|> adjustInventory
     :<|> transferInventory
     :<|> disableItems
     :<|> createSnack
+    :<|> getSnacksByItemId
     :<|> updateSnack
+    :<|> deleteSnack
     where
         getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO]
         getUnsoundBarcodes params = do
@@ -199,6 +227,10 @@ server conn =
         getLocations = do
             liftIO $ Queries.runSelect conn Queries.locations
         
+        adjustInventory params = do
+            liftIO $ Queries.runInserts conn [Queries.adjustInventory params.item params.amount params.description]
+            pure NoContent
+
         transferInventory :: TransferInventoryP -> Handler NoContent
         transferInventory params = do
             liftIO $ Queries.runInserts conn $ map (\t -> Queries.transfer t.from t.to t.amount) params.transfers
@@ -217,6 +249,9 @@ server conn =
                 params.taxGroup
                 params.location
         
+        getSnacksByItemId params = do
+            liftIO $ Queries.runSelect conn $ Queries.getSnacksByItemId params.item
+        
         updateSnack params = do
             liftIO $ Queries.runFunction conn $ Queries.snackUpdate
                 params.snack
@@ -225,9 +260,14 @@ server conn =
                 params.price
                 params.taxGroup
 
+        deleteSnack params = do
+            liftIO $ Queries.runFunction conn $ Queries.snackDelete params.snack
+            pure NoContent
+
 jonSwaggerDoc :: Swagger
 jonSwaggerDoc = toSwagger (Proxy :: Proxy JonAPI)
     & info . title   .~ "jon API"
     & info . version .~ "0.1.1"
---    & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing]
-    & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]
+    & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing]
+    -- Doesn't work :(
+    -- & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]

static/index.html

@@ -5,11 +5,10 @@
   <link rel="stylesheet" href="./jon.css">
 </head>
 <body>
-  <div class="jon-elm"></div>
   <!-- Compiled by Elm -->
   <script src="./jon.js"></script>
   <script>
-    Elm.Main.init({ node: document.querySelector('.jon-elm') });
+    Elm.Main.init();
   </script>
 </body>
 </html>

static/jon.css

@@ -0,0 +1,23 @@
+html {
+    font-size: 16px;
+}
+
+button, input {
+    font-size: 0.8rem;
+}
+
+body {
+    font-family: Arial, Helvetica, sans-serif;
+}
+
+table {
+    border-collapse: collapse;
+}
+
+th, td {
+    padding: .2em .4em;
+}
+
+tr:not(:first-child):hover, tbody tr:hover {
+    background-color: lightblue;
+}