7e8ea0ae74
+ Changed Setup.hs in accord with change in '--version' output. + Changed lhs test cases in accord with change in the way HTML headers are written (they are now put in divs, and the id is put on the div rather than the header itself). git-svn-id: https://pandoc.googlecode.com/svn/trunk@1588 788f1e2b-df1e-0410-8736-df70ead52e1b
65 lines
2.8 KiB
Haskell
65 lines
2.8 KiB
Haskell
import Distribution.Simple
|
|
import Control.Exception ( bracket_ )
|
|
import Control.Monad ( unless )
|
|
import System.Process ( runCommand, runProcess, waitForProcess )
|
|
import System.FilePath ( (</>), (<.>) )
|
|
import System.Directory
|
|
import System.IO ( stderr, openTempFile )
|
|
import System.Exit
|
|
import System.Time
|
|
import System.IO.Error ( isDoesNotExistError )
|
|
import Data.Maybe ( fromJust, isNothing, catMaybes )
|
|
import Data.List ( isInfixOf )
|
|
|
|
main = do
|
|
defaultMainWithHooks $ simpleUserHooks { runTests = runTestSuite
|
|
, postBuild = makeManPages }
|
|
exitWith ExitSuccess
|
|
|
|
-- | Run test suite.
|
|
runTestSuite _ _ _ _ = do
|
|
tempPath <- catch getTemporaryDirectory (\_ -> return ".")
|
|
(outputPath, hOut) <- openTempFile tempPath "out"
|
|
runProcess "pandoc" ["--version"] Nothing Nothing Nothing (Just hOut) Nothing >>= waitForProcess
|
|
output <- readFile outputPath
|
|
let highlightingSupport = "with syntax highlighting" `isInfixOf` output
|
|
let testArgs = if highlightingSupport then ["lhs"] else []
|
|
let testCmd = "runhaskell -i.. RunTests.hs " ++ unwords testArgs
|
|
inDirectory "tests" $ runCommand testCmd >>= waitForProcess >>= exitWith
|
|
|
|
-- | Build man pages from markdown sources in man/man1/.
|
|
makeManPages _ _ _ _ = do
|
|
mapM_ makeManPage ["pandoc.1", "hsmarkdown.1", "html2markdown.1", "markdown2pdf.1"]
|
|
|
|
-- | Build a man page from markdown source in man/man1.
|
|
makeManPage manpage = do
|
|
let manDir = "man" </> "man1"
|
|
let pandoc = "dist" </> "build" </> "pandoc" </> "pandoc"
|
|
let page = manDir </> manpage
|
|
let source = manDir </> manpage <.> "md"
|
|
modifiedDeps <- modifiedDependencies page [source]
|
|
unless (null modifiedDeps) $ do
|
|
ec <- runProcess pandoc ["-s", "-S", "-r", "markdown", "-w", "man", "-o", page, source]
|
|
Nothing Nothing Nothing Nothing (Just stderr) >>= waitForProcess
|
|
case ec of
|
|
ExitSuccess -> putStrLn $ "Created " ++ manDir </> manpage
|
|
_ -> do putStrLn $ "Error creating " ++ manDir </> manpage
|
|
exitWith ec
|
|
|
|
-- | Returns a list of 'dependencies' that have been modified after 'file'.
|
|
modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
|
|
modifiedDependencies file dependencies = do
|
|
fileModTime <- catch (getModificationTime file) $
|
|
\e -> if isDoesNotExistError e
|
|
then return (TOD 0 0) -- the minimum ClockTime
|
|
else ioError e
|
|
depModTimes <- mapM getModificationTime dependencies
|
|
let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes
|
|
return $ catMaybes modified
|
|
|
|
-- | Perform an IO action in a directory.
|
|
inDirectory :: FilePath -> IO a -> IO a
|
|
inDirectory dir action = do
|
|
oldDir <- getCurrentDirectory
|
|
bracket_ (setCurrentDirectory dir) (setCurrentDirectory oldDir) action
|
|
|