Add a few things

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
@@ -11,39 +18,57 @@ import Json.Encode as Enc
 import Set exposing (Set)
 
 main = Browser.element
-    { init = \() -> (init, getUnsoundBarcodes loc)
+    { init = \() -> init
     , subscriptions = \_ -> Sub.none
     , update = update
     , view = view
     }
 
-getUnsoundBarcodes : Int -> Cmd Msg
+getOverviewItems : Int -> Cmd Msg
-getUnsoundBarcodes location = Http.post
+getOverviewItems location = Http.post
-    { url = "/rpc/getUnsoundBarcodes"
+    { url = "/rpc/getOverviewItems"
-    , body = Http.jsonBody (Enc.object [("location", Enc.int location)])
+    , body = Http.jsonBody <| Enc.object
-    , expect = Http.expectJson RcvUnsoundBarcodes <| Dec.list (Dec.map3 UnsoundBarcode
+        [ ("location", Enc.int location)
-        (Dec.field "barcode" Dec.string)
+        ]
-        (Dec.field "name" Dec.string)
+    , expect = Http.expectJson RcvOverview <| Dec.list decodeOI
-        (Dec.field "entries" Dec.int))
     }
 
-getActiveItems : String -> Int -> Cmd Msg
+rpc : { func : String, args : Enc.Value, expect : Dec.Decoder a } -> (Result Http.Error a -> b) -> Cmd b
-getActiveItems barcode location = Http.post
+rpc { func, args, expect } mkMsg = Http.post
-    { url = "/rpc/getActiveItems"
+    { url = "/rpc/" ++ func
-    , body = Http.jsonBody (Enc.object
+    , body = Http.jsonBody args
-        [ ("barcode", Enc.string barcode)
+    , expect = Http.expectJson mkMsg expect
-        , ("location", Enc.int location)
-        ])
-    , expect = Http.expectJson (RcvActiveItems barcode) <| Dec.list decodeOI
     }
 
-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,7 @@ disableItems ids = Http.post
     , body = Http.jsonBody (Enc.object
         [ ("items", Enc.list Enc.int ids)
         ])
-    , expect = Http.expectWhatever RcvDisableItemResponse
+    , expect = Http.expectWhatever (\_ -> RcvOther)
     }
 
 decodeOI = Dec.succeed OverviewItem
@@ -70,12 +95,32 @@ decodeOI = Dec.succeed OverviewItem
     |> requiredAt ["item", "bought"] Dec.string
     |> requiredAt ["overview", "activeMappings"] Dec.int
 
-type alias UnsoundBarcode =
+getSnacksByItemId : Int -> Cmd Msg
-    { barcode : String
+getSnacksByItemId itemId = rpc
+    { func = "getSnacksByItemId"
+    , args = Enc.object
+        [ ("item", Enc.int itemId)
+        ]
+    , expect = Dec.list decodeSnack
+    } RcvSnacks
+
+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
@@ -86,116 +131,227 @@ type alias OverviewItem =
     , activeMappings : Int
     }
 
-type Model
+type alias Location =
-    = Init
+    { id : Int
-    | UBList (List UnsoundBarcode)
+    , name : String
-    | Overview String (Set Int) (List OverviewItem)
+    }
+
+type alias Model =
+    { state : State
+    }
+
+type State
+    = LoadingLocations
+    | LocationSelector (List Location)
+    | Overview
+        { location : Location
+        , selectedItems : Set Int
+        , desiredInventory : Dict Int Int
+        , overviewItems : List OverviewItem
+        }
+    | SnacksEditor
+        { snacks : List Snack
+        }
 
 type Msg
-    = RcvUnsoundBarcodes (Result Http.Error (List UnsoundBarcode))
+    = SelectItem Int Bool
-    | GetActiveItems String Int
+    | SetDesiredInventory Int String
-    | RcvActiveItems String (Result Http.Error (List OverviewItem))
+    | SelectLocation Location
-    | SetSelected Int Bool
+    | TransferInventory Int
-    | TransferInventory (List { amount : Int, from : Int, to : Int })
+    -- RPC calls
-    | RcvTransferResponse (Result Http.Error ())
+    | CallDisableItems (List Int)
-    | DisableItem Int
+    | CallAdjustInventory Int Int String
-    | RcvDisableItemResponse (Result Http.Error ())
+    | CallGetSnacksById Int
-    | GoBack
+    -- Responses
+    | RcvLocations (Result Http.Error (List Location))
+    | RcvOverview (Result Http.Error (List OverviewItem))
+    | RcvSnacks (Result Http.Error (List Snack))
+    | RcvOther
 
-init = Init
+init = ({ state = LoadingLocations }, getLocations)
-loc = 2
 
-update msg model = case model of
+update msg global = case msg of
-    Init -> case msg of
+    CallAdjustInventory item amount desc -> (global, adjustInventory item amount desc)
-        RcvUnsoundBarcodes (Ok ubs) -> (UBList ubs, Cmd.none)
+    CallDisableItems items -> (global, disableItems items)
-        _ -> (model, Cmd.none)
+    CallGetSnacksById itemId -> (global, getSnacksByItemId itemId)
-    UBList _ -> case msg of
+    _ ->
-        GetActiveItems barcode location -> (model, getActiveItems barcode location)
+        let
-        RcvActiveItems barcode (Ok ois) -> (Overview barcode (Set.empty) ois, Cmd.none)
+            (newState, cmd) = stateMachine msg global global.state
-        _ -> (model, Cmd.none)
+        in
-    Overview barcode selectedItems ois -> case msg of
+            ({ global | state = newState }, cmd)
-        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)
 
-view model = case model of
+stateMachine msg global state = case state of
-    Init -> h1 [] [ text "It works!" ]
+    LoadingLocations -> case msg of
-    UBList ubs -> viewUBList ubs
+        RcvLocations (Ok locations) ->
-    Overview barcode selectedItems ois -> viewOverview barcode selectedItems ois
+            (LocationSelector locations, Cmd.none)
+        _ ->
+            (state, Cmd.none)
+    LocationSelector locations -> case msg of
+        SelectLocation location ->
+            (Overview
+                { location = location
+                , selectedItems = Set.empty
+                , desiredInventory = Dict.empty
+                , overviewItems = []
+                }
+            , getOverviewItems location.id
+            )
+        _ ->
+            (state, Cmd.none)
+    Overview model -> case msg of
+        RcvOverview (Ok overviewItems) ->
+            (Overview
+                { location = model.location
+                , selectedItems = Set.empty
+                , desiredInventory = Dict.empty
+                , overviewItems = overviewItems
+                }
+            , Cmd.none
+            )
+        RcvSnacks (Ok snacks) ->
+            (SnacksEditor { snacks = snacks }, Cmd.none)
+        RcvOther ->
+            (state, getOverviewItems model.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)
+    SnacksEditor { snacks } ->
+        (state, Cmd.none)
 
-viewUBList ubs =
+view { state } = case state of
-    let
+    LoadingLocations -> progress [] []
-        header = tr []
+    LocationSelector locations ->
-            [ th [] [ text "Barcode" ]
+        let
-            , th [] [ text "Artikel" ]
+            viewLocationButton location =
-            , th [] [ text "Einträge" ]
+                button [ onClick <| SelectLocation location ] [ text location.name ]
-            , th [] [ text "Aktionen" ]
+        in
-            ]
+            div []
-        viewUB ub = tr []
+                [ p [] [ text "Raum auswählen:" ]
-            [ td [] [ text ub.barcode ]
+                , div [] <| List.map viewLocationButton locations
-            , 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
                 ]
-                [ text <| String.fromInt sumSelected ++ " Einträge umbuchen" ]
+    Overview { location, selectedItems, desiredInventory, overviewItems } ->
-            , button
+        let
-                [ disabled <| oi.unitsLeft /= 0 || oi.activeMappings /= 0
+            header = tableCells th <| List.map text [ "", "ID", "Artikel", "Barcode", "Preis", "Kaufdatum", "Snackeinträge", "Soll-Inv.", "Ist-Inv.", "Aktionen" ]
-                , onClick <| DisableItem oi.id
+            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 <| String.fromFloat oi.price
+                        , text <| Tuple.first <| splitAt 'T' oi.bought
+                        , text <| String.fromInt oi.activeMappings
+                        , text <| String.fromInt oi.unitsLeft
+                        , input
+                            [ type_ "number"
+                            , onInput <| SetDesiredInventory oi.id
+                            , value <| String.fromInt adjustedInventory
+                            , style "width" "5em"
+                            ] []
+                        , span []
+                            [ 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.activeMappings /= 0 || 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
+                                (if oi.activeMappings == 0
+                                    then [ disabled True ]
+                                    else [ onClick <| CallGetSnacksById oi.id ])
+                                [ text "Snackeinträge bearbeiten" ]
+                            ]
+                        ]
+        in
+            div []
+                [ h2 [] [ text <| "Inventar " ++ location.name ]
+                , table [] <| [header] ++ List.map viewOverviewItem overviewItems
+                ]
+    SnacksEditor { snacks } ->
+        let
+            header = tableCells th <| List.map text [ "ID", "Artikel", "Barcode", "Brutto" ]
+            viewSnack snack = tableCells td
+                [ text <| String.fromInt snack.id
+                , text snack.name
+                , text snack.barcode
+                , text <| String.fromFloat snack.price
+                ]
+        in
+            table []
+                [ thead [] [ header ]
+                , tbody [] <| List.map viewSnack snacks
                 ]
-                [ 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
 
+-- utils
+
+tableCells f =
+    let
+        mkTd elem = f [] [ elem ]
     in
-        div []
+        tr [] << List.map mkTd
-            [ button [ onClick GoBack ] [ text "Zurück" ]
+
-            , h2 [] [ text barcode ]
+setSelect elem state =
-            , table [] ([header] ++ List.map viewOI ois)
+    (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 (String.length str) str)

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,6 +61,9 @@ 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
@@ -90,6 +95,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 +123,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
@@ -165,6 +180,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,9 +191,11 @@ server conn =
     :<|> getOverviewItems
     :<|> getActiveItems
     :<|> getLocations
+    :<|> adjustInventory
     :<|> transferInventory
     :<|> disableItems
     :<|> createSnack
+    :<|> getSnacksByItemId
     :<|> updateSnack
     where
         getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO]
@@ -199,6 +219,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 +241,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
@@ -229,5 +256,6 @@ 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]
+    & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing]
-    & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]
+    -- Doesn't work :(
+    -- & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]

static/jon.css

@@ -0,0 +1,15 @@
+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;
+}