diff --git a/MakeManPage.hs b/MakeManPage.hs deleted file mode 100644 index c78fb7d77..000000000 --- a/MakeManPage.hs +++ /dev/null @@ -1,69 +0,0 @@ --- Create pandoc.1 man and pandoc_markdown.5 man pages from README -import Text.Pandoc -import Data.ByteString.UTF8 (toString, fromString) -import Data.Char (toUpper) -import qualified Data.ByteString as B -import Control.Monad -import System.FilePath -import System.Environment (getArgs) -import Text.Pandoc.Shared (normalize) - -main = do - rmContents <- liftM toString $ B.readFile "README" - let (Pandoc meta blocks) = readMarkdown def rmContents - let manBlocks = removeSect [Str "Wrappers"] - $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks - let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks - args <- getArgs - let verbose = "--verbose" `elem` args - makeManPage verbose ("man" "man1" "pandoc.1") - meta manBlocks - makeManPage verbose ("man" "man5" "pandoc_markdown.5") - meta syntaxBlocks - -makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO () -makeManPage verbose page meta blocks = do - let templ = page <.> "template" - manTemplate <- liftM toString $ B.readFile templ - writeManPage page manTemplate (Pandoc meta blocks) - when verbose $ putStrLn $ "Created " ++ page - -writeManPage :: FilePath -> String -> Pandoc -> IO () -writeManPage page templ doc = do - let opts = def{ writerStandalone = True - , writerTemplate = templ } - let manPage = writeMan opts $ - bottomUp (concatMap removeLinks) $ - bottomUp capitalizeHeaders doc - B.writeFile page $ fromString manPage - -removeLinks :: Inline -> [Inline] -removeLinks (Link l _) = l -removeLinks x = [x] - -capitalizeHeaders :: Block -> Block -capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs -capitalizeHeaders x = x - -capitalize :: Inline -> Inline -capitalize (Str xs) = Str $ map toUpper xs -capitalize x = x - -removeSect :: [Inline] -> [Block] -> [Block] -removeSect ils (Header 1 x:xs) | normalize x == normalize ils = - dropWhile (not . isHeader1) xs -removeSect ils (x:xs) = x : removeSect ils xs -removeSect _ [] = [] - -extractSect :: [Inline] -> [Block] -> [Block] -extractSect ils (Header 1 z:xs) | normalize z == normalize ils = - bottomUp promoteHeader $ takeWhile (not . isHeader1) xs - where promoteHeader (Header n x) = Header (n-1) x - promoteHeader x = x -extractSect ils (x:xs) = extractSect ils xs -extractSect _ [] = [] - -isHeader1 :: Block -> Bool -isHeader1 (Header 1 _) = True -isHeader1 _ = False - diff --git a/Setup.hs b/Setup.hs index 324142a30..4c50ec209 100644 --- a/Setup.hs +++ b/Setup.hs @@ -3,26 +3,16 @@ import Distribution.Simple import Distribution.Simple.Setup (copyDest, copyVerbosity, fromFlag, installVerbosity, BuildFlags(..)) -import Distribution.PackageDescription - (PackageDescription(..), Executable(..), BuildInfo(..)) +import Distribution.PackageDescription (PackageDescription(..), Executable(..)) import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), absoluteInstallDirs) import Distribution.Verbosity ( Verbosity, silent ) -import Distribution.Simple.GHC (ghcPackageDbOptions) -import Distribution.Simple.InstallDirs (mandir, bindir, CopyDest (NoCopyDest)) +import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest)) import Distribution.Simple.Utils (installOrdinaryFiles) import Prelude hiding (catch) -import Control.Exception ( bracket_, catch ) -import Control.Monad ( unless ) -import System.Process ( rawSystem, runCommand, waitForProcess ) +import System.Process ( rawSystem ) import System.FilePath ( () ) -import System.Directory import System.Exit -import System.Time -import System.IO.Error ( isDoesNotExistError ) -import Data.Maybe ( catMaybes ) -import Data.List ( (\\) ) -import Data.Time.Clock (UTCTime(..)) main :: IO () main = do @@ -33,39 +23,22 @@ main = do (fromFlag $ copyDest flags) , postInst = \ _ flags pkg lbi -> installManpages pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest + , copyHook = \pkgdescr -> + (copyHook simpleUserHooks) pkgdescr{ executables = + [x | x <- executables pkgdescr, exeName x /= "make-pandoc-man-pages"] } + , instHook = \pkgdescr -> + (instHook simpleUserHooks) pkgdescr{ executables = + [x | x <- executables pkgdescr, exeName x /= "make-pandoc-man-pages"] } } exitWith ExitSuccess -- | Build man pages from markdown sources in man/ makeManPages :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () -makeManPages _ flags _ lbi = do - ds1 <- modifiedDependencies (manDir "man1" "pandoc.1") - ["README", manDir "man1" "pandoc.1.template"] - ds2 <- modifiedDependencies (manDir "man5" "pandoc_markdown.5") - ["README", manDir "man5" "pandoc_markdown.5.template"] - - let distPref = fromFlag (buildDistPref flags) - packageDB = - withPackageDB lbi - ++ [SpecificPackageDB $ distPref "package.conf.inplace"] - - verbosity = fromFlag $ buildVerbosity flags - - args = makeGhcArgs (ghcPackageDbOptions packageDB) - ++ ["MakeManPage.hs"] - args' = if verbosity == silent - then args - else args ++ ["--verbose"] - -- Don't run MakeManPage.hs unless we have to - unless (null ds1 && null ds2) $ do - rawSystem "runghc" args' >>= exitWith - --- format arguments to runghc that we wish to pass to ghc --- normally runghc gets it right, unless the argument does --- not begin with a '-' charecter, so we need to give clear --- directions. -makeGhcArgs :: [String] -> [String] -makeGhcArgs = map ("--ghc-arg="++) +makeManPages _ flags _ _ = do + let verbosity = fromFlag $ buildVerbosity flags + let args = ["--verbose" | verbosity /= silent] + rawSystem ("dist" "build" "make-pandoc-man-pages" "make-pandoc-man-pages") + args >>= exitWith manpages :: [FilePath] manpages = ["man1" "pandoc.1" @@ -80,18 +53,3 @@ installManpages pkg lbi verbosity copy = installOrdinaryFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy)) (zip (repeat manDir) manpages) --- | 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 -#if __GLASGOW_HASKELL__ >= 706 - then return (UTCTime (toEnum 0) 0) -- the minimum ClockTime -#else - then return (TOD 0 0) -- the minimum ClockTime -#endif - 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 - diff --git a/man/make-pandoc-man-pages.hs b/man/make-pandoc-man-pages.hs new file mode 100644 index 000000000..b94af744e --- /dev/null +++ b/man/make-pandoc-man-pages.hs @@ -0,0 +1,98 @@ +-- Create pandoc.1 man and pandoc_markdown.5 man pages from README +import Text.Pandoc +import qualified Text.Pandoc.UTF8 as UTF8 +import Data.Char (toUpper) +import Control.Monad +import System.FilePath +import System.Environment (getArgs) +import Text.Pandoc.Shared (normalize) +import Data.Maybe ( catMaybes ) +import Data.Time.Clock (UTCTime(..)) +import Prelude hiding (catch) +import Control.Exception ( catch ) +import System.IO.Error ( isDoesNotExistError ) +import System.Time (ClockTime(..)) +import System.Directory + +main :: IO () +main = do + ds1 <- modifiedDependencies ("man" "man1" "pandoc.1") + ["README", "man" "man1" "pandoc.1.template"] + ds2 <- modifiedDependencies ("man" "man5" "pandoc_markdown.5") + ["README", "man" "man5" "pandoc_markdown.5.template"] + + unless (null ds1 && null ds2) $ do + rmContents <- UTF8.readFile "README" + let (Pandoc meta blocks) = readMarkdown def rmContents + let manBlocks = removeSect [Str "Wrappers"] + $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks + let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks + args <- getArgs + let verbose = "--verbose" `elem` args + unless (null ds1) $ + makeManPage verbose ("man" "man1" "pandoc.1") meta manBlocks + unless (null ds2) $ + makeManPage verbose ("man" "man5" "pandoc_markdown.5") meta syntaxBlocks + +makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO () +makeManPage verbose page meta blocks = do + let templ = page <.> "template" + manTemplate <- UTF8.readFile templ + writeManPage page manTemplate (Pandoc meta blocks) + when verbose $ putStrLn $ "Created " ++ page + +writeManPage :: FilePath -> String -> Pandoc -> IO () +writeManPage page templ doc = do + let opts = def{ writerStandalone = True + , writerTemplate = templ } + let manPage = writeMan opts $ + bottomUp (concatMap removeLinks) $ + bottomUp capitalizeHeaders doc + UTF8.writeFile page manPage + +removeLinks :: Inline -> [Inline] +removeLinks (Link l _) = l +removeLinks x = [x] + +capitalizeHeaders :: Block -> Block +capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs +capitalizeHeaders x = x + +capitalize :: Inline -> Inline +capitalize (Str xs) = Str $ map toUpper xs +capitalize x = x + +removeSect :: [Inline] -> [Block] -> [Block] +removeSect ils (Header 1 x:xs) | normalize x == normalize ils = + dropWhile (not . isHeader1) xs +removeSect ils (x:xs) = x : removeSect ils xs +removeSect _ [] = [] + +extractSect :: [Inline] -> [Block] -> [Block] +extractSect ils (Header 1 z:xs) | normalize z == normalize ils = + bottomUp promoteHeader $ takeWhile (not . isHeader1) xs + where promoteHeader (Header n x) = Header (n-1) x + promoteHeader x = x +extractSect ils (x:xs) = extractSect ils xs +extractSect _ [] = [] + +isHeader1 :: Block -> Bool +isHeader1 (Header 1 _) = True +isHeader1 _ = False + + +-- | 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 +#if __GLASGOW_HASKELL__ >= 706 + then return (UTCTime (toEnum 0) 0) -- the minimum ClockTime +#else + then return (TOD 0 0) -- the minimum ClockTime +#endif + 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 + diff --git a/pandoc.cabal b/pandoc.cabal index 070a3766c..7328ef51f 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -370,6 +370,19 @@ Executable pandoc else Buildable: False +-- NOTE: A trick in Setup.hs makes sure this won't be installed: +Executable make-pandoc-man-pages + Main-Is: make-pandoc-man-pages.hs + Hs-Source-Dirs: man + Build-Depends: base >= 4.2 && < 5, + pandoc, + directory >= 1 && < 1.3, + filepath >= 1.1 && < 1.4, + old-time >= 1.1 && < 1.2, + time >= 1.2 && < 1.5 + Default-Language: Haskell98 + Default-Extensions: CPP + Test-Suite test-pandoc Type: exitcode-stdio-1.0 Main-Is: test-pandoc.hs diff --git a/windows/make-windows-installer.bat b/windows/make-windows-installer.bat index 3afde2608..34ef5bb87 100644 --- a/windows/make-windows-installer.bat +++ b/windows/make-windows-installer.bat @@ -1,8 +1,7 @@ @echo off cd .. -ghc --make MakeManPage -MakeManPage.exe cabal update +cabal-dev clean cabal-dev install --disable-library-for-ghci highlighting-kate cabal-dev install --flags="embed_data_files" citeproc-hs cabal-dev install --flags="executable -library blaze_html_0_5" --datasubdir=