paul/jon
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add createSnack call

Browse Source
This commit is contained in:
Paul Brinkmeier 2022-12-07 14:17:47 +01:00
parent 3e4548dc75
commit 4be962a6fb
1 changed files with 58 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
src/Jon/Server.hs
View File

@ -16,7 +16,7 @@ module Jon.Server (JonAPI, jonSwaggerDoc, server) where
import Control.Lens
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, ToJSON(toJSON))
import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON))
import Data.Text (Text)
import Data.Int (Int32, Int64)
import Data.Scientific (Scientific)
@ -49,13 +49,19 @@ type JonAPI =
:> Description "If `amount` is negative, its absolute value is transferred in the opposite direction."
:> ReqBody '[JSON] TransferInventoryP
:> PostNoContent
:<|> SnackAPI
)
type SnackAPI =
"createSnack" :> Summary "Create a snack"
:> ReqBody '[JSON] CreateSnackP
:> Post '[JSON] SnackId
:<|> "updateSnack" :> Summary "Update a snack"
:> ReqBody '[JSON] UpdateSnackP
:> Post '[JSON] SnackId
)
data GetUnsoundBarcodesP = GetUnsoundBarcodesP
{ location :: Int32
{ location :: LocationId
} deriving (Generic, FromJSON, ToSchema)
data UnsoundBarcodeDTO = UnsoundBarcodeDTO
@ -66,7 +72,7 @@ data UnsoundBarcodeDTO = UnsoundBarcodeDTO
} deriving (Generic, ToJSON, ToSchema)
data GetOverviewItemsP = GetOverviewItemsP
{ location :: Int32
{ location :: LocationId
} deriving (Generic, FromJSON, ToSchema)
data OverviewItemDTO = OverviewItemDTO
@ -78,21 +84,29 @@ mkOverviewItemDTO = uncurry OverviewItemDTO
data GetActiveItemsP = GetActiveItemsP
{ barcode :: Text
, location :: Int32
, location :: LocationId
} deriving (Generic, FromJSON, ToSchema)
data TransferInventoryP = TransferInventoryP
{ from :: Int32
, to :: Int32
{ from :: InventoryItemId
, to :: InventoryItemId
, amount :: Int64
} deriving (Generic, FromJSON, ToSchema)
data CreateSnackP = CreateSnackP
{ name :: Text
, barcode :: Text
, price :: Scientific
, taxGroup :: TaxGroupId
, location :: LocationId
} deriving (Generic, FromJSON, ToSchema)
data UpdateSnackP = UpdateSnackP
{ snack :: Int32
{ snack :: SnackId
, name :: Text
, barcode :: Text
, price :: Scientific
, taxGroup :: Int32
, taxGroup :: TaxGroupId
} deriving (Generic, FromJSON, ToSchema)
-- Orphan instances for database types
@ -100,6 +114,8 @@ data UpdateSnackP = UpdateSnackP
instance ToJSON InventoryItemId where
toJSON = toJSON . (.unInventoryItemId)
instance FromJSON InventoryItemId where
parseJSON = fmap mkInventoryItemId . parseJSON
instance ToSchema InventoryItemId where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)
@ -110,16 +126,22 @@ instance ToSchema InventoryItemGroupId where
instance ToJSON TaxGroupId where
toJSON = toJSON . (.unTaxGroupId)
instance FromJSON TaxGroupId where
parseJSON = fmap mkTaxGroupId . parseJSON
instance ToSchema TaxGroupId where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)
instance ToJSON LocationId where
toJSON = toJSON . (.unLocationId)
instance FromJSON LocationId where
parseJSON = fmap mkLocationId . parseJSON
instance ToSchema LocationId where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)
instance ToJSON SnackId where
toJSON = toJSON . (.unSnackId)
instance FromJSON SnackId where
parseJSON = fmap mkSnackId . parseJSON
instance ToSchema SnackId where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Int32)
@ -135,23 +157,30 @@ deriving instance ToSchema Location
-- server
server :: Connection -> Server JonAPI
server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|> getLocations :<|> transferInventory :<|> updateSnack
server conn =
getUnsoundBarcodes
:<|> getOverviewItems
:<|> getActiveItems
:<|> getLocations
:<|> transferInventory
:<|> createSnack
:<|> updateSnack
where
getUnsoundBarcodes :: GetUnsoundBarcodesP -> Handler [UnsoundBarcodeDTO]
getUnsoundBarcodes params = do
rows <- liftIO $ Queries.runSelect conn $ Queries.unsoundBarcodes $ mkLocationId params.location
rows <- liftIO $ Queries.runSelect conn $ Queries.unsoundBarcodes params.location
pure $ map mkUnsoundBarcodeDTO rows
where
mkUnsoundBarcodeDTO (a, b, c, d) = UnsoundBarcodeDTO a b (fromIntegral c) (fromIntegral d)
getOverviewItems :: GetOverviewItemsP -> Handler [OverviewItemDTO]
getOverviewItems params = do
rows <- liftIO $ Queries.runSelect conn $ Queries.overviewItemsByLocation $ mkLocationId params.location
rows <- liftIO $ Queries.runSelect conn $ Queries.overviewItemsByLocation params.location
pure $ map mkOverviewItemDTO rows
getActiveItems :: GetActiveItemsP -> Handler [OverviewItemDTO]
getActiveItems params = do
rows <- liftIO $ Queries.runSelect conn $ Queries.activeItems params.barcode $ mkLocationId params.location
rows <- liftIO $ Queries.runSelect conn $ Queries.activeItems params.barcode params.location
pure $ map mkOverviewItemDTO rows
getLocations :: Handler [Location]
@ -160,21 +189,30 @@ server conn = getUnsoundBarcodes :<|> getOverviewItems :<|> getActiveItems :<|>
transferInventory params = do
liftIO $ Queries.runIns conn $ Queries.transfer
(mkInventoryItemId params.from)
(mkInventoryItemId params.to)
params.from
params.to
params.amount
pure NoContent
updateSnack params = do
liftIO $ Queries.runFunction conn $ Queries.snackUpdate
(mkSnackId params.snack)
createSnack params = do
liftIO $ Queries.runFunction conn $ Queries.snackCreate
params.name
params.barcode
params.price
(mkTaxGroupId params.taxGroup)
params.taxGroup
params.location
updateSnack params = do
liftIO $ Queries.runFunction conn $ Queries.snackUpdate
params.snack
params.name
params.barcode
params.price
params.taxGroup
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]