yesod 0.5.3 → 0.5.4

raw patch · 7 files changed

+57/−9 lines, 7 files

Files

Yesod.hs +2/−1
Yesod/Dispatch.hs +3/−1
Yesod/Handler.hs +43/−2
Yesod/Json.hs +1/−1
Yesod/Yesod.hs +5/−3
runtests.hs +2/−0
yesod.cabal +1/−1

Yesod.hs view

@@ -22,17 +22,18 @@ import Yesod.Json hiding (testSuite) import Yesod.Dispatch hiding (testSuite) import Yesod.Yesod hiding (testSuite)+import Yesod.Handler hiding (runHandler, testSuite) #else import Yesod.Content import Yesod.Json import Yesod.Dispatch import Yesod.Yesod+import Yesod.Handler hiding (runHandler) #endif  import Yesod.Request import Yesod.Form import Yesod.Widget-import Yesod.Handler hiding (runHandler) import Network.Wai (Application) import Yesod.Hamlet import "transformers" Control.Monad.Trans.Class (lift)

Yesod/Dispatch.hs view

@@ -2,6 +2,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Dispatch     ( -- * Quasi-quoted routing       parseRoutes@@ -25,11 +26,12 @@  #if TEST import Yesod.Yesod hiding (testSuite)+import Yesod.Handler hiding (testSuite) #else import Yesod.Yesod+import Yesod.Handler #endif -import Yesod.Handler import Yesod.Request import Yesod.Internal

Yesod/Handler.hs view

@@ -7,6 +7,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-} --------------------------------------------------------- -- -- Module        : Yesod.Handler@@ -72,17 +73,20 @@     , YesodApp (..)     , toMasterHandler     , localNoCurrent+    , finallyHandler+#if TEST+    , testSuite+#endif     ) where  import Prelude hiding (catch) import Yesod.Request-import Yesod.Content import Yesod.Internal import Data.List (foldl') import Data.Neither import Data.Time (UTCTime) -import Control.Exception hiding (Handler, catch)+import Control.Exception hiding (Handler, catch, finally) import qualified Control.Exception as E import Control.Applicative @@ -91,6 +95,7 @@ import Control.Monad.Trans.Writer import Control.Monad.Trans.Reader import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO)+import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as C  import System.IO import qualified Network.Wai as W@@ -100,6 +105,16 @@  import Text.Hamlet +#if TEST+import Test.Framework (testGroup, Test)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit hiding (Test)+import Yesod.Content hiding (testSuite)+import Data.IORef+#else+import Yesod.Content+#endif+ -- | The type-safe URLs associated with a site argument. type family Route a @@ -455,3 +470,29 @@ localNoCurrent :: GHandler s m a -> GHandler s m a localNoCurrent =     GHandler . local (\hd -> hd { handlerRoute = Nothing }) . unGHandler++#if TEST++testSuite :: Test+testSuite = testGroup "Yesod.Handler"+    [ testCase "finally" caseFinally+    ]++caseFinally :: Assertion+caseFinally = do+    i <- newIORef (1 :: Int)+    let h = finallyHandler (do+                liftIO $ writeIORef i 2+                () <- redirectString RedirectTemporary ""+                return ()) $ liftIO $ writeIORef i 3+    let y = runHandler h undefined undefined undefined undefined undefined+    _ <- unYesodApp y undefined undefined undefined+    j <- readIORef i+    j @?= 3++#endif++-- | A version of 'finally' which works correctly with short-circuiting.+finallyHandler :: GHandler s m a -> GHandler s m b -> GHandler s m a+finallyHandler (GHandler (ReaderT thing)) (GHandler (ReaderT after)) =+    GHandler $ ReaderT $ \hd -> mapMEitherT (`C.finally` runMEitherT (after hd)) (thing hd)

Yesod/Json.hs view

@@ -20,7 +20,7 @@  import qualified Data.ByteString.Char8 as S import Data.Char (isControl)-import Yesod.Handler+import Yesod.Handler (GHandler) import Numeric (showHex) import Data.Monoid (Monoid (..)) import Text.Blaze.Builder.Core

Yesod/Yesod.hs view

@@ -35,15 +35,16 @@ #if TEST import Yesod.Content hiding (testSuite) import Yesod.Json hiding (testSuite)+import Yesod.Handler hiding (testSuite) #else import Yesod.Content import Yesod.Json+import Yesod.Handler #endif  import Yesod.Widget import Yesod.Request import Yesod.Hamlet-import Yesod.Handler import qualified Network.Wai as W import Yesod.Internal import Web.ClientSession (getKey, defaultKeyFile)@@ -261,10 +262,10 @@ defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep defaultErrorHandler NotFound = do     r <- waiRequest-    let path = BSU.toString $ pathInfo r+    let path' = BSU.toString $ pathInfo r     applyLayout' "Not Found" $ [$hamlet| %h1 Not Found-%p $path$+%p $path'$ |]   where     pathInfo = W.pathInfo@@ -398,6 +399,7 @@ type instance Route TmpYesod = TmpRoute instance Yesod TmpYesod where approot _ = "" +propJoinSplitPath :: [String] -> Bool propJoinSplitPath ss =     splitPath TmpYesod (BSU.fromString $ joinPath TmpYesod "" ss' [])         == Right ss'

runtests.hs view

@@ -5,6 +5,7 @@ import qualified Yesod.Dispatch import qualified Yesod.Helpers.Static import qualified Yesod.Yesod+import qualified Yesod.Handler  main :: IO () main = defaultMain@@ -13,4 +14,5 @@     , Yesod.Dispatch.testSuite     , Yesod.Helpers.Static.testSuite     , Yesod.Yesod.testSuite+    , Yesod.Handler.testSuite     ]

yesod.cabal view

@@ -1,5 +1,5 @@ name:            yesod-version:         0.5.3+version:         0.5.4 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>