diff --git a/app/Janitor.hs b/app/Janitor.hs index 91bddf2..12fd024 100644 --- a/app/Janitor.hs +++ b/app/Janitor.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Janitor where import qualified Database.PostgreSQL.Simple as PGS diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index 4f83a11..23ea94e 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -16,7 +16,7 @@ journalShow -> Maybe Int -> Maybe Int -> MateHandler [JournalEntry] -journalShow (Just (_, method)) mlimit moffset = do +journalShow (Just (_, method)) mlimit moffset = if method `elem` [PrimaryPass, ChallengeResponse] then do conn <- asks rsConnection @@ -34,7 +34,7 @@ journalCheck :: Maybe (Int, AuthMethod) -> JournalCashCheck -> MateHandler () -journalCheck (Just (_, method)) check = do +journalCheck (Just (_, method)) check = if method `elem` [PrimaryPass, ChallengeResponse] then do conn <- asks rsConnection diff --git a/src/Model/Journal.hs b/src/Model/Journal.hs index a3a91af..d918443 100644 --- a/src/Model/Journal.hs +++ b/src/Model/Journal.hs @@ -156,7 +156,7 @@ insertNewCashCheck :: JournalCashCheck -> PGS.Connection -> MateHandler Int -insertNewCashCheck (JournalCashCheck amount) conn = do +insertNewCashCheck (JournalCashCheck amount) conn = -- lastTotal <- (\case -- Just j -> journalEntryTotalAmount j -- Nothing -> 0 diff --git a/src/Model/Product.hs b/src/Model/Product.hs index 9f1f273..9686ce2 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -126,54 +126,53 @@ produceProductOverviews , Column PGInt4 ) produceProductOverviews refine = - ( proc () -> do - (p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4) - <- orderBy (asc (\(_, a2, _, _, _, _, _, _, _, _, _) -> a2)) (leftJoinF - (\(pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13) - (_, _, ai3, ai4, _) -> - (pid, pi2, pi6, pi7, pi8, pi9, pi11, pi12, pi13, ai3, ai4) + proc () -> do + (p, i2, i6, i7, i8, i9, i11, i12, i13, a3, a4) + <- orderBy (asc (\(_, a2, _, _, _, _, _, _, _, _, _) -> a2)) (leftJoinF + (\(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) ) - (\_ -> - ( (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) + (\(a1, a2, _, _, _) (b1, b2) -> + (a1 .== b1) .&& (a2 .== b2) ) - ) - (\(pid, _, _, _, _, _, _, _, _) - (aid, _, _, _, _) -> - pid .== aid - ) - (selectTable productTable) - (joinF - (\(_, _, a3, a4, a5) (b1, b2) -> - (b1, b2, a3, a4, a5) + (selectTable amountTable) + (aggregate + ((,) + <$> P.lmap fst O.groupBy + <*> P.lmap snd O.max ) - (\(a1, a2, _, _, _) (b1, b2) -> - (a1 .== b1) .&& (a2 .== b2) - ) - (selectTable amountTable) - (aggregate - ((,) - <$> P.lmap fst O.groupBy - <*> P.lmap snd O.max - ) - (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) - ) + (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 :: PGS.Connection @@ -252,7 +251,7 @@ productShortOverviewSelect refine conn = do , Int )] mapM - (\(i1, i2, i3, i4, _, _, _, _, _, a3, a4) -> do + (\(i1, i2, i3, i4, _, _, _, _, _, a3, a4) -> return $ ProductShortOverview i1 i2 a4 a3 i3 i4 ) diff --git a/src/Util.hs b/src/Util.hs index 21e6434..91aba92 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -3,9 +3,9 @@ module Util where import Opaleye -import Data.Maybe (maybe) +import Data.Maybe (fromMaybe) import Data.Profunctor.Product.Default (Default) printSql :: Default Unpackspec a a => Select a -> IO () -printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres +printSql = putStrLn . fromMaybe "Empty query" . showSqlForPostgres