Merge pull request #6 from Shimuuar/master

Minor refactoring

Yesod/Dispatch.hs

@@ -22,7 +22,8 @@ module Yesod.Dispatch
     , toWaiAppPlain
     ) where
 
-import Data.Either (partitionEithers)
+import Data.Functor   ((<$>))
+import Data.Either    (partitionEithers)
 import Prelude hiding (exp)
 import Yesod.Internal.Core
 import Yesod.Handler
@@ -163,19 +164,13 @@ thResourceFromResource (Resource n _ _) =
 -- middlewares: GZIP compression, JSON-P and path cleaning. This is the
 -- recommended approach for most users.
 toWaiApp :: (Yesod y, YesodDispatch y y) => y -> IO W.Application
-toWaiApp y = do
-    a <- toWaiAppPlain y
-    return $ gzip False
-           $ jsonp
-           $ autohead
-             a
+toWaiApp y = gzip False . jsonp . autohead <$> toWaiAppPlain y
 
 -- | Convert the given argument into a WAI application, executable with any WAI
 -- handler. This differs from 'toWaiApp' in that it uses no middlewares.
 toWaiAppPlain :: (Yesod y, YesodDispatch y y) => y -> IO W.Application
-toWaiAppPlain a = do
-    key' <- encryptKey a
-    return $ toWaiApp' a key'
+toWaiAppPlain a = toWaiApp' a <$> encryptKey a
+
 
 toWaiApp' :: (Yesod y, YesodDispatch y y)
           => y

Yesod/Handler.hs

@@ -148,13 +148,12 @@ import Control.Monad.Trans.Control (MonadTransControl, liftControl)
 import qualified Data.Map as Map
 import qualified Data.ByteString as S
 import Data.ByteString (ByteString)
-import Data.Enumerator (Iteratee (..))
+import Data.Enumerator (Iteratee (..), run_, ($$))
 import Network.Wai.Parse (parseHttpAccept)
 
 import Yesod.Content
 import Data.Maybe (fromMaybe)
 import Web.Cookie (SetCookie (..), renderSetCookie)
-import Data.Enumerator (run_, ($$))
 import Control.Arrow (second, (***))
 import qualified Network.Wai.Parse as NWP
 import Data.Monoid (mappend, mempty, Endo (..))
@@ -171,11 +170,11 @@ class YesodSubRoute s y where
     fromSubRoute :: s -> y -> Route s -> Route y
 
 data HandlerData sub master = HandlerData
-    { handlerRequest :: Request
-    , handlerSub :: sub
-    , handlerMaster :: master
-    , handlerRoute :: Maybe (Route sub)
-    , handlerRender :: (Route master -> [(Text, Text)] -> Text)
+    { handlerRequest  :: Request
+    , handlerSub      :: sub
+    , handlerMaster   :: master
+    , handlerRoute    :: Maybe (Route sub)
+    , handlerRender   :: Route master -> [(Text, Text)] -> Text
     , handlerToMaster :: Route sub -> Route master
     }
 
@@ -222,9 +221,7 @@ class SubsiteGetter g m s | g -> s where
 
 instance (master ~ master'
          ) => SubsiteGetter (master -> sub) (GHandler anySub master') sub where
-  runSubsiteGetter getter = do
-    y <- getYesod
-    return $ getter y
+  runSubsiteGetter getter = getter <$> getYesod
 
 instance (anySub ~ anySub'
          ,master ~ master'

Yesod/Internal/Core.hs

@@ -33,6 +33,7 @@ import Yesod.Content
 import Yesod.Handler
 
 import Control.Arrow ((***))
+import Control.Monad (forM)
 import qualified Paths_yesod_core
 import Data.Version (showVersion)
 import Yesod.Widget
@@ -175,7 +176,7 @@ class RenderRoute (Route a) => Yesod a where
     isWriteRequest :: Route a -> GHandler s a Bool
     isWriteRequest _ = do
         wai <- waiRequest
-        return $ not $ W.requestMethod wai `elem`
+        return $ W.requestMethod wai `notElem`
             ["GET", "HEAD", "OPTIONS", "TRACE"]
 
     -- | The default route for authentication.
@@ -494,7 +495,7 @@ widgetToPageContent (GWidget w) = do
                 Nothing -> Nothing
                 Just (Left s) -> Just s
                 Just (Right (u, p)) -> Just $ render u p
-    css <- flip mapM (Map.toList style) $ \(mmedia, content) -> do
+    css <- forM (Map.toList style) $ \(mmedia, content) -> do
         let rendered = renderCassius render content
         x <- addStaticContent "css" "text/css; charset=utf-8"
            $ encodeUtf8 rendered

Yesod/Internal/Dispatch.hs

@@ -172,7 +172,7 @@ mkSimpleExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, met
             return $ Match
                 (VarP x)
                 (GuardedB
-                    [ ( NormalG $ InfixE (Just $ VarE x) eq (Just $ (LitE $ StringL m)) -- FIXME need to pack, right?
+                    [ ( NormalG $ InfixE (Just $ VarE x) eq (Just $ LitE $ StringL m) -- FIXME need to pack, right?
                       , runHandlerVars $ map toLower m ++ constr
                       )
                     ])

Yesod/Internal/Request.hs

@@ -37,7 +37,7 @@ parseWaiRequest :: W.Request
                 -> IO Request
 parseWaiRequest env session' key' = do
     let gets' = queryToQueryText $ W.queryString env
-    let reqCookie = maybe mempty id $ lookup "Cookie"
+    let reqCookie = fromMaybe mempty $ lookup "Cookie"
                   $ W.requestHeaders env
         cookies' = parseCookiesText reqCookie
         acceptLang = lookup "Accept-Language" $ W.requestHeaders env

Yesod/Widget.hs

@@ -59,7 +59,7 @@ import Text.Julius
 import Text.Coffee
 import Yesod.Handler
     (Route, GHandler, GGHandler, YesodSubRoute(..), toMasterHandlerMaybe, getYesod
-    , getMessageRender
+    , getMessageRender, getUrlRenderParams
     )
 import Yesod.Message (RenderMessage)
 import Yesod.Content (RepHtml (..), toContent)
@@ -72,7 +72,6 @@ import Data.Text (Text)
 import qualified Data.Map as Map
 import Language.Haskell.TH.Quote (QuasiQuoter)
 import Language.Haskell.TH.Syntax (Q, Exp (InfixE, VarE, LamE), Pat (VarP), newName)
-import Yesod.Handler (getUrlRenderParams)
 
 import Control.Monad.IO.Control (MonadControlIO)
 import qualified Text.Hamlet.NonPoly as NP