Add a few things
This commit is contained in:
parent
5bd3832d27
commit
9ce0f974fb
406
elm/Main.elm
406
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)
|
||||
|
||||
view model = case model of
|
||||
Init -> h1 [] [ text "It works!" ]
|
||||
UBList ubs -> viewUBList ubs
|
||||
Overview barcode selectedItems ois -> viewOverview barcode selectedItems ois
|
||||
|
||||
viewUBList ubs =
|
||||
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
|
||||
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" ] ]
|
||||
]
|
||||
(newState, cmd) = stateMachine msg global global.state
|
||||
in
|
||||
table [] ([header] ++ List.map viewUB ubs)
|
||||
({ global | state = newState }, cmd)
|
||||
|
||||
viewOverview : String -> Set Int -> List OverviewItem -> Html Msg
|
||||
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
|
||||
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" ]
|
||||
, 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
|
||||
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)
|
||||
|
||||
view { state } = case state of
|
||||
LoadingLocations -> progress [] []
|
||||
LocationSelector locations ->
|
||||
let
|
||||
viewLocationButton location =
|
||||
button [ onClick <| SelectLocation location ] [ text location.name ]
|
||||
in
|
||||
div []
|
||||
[ button [ onClick GoBack ] [ text "Zurück" ]
|
||||
, h2 [] [ text barcode ]
|
||||
, table [] ([header] ++ List.map viewOI ois)
|
||||
[ p [] [ text "Raum auswählen:" ]
|
||||
, div [] <| List.map viewLocationButton locations
|
||||
]
|
||||
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
|
||||
]
|
||||
|
||||
-- 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 (String.length str) str)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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]
|
||||
|
||||
15
static/jon.css
Normal file
15
static/jon.css
Normal file
@ -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;
|
||||
}
|
||||
Loading…
x
Reference in New Issue
Block a user