diff --git a/app/Main.hs b/app/Main.hs index 5108941..7e9f077 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -88,7 +88,7 @@ main = do store <- newTVarIO S.empty -- tracker <- newTVarIO M.empty migrationsExist <- existsTable conn "schema_migrations" - when (not migrationsExist) $ do + unless migrationsExist $ do withTransaction conn $ void $ do runMigration $ @@ -110,7 +110,7 @@ main = do case ok of MigrationError err -> do putStrLn ("Migration validation error: " ++ err) - putStrLn ("Running Migrations!") + putStrLn "Running Migrations!" void $ withTransaction conn $ runMigration $ MigrationContext (MigrationDirectory migLoc) True conn MigrationSuccess -> return () @@ -119,11 +119,11 @@ main = do case ok2 of MigrationError err -> do putStrLn ("Migration validation error: " ++ err) - putStrLn ("MIgration failure! exiting...") + putStrLn "MIgration failure! exiting..." exitWith (ExitFailure 3) MigrationSuccess -> do - putStrLn ("Migration validation success!") - putStrLn ("starting up...") + putStrLn "Migration validation success!" + putStrLn "starting up..." forkCleanProcess conn store withStdoutLogger $ \ilog -> do let settings = setPort (fromIntegral lport) $ diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index f21a8f4..b436d07 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -22,7 +22,7 @@ journalShow (Just (uid, method)) mlimit moffset = do maySeeJournal <- anyM (checkCapability uid) [roleCanViewJournal, roleCanManageJournal] - if (method `elem` [PrimaryPass, ChallengeResponse] && maySeeJournal) + if method `elem` [PrimaryPass, ChallengeResponse] && maySeeJournal then do conn <- asks rsConnection selectJournalEntries mlimit moffset conn @@ -41,7 +41,7 @@ journalCheck -> MateHandler () journalCheck (Just (uid, method)) check = do mayCheckJournal <- checkCapability uid roleCanManageJournal - if (method `elem` [PrimaryPass, ChallengeResponse] && mayCheckJournal) + if method `elem` [PrimaryPass, ChallengeResponse] && mayCheckJournal then do conn <- asks rsConnection void $ insertNewCashCheck check conn diff --git a/src/Control/Product.hs b/src/Control/Product.hs index fd0682d..b83615b 100644 --- a/src/Control/Product.hs +++ b/src/Control/Product.hs @@ -23,7 +23,7 @@ productNew -> MateHandler Int productNew (Just (uid, auth)) bevsub = do mayAddProduct <- checkCapability uid roleCanManageProducts - if (auth `elem` [PrimaryPass, ChallengeResponse] && mayAddProduct) + if auth `elem` [PrimaryPass, ChallengeResponse] && mayAddProduct then do conn <- asks rsConnection bevid <- insertProduct bevsub conn @@ -53,13 +53,13 @@ productStockRefill (Just (uid, auth)) amorefs = do mayRefill <- anyM (checkCapability uid) [ roleCanRefillStock, roleCanManageProducts ] - if (auth `elem` [PrimaryPass, ChallengeResponse] && mayRefill) + if auth `elem` [PrimaryPass, ChallengeResponse] && mayRefill then do conn <- asks rsConnection prods <- mapM (\refill -> productSelectSingle (amountRefillProductId refill) conn) amorefs - if all (not . null) prods + if not (any null prods) then if all @@ -93,7 +93,7 @@ productStockUpdate -> MateHandler () productStockUpdate (Just (uid, method)) amoups = do mayUpdateStock <- checkCapability uid roleCanManageProducts - if (method `elem` [PrimaryPass, ChallengeResponse] && mayUpdateStock) + if method `elem` [PrimaryPass, ChallengeResponse] && mayUpdateStock then if all ((>= 0) . amountUpdateRealAmount) amoups then do diff --git a/src/Control/Role.hs b/src/Control/Role.hs index d8be9b9..09f022f 100644 --- a/src/Control/Role.hs +++ b/src/Control/Role.hs @@ -28,7 +28,7 @@ roleNew roleNew (Just (uid, auth)) (RoleSubmit name c1 c2 c3 c4 c5 c6 c7 c8 c9) = do isRoleManager <- checkCapability uid roleCanManageRoles - if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager then insertRole name c1 c2 c3 c4 c5 c6 c7 c8 c9 =<< asks rsConnection else @@ -47,7 +47,7 @@ roleUpdate -> MateHandler () roleUpdate (Just (uid, auth)) id_ roleSubmit = do isRoleManager <- checkCapability uid roleCanManageRoles - if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager then void $ updateRole id_ roleSubmit =<< asks rsConnection else @@ -65,7 +65,7 @@ roleDelete -> MateHandler () roleDelete (Just (uid, auth)) id_ = do isRoleManager <- checkCapability uid roleCanManageRoles - if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager then void $ deleteRole id_ =<< asks rsConnection else @@ -88,7 +88,7 @@ roleAssociationSubmit -> MateHandler () roleAssociationSubmit (Just (uid, auth)) (RoleAssociationSubmit auid arid) = do isRoleManager <- checkCapability uid roleCanManageRoles - if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager then associateUserToRole auid arid =<< asks rsConnection else @@ -106,7 +106,7 @@ roleAssociationDelete -> MateHandler () roleAssociationDelete (Just (uid, auth)) (RoleAssociation auid arid) = do isRoleManager <- checkCapability uid roleCanManageRoles - if (auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager) + if auth `elem` [PrimaryPass, ChallengeResponse] && isRoleManager then void $ deleteAssociation auid arid =<< asks rsConnection else diff --git a/src/Model/Amount.hs b/src/Model/Amount.hs index 691d621..d7bc776 100644 --- a/src/Model/Amount.hs +++ b/src/Model/Amount.hs @@ -113,7 +113,7 @@ getLatestAmountByProductId pid conn = do , Bool ) ] - head <$> return ( map + return (head $ map (\(_, _, amount, _, _) -> amount) amounts ) @@ -135,7 +135,7 @@ getLatestTotalPrice (PurchaseDetail pid amount) conn = do , Bool ) ] - (amount *) . head <$> return (map + return $ ((amount *) . head) (map (\(_, _, _, price, _) -> price) amounts ) diff --git a/src/Model/Journal.hs b/src/Model/Journal.hs index cb701f2..ce94866 100644 --- a/src/Model/Journal.hs +++ b/src/Model/Journal.hs @@ -3,7 +3,7 @@ {-# LANGUAGE Arrows #-} module Model.Journal where -import Data.Maybe (isJust, fromJust) +import Data.Maybe import Data.Time (UTCTime) import Data.Time.Clock @@ -74,9 +74,7 @@ selectJournalEntries mlimit moffset conn = liftIO $ do let lim = case mlimit of Just l -> limit (l + 1) Nothing -> id - off = case moffset of - Just o -> offset o - Nothing -> id + off = maybe id offset moffset entries <- runSelect conn ( proc () -> do ret <- lim $ off $ orderBy (desc (\(id_, _, _, _, _) -> id_)) diff --git a/src/Model/Product.hs b/src/Model/Product.hs index c12d294..8698b01 100644 --- a/src/Model/Product.hs +++ b/src/Model/Product.hs @@ -321,7 +321,7 @@ manualProductAmountRefill aups conn = (\(AmountRefill pid amountSingles amountCrates) -> do oldamount <- getLatestAmountByProductId pid conn oldprice <- getLatestPriceByProductId pid conn - perCrate <- (productAmountPerCrate . head) <$> + perCrate <- productAmountPerCrate . head <$> productSelectSingle pid conn head <$> liftIO (do now <- getCurrentTime diff --git a/src/Model/Role.hs b/src/Model/Role.hs index db979e3..dcbc2ca 100644 --- a/src/Model/Role.hs +++ b/src/Model/Role.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE Arrows #-} {-# LANGUAGE ScopedTypeVariables #-} module Model.Role where @@ -202,8 +201,8 @@ selectRoleList -> MateHandler [Role] selectRoleList ids conn = do rawRoles <- liftIO $ runSelect conn ( - (keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _) -> - in_ (map C.constant ids) id_)) + keepWhen (\(id_, _, _, _, _, _, _, _, _, _, _) -> + in_ (map C.constant ids) id_) <<< queryTable roleTable ) :: MateHandler [ @@ -341,7 +340,7 @@ selectAllRoleAssociations conn = do ) ] return $ map - (\(uid, rid) -> RoleAssociation uid rid) + (uncurry RoleAssociation) rawRoleAssocs @@ -359,7 +358,7 @@ selectUserAssociations uid conn = do , Int ) ] - return $ map (\(auid, arid) -> RoleAssociation auid arid) rawAssocs + return $ map (uncurry RoleAssociation) rawAssocs associateUserToRole @@ -390,7 +389,7 @@ deleteAssociation uid rid conn = liftIO $ runDelete_ conn $ Delete { dTable = userToRoleTable , dWhere = - (\(auid, arid) -> auid .== C.constant uid .&& arid .== C.constant rid) + \(auid, arid) -> auid .== C.constant uid .&& arid .== C.constant rid , dReturning = rCount } @@ -430,6 +429,6 @@ deleteRole rid conn = liftIO $ runDelete_ conn $ Delete { dTable = roleTable , dWhere = - (\(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant rid) + \(id_, _, _, _, _, _, _, _, _, _, _) -> id_ .== C.constant rid , dReturning = rCount }