doctests cleanup

Setup.hs

@@ -1,51 +1,7 @@
-{-# OPTIONS_GHC -Wall #-}
-module Main (main) where
+#!/usr/bin/env runhaskell
 
-import Data.List ( nub )
-import Data.Version ( showVersion )
-import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )
-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )
-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )
-import Distribution.Simple.BuildPaths ( autogenModulesDir )
-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))
-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )
-import Distribution.Text ( display )
-import Distribution.Verbosity ( Verbosity, normal )
-import System.FilePath ( (</>) )
+module Main where
+import Distribution.Simple
 
 main :: IO ()
-main = defaultMainWithHooks simpleUserHooks
-  { buildHook = \pkg lbi hooks flags -> do
-     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi
-     buildHook simpleUserHooks pkg lbi hooks flags
-  , postHaddock = \args flags pkg lbi -> do
-     -- copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]
-     postHaddock simpleUserHooks args flags pkg lbi
-  }
-
-haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath
-haddockOutputDir flags pkg = destDir where
-  baseDir = case haddockDistPref flags of
-    NoFlag -> "."
-    Flag x -> x
-  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)
-
-generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-generateBuildModule verbosity pkg lbi = do
-  let dir = autogenModulesDir lbi
-  createDirectoryIfMissingVerbose verbosity True dir
-  withLibLBI pkg lbi $ \_ libcfg -> do
-    withTestLBI pkg lbi $ \suite suitecfg -> do
-      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines
-        [ "module Build_" ++ testName suite ++ " where"
-        , "deps :: [String]"
-        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))
-        ]
-  where
-    formatdeps = map (formatone . snd)
-    formatone p = case packageName p of
-      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)
-
-testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]
-testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys
+main = defaultMain

bloodhound.cabal

@@ -66,15 +66,20 @@ test-suite tests
   default-language:    Haskell2010
 
 test-suite doctests
+  ghc-options:      -threaded -Wall
   default-language: Haskell2010
   type:             exitcode-stdio-1.0
   main-is:          doctests.hs
-  hs-source-dirs:   tests
+  hs-source-dirs:   tests, src
   if impl(ghc >= 7.8)
     build-depends:    base,
                       directory,
-                      doctest,
+                      doctest >= 0.10.1,
                       doctest-prop,
                       filepath
   else
     buildable: False
+
+Source-Repository head
+  Type:     git
+  Location: git://github.com/bitemyapp/bloodhound.git

stack.yaml

@@ -2,6 +2,7 @@ flags: {}
 packages:
 - '.'
 extra-deps:
+- doctest-0.10.1
 - doctest-prop-0.2.0.1
 - quickcheck-properties-0.1
 - uri-bytestring-0.1.2

tests/doctests.hs

@@ -0,0 +1,4 @@
+import Test.DocTest
+
+main :: IO ()
+main = doctest ["-isrc", "Database"]

tests/doctests.hsc

@@ -1,74 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Main (doctests)
--- Copyright   :  (C) 2014 Chris Allen
--- License     :  BSD-style (see the file LICENSE)
--- Maintainer  :  Chris Allen <cma@bitemyapp.com>
--- Stability   :  provisional
--- Portability :  portable
---
--- This module provides doctests for a project based on the actual versions
--- of the packages it was built with. It requires a corresponding Setup.lhs
--- to be added to the project
------------------------------------------------------------------------------
-
-module Main where
-
-import Build_doctests (deps)
-import Control.Applicative
-import Control.Monad
-import Data.List
-import System.Directory
-import System.FilePath
-import Test.DocTest
-
-##if defined(mingw32_HOST_OS)
-##if defined(i386_HOST_ARCH)
-##define USE_CP
-import Control.Applicative
-import Control.Exception
-import Foreign.C.Types
-foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
-foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
-##elif defined(x86_64_HOST_ARCH)
-##define USE_CP
-import Control.Applicative
-import Control.Exception
-import Foreign.C.Types
-foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
-foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
-##endif
-##endif
-
--- | Run in a modified codepage where we can print UTF-8 values on Windows.
-withUnicode :: IO a -> IO a
-##ifdef USE_CP
-withUnicode m = do
-  cp <- c_GetConsoleCP
-  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp
-##else
-withUnicode m = m
-##endif
-
-main :: IO ()
-main = withUnicode $ getSources >>= \sources -> doctest $
-    "-isrc"
-  : "-idist/build/autogen"
-  : "-optP-include"
-  : "-optPdist/build/autogen/cabal_macros.h"
-  : "-hide-all-packages"
-  : map ("-package="++) deps ++ sources
-
-getSources :: IO [FilePath]
-getSources = filter (isSuffixOf ".hs") <$> go "src"
-  where
-    go dir = do
-      (dirs, files) <- getFilesAndDirectories dir
-      (files ++) . concat <$> mapM go dirs
-
-getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
-getFilesAndDirectories dir = do
-  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
-  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c