fix product overview queries
This commit is contained in:
parent
f7be7e317d
commit
8612987cf8
2 changed files with 108 additions and 99 deletions
|
|
@ -42,7 +42,7 @@ executable mateamt
|
|||
default-language: Haskell2010
|
||||
|
||||
library
|
||||
exposed-modules: API
|
||||
exposed-modules: API
|
||||
, Control
|
||||
, Control.Buy
|
||||
, Control.Journal
|
||||
|
|
@ -67,6 +67,7 @@ library
|
|||
, Types.Amount
|
||||
, Types.Journal
|
||||
, Types.Avatar
|
||||
, Util
|
||||
-- other-extensions:
|
||||
build-depends: base ^>=4.12.0.0
|
||||
, servant
|
||||
|
|
@ -76,6 +77,7 @@ library
|
|||
, aeson
|
||||
, text
|
||||
, time
|
||||
, profunctors
|
||||
, product-profunctors
|
||||
, postgresql-simple
|
||||
, warp
|
||||
|
|
|
|||
|
|
@ -10,11 +10,15 @@ import Data.Profunctor.Product (p9)
|
|||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
|
||||
import Control.Arrow ((<<<), returnA, arr)
|
||||
import Control.Arrow
|
||||
|
||||
import qualified Database.PostgreSQL.Simple as PGS
|
||||
|
||||
import Opaleye as O hiding (max)
|
||||
import qualified Data.Profunctor as P
|
||||
import qualified Data.Profunctor.Product as PP
|
||||
import qualified Data.Profunctor.Product.Default as D
|
||||
|
||||
import Opaleye as O
|
||||
import Opaleye.Constant as C
|
||||
|
||||
-- internal imports
|
||||
|
|
@ -103,55 +107,76 @@ productOverviewSelect
|
|||
-> PGS.Connection
|
||||
-> MateHandler [ProductOverview]
|
||||
productOverviewSelect refine conn = do
|
||||
prods <- liftIO $ runSelect conn
|
||||
( proc () -> do
|
||||
-- (a1, _, a3, _, _)
|
||||
-- <- arr
|
||||
-- (\(arrdata, pid) -> (limit 1 (
|
||||
-- orderBy (desc (\(_, ts, _, _, _) -> ts)) (
|
||||
-- keepWhen (\(aid, _, _, _, _) -> pid .== aid) <<< arrdata)))) <<<
|
||||
-- (arr (\pid -> (selectTable amountTable, pid))) -< pid
|
||||
(pid, i2, i6, i7, i8, i9, i11, i12, i13, a3) ::
|
||||
( Column PGInt4
|
||||
, Column PGText
|
||||
, Column PGInt4
|
||||
, Column (Nullable PGInt4)
|
||||
, Column (Nullable PGInt4)
|
||||
, Column (PGInt4)
|
||||
, Column (PGInt4)
|
||||
, Column (Nullable SqlInt4)
|
||||
, Column (Nullable SqlText)
|
||||
, Column PGInt4
|
||||
) <-
|
||||
arr (\((p, i2, i6, i7, i8, i9, i11, i12, i13), (_, _, a3, _, _)) ->
|
||||
(p, i2, i6, i7, i8, i9, i11, i12, i13, a3))
|
||||
<<< leftJoin
|
||||
(selectTable productTable)
|
||||
(selectTable amountTable)
|
||||
(\((pid, _, _, _, _, _, _, _, _), (aid, _, _, _, _)) ->
|
||||
pid .== aid
|
||||
) -< ()
|
||||
restrict -< case refine of
|
||||
AllProducts -> C.constant True
|
||||
AvailableProducts -> a3 ./= C.constant (0 :: Int)
|
||||
DepletedProducts -> a3 .== C.constant (0 :: Int)
|
||||
returnA -< (pid, i2, i6, i7, i8, i9, i11, i12, i13)
|
||||
) :: MateHandler
|
||||
[ ( Int
|
||||
, T.Text
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe T.Text
|
||||
)
|
||||
]
|
||||
prods <- liftIO $ runSelect conn (produceProductOverviews refine)
|
||||
mapM
|
||||
(generateProductOverview conn)
|
||||
prods
|
||||
|
||||
produceProductOverviews
|
||||
:: ProductRefine
|
||||
-> Select
|
||||
( Column PGInt4
|
||||
, Column PGText
|
||||
, Column PGInt4
|
||||
, Column (Nullable PGInt4)
|
||||
, Column (Nullable PGInt4)
|
||||
, Column PGInt4
|
||||
, Column PGInt4
|
||||
, Column (Nullable PGInt4)
|
||||
, Column (Nullable PGText)
|
||||
, Column PGInt4
|
||||
, Column PGInt4
|
||||
)
|
||||
produceProductOverviews refine =
|
||||
( proc () -> do
|
||||
(p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4)
|
||||
<- leftJoinF
|
||||
(\(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13)
|
||||
(aid, ai2, ai3, ai4, ai5) ->
|
||||
(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13, ai3, ai4)
|
||||
)
|
||||
(\_ ->
|
||||
( (C.constant (0 :: Int) :: Column PGInt4)
|
||||
, (C.constant ("ERROR PRODUCT" :: T.Text) :: Column PGText)
|
||||
, (C.constant (0 :: Int) :: Column PGInt4)
|
||||
, (C.constant (Just (0 :: Int)) :: Column (Nullable PGInt4))
|
||||
, (C.constant (Just (0 :: Int)) :: Column (Nullable PGInt4))
|
||||
, (C.constant (0 :: Int) :: Column PGInt4)
|
||||
, (C.constant (0 :: Int) :: Column PGInt4)
|
||||
, (C.constant (Just (0 :: Int)) :: Column (Nullable PGInt4))
|
||||
, (C.constant (Just ("" :: T.Text)) :: Column (Nullable PGText))
|
||||
, (C.constant (0 :: Int) :: Column PGInt4)
|
||||
, (C.constant (0 :: Int) :: Column PGInt4)
|
||||
)
|
||||
)
|
||||
(\(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13)
|
||||
(aid, ai2, ai3, ai4, ai5) ->
|
||||
pid .== aid
|
||||
)
|
||||
(selectTable productTable)
|
||||
(joinF
|
||||
(\(a1, a2, a3, a4, a5) (b1, b2) ->
|
||||
(b1, b2, a3, a4, a5)
|
||||
)
|
||||
(\(a1, a2, a3, a4, a5) (b1, b2) ->
|
||||
(a1 .== b1) .&& (a2 .== b2)
|
||||
)
|
||||
(selectTable amountTable)
|
||||
(aggregate
|
||||
((,)
|
||||
<$> P.lmap fst O.groupBy
|
||||
<*> P.lmap snd O.max
|
||||
)
|
||||
(arr (\(a, b, c, d, e) -> (a, b)) <<< selectTable amountTable))
|
||||
) -< ()
|
||||
-- <<< arr (\_ -> (selectTable productTable, selectTable amountTable)) -< ()
|
||||
restrict -< case refine of
|
||||
AllProducts -> C.constant True
|
||||
AvailableProducts -> a3 ./= (C.constant (0 :: Int) :: Column PGInt4)
|
||||
DepletedProducts -> a3 .== (C.constant (0 :: Int) :: Column PGInt4)
|
||||
returnA -< (p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4)
|
||||
)
|
||||
|
||||
queryAmounts
|
||||
:: PGS.Connection
|
||||
-> Int
|
||||
|
|
@ -164,9 +189,20 @@ queryAmounts conn pid = runSelect conn $ proc () -> do
|
|||
|
||||
generateProductOverview
|
||||
:: PGS.Connection
|
||||
-> (Int, Text, Int, Maybe Int, Maybe Int, Int, Int, Maybe Int, Maybe Text)
|
||||
-> ( Int
|
||||
, Text
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Text
|
||||
, Int
|
||||
, Int
|
||||
)
|
||||
-> MateHandler ProductOverview
|
||||
generateProductOverview conn (i1, i2, i3, i4, i5, i6, i7, i8, i9) = do
|
||||
generateProductOverview conn (i1, i2, i3, i4, i5, i6, i7, i8, i9, a3, a4) = do
|
||||
amounts <- liftIO $ queryAmounts conn i1
|
||||
(ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
|
||||
let ii5 = snd $
|
||||
|
|
@ -181,38 +217,22 @@ generateProductOverview conn (i1, i2, i3, i4, i5, i6, i7, i8, i9) = do
|
|||
ii10 = snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
|
||||
if ver
|
||||
then (amo, tot)
|
||||
else (amo, tot + max 0 (bef - amo))
|
||||
else (amo, tot + Prelude.max 0 (bef - amo))
|
||||
)
|
||||
(0, 0)
|
||||
(Prelude.reverse amounts)
|
||||
return $ ProductOverview
|
||||
i1 i2 ii3 ii4 ii5 i3 i4 i5 i6 ii10 i7 i8 i9
|
||||
i1 i2 a3 a4 ii5 i3 i4 i5 i6 ii10 i7 i8 i9
|
||||
|
||||
productOverviewSelectSingle
|
||||
:: Int
|
||||
-> PGS.Connection
|
||||
-> MateHandler ProductOverview
|
||||
productOverviewSelectSingle pid conn = do
|
||||
prods <- liftIO $ runSelect conn
|
||||
( proc () -> do
|
||||
(i1, i2, i6, i7, i8, i9, i11, i12, i13) <- queryTable productTable -< ()
|
||||
restrict -< C.constant pid .== i1
|
||||
returnA -< (i1, i2, i6, i7, i8, i9, i11, i12, i13)
|
||||
) :: MateHandler
|
||||
[ ( Int
|
||||
, T.Text
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe T.Text
|
||||
)
|
||||
]
|
||||
prods <- liftIO $ runSelect conn (produceProductOverviews AllProducts)
|
||||
head <$> mapM
|
||||
(generateProductOverview conn)
|
||||
prods
|
||||
(Prelude.filter (\(p, _, _, _, _, _, _, _, _, _, _) -> p == pid) prods)
|
||||
|
||||
|
||||
productShortOverviewSelect
|
||||
|
|
@ -220,37 +240,24 @@ productShortOverviewSelect
|
|||
-> PGS.Connection
|
||||
-> MateHandler [ProductShortOverview]
|
||||
productShortOverviewSelect refine conn = do
|
||||
prods <- liftIO $ runSelect conn
|
||||
( proc () -> do
|
||||
(i1, i2, i6, i7, i8, i9, i11, i12, i13) <- queryTable productTable -< ()
|
||||
(a1, _, a3, _, _) <-
|
||||
limit 1 (
|
||||
orderBy (desc (\(_, ts, _, _, _) -> ts)) (queryTable amountTable))
|
||||
-< ()
|
||||
restrict -< a1 .== i1
|
||||
restrict -< case refine of
|
||||
AllProducts -> C.constant True
|
||||
AvailableProducts -> a3 ./= C.constant (0 :: Int)
|
||||
DepletedProducts -> a3 .== C.constant (0 :: Int)
|
||||
returnA -< (i1, i2, i6, i7, i8, i9, i11, i12, i13)
|
||||
) :: MateHandler
|
||||
[ ( Int
|
||||
, T.Text
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe T.Text
|
||||
)
|
||||
]
|
||||
prods <- liftIO $ runSelect conn (produceProductOverviews refine)
|
||||
:: MateHandler [
|
||||
( Int
|
||||
, Text
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Int
|
||||
, Int
|
||||
, Int
|
||||
, Maybe Int
|
||||
, Maybe Text
|
||||
, Int
|
||||
, Int
|
||||
)]
|
||||
mapM
|
||||
(\(i1, i2, i3, i4, _, _, _, _, _) -> do
|
||||
amounts <- liftIO $ queryAmounts conn i1
|
||||
(ii3, ii4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
|
||||
(\(i1, i2, i3, i4, _, _, _, _, _, a3, a4) -> do
|
||||
return $ ProductShortOverview
|
||||
i1 i2 ii3 ii4 i3 i4
|
||||
i1 i2 a4 a3 i3 i4
|
||||
)
|
||||
prods
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue