From 9ce0f974fbb2b47f65a518b50e7a62e2401d6d13 Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Thu, 8 Dec 2022 18:06:15 +0100 Subject: [PATCH] Add a few things --- elm/Main.elm | 410 +++++++++++++++++++++++++----------- src/Jon/Garfield/Queries.hs | 19 ++ src/Jon/Garfield/Types.hs | 63 +++++- src/Jon/Server.hs | 32 ++- static/jon.css | 15 ++ 5 files changed, 406 insertions(+), 133 deletions(-) create mode 100644 static/jon.css diff --git a/elm/Main.elm b/elm/Main.elm index 9bbb252..188aab5 100644 --- a/elm/Main.elm +++ b/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 -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,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 = - { barcode : String +getSnacksByItemId : Int -> Cmd Msg +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 - = Init - | UBList (List UnsoundBarcode) - | Overview String (Set Int) (List OverviewItem) +type alias Location = + { id : Int + , name : String + } + +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)) - | 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 ()) - | GoBack + = SelectItem Int Bool + | SetDesiredInventory Int String + | SelectLocation Location + | TransferInventory Int + -- RPC calls + | CallDisableItems (List Int) + | CallAdjustInventory Int Int String + | CallGetSnacksById Int + -- Responses + | RcvLocations (Result Http.Error (List Location)) + | RcvOverview (Result Http.Error (List OverviewItem)) + | RcvSnacks (Result Http.Error (List Snack)) + | RcvOther -init = Init -loc = 2 +init = ({ state = 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 global = case msg of + CallAdjustInventory item amount desc -> (global, adjustInventory item amount desc) + CallDisableItems items -> (global, disableItems items) + CallGetSnacksById itemId -> (global, getSnacksByItemId itemId) + _ -> + let + (newState, cmd) = stateMachine msg global global.state + in + ({ global | state = 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 + LoadingLocations -> case msg of + RcvLocations (Ok locations) -> + (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 = - 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 { state } = case state 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 + Overview { location, selectedItems, desiredInventory, overviewItems } -> + let + header = tableCells th <| List.map text [ "", "ID", "Artikel", "Barcode", "Preis", "Kaufdatum", "Snackeinträge", "Soll-Inv.", "Ist-Inv.", "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 <| 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 [] - [ button [ onClick GoBack ] [ text "Zurück" ] - , h2 [] [ text barcode ] - , table [] ([header] ++ List.map viewOI ois) - ] + 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 (String.length str) str) diff --git a/src/Jon/Garfield/Queries.hs b/src/Jon/Garfield/Queries.hs index ab95ee1..d89ffb9 100644 --- a/src/Jon/Garfield/Queries.hs +++ b/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 diff --git a/src/Jon/Garfield/Types.hs b/src/Jon/Garfield/Types.hs index f1f64a4..6cb8be9 100644 --- a/src/Jon/Garfield/Types.hs +++ b/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) diff --git a/src/Jon/Server.hs b/src/Jon/Server.hs index 8634477..cb34c61 100644 --- a/src/Jon/Server.hs +++ b/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] - & 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] diff --git a/static/jon.css b/static/jon.css new file mode 100644 index 0000000..dc5b6c2 --- /dev/null +++ b/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; +}