add short product overview

This commit is contained in:
nek0 2019-08-03 09:30:18 +02:00
parent a937fe4775
commit 340ccdc275
4 changed files with 98 additions and 4 deletions

View file

@ -32,7 +32,8 @@ type UserAPI =
:> Capture "id" Int :> ReqBody '[JSON] UserDetailsSubmit :> Post '[JSON] ()
)
:<|> "product" :>
( "list" :> Get '[JSON] [ProductOverview]
( "list" :> Get '[JSON] [ProductShortOverview]
:<|> "list" :> AuthProtect "header-auth" :> Get '[JSON] [ProductOverview]
:<|> "new" :> AuthProtect "header-auth" :> ReqBody '[JSON] ProductSubmit
:> Post '[JSON] Int
:<|> "update" :> AuthProtect "header-auth"

View file

@ -149,14 +149,22 @@ users =
}
products =
list :<|>
listShort :<|>
listLong :<|>
new :<|>
update
where
list :: MateHandler [ProductOverview]
list = do
listShort :: MateHandler [ProductShortOverview]
listShort = do
conn <- rsConnection <$> ask
productShortOverviewSelect conn
listLong :: Maybe Int -> MateHandler [ProductOverview]
listLong (Just _) = do
conn <- rsConnection <$> ask
productOverviewSelect conn
listLong Nothing =
throwError $ err403
new :: Maybe Int -> ProductSubmit -> MateHandler Int
new (Just _) bevsub = do

View file

@ -193,6 +193,69 @@ productOverviewSelect conn = do
bevs
productShortOverviewSelect
:: PGS.Connection
-> MateHandler [ProductShortOverview]
productShortOverviewSelect conn = do
bevs <- liftIO $ runSelect conn
( proc () -> do
(i1, i2, i6, i7, i8, i9, i11, i12, i13) <- queryTable productTable -< ()
returnA -< (i1, i2, i6, i7, i8, i9, i11, i12, i13)
) :: MateHandler
[ ( Int
, T.Text
-- , Int
-- , Int
-- , Int
, Int
, Maybe Int
, Maybe Int
, Int
-- , Int
, Int
, Maybe Int
, Maybe T.Text
)
]
mapM
(\(i1, i2, {-i3, i4, i5,-} i6, i7, i8, i9, {-i10,-} i11, i12, i13) -> do
amounts <- liftIO $ runSelect conn
( proc () -> do
stuff@(a1, _, _, _, _) <- orderBy (desc (\(_, ts, _, _, _) -> ts))
(queryTable amountTable) -< ()
restrict -< C.constant i1 .== a1
returnA -< stuff
) :: MateHandler
[ ( Int
, UTCTime
, Int
, Int
, Bool
)
]
(i3, i4) <- return $ (\(_, _, y, x, _) -> (x, y)) $ head amounts
i5 <- return $ (\(_, x) -> x) $
foldl
(\(bef, van) (_, _, amo, _, ver) ->
if ver
then (amo, if amo < bef then van + (bef - amo) else van)
else (amo, van)
)
(0, 0)
(Prelude.reverse amounts)
i10 <- return $ snd $ foldl (\(bef, tot) (_, _, amo, _, ver) ->
if ver
then (amo, tot)
else (amo, tot + (bef - amo))
)
(0, 0)
(Prelude.reverse amounts)
return $ ProductShortOverview
i1 i2 i3 i4 i6 i7
)
bevs
-- getProductPrice
-- :: PurchaseDetail
-- -> PGS.Connection

View file

@ -51,6 +51,28 @@ instance ToJSON ProductOverview where
instance FromJSON ProductOverview
data ProductShortOverview = ProductShortOverview
{ productShortOverviewId :: Int
, productShortOverviewIdent :: T.Text
, productShortOverviewPrice :: Int
, productShortOverviewAmount :: Int
-- , productShortOverviewVanish :: Int
, productShortOverviewMl :: Int
, productShortOverviewAvatar :: Maybe Int
-- , productShortOverviewSupplier :: Maybe Int
-- , productShortOverviewMaxAmount :: Int
-- , productShortOverviewTotalBought :: Int
-- , productShortOverviewAmountPerCrate :: Int
-- , productShortOverviewPricePerCrate :: Maybe Int
-- , productShortOverviewArtNr :: Maybe T.Text
} deriving (Generic, Show)
instance ToJSON ProductShortOverview where
toEncoding = genericToEncoding defaultOptions
instance FromJSON ProductShortOverview
data ProductSubmit = ProductSubmit
{ productSubmitIdent :: T.Text
, productSubmitPrice :: Int