blob: 90d82242cfa32c7cfd66627e3c8a074a5e09de25 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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
|
