{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} module Jon.Garfield.Queries where import Data.Int (Int64) import Data.Scientific (Scientific) import Data.Text (Text) import Database.Beam import Database.Beam.Postgres import Database.PostgreSQL.Simple import Text.Printf (printf) import qualified Data.Text as Text import Jon.Garfield.Types -- Selects runSelect :: (FromBackendRow Postgres (QExprToIdentity e), Projectible Postgres e) => Connection -> Q Postgres db QBaseScope e -> IO [QExprToIdentity e] runSelect conn q = runBeamPostgresDebug putStrLn conn $ runSelectReturningList $ select q overviewItems :: Q Postgres GarfieldDb s (OverviewT (QExpr Postgres s), InventoryItemT (QExpr Postgres s)) overviewItems = do ov <- all_ garfieldDb.overview it <- related_ garfieldDb.inventoryItems ov.itemId pure (ov, it) overviewItemsByLocation :: LocationId -> Q Postgres GarfieldDb s (OverviewT (QExpr Postgres s), InventoryItemT (QExpr Postgres s)) overviewItemsByLocation loc = do row@(_, it) <- overviewItems guard_ $ it.location ==. val_ loc pure row unsoundBarcodes :: LocationId -> Q Postgres GarfieldDb s (QExpr Postgres s Text, QExpr Postgres s Text, QExpr Postgres s Int64, QExpr Postgres s Int64) unsoundBarcodes loc = filter_ (\(_, _, entries, _) -> entries >=. 2) $ aggregate_ (\(ov, it) -> ( group_ it.barcode , fromMaybe_ "" $ max_ it.name , as_ @Int64 countAll_ , as_ @Int64 $ cast_ (sum_ ov.unitsLeft) int )) (overviewItemsByLocation loc) activeItems :: Text -- barcode -> LocationId -> Q Postgres GarfieldDb s (OverviewT (QExpr Postgres s), InventoryItemT (QExpr Postgres s)) activeItems barcode loc = do (ov, it) <- overviewItemsByLocation loc guard_ $ it.barcode ==. val_ barcode pure (ov, it) 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 :: Connection -> [SqlInsert Postgres table] -> 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 -> Int64 -- ^ amount to transfer. If negative, acts like 'transfer b a (-amount)' -> SqlInsert Postgres CorrectionT transfer from to amount | amount < 0 = transfer to from (-amount) | otherwise = insert garfieldDb.inventoryCorrections $ insertExpressions [ Correction (val_ from) default_ (val_ $ -amount) (val_ $ Text.pack $ printf "Umbuchung auf %d" $ to.unInventoryItemId) , Correction (val_ to) default_ (val_ amount) (val_ $ Text.pack $ printf "Umbuchung von %d" $ from.unInventoryItemId) ] -- Updates runUpdates :: Connection -> [SqlUpdate Postgres table] -> IO () runUpdates conn us = runBeamPostgresDebug putStrLn conn $ mapM_ runUpdate us disableItem :: InventoryItemId -> SqlUpdate Postgres InventoryItemT disableItem itemId = update (inventoryItems garfieldDb) (\it -> it.available <-. val_ False) (\it -> it.id ==. val_ itemId.unInventoryItemId) -- Function calls type SqlFunction a = Connection -> IO a runFunction :: Connection -> SqlFunction a -> IO a runFunction conn f = f conn snackDelete :: SnackId -> SqlFunction () snackDelete snack conn = do [Only ()] <- query conn "SELECT garfield.snack_delete(?)" (Only $ snack.unSnackId) pure () snackCreate :: Text -> Text -> Scientific -> TaxGroupId -> LocationId -> SqlFunction SnackId snackCreate name barcode price taxGroup location conn = do [Only rawSnackId] <- query conn "SELECT garfield.snack_create(?, ?, ?, ?, ?)" (name, barcode, price, taxGroup.unTaxGroupId, location.unLocationId) pure $ mkSnackId rawSnackId snackUpdate :: SnackId -> Text -- Name -> Text -- Barcode -> Scientific -> TaxGroupId -> SqlFunction SnackId snackUpdate snack name barcode price taxGroup conn = do [Only rawSnackId] <- query conn "SELECT garfield.snack_update(?, ?, ?, ?, ?)" (snack.unSnackId, name, barcode, price, taxGroup.unTaxGroupId) pure $ mkSnackId rawSnackId inventoryMapSnack :: SnackId -> InventoryItemId -> SqlFunction () inventoryMapSnack snack item conn = do [Only ()] <- query conn "SELECT garfield.inventory_map_snack(?, ?)" (snack.unSnackId, item.unInventoryItemId) pure ()