elm/Main.elm

@@ -1,15 +1,8 @@
 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
@@ -17,58 +10,40 @@ import Json.Decode.Pipeline exposing (..)
 import Json.Encode as Enc
 import Set exposing (Set)
 
-main = Browser.document
+main = Browser.element
-    { init = \() -> init
+    { init = \() -> (init, getUnsoundBarcodes loc)
     , subscriptions = \_ -> Sub.none
     , update = update
-    , view = \outerState -> { title = "jon",  body = [ view outerState ] }
+    , view = view
     }
 
-getOverviewItems : Int -> Cmd Msg
+getUnsoundBarcodes : Int -> Cmd Msg
-getOverviewItems location = Http.post
+getUnsoundBarcodes location = Http.post
-    { url = "/rpc/getOverviewItems"
+    { url = "/rpc/getUnsoundBarcodes"
-    , body = Http.jsonBody <| Enc.object
+    , body = Http.jsonBody (Enc.object [("location", Enc.int location)])
-        [ ("location", Enc.int location)
+    , expect = Http.expectJson RcvUnsoundBarcodes <| Dec.list (Dec.map3 UnsoundBarcode
-        ]
+        (Dec.field "barcode" Dec.string)
-    , expect = Http.expectJson RcvOverview <| Dec.list decodeOI
+        (Dec.field "name" Dec.string)
+        (Dec.field "entries" Dec.int))
     }
 
-rpc : { func : String, args : Enc.Value, expect : Dec.Decoder a } -> (Result Http.Error a -> b) -> Cmd b
+getActiveItems : String -> Int -> Cmd Msg
-rpc { func, args, expect } mkMsg = Http.post
+getActiveItems barcode location = Http.post
-    { url = "/rpc/" ++ func
+    { url = "/rpc/getActiveItems"
-    , body = Http.jsonBody args
+    , body = Http.jsonBody (Enc.object
-    , expect = Http.expectJson mkMsg expect
+        [ ("barcode", Enc.string barcode)
+        , ("location", Enc.int location)
+        ])
+    , expect = Http.expectJson (RcvActiveItems barcode) <| Dec.list decodeOI
     }
 
-getLocations : Cmd Msg
+transferInventory : List { from : Int, to : Int, amount : Int } -> 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)
+    , expect = Http.expectWhatever RcvTransferResponse
     }
 
 encodeTransfer t = Enc.object
@@ -83,16 +58,7 @@ disableItems ids = Http.post
     , body = Http.jsonBody (Enc.object
         [ ("items", Enc.list Enc.int ids)
         ])
-    , expect = Http.expectWhatever (\_ -> RcvOther)
+    , expect = Http.expectWhatever RcvDisableItemResponse
-    }
-
-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
@@ -103,35 +69,13 @@ 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
 
-getSnacksByItem : OverviewItem -> Cmd Msg
+type alias UnsoundBarcode =
-getSnacksByItem item = rpc
+    { barcode : String
-    { 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
+    , entries : Int
-    , 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
@@ -140,286 +84,118 @@ type alias OverviewItem =
     , price : Float
     , bought : String
     , activeMappings : Int
-    , groupId : Int
-    , groupName : String
     }
 
-type alias Location =
+type Model
-    { id : Int
+    = Init
-    , name : String
+    | UBList (List UnsoundBarcode)
-    }
+    | Overview String (Set Int) (List OverviewItem)
-
-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
+    = RcvUnsoundBarcodes (Result Http.Error (List UnsoundBarcode))
-    | SelectItem Int Bool
+    | GetActiveItems String Int
-    | ChangeLocation
+    | RcvActiveItems String (Result Http.Error (List OverviewItem))
-    | SetDesiredInventory Int String
+    | SetSelected Int Bool
-    | TransferInventory Int
+    | TransferInventory (List { amount : Int, from : Int, to : Int })
+    | RcvTransferResponse (Result Http.Error ())
+    | DisableItem Int
+    | RcvDisableItemResponse (Result Http.Error ())
     | 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)
+init = Init
+loc = 2
 
-update msg outerState = case msg of
+update msg model = case model of
-    CallAdjustInventory item amount desc -> (outerState, adjustInventory item amount desc)
+    Init -> case msg of
-    CallDisableItems items -> (outerState, disableItems items)
+        RcvUnsoundBarcodes (Ok ubs) -> (UBList ubs, Cmd.none)
-    CallGetSnacksById item -> (outerState, getSnacksByItem item)
+        _ -> (model, Cmd.none)
-    CallDeleteSnack snack -> (outerState, deleteSnack snack)
+    UBList _ -> case msg of
-    _ -> case outerState of
+        GetActiveItems barcode location -> (model, getActiveItems barcode location)
-        LoadingLocations -> case msg of
+        RcvActiveItems barcode (Ok ois) -> (Overview barcode (Set.empty) ois, Cmd.none)
-            RcvLocations (Ok locations) ->
+        _ -> (model, Cmd.none)
-                (LocationSelector locations, 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)
-                (outerState, Cmd.none)
+        TransferInventory transfers -> (model, transferInventory transfers)
-        LocationSelector locations -> case msg of
+        RcvTransferResponse _ -> (model, getActiveItems barcode loc)
-            SelectLocation location ->
+        RcvActiveItems barcode_ (Ok ois_) -> (Overview barcode_ (Set.empty) ois_, Cmd.none)
-                (Initialized { locations = locations, location = location } <| Overview
+        DisableItem id -> (model, disableItems [id])
-                    { selectedItems = Set.empty
+        RcvDisableItemResponse _ -> (model, getActiveItems barcode loc)
-                    , desiredInventory = Dict.empty
+        GoBack -> (model, getUnsoundBarcodes loc)
-                    , overviewItems = []
+        RcvUnsoundBarcodes (Ok ubs) -> (UBList ubs, Cmd.none)
-                    }
+        _ -> (model, Cmd.none)
-                , 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
+view model = case model of
-    Overview model -> case msg of
+    Init -> h1 [] [ text "It works!" ]
-        RcvOverview (Ok overviewItems) ->
+    UBList ubs -> viewUBList ubs
-            (Overview
+    Overview barcode selectedItems ois -> viewOverview barcode selectedItems ois
-                { 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
+viewUBList ubs =
-    LoadingLocations -> progress [] []
+    let
-    LocationSelector locations ->
+        header = tr []
-        let
+            [ th [] [ text "Barcode" ]
-            viewLocationButton location =
+            , th [] [ text "Artikel" ]
-                button [ onClick <| SelectLocation location ] [ text location.name ]
+            , th [] [ text "Einträge" ]
-        in
+            , th [] [ text "Aktionen" ]
-            div []
+            ]
-                [ p [] [ text "Raum auswählen:" ]
+        viewUB ub = tr []
-                , div [] <| List.map viewLocationButton locations
+            [ td [] [ text ub.barcode ]
-                ]
+            , td [] [ text ub.name ]
-    Initialized global state ->
+            , td [] [ text <| String.fromInt ub.entries ]
-        div []
+            , td [] [ button [ onClick (GetActiveItems ub.barcode loc) ] [ text "Einträge ansehen" ] ]
-            [ 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
+        table [] ([header] ++ List.map viewUB ubs)
 
-setSelect elem state =
+viewOverview : String -> Set Int -> List OverviewItem -> Html Msg
-    (if state then Set.insert else Set.remove) elem
+viewOverview barcode selectedItems ois =
-
-splitAt : Char -> String -> (String, String)
-splitAt delim str =
     let
-        locate c s = case String.uncons s of
+        sumSelected =
-            Nothing -> 0
+            List.sum
-            Just (x, xs) ->
+            <| List.map (\oi -> oi.unitsLeft)
-                if x == c then
+            <| List.filter (\oi -> Set.member oi.id selectedItems) ois
-                    0
-                else
-                    1 + locate c xs
 
-        firstOcc = locate delim str
+        header = tr []
-    in
+            [ th [] []
-        (String.slice 0 firstOcc str, String.slice (firstOcc + 1) (String.length str) str)
+            , 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" ]
+            , 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
 
-showEuros : Float -> String
-showEuros x =
-    let
-        (whole, fractional) = splitAt '.' (String.fromFloat x)
     in
-        whole ++ "," ++ String.slice 0 2 (fractional ++ "00") ++ "€"
+        div []
-
+            [ button [ onClick GoBack ] [ text "Zurück" ]
-roundTo : Int -> Float -> Float
+            , h2 [] [ text barcode ]
-roundTo decimals x =
+            , table [] ([header] ++ List.map viewOI ois)
-    let
+            ]
-        m = toFloat <| 10^decimals
-    in
-        toFloat (round (x * m)) / m

src/Jon/Garfield/Queries.hs

@@ -68,17 +68,6 @@ 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
@@ -87,14 +76,6 @@ 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,9 +20,6 @@ module Jon.Garfield.Types
     , InventoryItemGroup
     , InventoryItemGroupId
     , InventoryItemGroupT(..)
-    , InventoryMap
-    , InventoryMapId
-    , InventoryMapT(..)
     , TaxGroup
     , TaxGroupId
     , TaxGroupT(..)
@@ -35,9 +32,6 @@ module Jon.Garfield.Types
     , Snack
     , SnackId
     , SnackT(..)
-    , SnackAvailable
-    , SnackAvailableId
-    , SnackAvailableT(..)
     , Sale
     , SaleId
     , SaleT(..)
@@ -49,18 +43,16 @@ module Jon.Garfield.Types
     , mkInventoryItemId
     , mkTaxGroupId
     , mkLocationId
-    , mkSaleId
     , mkSnackId
-    , mkSnackAvailableId
+    , mkSaleId
     , mkUserId
     , unOverviewId
     , unInventoryItemId
     , unInventoryItemGroupId
     , unTaxGroupId
     , unLocationId
-    , unSaleId
     , unSnackId
-    , unSnackAvailableId
+    , unSaleId
     , unUserId
     ) where
 
@@ -105,8 +97,6 @@ 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
@@ -178,14 +168,6 @@ 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
@@ -329,11 +311,11 @@ instance Table CorrectionT where
 data SnackT f = Snack
     { id            :: C f Int32
     , name          :: C f Text
-    , barcode       :: C (Nullable f) Text
+    , barcode       :: C f Text
     , price         :: C f Scientific
     , location      :: PrimaryKey LocationT f
     -- , snackModifiedBy :: PrimaryKey UserT f
-    , timestamp     :: C (Nullable f) UTCTime
+    , timestamp     :: C f UTCTime
     , taxGroup      :: PrimaryKey TaxGroupT f
     } deriving (Beamable, Generic)
 
@@ -400,40 +382,3 @@ 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,8 +45,6 @@ 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
@@ -61,15 +59,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
-        :<|> "deleteSnack"          :> Summary "Delete a snack"
-                                    :> ReqBody '[JSON] DeleteSnackP
-                                    :> PostNoContent
 
 data GetUnsoundBarcodesP = GetUnsoundBarcodesP
     { location :: LocationId
@@ -98,12 +90,6 @@ 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)
@@ -126,10 +112,6 @@ 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
@@ -138,10 +120,6 @@ 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
 
@@ -187,9 +165,6 @@ 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
@@ -198,13 +173,10 @@ server conn =
     :<|> getOverviewItems
     :<|> getActiveItems
     :<|> getLocations
-    :<|> adjustInventory
     :<|> transferInventory
     :<|> disableItems
     :<|> createSnack
-    :<|> getSnacksByItemId
     :<|> updateSnack
-    :<|> deleteSnack
     where
         getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO]
         getUnsoundBarcodes params = do
@@ -227,10 +199,6 @@ 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
@@ -249,9 +217,6 @@ 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
@@ -260,14 +225,9 @@ 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]
+--    & applyTags [Tag "jon RPC" (Just "Crudely improvised Garfield API") Nothing]
-    -- Doesn't work :(
+    & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]
-    -- & applyTagsFor (operationsOf $ toSwagger (Proxy :: Proxy SnackAPI)) [Tag "Snacks" Nothing Nothing]

static/index.html

@@ -5,10 +5,11 @@
   <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();
+    Elm.Main.init({ node: document.querySelector('.jon-elm') });
   </script>
 </body>
 </html>

static/jon.css

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