From 1f2f6239a5d942d2cd0f06aeec2d96ab05980600 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Mon, 19 Apr 2010 03:49:46 +0200
Subject: Rearrange tests. See test/genMain.hs for instructions.

Ignore-this: 1745e6f1052e84e40153b5b1c0a6e15a

darcs-hash:20100419014946-1499c-4705ec3d27ad26df038a7d72e978e5a137d712b5.gz
---
 tests/genMain.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)
 create mode 100644 tests/genMain.hs

(limited to 'tests/genMain.hs')

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
-- 
cgit v1.2.3