linted

Foundation.hs

@@ -32,29 +32,26 @@ import Text.Printf
 
 
 prependZero :: Text -> Text
-prependZero t0 = if T.null t1
+prependZero t0
-                 then t1
+ | T.null t1              = t1
-                 else if T.head t1 == '.'
+ | T.head t1 == '.'       = '0' `T.cons` t1
-                      then '0' `T.cons` t1
+ | "-." `T.isPrefixOf` t1 = "-0." `T.append` T.drop 2 t1
-                      else if "-." `T.isPrefixOf` t1
+ | otherwise              = t1
-                           then "-0." `T.append` (T.drop 2 t1)
+ where t1 = T.dropWhile (' ' ==) t0
-                           else t1
-
-  where t1 = T.dropWhile ((==) ' ') t0
 
 formatFloat :: Double -> Text
 formatFloat d = T.pack (pre ++ t ++ c)
   where
     t = reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp)
     c = "," ++ tail (snd sp)
-    sp = (break (== '.') (printf "%.2f" (abs d)))
+    sp = break (== '.') (printf "%.2f" (abs d))
-    pre = case d < 0 of
+    pre = if d < 0
-      True -> "-"
+      then "-"
-      False -> ""
+      else ""
     -- T.pack . (splitEvery 3) . (printf "%,2f")
 
 formatIntCurrency :: Int -> Text
-formatIntCurrency x = formatFloat $ ((fromIntegral x) / 100)
+formatIntCurrency x = formatFloat $ fromIntegral x / 100
 
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
@@ -97,9 +94,9 @@ approotRequest master req =
         Nothing -> appRoot $ appSettings master
     where
         prefix =
-            case isSecure req of
+            if isSecure req
-                True  -> "https://"
+                then "https://"
-                False -> "http://"
+                else "http://"
 
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
@@ -111,7 +108,7 @@ instance Yesod App where
 
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
-    makeSessionBackend _ = fmap Just $ defaultClientSessionBackend
+    makeSessionBackend _ = Just <$> defaultClientSessionBackend
         120    -- timeout in minutes
         "config/client_session_key.aes"
 

Handler/Avatar.hs

@@ -24,29 +24,29 @@ import Graphics.ImageMagick.MagickWand
 getAvatarR :: Handler Html
 getAvatarR = do
   avatars <- runDB $ selectList [] [Asc AvatarIdent]
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "avatars")
 
 getNewAvatarR :: Handler Html
 getNewAvatarR = do
-  (newAvatarWidget, enctype) <- generateFormPost $ avatarNewForm
+  (newAvatarWidget, enctype) <- generateFormPost avatarNewForm
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "newAvatar")
 
 postNewAvatarR :: Handler Html
 postNewAvatarR = do
-  ((res, _), _) <- runFormPost $ avatarNewForm
+  ((res, _), _) <- runFormPost avatarNewForm
   case res of
     FormSuccess na -> do
       raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs
       thumb <- generateThumb $ B.concat $ L.toChunks raw
-      now <- liftIO $ getCurrentTime
+      now <- liftIO getCurrentTime
       runDB $ insert_ $ Avatar (avatarNewIdent na) thumb now
       setMessageI MsgAvatarUploadSuccessfull
-      redirect $ HomeR
+      redirect HomeR
     _ -> do
       setMessageI MsgErrorOccured
-      redirect $ NewAvatarR
+      redirect NewAvatarR
 
 avatarNewForm :: Form AvatarNew
 avatarNewForm = renderDivs $ AvatarNew
@@ -64,11 +64,11 @@ getModifyAvatarR aId = do
   case ma of
     Just avatar -> do
       (avatarModifyWidget, enctype) <- generateFormPost $ avatarModForm avatar
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "modifyAvatar")
     Nothing -> do
       setMessageI MsgAvatarUnknown
-      redirect $ AvatarR
+      redirect AvatarR
 
 postModifyAvatarR :: AvatarId -> Handler Html
 postModifyAvatarR aId = do
@@ -80,13 +80,13 @@ postModifyAvatarR aId = do
         FormSuccess md -> do
           updateAvatar aId md
           setMessageI MsgAvatarUpdateSuccessfull
-          redirect $ AvatarR
+          redirect AvatarR
         _ -> do
           setMessageI MsgErrorOccured
           redirect $ ModifyAvatarR aId
     Nothing -> do
       setMessageI MsgAvatarUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 avatarModForm :: Avatar -> Form AvatarMod
 avatarModForm a = renderDivs $ AvatarMod
@@ -99,7 +99,7 @@ data AvatarMod = AvatarMod
   }
 
 updateAvatar :: AvatarId -> AvatarMod -> Handler ()
-updateAvatar aId (AvatarMod ident Nothing) = do
+updateAvatar aId (AvatarMod ident Nothing) =
   runDB $ update aId [AvatarIdent =. ident]
 updateAvatar aId (AvatarMod ident (Just fi)) = do
   raw <- runResourceT $ fileSource fi $$ sinkLbs
@@ -110,19 +110,18 @@ updateAvatar aId (AvatarMod ident (Just fi)) = do
     ]
 
 generateThumb :: ByteString -> Handler ByteString
-generateThumb raw = do
+generateThumb raw =
-  thumb <- liftIO $ withMagickWandGenesis $ do
+  liftIO $ withMagickWandGenesis $ do
     (_, w) <- magickWand
     readImageBlob w raw
     w1 <- getImageWidth w
     h1 <- getImageHeight w
-    h2 <- return 140
+    let h2 = 140
-    w2 <- return $ floor (((fromIntegral w1) / (fromIntegral h1)) * (fromIntegral h2) :: Double)
+    let w2 = floor (fromIntegral w1 / fromIntegral h1 * fromIntegral h2 :: Double)
     resizeImage w w2 h2 lanczosFilter 1
     setImageCompressionQuality w 95
     setImageFormat w "png"
     getImageBlob w
-  return thumb
 
 getGetAvatarR :: AvatarId -> Handler TypedContent
 getGetAvatarR aId = do
@@ -136,14 +135,14 @@ getAvatarDeleteR aId = do
     Just _ -> do
       c <- runDB $ selectList [UserAvatar ==. Just aId] []
       d <- runDB $ selectList [BeverageAvatar ==. Just aId] []
-      case null c && null d of
+      if null c && null d
-        True -> do
+        then do
           runDB $ delete aId
           setMessageI MsgAvatarDeleted
-          redirect $ HomeR
+          redirect HomeR
-        False -> do
+        else do
           setMessageI MsgAvatarInUseError
-          redirect $ AvatarR
+          redirect AvatarR
     Nothing -> do
       setMessageI MsgAvatarUnknown
-      redirect $ AvatarR
+      redirect AvatarR

Handler/Barcode.hs

@@ -21,19 +21,19 @@ getHomeBarcodeR :: Handler Html
 getHomeBarcodeR = do
   eub <- handleSelectParam
   case eub of
-    Just (Left uId) -> do
+    Just (Left uId) ->
       redirect $ SelectR uId
     Just (Right _) -> do
       setMessageI MsgBarcodeNotUser
-      redirect $ HomeR
+      redirect HomeR
-    Nothing -> do
+    Nothing ->
-      redirect $ HomeR
+      redirect HomeR
 
 getSelectBarcodeR :: UserId -> Handler Html
 getSelectBarcodeR uId = do
   eub <- handleSelectParam
   case eub of
-    Just (Right bId) -> do
+    Just (Right bId) ->
       redirect $ BuyR uId bId
     Just (Left _) -> do
       setMessageI MsgBarcodeNotBev
@@ -45,13 +45,13 @@ getSelectCashBarcodeR :: Handler Html
 getSelectCashBarcodeR = do
   eub <- handleSelectParam
   case eub of
-    Just (Right bId) -> do
+    Just (Right bId) ->
       redirect $ BuyCashR bId
     Just (Left _) -> do
       setMessageI MsgBarcodeNotBev
-      redirect $ SelectCashR
+      redirect SelectCashR
-    Nothing -> do
+    Nothing ->
-      redirect $ SelectCashR
+      redirect SelectCashR
 
 handleSelectParam :: Handler (Maybe (Either UserId BeverageId))
 handleSelectParam = do
@@ -60,15 +60,15 @@ handleSelectParam = do
     Just code -> do
       be <- runDB $ getBy $ UniqueBarcode code
       case be of
-        Just (Entity _ bar) -> do
+        Just (Entity _ bar) ->
-          case barcodeIsUser bar of
+          if barcodeIsUser bar
-            True -> do
+            then
               case (barcodeUser bar, barcodeBev bar) of
                 (Just uId, Nothing) ->
                   return $ Just $ Left uId
                 _ ->
                   error "Malformed barcode"
-            False -> do
+            else
               case (barcodeBev bar, barcodeUser bar) of
                 (Just bId, Nothing) ->
                   return $ Just $ Right bId

Handler/Buy.hs

@@ -28,11 +28,11 @@ getBuyR uId bId = do
     Just (user, bev) -> do
       master <- getYesod
       (buyWidget, enctype) <- generateFormPost buyForm
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "buy")
     Nothing -> do
       setMessageI MsgUserOrArticleUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 postBuyR :: UserId -> BeverageId -> Handler Html
 postBuyR uId bId = do
@@ -42,10 +42,13 @@ postBuyR uId bId = do
       ((res, _), _) <- runFormPost buyForm
       case res of
         FormSuccess quant -> do
-          case quant > beverageAmount bev of
+          if quant > beverageAmount bev
-            False -> do
+            then do
-              price <- return $ quant * (beveragePrice bev)
+              setMessageI MsgNotEnoughItems
-              sw <- return $ price > (userBalance user)
+              redirect $ BuyR uId bId
+            else do
+              let price = quant * (beveragePrice bev)
+              let sw = price > (userBalance user)
               runDB $ update uId [UserBalance -=. price]
               runDB $ update bId [BeverageAmount -=. quant]
               checkAlert bId
@@ -54,19 +57,16 @@ postBuyR uId bId = do
               case sw of
                 False -> do
                   setMessageI MsgPurchaseSuccess
-                  redirect $ HomeR
+                  redirect HomeR
                 True -> do
                   setMessageI MsgPurchaseDebtful
-                  redirect $ HomeR
+                  redirect HomeR
-            True -> do
-              setMessageI MsgNotEnoughItems
-              redirect $ BuyR uId bId
         _ -> do
           setMessageI MsgErrorOccured
-          redirect $ HomeR
+          redirect HomeR
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 notifyUser :: User -> Beverage -> Int -> App -> IO ()
 notifyUser user bev price master = do
@@ -92,11 +92,11 @@ getBuyCashR bId = do
     Just bev -> do
       master <- getYesod
       (buyCashWidget, enctype) <- generateFormPost buyForm
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "buyCash")
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 postBuyCashR :: BeverageId -> Handler Html
 postBuyCashR bId = do
@@ -106,25 +106,25 @@ postBuyCashR bId = do
       ((res, _), _) <- runFormPost buyForm
       case res of
         FormSuccess quant -> do
-          case quant > beverageAmount bev of
+          if quant > beverageAmount bev
-            False -> do
+            then do
+              setMessageI MsgNotEnoughItems
+              redirect $ BuyCashR bId
+            else do
               master <- getYesod
-              price <- return $ quant * (beveragePrice bev + (appCashCharge $ appSettings master))
+              let price = quant * (beveragePrice bev + appCashCharge (appSettings master))
               runDB $ update bId [BeverageAmount -=. quant]
               updateCashier price "Barzahlung"
               checkAlert bId
               let currency = appCurrency $ appSettings master
               setMessageI $ MsgPurchaseSuccessCash price currency
               redirect HomeR
-            True -> do
-              setMessageI MsgNotEnoughItems
-              redirect $ BuyCashR bId
         _ -> do
           setMessageI MsgItemDisappeared
-          redirect $ HomeR
+          redirect HomeR
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 checkData :: UserId -> BeverageId -> Handler (Maybe (User, Beverage))
 checkData uId bId = do

Handler/CashCheck.hs

@@ -21,7 +21,7 @@ import Handler.Common
 getCashCheckR :: Handler Html
 getCashCheckR = do
   (cashCheckWidget, enctype) <- generateFormPost createCashCheckForm
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "cashCheck")
 
 postCashCheckR :: Handler Html
@@ -33,10 +33,10 @@ postCashCheckR = do
       runDB $ insert_ c
       runDB $ insert_ $ Cashier (cashCheckBalance c) currentTime
       setMessageI MsgCashChecked
-      redirect $ HomeR
+      redirect HomeR
     _ -> do
       setMessageI MsgCashCheckError
-      redirect $ CashCheckR
+      redirect CashCheckR
 
 createCashCheckForm :: Form CashCheck
 createCashCheckForm = renderDivs $ CashCheck

Handler/Common.hs

@@ -33,22 +33,22 @@ import Import
 
 getFaviconR :: Handler TypedContent
 getFaviconR = return $ TypedContent "image/x-icon"
-                     $ toContent $(embedFile "config/favicon.ico")
+  $ toContent $(embedFile "config/favicon.ico")
 
 getRobotsR :: Handler TypedContent
 getRobotsR = return $ TypedContent typePlain
-                    $ toContent $(embedFile "config/robots.txt")
+  $ toContent $(embedFile "config/robots.txt")
 
 removeItem :: Eq a => a -> [a] -> [a]
 removeItem _ [] = []
 removeItem x (y:ys)
-  | x == y = removeItem x ys
+  | x == y    = removeItem x ys
   | otherwise = y : (removeItem x ys)
 
 updateCashier :: Int -> Text -> Handler ()
 updateCashier amount desc = do
   mCashier <- runDB $ selectFirst [] [Desc CashierId]
-  trans <- liftIO $ (\time -> return $ Transaction desc amount time) =<< getCurrentTime
+  trans <- liftIO $ (return . Transaction desc amount) =<< getCurrentTime
   case mCashier of
     Just entCash -> do
       runDB $ update (entityKey entCash) [CashierBalance +=. amount]
@@ -62,9 +62,9 @@ getCashierBalance :: Handler Int
 getCashierBalance = do
   mCashier <- runDB $ selectFirst [] [Desc CashierId]
   case mCashier of
-    Just cashier -> do
+    Just cashier ->
       return $ cashierBalance $ entityVal cashier
-    Nothing -> do
+    Nothing ->
       return 0
 
 currencyField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a
@@ -108,10 +108,10 @@ barcodeField = Field
 handleBarcodes :: Either UserId BeverageId -> [Text] -> Handler ()
 handleBarcodes (Left uId) nbs = do
   raws <- runDB $ selectList [BarcodeUser ==. Just uId] []
-  obs <- return $ map (barcodeCode . entityVal) raws
+  let obs = map (barcodeCode . entityVal) raws
-  toDel <- return $ obs L.\\ nbs
+  let toDel = obs L.\\ nbs
-  toAdd <- return $ nbs L.\\ obs
+  let toAdd = nbs L.\\ obs
-  _ <- mapM (\b -> runDB $ insert_ $ Barcode
+  mapM_ (\b -> runDB $ insert_ $ Barcode
     b
     True
     (Just uId)
@@ -121,10 +121,10 @@ handleBarcodes (Left uId) nbs = do
   mapM_ (runDB . delete . entityKey . fromJust) ents
 handleBarcodes (Right bId) nbs = do
   raws <- runDB $ selectList [BarcodeBev ==. Just bId] []
-  obs <- return $ map (barcodeCode . entityVal) raws
+  let obs = map (barcodeCode . entityVal) raws
-  toDel <- return $ obs L.\\ nbs
+  let toDel = obs L.\\ nbs
-  toAdd <- return $ nbs L.\\ obs
+  let toAdd = nbs L.\\ obs
-  _ <- mapM (\b -> runDB $ insert $ Barcode
+  mapM_ (\b -> runDB $ insert_ $ Barcode
     b
     False
     Nothing
@@ -138,11 +138,11 @@ handleGetParam Nothing _ =
   return ()
 handleGetParam (Just b) eub = do
   f <- return $ T.filter C.isAlphaNum b
-  case (T.length f) > 0 && b /= ", " of
+  if T.length f > 0 && b /= ", "
-    True -> do
+    then do
       e <- runDB $ getBy $ UniqueBarcode f
-      case e of
+      if isNothing e
-        Nothing -> do
+        then do
           _ <- case eub of
             Left uId -> do
               -- should usernames containing, among other, spaces cause problems, replace b for f here
@@ -151,9 +151,9 @@ handleGetParam (Just b) eub = do
               -- and here
               runDB $ insert_ $ Barcode b False Nothing (Just bId)
           setMessageI MsgBarcodeAdded
-        Just _ ->
+        else
           setMessageI MsgBarcodeDuplicate
-    False -> do
+    else
       setMessageI MsgProvideBarcode
 
 amountField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a
@@ -174,10 +174,10 @@ amountField = Field
 checkAlert :: BeverageId -> Handler ()
 checkAlert bId = do
   bev <- runDB $ getJust bId
-  case beverageAmount bev < beverageAlertAmount bev of
+  if beverageAmount bev < beverageAlertAmount bev
-    True -> do
+    then do
       master <- getYesod
-      to <- return $ appEmail $ appSettings master 
+      let to = appEmail $ appSettings master 
       liftIO $ sendMail to "Niedriger Bestand"
         [stext|
 Hallo,
@@ -189,7 +189,8 @@ Viele Grüße,
 
 der Matemat
         |]
-    False -> return () -- do nothing
+    else
+      return () -- do nothing
 
 --sendMail :: MonadIO m => Text -> Text -> Text -> m ()
 sendMail to subject body =
@@ -211,4 +212,4 @@ sendMail to subject body =
       }
 
 formatIntVolume :: Int -> Text
-formatIntVolume x = formatFloat $ ((fromIntegral x) / 1000)
+formatIntVolume x = formatFloat (fromIntegral x / 1000)

Handler/Home.hs

@@ -30,21 +30,17 @@ getHomeR :: Handler Html
 getHomeR = do
   beverages <- runDB $ selectList [BeverageAmount !=. 0] [Desc BeverageIdent]
   time <- liftIO getCurrentTime
-  secs <- return $ (R.read $ formatTime defaultTimeLocale "%s" time) - 2592000
+  let secs = R.read (formatTime defaultTimeLocale "%s" time) - 2592000
   users <- runDB $ selectList [UserTimestamp >=. secs] [Asc UserIdent]
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "home")
 
-postHomeR :: Handler Html
-postHomeR = do
-  error "Not yet implemented"
-
 getReactivateR :: Handler Html
 getReactivateR = do
   time <- liftIO getCurrentTime
-  secs <- return $ (R.read $ formatTime defaultTimeLocale "%s" time) - 2592000
+  let secs = R.read (formatTime defaultTimeLocale "%s" time) - 2592000
   users <- runDB $ selectList [UserTimestamp <. secs] [Asc UserIdent]
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "reactivate")
 
 getUserReactivateR :: UserId -> Handler Html
@@ -53,10 +49,10 @@ getUserReactivateR uId = do
   case mUser of
     Just user -> do
       time <- liftIO getCurrentTime
-      secs <- return $ R.read $ formatTime defaultTimeLocale "%s" time
+      let secs = R.read $ formatTime defaultTimeLocale "%s" time
       runDB $ update uId [UserTimestamp =. secs]
       setMessageI MsgUserReactivated
-      redirect $ HomeR
+      redirect HomeR
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR

Handler/Journal.hs

@@ -24,15 +24,15 @@ getJournalR = do
   master <- getYesod
   rawEntries <- runDB $ selectList [] [Desc TransactionId]
   next <- runDB $ selectList [] [Desc TransactionId, OffsetBy 30]
-  entries <- return $ L.reverse $ L.take 30 rawEntries
+  let entries = L.reverse $ L.take 30 rawEntries
-  total <- return $ L.sum $ I.map (transactionAmount . entityVal) rawEntries
+  let total = L.sum $ I.map (transactionAmount . entityVal) rawEntries
-  timeLimit <- case L.null entries of
+  timeLimit <- if L.null entries
-    False -> return $ transactionTime $ entityVal $ L.head $ entries
+    then liftIO getCurrentTime
-    True -> liftIO getCurrentTime
+    else return $ transactionTime $ entityVal $ L.head entries
   cashChecks <- runDB $ selectList [CashCheckTime >=. timeLimit] [Asc CashCheckId]
-  list <- return $ merge entries cashChecks
+  let list = merge entries cashChecks
   cashBalance <- getCashierBalance
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "journal")
 
 merge :: [Entity Transaction] -> [Entity CashCheck] -> [Either Transaction CashCheck]
@@ -48,14 +48,14 @@ getJournalPageR p = do
   master <- getYesod
   rawEntries <- runDB $ selectList [] [Desc TransactionId, OffsetBy (p * 30)]
   next <- runDB $ selectList [] [Desc TransactionId, OffsetBy ((p + 1) * 30)]
-  entries <- return $ L.reverse $ L.take 30 rawEntries
+  let entries = L.reverse $ L.take 30 rawEntries
-  lTimeLimit <- case L.null entries of
+  lTimeLimit <- if L.null entries
-    False -> return $ transactionTime $ entityVal $ L.head $ entries
+    then liftIO getCurrentTime
-    True -> liftIO getCurrentTime
+    else return $ transactionTime $ entityVal $ L.head entries
-  uTimeLimit <- case L.null entries of
+  uTimeLimit <- if L.null entries
-    False -> return $ transactionTime $ entityVal $ L.last $ entries
+    then liftIO getCurrentTime
-    True -> liftIO getCurrentTime
+    else return $ transactionTime $ entityVal $ L.last entries
   cashChecks <- runDB $ selectList [CashCheckTime >=. lTimeLimit, CashCheckTime <. uTimeLimit] [Asc CashCheckId]
-  list <- return $ merge entries cashChecks
+  let list = merge entries cashChecks
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "journalPage")

Handler/Modify.hs

@@ -26,13 +26,13 @@ getModifyR bId = do
       p <- lookupGetParam "barcode"
       _ <- handleGetParam p (Right bId)
       rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
-      bs <- return $ map (barcodeCode . entityVal) rawbs
+      let bs = map (barcodeCode . entityVal) rawbs
       (modifyWidget, enctype) <- generateFormPost $ modifyForm bev bs
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "modify")
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ SummaryR
+      redirect SummaryR
 
 postModifyR :: BeverageId -> Handler Html
 postModifyR bId = do
@@ -40,7 +40,7 @@ postModifyR bId = do
   case mBev of
     Just bev -> do
       rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
-      bs <- return $ map (barcodeCode . entityVal) rawbs
+      let bs = map (barcodeCode . entityVal) rawbs
       ((res, _), _) <- runFormPost $ modifyForm bev bs
       case res of
         FormSuccess nBev -> do
@@ -49,19 +49,19 @@ postModifyR bId = do
             , BeveragePrice =. modBevPrice nBev
             , BeverageAmount =. modBevAmount nBev
             , BeverageAlertAmount =. modBevAlertAmount nBev
-            , BeverageCorrectedAmount +=. ((modBevAmount nBev) - (beverageAmount bev))
+            , BeverageCorrectedAmount +=. (modBevAmount nBev - beverageAmount bev)
             , BeverageMl =. modBevMl nBev
             , BeverageAvatar =. modBevAvatar nBev
             ]
           handleBarcodes (Right bId) (fromMaybe [] $ modBevBarcodes nBev)
           setMessageI MsgEditSuccess
-          redirect $ SummaryR
+          redirect SummaryR
         _ -> do
           setMessageI MsgEditFail
-          redirect $ SummaryR
+          redirect SummaryR
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ SummaryR
+      redirect SummaryR
 
 data ModBev = ModBev
   { modBevIdent :: Text
@@ -85,7 +85,7 @@ modifyForm bev bs = renderDivs $ ModBev
   where
     avatars = do
       ents <- runDB $ selectList [] [Asc AvatarIdent]
-      optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents
+      optionsPairs $ map (\ent -> (avatarIdent $ entityVal ent, entityKey ent)) ents
 
 getDeleteBeverageR :: BeverageId -> Handler Html
 getDeleteBeverageR bId = do
@@ -94,7 +94,7 @@ getDeleteBeverageR bId = do
     Just bev -> do
       runDB $ delete bId
       setMessageI MsgItemDeleted
-      redirect $ HomeR
+      redirect HomeR
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ HomeR
+      redirect HomeR

Handler/NewUser.hs

@@ -23,24 +23,24 @@ import Text.Shakespeare.Text
 getNewUserR :: Handler Html
 getNewUserR = do
   time <- liftIO getCurrentTime
-  secs <- return $ read $ formatTime defaultTimeLocale "%s" time
+  let secs = read $ formatTime defaultTimeLocale "%s" time
   (newUserWidget, enctype) <- generateFormPost $ newUserForm secs
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "newUser")
 
 postNewUserR :: Handler Html
 postNewUserR = do
   time <- liftIO getCurrentTime
-  secs <- return $ read $ formatTime defaultTimeLocale "%s" time
+  let secs = read $ formatTime defaultTimeLocale "%s" time
   ((res, _), _) <- runFormPost $ newUserForm secs
   case res of
     FormSuccess user -> do
-      _ <- runDB $ insert user
+      runDB $ insert_ user
       setMessageI MsgUserCreated
-      redirect $ HomeR
+      redirect HomeR
     _ -> do
       setMessageI MsgUserNotCreated
-      redirect $ NewUserR
+      redirect NewUserR
 
 newUserForm :: Int -> Form User
 newUserForm secs = renderDivs $ User
@@ -68,13 +68,13 @@ getModifyUserR uId = do
       p <- lookupGetParam "barcode"
       _ <- handleGetParam p (Left uId)
       rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
-      bs <- return $ map (barcodeCode . entityVal) rawbs
+      let bs = map (barcodeCode . entityVal) rawbs
       (modifyUserWidget, enctype) <- generateFormPost $ modifyUserForm user bs
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "modifyUser")
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 postModifyUserR :: UserId -> Handler Html
 postModifyUserR uId = do
@@ -82,7 +82,7 @@ postModifyUserR uId = do
   case mUser of
     Just user -> do
       rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
-      bs <- return $ map (barcodeCode . entityVal) rawbs
+      let bs = map (barcodeCode . entityVal) rawbs
       ((res, _), _) <- runFormPost $ modifyUserForm user bs
       case res of
         FormSuccess uc -> do
@@ -99,7 +99,7 @@ postModifyUserR uId = do
           redirect $ SelectR uId
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 modifyUserForm :: User -> [Text] -> Form UserConf
 modifyUserForm user bs = renderDivs $ UserConf

Handler/Payout.hs

@@ -27,7 +27,7 @@ data Payment = Payment
 getPayoutR :: Handler Html
 getPayoutR = do
   (payoutWidget, enctype) <- generateFormPost payoutForm
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "payout")
 
 postPayoutR :: Handler Html
@@ -38,10 +38,10 @@ postPayoutR = do
       msg <- renderMessage' $ MsgPayout $ paymentDesc payment
       updateCashier (- (paymentAmount payment)) msg
       setMessageI MsgPaidOut
-      redirect $ HomeR
+      redirect HomeR
     _ -> do
       setMessageI MsgNotPaidOut
-      redirect $ JournalR
+      redirect JournalR
 
 payoutForm :: Form Payment
 payoutForm = renderDivs $ Payment

Handler/Restock.hs

@@ -21,7 +21,7 @@ import Handler.Common
 getRestockR :: Handler Html
 getRestockR = do
   beverages <- runDB $ selectList [] [Asc BeverageIdent]
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "restock")
 
 getUpstockR :: BeverageId -> Handler Html
@@ -30,26 +30,26 @@ getUpstockR bId = do
   case mBev of
     Just bev -> do
       (upstockWidget, enctype) <- generateFormPost upstockForm
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "upstock")
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 postUpstockR :: BeverageId -> Handler Html
 postUpstockR bId = do
   mBev <- runDB $ get bId
   case mBev of
-    Just bev -> do
+    Just _ -> do
       ((res, _), _) <- runFormPost upstockForm
       case res of
-        FormSuccess c -> do
+        FormSuccess c ->
-          case c > 0 of
+          if c > 0
-            True -> do
+            then do
               runDB $ update bId [BeverageAmount +=. c]
               setMessageI MsgStockedUp
-              redirect $ HomeR
+              redirect HomeR
-            False -> do
+            else do
               setMessageI MsgNotStockedUp
               redirect $ UpstockR bId
         _ -> do
@@ -57,7 +57,7 @@ postUpstockR bId = do
           redirect $ UpstockR bId
     Nothing -> do
       setMessageI MsgItemUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 upstockForm :: Form Int
 upstockForm = renderDivs
@@ -66,7 +66,7 @@ upstockForm = renderDivs
 getNewArticleR :: Handler Html
 getNewArticleR = do
   (newArticleWidget, enctype) <- generateFormPost newArticleForm
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "newArticle")
 
 postNewArticleR :: Handler Html
@@ -76,10 +76,10 @@ postNewArticleR = do
     FormSuccess bev -> do
       runDB $ insert_ bev
       setMessageI MsgItemAdded
-      redirect $ HomeR
+      redirect HomeR
     _ -> do
       setMessageI MsgItemNotAdded
-      redirect $ HomeR
+      redirect HomeR
 
 newArticleForm :: Form Beverage
 newArticleForm = renderDivs $ Beverage
@@ -93,4 +93,4 @@ newArticleForm = renderDivs $ Beverage
   where
     avatars = do
       ents <- runDB $ selectList [] [Asc AvatarIdent]
-      optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents
+      optionsPairs $ map (\ent -> (avatarIdent $ entityVal ent, entityKey ent)) ents

Handler/Select.hs

@@ -28,16 +28,16 @@ getSelectR uId = do
     Just user -> do
       master <- getYesod
       beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent]
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "select")
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 getSelectCashR :: Handler Html
 getSelectCashR = do
   beverages <- runDB $ selectList [BeverageAmount >. 0] [Asc BeverageIdent]
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "selectCash")
 
 getRechargeR :: UserId -> Handler Html
@@ -47,11 +47,11 @@ getRechargeR uId = do
     Just user -> do
       (rechargeWidget, enctype) <- generateFormPost rechargeForm
       currency <- appCurrency <$> appSettings <$> getYesod
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "recharge")
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 postRechargeR :: UserId -> Handler Html
 postRechargeR uId = do
@@ -60,24 +60,24 @@ postRechargeR uId = do
     Just user -> do
       ((res, _), _) <- runFormPost rechargeForm
       case res of
-        FormSuccess amount -> do
+        FormSuccess amount ->
-          case amount < 0 of
+          if amount < 0
-            False -> do
+            then do
-              updateCashier amount ("Guthaben: " `T.append` (userIdent user))
-              time <- liftIO getCurrentTime
-              secs <- return $ R.read $ formatTime defaultTimeLocale "%s" time
-              runDB $ update uId [UserBalance +=. amount, UserTimestamp =. secs]
-              setMessageI MsgRecharged
-              redirect $ HomeR
-            True -> do
               setMessageI MsgNegativeRecharge
               redirect $ RechargeR uId
+            else do
+              updateCashier amount ("Guthaben: " `T.append` userIdent user)
+              time <- liftIO getCurrentTime
+              let secs = R.read $ formatTime defaultTimeLocale "%s" time
+              runDB $ update uId [UserBalance +=. amount, UserTimestamp =. secs]
+              setMessageI MsgRecharged
+              redirect HomeR
         _ -> do
           setMessageI MsgRechargeError
-          redirect $ HomeR
+          redirect HomeR
     Nothing -> do
       setMessageI MsgUserUnknown
-      redirect $ HomeR
+      redirect HomeR
 
 rechargeForm :: Form Int
 rechargeForm = renderDivs

Handler/Summary.hs

@@ -25,7 +25,7 @@ getSummaryR :: Handler Html
 getSummaryR = do
   master <- getYesod
   bevs <- runDB $ selectList [] [Asc BeverageIdent]
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "summary")
 
 getSummaryJsonR :: Handler RepJson
@@ -37,8 +37,8 @@ getSummaryJsonR = do
     map (\(Entity _ bev) ->
           object [ "name" .= beverageIdent bev
                  , "value" .= beverageAmount bev
-                 , "volume" .= ((fromIntegral (beverageMl bev)) / 1000 :: Double)
+                 , "volume" .= (fromIntegral (beverageMl bev) / 1000 :: Double)
-                 , "price" .= ((fromIntegral (beveragePrice bev)) / 100 :: Double)
+                 , "price" .= (fromIntegral (beveragePrice bev) / 100 :: Double)
                  , "currency" .= appCurrency (appSettings master)
                  ]
         ) bevs
@@ -87,27 +87,27 @@ getInventoryJsonR = do
 getUploadInventoryJsonR :: Handler Html
 getUploadInventoryJsonR = do
   (uploadJsonWidget, enctype) <- generateFormPost uploadJsonForm
-  defaultLayout $ do
+  defaultLayout $
     $(widgetFile "uploadJson")
 
 postUploadInventoryJsonR :: Handler Html
 postUploadInventoryJsonR = do
   ((res, _), _) <- runFormPost uploadJsonForm
   case res of
-    FormSuccess file -> do
+    FormSuccess file ->
-      case fileContentType file == "application/json" of
+      if fileContentType file == "application/json"
-        True -> do
+        then do
           source <- runResourceT $ fileSource file $$ sinkLbs
-          bevs <- return $ fromMaybe [] $ (decode source :: Maybe [BevStore])
+          let bevs = fromMaybe [] (decode source :: Maybe [BevStore])
           I.mapM_ insOrUpd bevs
           setMessageI MsgRestoreSuccess
-          redirect $ HomeR
+          redirect HomeR
-        False -> do
+        else do
           setMessageI MsgNotJson
-          redirect $ UploadInventoryJsonR
+          redirect UploadInventoryJsonR
     _ -> do
       setMessageI MsgErrorOccured
-      redirect $ UploadInventoryJsonR
+      redirect UploadInventoryJsonR
 
 uploadJsonForm :: Form FileInfo
 uploadJsonForm = renderDivs
@@ -117,14 +117,14 @@ insOrUpd :: BevStore -> Handler ()
 insOrUpd bev = do
   meb <- runDB $ getBy $ UniqueBeverage $ bevStoreIdent bev
   case meb of
-    Just eb -> do
+    Just eb ->
       runDB $ update (entityKey eb)
         [ BeveragePrice =. bevStorePrice bev
         , BeverageAmount =. bevStoreAmount bev
         , BeverageAlertAmount =. bevStoreAlertAmount bev
         , BeverageMl =. bevStoreMl bev
         ]
-    Nothing -> do
+    Nothing ->
       runDB $ insert_ $ Beverage
         (bevStoreIdent bev)
         (bevStorePrice bev)

Handler/Transfer.hs

@@ -24,9 +24,9 @@ getTransferSelectR :: UserId -> Handler Html
 getTransferSelectR from = do
   mUser <- runDB $ get from
   case mUser of
-    Just user -> do
+    Just _ -> do
       users <- runDB $ selectList [UserId !=. from] [Asc UserIdent]
-      defaultLayout $ do
+      defaultLayout $
         $(widgetFile "transferSelect")
     Nothing -> do
       setMessageI MsgUserUnknown
@@ -62,17 +62,17 @@ postTransferR from to = do
           ((res, _), _) <- runFormPost transferForm
           case res of
             FormSuccess amount -> do
-              case amount < 0 of
+              if amount < 0
-                False -> do
+                then do
+                  setMessageI MsgNegativeTransfer
+                  redirect $ TransferR from to
+                else do
                   runDB $ update from [UserBalance -=. amount]
                   runDB $ update to [UserBalance +=. amount]
                   master <- getYesod
                   liftIO $ notify sender recpt amount master
                   setMessageI MsgTransferComplete
                   redirect HomeR
-                True -> do
-                  setMessageI MsgNegativeTransfer
-                  redirect $ TransferR from to
             _ -> do
               setMessageI MsgTransferError
               redirect HomeR

config/routes

@@ -3,7 +3,7 @@
 /favicon.ico FaviconR GET
 /robots.txt RobotsR GET
 
-/ 				HomeR 			GET POST
+/ 				HomeR 			GET
 /reactivate			ReactivateR		GET
 /user/#UserId/reactivate	UserReactivateR		GET
 /user/#UserId		 	SelectR			GET