Permalink
Browse files

Haddock is now used for parsing

  • Loading branch information...
1 parent cdffb10 commit 724e0f69946889525803e3f06f25db34290c2d2b @sol committed Mar 17, 2010
Showing with 42 additions and 13 deletions.
  1. +1 −5 .gitignore
  2. +1 −0 DocTest.cabal
  3. +40 −8 Main.hs
View
@@ -1,5 +1 @@
-*.swp
-*.hi
-*.o
-/main
-Session.vim
+/dist/
View
@@ -36,3 +36,4 @@ executable doctest
, directory
, filepath
, process
+ , haddock >= 2.8.0 && < 2.9.0
View
48 Main.hs
@@ -1,12 +1,44 @@
module Main where
-import System.Environment
-import Test.DocTest
-import Test.DocTest.Parser
-import Test.HUnit
+import System.Environment ( getArgs )
+import Test.DocTest.Parser ( parseModule )
+import Test.DocTest ( DocTest(..)
+ , docTestToTestCase
+ )
+import Test.HUnit ( runTestTT
+ , Test(..)
+ )
+import Documentation.Haddock.DocTest (
+ DocTestAsset(..)
+ , Example(..)
+ , getTestAssets
+ )
+import Data.Char
+
+-- | Remove all leading and trailing whitespace
+strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+docTestFromAsset :: DocTestAsset -> [DocTest]
+docTestFromAsset asset = map tranform (testList asset)
+ where
+ tranform :: Example -> DocTest
+ tranform (Example p e r) = DocTest
+ { source = sourceFile asset
+ , _module = moduleName asset
+ , expression = e
+ , result = strip $ unlines r
+ }
+
+internalParse args = do
+ docTests <- mapM parseModule args
+ return $ concat docTests
+
+haddockParse args = do
+ testAssets <- getTestAssets args
+ return $ concat $ map docTestFromAsset testAssets
main = do
- args <- getArgs
- docTests <- mapM parseModule args
- tests <- mapM docTestToTestCase (concat docTests)
- runTestTT (TestList tests)
+ args <- getArgs
+ docTests <- haddockParse args
+ tests <- mapM docTestToTestCase docTests
+ runTestTT (TestList tests)

0 comments on commit 724e0f6

Please sign in to comment.