a simple doctest implementation for functional/shell testing

Tests.hs

@@ -1,4 +1,80 @@
--- see also
+{- |
+hledger's test suite. Most tests are HUnit-based, and defined in the
+@tests@ list below. These tests are built in to hledger and can be run at
+any time with @hledger test@.
+
+In addition, we have tests in doctest format, which can be run with @make
+doctest@ in the hledger source tree. These have some advantages:
+
+- easier to read and write than hunit, for functional/shell tests
+
+- easier to read multi-line output from failing tests
+
+- can also appear in, and test, docs
+
+and disadvantages:
+
+- not included in hledger's built-in tests
+
+- not platform independent
+
+All doctests are included below. Some of these may also appear in other
+modules as examples within the api docs.
+
+Run a few with c++ ledger first:
+
+@
+$ ledger -f sample.ledger balance
+                 $-1  assets
+                  $1    bank:saving
+                 $-2    cash
+                  $2  expenses
+                  $1    food
+                  $1    supplies
+                 $-2  income
+                 $-1    gifts
+                 $-1    salary
+                  $1  liabilities:debts
+@
+
+@
+$ ledger -f sample.ledger balance o
+                  $1  expenses:food
+                 $-2  income
+                 $-1    gifts
+                 $-1    salary
+--------------------
+                 $-1
+@
+
+Then hledger:
+
+@
+$ hledger -f sample.ledger balance
+                 $-1  assets
+                  $1    bank:saving
+                 $-2    cash
+                  $2  expenses
+                  $1    food
+                  $1    supplies
+                 $-2  income
+                 $-1    gifts
+                 $-1    salary
+                  $1  liabilities:debts
+@
+
+@
+$ hledger -f sample.ledger balance o
+                  $1  expenses:food
+                 $-2  income
+                 $-1    gifts
+                 $-1    salary
+--------------------
+                 $-1
+@
+
+-}
+-- other test tools:
 -- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/test-framework
 -- http://hackage.haskell.org/cgi-bin/hackage-scripts/package/HTF
 

tools/doctest.hs

@@ -0,0 +1,86 @@
+#!/usr/bin/env runhaskell
+{- |
+Extract (shell) tests from haddock comments in Haskell code, run them and
+verify expected output, like Python's doctest system.
+
+Here, a doctest is a haddock literal block whose first line begins with a
+$ (leading whitespace ignored). The rest of the line is a shell command
+and the remaining lines are the expected output.
+
+Usage example: $ doctest.hs doctest.hs
+
+Doctest examples:
+
+@
+$ ls doctest.hs
+This doctest will fail.
+@
+
+@
+$ ls doctest.hs
+doctest.hs
+@
+
+After writing this I found the doctest on hackage; that one runs haskell
+expressions in comments, converting them to hunit tests. We might add this
+to that, and/or add this to hledger's built-in test runner.
+
+-}
+
+module Main where
+import Data.List (isPrefixOf)
+import System (getArgs)
+import System.Exit (ExitCode(ExitSuccess))
+import System.IO (hGetContents)
+import System.Process (runInteractiveCommand, waitForProcess)
+import Text.Printf (printf)
+
+main = do
+  f <- head `fmap` getArgs
+  s <- readFile f
+  let tests = doctests s
+  putStrLn $ printf "running %d doctests from %s" (length tests) f
+  mapM_ runShellDocTest $ doctests s
+
+runShellDocTest :: String -> IO Bool
+runShellDocTest s = do
+  let (cmd, expected) = splitDocTest s
+  putStr $ printf "testing: %s .. " cmd
+  (_, out, _, h) <- runInteractiveCommand cmd
+  exit <- waitForProcess h
+  output <- hGetContents out
+  if exit == ExitSuccess
+    then
+      if output == expected
+        then do
+          putStrLn "ok"
+          return True
+        else do
+          putStr $ printf "FAILED\nexpected:\n%sgot:\n%s" expected output
+          return False
+    else do
+      putStrLn $ printf "ERROR: %s" (show exit)
+      return False
+
+splitDocTest s = (strip $ drop 1 $ strip $ head ls, unlines $ tail ls)
+    where ls = lines s
+
+-- extract doctests from haskell source code
+doctests :: String -> [String]
+doctests s = filter isDocTest $ haddockLiterals s
+    where
+      isDocTest s = (("$" `isPrefixOf`) . dropws) $ head $ lines s
+
+-- extract haddock literal blocks from haskell source code
+haddockLiterals :: String -> [String]
+haddockLiterals "" = []
+haddockLiterals s | null lit = []
+                  | otherwise = [lit] ++ haddockLiterals rest
+    where
+      ls = drop 1 $ dropWhile (not . isLiteralBoundary) $ lines s
+      lit = unlines $ takeWhile (not . isLiteralBoundary) ls
+      rest = unlines $ drop 1 $ dropWhile (not . isLiteralBoundary) ls
+      isLiteralBoundary = (== "@") . strip
+
+strip = dropws . reverse . dropws . reverse
+dropws = dropWhile (`elem` " \t")