git.iko.soy/typeable/bloodhound
on 9c4c90a help sign in
typeable/bloodhound/tests/doctests.hsc
74 lines 2.4 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ForeignFunctionInterface #-}
3-----------------------------------------------------------------------------
4-- |
5-- Module : Main (doctests)
6-- Copyright : (C) 2014 Chris Allen
7-- License : BSD-style (see the file LICENSE)
8-- Maintainer : Chris Allen <cma@bitemyapp.com>
9-- Stability : provisional
10-- Portability : portable
11--
12-- This module provides doctests for a project based on the actual versions
13-- of the packages it was built with. It requires a corresponding Setup.lhs
14-- to be added to the project
15-----------------------------------------------------------------------------
17module Main where
19import Build_doctests (deps)
20import Control.Applicative
21import Control.Monad
22import Data.List
23import System.Directory
24import System.FilePath
25import Test.DocTest
27##if defined(mingw32_HOST_OS)
28##if defined(i386_HOST_ARCH)
29##define USE_CP
30import Control.Applicative
31import Control.Exception
32import Foreign.C.Types
33foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
34foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
35##elif defined(x86_64_HOST_ARCH)
36##define USE_CP
37import Control.Applicative
38import Control.Exception
39import Foreign.C.Types
40foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool
41foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt
42##endif
43##endif
45-- | Run in a modified codepage where we can print UTF-8 values on Windows.
46withUnicode :: IO a -> IO a
47##ifdef USE_CP
48withUnicode m = do
49 cp <- c_GetConsoleCP
50 (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp
51##else
52withUnicode m = m
53##endif
55main :: IO ()
56main = withUnicode $ getSources >>= \sources -> doctest $
57 "-isrc"
58 : "-idist/build/autogen"
59 : "-optP-include"
60 : "-optPdist/build/autogen/cabal_macros.h"
61 : "-hide-all-packages"
62 : map ("-package="++) deps ++ sources
64getSources :: IO [FilePath]
65getSources = filter (isSuffixOf ".hs") <$> go "src"
66 where
67 go dir = do
68 (dirs, files) <- getFilesAndDirectories dir
69 (files ++) . concat <$> mapM go dirs
71getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])
72getFilesAndDirectories dir = do
73 c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir
74 (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c