From decdd8c9e2f0e5c35febecae0c8f0877d48504cc Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sat, 28 Nov 2009 19:36:04 +0200 Subject: [PATCH] Build tests only with flag --- Test.hs | 1 + Web/Restful.hs | 4 ++-- Web/Restful/Resource.hs | 16 +++++++++++++--- Web/Restful/Response.hs | 7 +++++++ Web/Restful/Utils.hs | 7 +++++++ restful.cabal | 27 ++++++++++++++++++++++----- 6 files changed, 52 insertions(+), 10 deletions(-) diff --git a/Test.hs b/Test.hs index 3ca5e328..6fdb084b 100644 --- a/Test.hs +++ b/Test.hs @@ -4,6 +4,7 @@ import qualified Web.Restful.Response import qualified Web.Restful.Utils import qualified Web.Restful.Resource +main :: IO () main = defaultMain [ Web.Restful.Response.testSuite , Web.Restful.Utils.testSuite diff --git a/Web/Restful.hs b/Web/Restful.hs index 1f591eb4..47ac2fbc 100644 --- a/Web/Restful.hs +++ b/Web/Restful.hs @@ -24,8 +24,8 @@ module Web.Restful import Data.Object import Web.Restful.Request -import Web.Restful.Response hiding (testSuite) +import Web.Restful.Response import Web.Restful.Application import Web.Restful.Definitions import Web.Restful.Handler -import Web.Restful.Resource hiding (testSuite) +import Web.Restful.Resource diff --git a/Web/Restful/Resource.hs b/Web/Restful/Resource.hs index 3bffbffb..24602673 100644 --- a/Web/Restful/Resource.hs +++ b/Web/Restful/Resource.hs @@ -2,6 +2,8 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE StandaloneDeriving #-} --------------------------------------------------------- -- -- Module : Web.Restful.Resource @@ -21,8 +23,10 @@ module Web.Restful.Resource , checkPattern , validatePatterns , checkResourceName +#if TEST -- * Testing , testSuite +#endif ) where import Data.List.Split (splitOn) @@ -30,14 +34,16 @@ import Web.Restful.Definitions import Web.Restful.Handler import Data.List (intercalate) import Data.Enumerable -import Control.Monad (replicateM, when) import Data.Char (isDigit) +#if TEST +import Control.Monad (replicateM, when) import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck (testProperty) import Test.HUnit hiding (Test) import Test.QuickCheck +#endif data ResourcePatternPiece = Static String @@ -57,7 +63,7 @@ isSlurp (Slurp _) = True isSlurp _ = False newtype ResourcePattern = ResourcePattern { unRP :: [ResourcePatternPiece] } - deriving (Eq, Arbitrary) + deriving Eq fromString :: String -> ResourcePattern fromString = ResourcePattern @@ -74,7 +80,7 @@ class (Show a, Enumerable a) => ResourceName a where -- Something like /foo/$bar/baz/ will match the regular expression -- /foo/(\\w*)/baz/, matching the middle part with the urlParam bar. -- - -- Also, /foo/*bar/ will match /foo/[anything else], capturing the value + -- Also, /foo/\*bar/ will match /foo/, capturing the value -- into the bar urlParam. resourcePattern :: a -> String @@ -152,6 +158,7 @@ validatePatterns (x:xs) = -> [(ResourcePattern, ResourcePattern)] validatePatterns' a b = [(a, b) | overlaps (unRP a) (unRP b)] +#if TEST ---- Testing testSuite :: Test testSuite = testGroup "Web.Restful.Resource" @@ -163,6 +170,8 @@ testSuite = testGroup "Web.Restful.Resource" , testCase "integers" caseIntegers ] +deriving instance Arbitrary ResourcePattern + caseOverlap1 :: Assertion caseOverlap1 = assert $ not $ overlaps (unRP $ fromString "/foo/$bar/") @@ -219,3 +228,4 @@ instance Arbitrary ResourcePatternPiece where s <- replicateM size $ elements ['a'..'z'] return $ constr s coarbitrary = undefined +#endif diff --git a/Web/Restful/Response.hs b/Web/Restful/Response.hs index 1fdc2f5a..11a0c3b6 100644 --- a/Web/Restful/Response.hs +++ b/Web/Restful/Response.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeSynonymInstances #-} -- FIXME remove {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} --------------------------------------------------------- -- -- Module : Web.Restful.Response @@ -39,8 +40,10 @@ module Web.Restful.Response , genResponse , htmlResponse , objectResponse +#if TEST -- * Tests , testSuite +#endif ) where import Data.Time.Clock @@ -55,7 +58,9 @@ import qualified Data.Text.Lazy.Encoding as LTE import Web.Encodings (formatW3) +#if TEST import Test.Framework (testGroup, Test) +#endif import Data.Generics import Control.Exception (Exception) @@ -191,8 +196,10 @@ instance HasReps (Reps m) where reps = id -} +#if TEST ----- Testing testSuite :: Test testSuite = testGroup "Web.Restful.Response" [ ] +#endif diff --git a/Web/Restful/Utils.hs b/Web/Restful/Utils.hs index e4a43309..aec16186 100644 --- a/Web/Restful/Utils.hs +++ b/Web/Restful/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} --------------------------------------------------------- -- -- Module : Web.Restful.Utils @@ -15,15 +16,19 @@ module Web.Restful.Utils ( parseHttpAccept , tryLookup +#if TEST , testSuite +#endif ) where import Data.List.Split (splitOneOf) import Data.Maybe (fromMaybe) +#if TEST import Test.Framework (testGroup, Test) import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test) +#endif -- | Parse the HTTP accept string to determine supported content types. parseHttpAccept :: String -> [String] @@ -38,6 +43,7 @@ specialHttpAccept _ = False tryLookup :: Eq k => v -> k -> [(k, v)] -> v tryLookup def key = fromMaybe def . lookup key +#if TEST ----- Testing testSuite :: Test testSuite = testGroup "Web.Restful.Response" @@ -50,3 +56,4 @@ caseTryLookup1 = tryLookup "default" "foo" [] @?= "default" caseTryLookup2 :: Assertion caseTryLookup2 = tryLookup "default" "foo" [("foo", "baz")] @?= "baz" +#endif diff --git a/restful.cabal b/restful.cabal index 12cfd6bb..1ba034ab 100644 --- a/restful.cabal +++ b/restful.cabal @@ -11,7 +11,15 @@ cabal-version: >= 1.2 build-type: Simple homepage: http://github.com/snoyberg/restful/tree/master +flag buildtests + description: Build the executable to run unit tests + default: False + library + if flag(buildtests) + Buildable: False + else + Buildable: True build-depends: base >= 4 && < 5, old-locale >= 1.0.0.1, time >= 1.1.3, @@ -31,11 +39,6 @@ library data-object >= 0.2.0, data-object-translate, yaml >= 0.2.0, - test-framework, - test-framework-quickcheck, - test-framework-hunit, - HUnit, - QuickCheck == 1.*, enumerable >= 0.0.3, directory >= 1, transformers >= 0.1.4.0, @@ -60,3 +63,17 @@ library Web.Restful.Response.AtomFeed, Web.Restful.Response.Sitemap ghc-options: -Wall -Werror + +executable runtests + if flag(buildtests) + Buildable: True + cpp-options: -DTEST + build-depends: test-framework, + test-framework-quickcheck, + test-framework-hunit, + HUnit, + QuickCheck == 1.* + else + Buildable: False + ghc-options: -Wall + main-is: Test.hs