hunting warnings

This commit is contained in:
nek0 2019-12-12 03:15:56 +01:00
parent f02dbe49ac
commit 5b1b4b8cfe
5 changed files with 50 additions and 52 deletions

View File

@ -1,4 +1,3 @@
{-# LANGUAGE OverloadedStrings #-}
module Janitor where module Janitor where
import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple as PGS

View File

@ -16,7 +16,7 @@ journalShow
-> Maybe Int -> Maybe Int
-> Maybe Int -> Maybe Int
-> MateHandler [JournalEntry] -> MateHandler [JournalEntry]
journalShow (Just (_, method)) mlimit moffset = do journalShow (Just (_, method)) mlimit moffset =
if method `elem` [PrimaryPass, ChallengeResponse] if method `elem` [PrimaryPass, ChallengeResponse]
then do then do
conn <- asks rsConnection conn <- asks rsConnection
@ -34,7 +34,7 @@ journalCheck
:: Maybe (Int, AuthMethod) :: Maybe (Int, AuthMethod)
-> JournalCashCheck -> JournalCashCheck
-> MateHandler () -> MateHandler ()
journalCheck (Just (_, method)) check = do journalCheck (Just (_, method)) check =
if method `elem` [PrimaryPass, ChallengeResponse] if method `elem` [PrimaryPass, ChallengeResponse]
then do then do
conn <- asks rsConnection conn <- asks rsConnection

View File

@ -156,7 +156,7 @@ insertNewCashCheck
:: JournalCashCheck :: JournalCashCheck
-> PGS.Connection -> PGS.Connection
-> MateHandler Int -> MateHandler Int
insertNewCashCheck (JournalCashCheck amount) conn = do insertNewCashCheck (JournalCashCheck amount) conn =
-- lastTotal <- (\case -- lastTotal <- (\case
-- Just j -> journalEntryTotalAmount j -- Just j -> journalEntryTotalAmount j
-- Nothing -> 0 -- Nothing -> 0

View File

@ -126,54 +126,53 @@ produceProductOverviews
, Column PGInt4 , Column PGInt4
) )
produceProductOverviews refine = produceProductOverviews refine =
( proc () -> do proc () -> do
(p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4) (p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4)
<- orderBy (asc (\(_, a2, _, _, _, _, _, _, _, _, _) -> a2)) (leftJoinF <- orderBy (asc (\(_, a2, _, _, _, _, _, _, _, _, _) -> a2)) (leftJoinF
(\(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13) (\(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13)
(_, _, ai3, ai4, _) -> (_, _, ai3, ai4, _) ->
(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13, ai3, ai4) (pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13, ai3, ai4)
)
(const
( 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, _, _, _, _, _, _, _, _)
(aid, _, _, _, _) ->
pid .== aid
)
(selectTable productTable)
(joinF
(\(_, _, a3, a4, a5) (b1, b2) ->
(b1, b2, a3, a4, a5)
) )
(\_ -> (\(a1, a2, _, _, _) (b1, b2) ->
( (C.constant (0 :: Int) :: Column PGInt4) (a1 .== b1) .&& (a2 .== b2)
, (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)
) )
) (selectTable amountTable)
(\(pid, _, _, _, _, _, _, _, _) (aggregate
(aid, _, _, _, _) -> ((,)
pid .== aid <$> P.lmap fst O.groupBy
) <*> P.lmap snd O.max
(selectTable productTable)
(joinF
(\(_, _, a3, a4, a5) (b1, b2) ->
(b1, b2, a3, a4, a5)
) )
(\(a1, a2, _, _, _) (b1, b2) -> (arr (\(a, b, _, _, _) -> (a, b)) <<< selectTable amountTable))
(a1 .== b1) .&& (a2 .== b2) )) -< ()
) -- <<< arr (\_ -> (selectTable productTable, selectTable amountTable)) -< ()
(selectTable amountTable) restrict -< case refine of
(aggregate AllProducts -> C.constant True
((,) AvailableProducts -> a3 ./= (C.constant (0 :: Int) :: Column PGInt4)
<$> P.lmap fst O.groupBy DepletedProducts -> a3 .== (C.constant (0 :: Int) :: Column PGInt4)
<*> P.lmap snd O.max returnA -< (p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4)
)
(arr (\(a, b, _, _, _) -> (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 queryAmounts
:: PGS.Connection :: PGS.Connection
@ -252,7 +251,7 @@ productShortOverviewSelect refine conn = do
, Int , Int
)] )]
mapM mapM
(\(i1, i2, i3, i4, _, _, _, _, _, a3, a4) -> do (\(i1, i2, i3, i4, _, _, _, _, _, a3, a4) ->
return $ ProductShortOverview return $ ProductShortOverview
i1 i2 a4 a3 i3 i4 i1 i2 a4 a3 i3 i4
) )

View File

@ -3,9 +3,9 @@ module Util where
import Opaleye import Opaleye
import Data.Maybe (maybe) import Data.Maybe (fromMaybe)
import Data.Profunctor.Product.Default (Default) import Data.Profunctor.Product.Default (Default)
printSql :: Default Unpackspec a a => Select a -> IO () printSql :: Default Unpackspec a a => Select a -> IO ()
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres printSql = putStrLn . fromMaybe "Empty query" . showSqlForPostgres