jon/src/Jon/Garfield/Queries.hs

{-# 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 ()