diff --git a/Yesod/Content.hs b/Yesod/Content.hs index 7a7bd274..aaf57d60 100644 --- a/Yesod/Content.hs +++ b/Yesod/Content.hs @@ -46,7 +46,7 @@ module Yesod.Content , formatW3 , formatRFC1123 #if TEST - , testSuite + , contentTestSuite #endif ) where @@ -245,8 +245,8 @@ ext = reverse . fst . break (== '.') . reverse #if TEST ---- Testing -testSuite :: Test -testSuite = testGroup "Yesod.Resource" +contentTestSuite :: Test +contentTestSuite = testGroup "Yesod.Resource" [ testProperty "ext" propExt , testCase "typeByExt" caseTypeByExt ] diff --git a/Yesod/Core.hs b/Yesod/Core.hs index 2b244462..ee31f54e 100644 --- a/Yesod/Core.hs +++ b/Yesod/Core.hs @@ -25,18 +25,12 @@ module Yesod.Core -- * Misc , yesodVersion #if TEST - , testSuite + , coreTestSuite #endif ) where -#if TEST -import Yesod.Content hiding (testSuite) -import Yesod.Handler hiding (testSuite) -import qualified Data.ByteString.UTF8 as BSU -#else import Yesod.Content import Yesod.Handler -#endif import qualified Paths_yesod_core import Data.Version (showVersion) @@ -63,6 +57,8 @@ import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit hiding (Test) +import qualified Data.Text +import qualified Data.Text.Encoding #endif #if GHC7 @@ -447,8 +443,8 @@ $maybe jscript j return $ PageContent title head'' body #if TEST -testSuite :: Test -testSuite = testGroup "Yesod.Yesod" +coreTestSuite :: Test +coreTestSuite = testGroup "Yesod.Yesod" [ testProperty "join/split path" propJoinSplitPath , testCase "join/split path [\".\"]" caseJoinSplitPathDquote , testCase "utf8 split path" caseUtf8SplitPath @@ -460,34 +456,37 @@ data TmpRoute = TmpRoute deriving Eq type instance Route TmpYesod = TmpRoute instance Yesod TmpYesod where approot _ = "" +fromString :: String -> S8.ByteString +fromString = Data.Text.Encoding.encodeUtf8 . Data.Text.pack + propJoinSplitPath :: [String] -> Bool propJoinSplitPath ss = - splitPath TmpYesod (BSU.fromString $ joinPath TmpYesod "" ss' []) + splitPath TmpYesod (fromString $ joinPath TmpYesod "" ss' []) == Right ss' where ss' = filter (not . null) ss caseJoinSplitPathDquote :: Assertion caseJoinSplitPathDquote = do - splitPath TmpYesod (BSU.fromString "/x%2E/") @?= Right ["x."] - splitPath TmpYesod (BSU.fromString "/y./") @?= Right ["y."] + splitPath TmpYesod (fromString "/x%2E/") @?= Right ["x."] + splitPath TmpYesod (fromString "/y./") @?= Right ["y."] joinPath TmpYesod "" ["z."] [] @?= "/z./" x @?= Right ss where - x = splitPath TmpYesod (BSU.fromString $ joinPath TmpYesod "" ss' []) + x = splitPath TmpYesod (fromString $ joinPath TmpYesod "" ss' []) ss' = filter (not . null) ss ss = ["a."] caseUtf8SplitPath :: Assertion caseUtf8SplitPath = do Right ["שלום"] @=? - splitPath TmpYesod (BSU.fromString "/שלום/") + splitPath TmpYesod (fromString "/שלום/") Right ["page", "Fooé"] @=? - splitPath TmpYesod (BSU.fromString "/page/Fooé/") + splitPath TmpYesod (fromString "/page/Fooé/") Right ["\156"] @=? - splitPath TmpYesod (BSU.fromString "/\156/") + splitPath TmpYesod (fromString "/\156/") Right ["ð"] @=? - splitPath TmpYesod (BSU.fromString "/%C3%B0/") + splitPath TmpYesod (fromString "/%C3%B0/") caseUtf8JoinPath :: Assertion caseUtf8JoinPath = do diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index d782a2d3..35dae927 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -12,27 +12,20 @@ module Yesod.Dispatch , mkYesodData , mkYesodSubData , mkYesodDispatch - , mkYesodSubDispatch + , mkYesodSubDispatch -- ** Path pieces , SinglePiece (..) , MultiPiece (..) , Strings -- * Convert to WAI , toWaiApp - , basicHandler - , basicHandler' #if TEST - , testSuite + , dispatchTestSuite #endif ) where -#if TEST -import Yesod.Core hiding (testSuite) -import Yesod.Handler hiding (testSuite) -#else import Yesod.Core import Yesod.Handler -#endif import Yesod.Request import Yesod.Internal @@ -47,10 +40,6 @@ import Network.Wai.Middleware.CleanPath (cleanPath) import Network.Wai.Middleware.Jsonp import Network.Wai.Middleware.Gzip -import qualified Network.Wai.Handler.SimpleServer as SS -import qualified Network.Wai.Handler.CGI as CGI -import System.Environment (getEnvironment) - import qualified Data.ByteString.Char8 as B import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L @@ -87,13 +76,10 @@ import Test.Framework (testGroup, Test) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck import System.IO.Unsafe -import Yesod.Content hiding (testSuite) -import Data.Serialize.Get -import Data.Serialize.Put -#else -import Yesod.Content #endif +import Yesod.Content + -- | Generates URL datatype and site function for the given 'Resource's. This -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter. -- Use 'parseRoutes' to create the 'Resource's. @@ -359,34 +345,6 @@ httpAccept = map B.unpack . lookup "Accept" . W.requestHeaders --- | Runs an application with CGI if CGI variables are present (namely --- PATH_INFO); otherwise uses SimpleServer. -basicHandler :: (Yesod y, YesodSite y) - => Int -- ^ port number - -> y - -> IO () -basicHandler port y = basicHandler' port (Just "localhost") y - - --- | Same as 'basicHandler', but allows you to specify the hostname to display --- to the user. If 'Nothing' is provided, then no output is produced. -basicHandler' :: (Yesod y, YesodSite y) - => Int -- ^ port number - -> Maybe String -- ^ host name, 'Nothing' to show nothing - -> y - -> IO () -basicHandler' port mhost y = do - app <- toWaiApp y - vars <- getEnvironment - case lookup "PATH_INFO" vars of - Nothing -> do - case mhost of - Nothing -> return () - Just h -> putStrLn $ concat - ["http://", h, ":", show port, "/"] - SS.run port app - Just _ -> CGI.run app - parseWaiRequest :: W.Request -> [(String, String)] -- ^ session -> IO Request @@ -518,8 +476,8 @@ getTime = do #if TEST -testSuite :: Test -testSuite = testGroup "Yesod.Dispatch" +dispatchTestSuite :: Test +dispatchTestSuite = testGroup "Yesod.Dispatch" [ testProperty "encode/decode session" propEncDecSession , testProperty "get/put time" propGetPutTime ] diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 1420a8f4..a3be72af 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -88,7 +88,7 @@ module Yesod.Handler , ErrorResponse (..) , YesodAppResult (..) #if TEST - , testSuite + , handlerTestSuite #endif ) where @@ -120,14 +120,10 @@ import qualified Data.ByteString.Char8 as S8 #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 +import Yesod.Content + -- | The type-safe URLs associated with a site argument. type family Route a @@ -580,8 +576,8 @@ getSession = GHandler $ lift $ lift $ lift get #if TEST -testSuite :: Test -testSuite = testGroup "Yesod.Handler" +handlerTestSuite :: Test +handlerTestSuite = testGroup "Yesod.Handler" [ ] diff --git a/runtests.hs b/runtests.hs index e3fe7bc8..8498ef14 100644 --- a/runtests.hs +++ b/runtests.hs @@ -1,18 +1,12 @@ import Test.Framework (defaultMain) -import qualified Yesod.Content -import qualified Yesod.Json -import qualified Yesod.Dispatch -import qualified Yesod.Helpers.Static -import qualified Yesod.Yesod -import qualified Yesod.Handler +import Yesod.Content +import Yesod.Dispatch +import Yesod.Handler main :: IO () main = defaultMain - [ Yesod.Content.testSuite - , Yesod.Json.testSuite - , Yesod.Dispatch.testSuite - , Yesod.Helpers.Static.testSuite - , Yesod.Yesod.testSuite - , Yesod.Handler.testSuite + [ contentTestSuite + , dispatchTestSuite + , handlerTestSuite ]