mateamt/src/Model/Beverage.hs

130 lines
3.3 KiB
Haskell
Raw Normal View History

2019-04-15 20:23:25 +00:00
{-# LANGUAGE DeriveGeneric #-}
2019-04-16 12:02:41 +00:00
{-# LANGUAGE OverloadedStrings #-}
2019-04-15 20:23:25 +00:00
module Model.Beverage where
import Data.Text as T
import Data.Time.Calendar (Day)
2019-04-16 12:02:41 +00:00
import Data.Profunctor.Product (p13)
2019-04-15 20:23:25 +00:00
import Data.Aeson
import Data.Aeson.Types
2019-07-18 12:57:35 +00:00
import Control.Monad.IO.Class (liftIO)
import Control.Arrow ((<<<))
2019-04-16 12:02:41 +00:00
import qualified Database.PostgreSQL.Simple as PGS
2019-04-15 20:23:25 +00:00
import GHC.Generics
import Opaleye as O
2019-07-18 12:57:35 +00:00
import Opaleye.Constant as C
-- internal imports
import Types
2019-04-15 20:23:25 +00:00
2019-04-16 12:02:41 +00:00
initBeverage :: PGS.Query
2019-04-21 15:27:15 +00:00
initBeverage = "create Table if not exists \"beverage\" (beverage_id serial primary key, beverage_ident varchar(128) not null, beverage_price integer not null, beverage_amount integer not null, beverage_vanish integer not null, beverage_ml integer not null, beverage_avatar integer, beverage_supplier integer, beverage_max_amount integer not null, beverage_total_bought integer not null, beverage_amount_per_crate integer not null, beverage_price_per_crate integer, beverage_art_nr varchar(128))"
2019-04-16 12:02:41 +00:00
2019-04-15 20:23:25 +00:00
beverageTable :: Table
2019-04-16 12:02:41 +00:00
( Maybe (Field SqlInt4)
, Field SqlText
, Field SqlInt4
, Field SqlInt4
, Field SqlInt4
, Field SqlInt4
2019-04-15 20:23:25 +00:00
, FieldNullable SqlInt4
, FieldNullable SqlInt4
2019-04-16 12:02:41 +00:00
, Field SqlInt4
, Field SqlInt4
, Field SqlInt4
, FieldNullable SqlInt4
2019-04-15 20:23:25 +00:00
, FieldNullable SqlText
)
2019-04-16 12:02:41 +00:00
( Field SqlInt4
, Field SqlText
, Field SqlInt4
, Field SqlInt4
, Field SqlInt4
, Field SqlInt4
, FieldNullable SqlInt4
2019-04-15 20:23:25 +00:00
, FieldNullable SqlInt4
2019-04-16 12:02:41 +00:00
, Field SqlInt4
, Field SqlInt4
, Field SqlInt4
2019-04-15 20:23:25 +00:00
, FieldNullable SqlInt4
, FieldNullable SqlText
)
beverageTable = table "beverage" (
2019-04-16 12:02:41 +00:00
p13
2019-04-21 15:27:15 +00:00
( tableField "beverage_id"
, tableField "beverage_ident"
, tableField "beverage_price"
, tableField "beverage_amount"
, tableField "beverage_vanish"
, tableField "beverage_ml"
, tableField "beverage_avatar"
, tableField "beverage_supplier"
, tableField "beverage_max_amount"
, tableField "beverage_total_bought"
, tableField "beverage_amount_per_crate"
, tableField "beverage_price_per_crate"
, tableField "beverage_art_nr"
2019-04-15 20:23:25 +00:00
)
)
2019-07-18 12:57:35 +00:00
beverageSelect
:: PGS.Connection
-> MateHandler [Beverage]
beverageSelect conn = do
bevs <- liftIO $ runSelect conn
( keepWhen (\_ -> C.constant True) <<< queryTable beverageTable
) :: 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) -> return $
Beverage i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13
)
bevs
insertBeverage
:: BeverageSubmit
-> Insert [Int]
insertBeverage (BeverageSubmit ident price ml sup max apc ppc artnr) = Insert
{ iTable = beverageTable
, iRows =
[
( C.constant (Nothing :: Maybe Int)
, C.constant ident
, C.constant price
, C.constant (0 :: Int)
, C.constant (0 :: Int)
, C.constant ml
, C.constant (Nothing :: Maybe Int)
, C.constant sup
, C.constant max
, C.constant (0 :: Int)
, C.constant apc
, C.constant ppc
, C.constant artnr
)
]
, iReturning = rReturning (\(id, _, _, _, _, _, _, _, _, _, _, _, _) -> id)
, iOnConflict = Nothing
}