test-framework-th-prime-0.0.9/0000755000000000000000000000000012727461121014406 5ustar0000000000000000test-framework-th-prime-0.0.9/LICENSE0000644000000000000000000000276512727461121015425 0ustar0000000000000000Copyright (c) 2012, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. test-framework-th-prime-0.0.9/Setup.hs0000644000000000000000000000005612727461121016043 0ustar0000000000000000import Distribution.Simple main = defaultMain test-framework-th-prime-0.0.9/test-framework-th-prime.cabal0000644000000000000000000000207612727461121022074 0ustar0000000000000000Name: test-framework-th-prime Version: 0.0.9 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: Template Haskell for test framework Description: Automatically generates a Test list for HUnit, doctest and QuickCheck2. Category: Testing Cabal-Version: >= 1.6 Build-Type: Simple Library if impl(ghc >= 6.12) GHC-Options: -Wall -fno-warn-unused-do-bind else GHC-Options: -Wall Exposed-Modules: Test.Framework.TH.Prime Other-Modules: Test.Framework.TH.Prime.Parser Build-Depends: base >= 4 && < 5 , cpphs >= 0.2.1 , haskell-src-exts , template-haskell , test-framework Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/test-framework-th-prime.git test-framework-th-prime-0.0.9/Test/0000755000000000000000000000000012727461121015325 5ustar0000000000000000test-framework-th-prime-0.0.9/Test/Framework/0000755000000000000000000000000012727461121017262 5ustar0000000000000000test-framework-th-prime-0.0.9/Test/Framework/TH/0000755000000000000000000000000012727461121017575 5ustar0000000000000000test-framework-th-prime-0.0.9/Test/Framework/TH/Prime.hs0000644000000000000000000001010012727461121021175 0ustar0000000000000000{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell #-} -- | -- Template Haskell to generate defaultMain with a list of "Test" from -- \"doc_test\", \"case_\\", and \"prop_\\". -- -- An example of source code (Data/MySet.hs): -- -- > {-| Creating a set from a list. O(N log N) -- > -- > >>> empty == fromList [] -- > True -- > >>> singleton 'a' == fromList ['a'] -- > True -- > >>> fromList [5,3,5] == fromList [5,3] -- > True -- > -} -- > -- > fromList :: Ord a => [a] -> RBTree a -- > fromList = foldl' (flip insert) empty -- -- An example of test code in the src directory (test/Test.hs): -- -- > {-# LANGUAGE TemplateHaskell #-} -- > module Main where -- > -- > import Test.Framework.TH.Prime -- > import Test.Framework.Providers.DocTest -- > import Test.Framework.Providers.HUnit -- > import Test.Framework.Providers.QuickCheck2 -- > import Test.QuickCheck2 -- > import Test.HUnit -- > -- > import Data.MySet -- > -- > main :: IO () -- > main = $(defaultMainGenerator) -- > -- > doc_test :: DocTests -- > doc_test = docTest ["../Data/MySet.hs"] ["-i.."] -- > -- > prop_toList :: [Int] -> Bool -- > prop_toList xs = ordered ys -- > where -- > ys = toList . fromList $ xs -- > ordered (x:y:xys) = x <= y && ordered (y:xys) -- > ordered _ = True -- > -- > case_ticket4242 :: Assertion -- > case_ticket4242 = (valid $ deleteMin $ deleteMin $ fromList [0,2,5,1,6,4,8,9,7,11,10,3]) @?= True -- -- And run: -- -- > test% runghc -i.. Test.hs -- -- "defaultMainGenerator" generates the following: -- -- > main = do -- > TestGroup _ doctests <- docTest ["../Data/MySet.hs"] ["-i.."] -- > defaultMain [ -- > testGroup "Doc tests" doctests -- > , testGroup "Unit tests" [ -- > testCase "case_ticket4242" case_ticket4242 -- > ] -- > , testGroup "Property tests" [ -- > testProperty "prop_toList" prop_toList -- > ] -- > ] -- -- Note: examples in haddock document is only used as unit tests at this -- moment. I hope that properties of QuickCheck2 can also be specified in -- haddock document in the future. I guess it's Haskell way of Behavior -- Driven Development. module Test.Framework.TH.Prime ( defaultMainGenerator , DocTests ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Language.Haskell.TH hiding (Match) import Language.Haskell.TH.Syntax hiding (Match) import Test.Framework (defaultMain) import Test.Framework.Providers.API import Test.Framework.TH.Prime.Parser ---------------------------------------------------------------- -- | Type for \"doc_test\". type DocTests = IO Test ---------------------------------------------------------------- {-| Generating defaultMain with a list of "Test" from \"doc_test\", \"case_\\", and \"prop_\\". -} defaultMainGenerator :: ExpQ defaultMainGenerator = do defined <- isDefined docTestKeyword if defined then [| do TestGroup _ doctests <- $(docTests) let (unittests, proptests) = $(unitPropTests) defaultMain [ testGroup "Doc tests" doctests , testGroup "Unit tests" unittests , testGroup "Property tests" proptests ] |] else [| do let (unittests, proptests) = $(unitPropTests) defaultMain [ testGroup "Unit tests" unittests , testGroup "Property tests" proptests ] |] ---------------------------------------------------------------- -- code from Hiromi Ishii isDefined :: String -> Q Bool isDefined n = return False `recover` do #if MIN_VERSION_template_haskell(2, 11, 0) VarI (Name _ flavour) _ _ <- reify (mkName n) #else VarI (Name _ flavour) _ _ _ <- reify (mkName n) #endif modul <- loc_module <$> location case flavour of NameG ns _ mdl -> return (ns == VarName && modString mdl == modul) _ -> return False ---------------------------------------------------------------- docTestKeyword :: String docTestKeyword = "doc_test" docTests :: ExpQ docTests = return $ symbol docTestKeyword test-framework-th-prime-0.0.9/Test/Framework/TH/Prime/0000755000000000000000000000000012727461121020651 5ustar0000000000000000test-framework-th-prime-0.0.9/Test/Framework/TH/Prime/Parser.hs0000644000000000000000000000635012727461121022445 0ustar0000000000000000{-# LANGUAGE CPP #-} module Test.Framework.TH.Prime.Parser ( unitPropTests , symbol, string ) where import Control.Applicative import Data.List import Language.Haskell.Exts.Extension import Language.Haskell.Exts.Parser import Language.Haskell.Exts.Syntax hiding (VarName, Exp) import Language.Haskell.TH hiding (Match, Extension (..)) import Language.Preprocessor.Cpphs hiding (Ident) ---------------------------------------------------------------- symbol :: String -> Exp symbol = VarE . mkName string :: String -> Exp string = LitE . StringL ---------------------------------------------------------------- unitPropTests :: ExpQ unitPropTests = do file <- loc_filename <$> location (cases, props) <- runIO $ getTests file return $ TupE [ListE (map toCase cases), ListE (map toProp props)] ---------------------------------------------------------------- toCase :: String -> Exp toCase = toTest "testCase" toProp :: String -> Exp toProp = toTest "testProperty" toTest :: String -> String -> Exp toTest tag nm = AppE (AppE (symbol tag ) (string nm)) (symbol nm) ---------------------------------------------------------------- getTests :: FilePath -> IO ([String], [String]) getTests file = do ParseOk (Module _ _ _ _ _ _ decls) <- parseTest file let funs = map fromFunBind $ filter isFunBind decls pats = map fromPatBind $ filter isPatBind decls names = funs ++ pats return (filter isCase names, filter isProp names) where isProp = ("prop_" `isPrefixOf`) isCase = ("case_" `isPrefixOf`) parseTest :: FilePath -> IO (ParseResult Module) parseTest file = do raw <- readFile file parseModuleWithMode (opt raw) . pack <$> go raw where pack = unlines . tail . map snd go = cppIfdef "dummy" [] [] defaultBoolOptions exts raw = case getTopPragmas raw of ParseOk pragmas -> [ toExtention name | LanguagePragma _ names <- pragmas, name <- names] ParseFailed _ _ -> [] where #if MIN_VERSION_haskell_src_exts(1, 14, 0) toExtention = parseExtension . toStr #else toExtention = read . toStr #endif toStr (Ident str) = str toStr (Symbol str) = str opt raw = defaultParseMode { #if MIN_VERSION_haskell_src_exts(1, 14, 0) extensions = nub $ EnableExtension TemplateHaskell : exts raw #else extensions = nub $ TemplateHaskell : exts raw #endif -- to prevent "Ambiguous infix expression" , fixities = Nothing } ---------------------------------------------------------------- isFunBind :: Decl -> Bool isFunBind (FunBind _) = True isFunBind _ = False isPatBind :: Decl -> Bool isPatBind PatBind{} = True isPatBind _ = False fromPatBind :: Decl -> String #if MIN_VERSION_haskell_src_exts(1, 16, 0) fromPatBind (PatBind _ (PVar (Ident name)) _ _) = name fromPatBind (PatBind _ (PVar (Symbol name)) _ _) = name #else fromPatBind (PatBind _ (PVar (Ident name)) _ _ _) = name fromPatBind (PatBind _ (PVar (Symbol name)) _ _ _) = name #endif fromPatBind _ = error "fromPatBind" fromFunBind :: Decl -> String fromFunBind (FunBind (Match _ (Ident name) _ _ _ _:_)) = name fromFunBind (FunBind (Match _ (Symbol name) _ _ _ _:_)) = name fromFunBind _ = error "fromFunBind"