diff options
author | Adam Vogt <vogt.adam@gmail.com> | 2010-04-19 03:49:46 +0200 |
---|---|---|
committer | Adam Vogt <vogt.adam@gmail.com> | 2010-04-19 03:49:46 +0200 |
commit | 1f2f6239a5d942d2cd0f06aeec2d96ab05980600 (patch) | |
tree | 5b789a736dc3a938f4bdb598b8ed0bd591878d2c /tests/genMain.hs | |
parent | 21033ad1ff3948c39dab6fca2e003acb6f575cc2 (diff) | |
download | XMonadContrib-1f2f6239a5d942d2cd0f06aeec2d96ab05980600.tar.gz XMonadContrib-1f2f6239a5d942d2cd0f06aeec2d96ab05980600.tar.xz XMonadContrib-1f2f6239a5d942d2cd0f06aeec2d96ab05980600.zip |
Rearrange tests. See test/genMain.hs for instructions.
Ignore-this: 1745e6f1052e84e40153b5b1c0a6e15a
darcs-hash:20100419014946-1499c-4705ec3d27ad26df038a7d72e978e5a137d712b5.gz
Diffstat (limited to 'tests/genMain.hs')
-rw-r--r-- | tests/genMain.hs | 52 |
1 files changed, 52 insertions, 0 deletions
diff --git a/tests/genMain.hs b/tests/genMain.hs new file mode 100644 index 0000000..90d8224 --- /dev/null +++ b/tests/genMain.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE ViewPatterns #-} +{- | generate another Main from all modules in the current directory, +extracting all functions with @prop_@. + +Usage (your QuickCheck-1 version may vary): + +> ln -s ../../xmonad/tests/Properties.hs . +> runghc genMain.hs > Main.hs +> ghc -DTESTING -i.. -i. -package QuickCheck-1.2.0.0 Main.hs -e main + +-} +module Main where + +import Control.Monad.List +import Data.Char +import Data.IORef +import Data.List +import qualified Data.Set as S +import System.Directory +import System.FilePath +import Text.PrettyPrint.HughesPJ + +main = do + imports <- newIORef S.empty + props <- runListT $ do + f @ ((isUpper -> True) : (takeExtension -> ".hs")) + <- ListT (getDirectoryContents ".") + guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"] + let b = takeBaseName f + nesting <- io $ newIORef 0 + decl : _ <- ListT $ (map words . lines) `fmap` readFile f + case decl of + "{-" -> io $ modifyIORef nesting succ + "-}" -> io $ modifyIORef nesting pred + _ -> return () + 0 <- io $ readIORef nesting + guard $ "prop_" `isPrefixOf` decl + io $ modifyIORef imports (S.insert b) + return (b ++ "." ++ decl) + imports <- S.toList `fmap` readIORef imports + print $ genModule imports props + +genModule :: [String] -> [String] -> Doc +genModule imports props = vcat [header,imports', main ] + where + header = text "module Main where" + imports' = text "import Test.QuickCheck" + $$ vcat [ text "import qualified" <+> text im | im <- imports ] + props' = vcat [ text "quickCheck" <+> text p | p <- props ] + main = hang (text "main = do") 4 props' + +io x = liftIO x |