New method for producing man pages.

This change adds `--man1` and `--man5` options to pandoc, so
pandoc can generate its own man pages.

It removes the old overly complex method of building a separate
executable (but not installing it) just to create the man pages.

The man pages are no longer automatically created in the build
process.

The man/ directory has been removed.  The man page templates
have been moved to data/.

New unexported module:  Text.Pandoc.ManPages.

Text.Pandoc.Data now exports readmeFile, and `readDataFile`
knows how to find README.

Closes #2190.
This commit is contained in:
John MacFarlane 2015-06-28 14:39:17 -07:00
parent 3e5b4faaf2
commit fe625e053d
11 changed files with 151 additions and 147 deletions

View file

@ -75,7 +75,11 @@ Quick install
--extra-include-dirs=/usr/local/Cellar/icu4c/51.1/include \ --extra-include-dirs=/usr/local/Cellar/icu4c/51.1/include \
-funicode_collation text-icu pandoc-citeproc -funicode_collation text-icu pandoc-citeproc
The build process will create man pages in `man/man1` and `man/man5`. To build the `pandoc.1` and `pandoc_markdown.5` man pages, you
can ues pandoc itself:
pandoc --man1 > pandoc.1
pandoc --man5 > pandoc_markdown.5
To build the `pandoc-citeproc` man pages, go to the pandoc-citeproc To build the `pandoc-citeproc` man pages, go to the pandoc-citeproc
build directory, and build directory, and

8
README
View file

@ -240,6 +240,14 @@ General options
`epub.css`, `templates`, `slidy`, `slideous`, or `s5` directory `epub.css`, `templates`, `slidy`, `slideous`, or `s5` directory
placed in this directory will override pandoc's normal defaults. placed in this directory will override pandoc's normal defaults.
`--man1`
: Write `pandoc.1` man page to *stdout*.
`--man5`
: Write `pandoc_markdown.5` man page to *stdout*.
`--verbose` `--verbose`
: Give verbose debugging output. Currently this only has an effect : Give verbose debugging output. Currently this only has an effect

View file

@ -31,18 +31,7 @@ main :: IO ()
main = defaultMainWithHooks $ simpleUserHooks { main = defaultMainWithHooks $ simpleUserHooks {
-- enable hsb2hs preprocessor for .hsb files -- enable hsb2hs preprocessor for .hsb files
hookedPreProcessors = [ppBlobSuffixHandler] hookedPreProcessors = [ppBlobSuffixHandler]
-- ensure that make-pandoc-man-pages doesn't get installed to bindir
, copyHook = \pkgdescr ->
copyHook simpleUserHooks pkgdescr{ executables =
[x | x <- executables pkgdescr, exeName x `notElem` noInstall] }
, instHook = \pkgdescr ->
instHook simpleUserHooks pkgdescr{ executables =
[x | x <- executables pkgdescr, exeName x `notElem` noInstall] }
, postBuild = \args bf pkgdescr lbi ->
makeManPages args bf pkgdescr lbi
} }
where
noInstall = ["make-pandoc-man-pages"]
ppBlobSuffixHandler :: PPSuffixHandler ppBlobSuffixHandler :: PPSuffixHandler
ppBlobSuffixHandler = ("hsb", \_ _ -> ppBlobSuffixHandler = ("hsb", \_ _ ->
@ -56,10 +45,3 @@ ppBlobSuffixHandler = ("hsb", \_ _ ->
Nothing -> error "hsb2hs is needed to build this program: cabal install hsb2hs" Nothing -> error "hsb2hs is needed to build this program: cabal install hsb2hs"
return () return ()
}) })
makeManPages :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
makeManPages _ bf _ LocalBuildInfo{buildDir=buildDir}
= rawSystemExit verbosity progPath []
where
verbosity = fromFlagOrDefault normal $ buildVerbosity bf
progPath = buildDir </> "make-pandoc-man-pages" </> "make-pandoc-man-pages"

View file

@ -1,104 +0,0 @@
{-# LANGUAGE CPP #-}
-- Create pandoc.1 man and pandoc_markdown.5 man pages from README
import Text.Pandoc
import Text.Pandoc.Error (handleError)
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 Prelude hiding (catch)
import Control.Exception ( catch )
import System.IO.Error ( isDoesNotExistError )
#if MIN_VERSION_directory(1,2,0)
import Data.Time.Clock (UTCTime(..))
#else
import System.Time (ClockTime(..))
#endif
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) = normalize $ handleError $ 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 version = pandocVersion
let opts = def{ writerStandalone = True
, writerTemplate = templ
, writerVariables = [("version",version)] }
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 attr xs) = Header 1 attr $ 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) | x == ils =
dropWhile (not . isHeader1) xs
removeSect ils (x:xs) = x : removeSect ils xs
removeSect _ [] = []
extractSect :: [Inline] -> [Block] -> [Block]
extractSect ils (Header 1 _ z:xs) | z == ils =
bottomUp promoteHeader $ takeWhile (not . isHeader1) xs
where promoteHeader (Header n attr x) = Header (n-1) attr 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 MIN_VERSION_directory(1,2,0)
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

View file

@ -106,13 +106,12 @@ Data-Files:
data/sample.lua data/sample.lua
-- documentation -- documentation
README, COPYRIGHT README, COPYRIGHT
-- man page templates
data/pandoc.1.template
data/pandoc_markdown.5.template
Extra-Source-Files: Extra-Source-Files:
-- documentation -- documentation
INSTALL, BUGS, CONTRIBUTING.md, changelog INSTALL, BUGS, CONTRIBUTING.md, changelog
-- code to create pandoc.1 man page
Makefile
man/man1/pandoc.1.template
man/man5/pandoc_markdown.5.template
-- trypandoc -- trypandoc
trypandoc/Makefile trypandoc/Makefile
trypandoc/index.html trypandoc/index.html
@ -323,6 +322,7 @@ Library
Text.Pandoc.Readers.Native, Text.Pandoc.Readers.Native,
Text.Pandoc.Readers.Haddock, Text.Pandoc.Readers.Haddock,
Text.Pandoc.Readers.TWiki, Text.Pandoc.Readers.TWiki,
Text.Pandoc.Readers.Txt2Tags,
Text.Pandoc.Readers.Docx, Text.Pandoc.Readers.Docx,
Text.Pandoc.Readers.EPUB, Text.Pandoc.Readers.EPUB,
Text.Pandoc.Writers.Native, Text.Pandoc.Writers.Native,
@ -356,7 +356,7 @@ Library
Text.Pandoc.XML, Text.Pandoc.XML,
Text.Pandoc.SelfContained, Text.Pandoc.SelfContained,
Text.Pandoc.Process, Text.Pandoc.Process,
Text.Pandoc.Readers.Txt2Tags Text.Pandoc.ManPages
Other-Modules: Text.Pandoc.Readers.Docx.Lists, Other-Modules: Text.Pandoc.Readers.Docx.Lists,
Text.Pandoc.Readers.Docx.Reducible, Text.Pandoc.Readers.Docx.Reducible,
Text.Pandoc.Readers.Docx.Parse, Text.Pandoc.Readers.Docx.Parse,
@ -422,19 +422,6 @@ Executable trypandoc
else else
Buildable: False 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: pandoc,
base >= 4.2 && < 5,
directory >= 1 && < 1.3,
filepath >= 1.1 && < 1.5,
old-time >= 1.0 && < 1.2,
time >= 1.2 && < 1.6
Default-Language: Haskell98
Buildable: True
Test-Suite test-pandoc Test-Suite test-pandoc
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Main-Is: test-pandoc.hs Main-Is: test-pandoc.hs

View file

@ -39,6 +39,7 @@ import Text.Pandoc.Shared ( tabFilter, readDataFileUTF8, readDataFile,
safeRead, headerShift, normalize, err, warn, safeRead, headerShift, normalize, err, warn,
openURL ) openURL )
import Text.Pandoc.MediaBag ( mediaDirectory, extractMediaBag, MediaBag ) import Text.Pandoc.MediaBag ( mediaDirectory, extractMediaBag, MediaBag )
import Text.Pandoc.ManPages ( manPandoc1, manPandocMarkdown5 )
import Text.Pandoc.XML ( toEntities ) import Text.Pandoc.XML ( toEntities )
import Text.Pandoc.SelfContained ( makeSelfContained ) import Text.Pandoc.SelfContained ( makeSelfContained )
import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Process (pipeProcess)
@ -869,6 +870,20 @@ options =
(\opt -> return opt { optIgnoreArgs = True })) (\opt -> return opt { optIgnoreArgs = True }))
"" -- "Ignore command-line arguments." "" -- "Ignore command-line arguments."
, Option "" ["man1"]
(NoArg
(\_ -> do
manPandoc1 >>= UTF8.hPutStr stdout
exitWith ExitSuccess ))
"" -- "Print pandoc.1 man page"
, Option "" ["man5"]
(NoArg
(\_ -> do
manPandocMarkdown5 >>= UTF8.hPutStr stdout
exitWith ExitSuccess ))
"" -- "Print pandoc_markdown.5 man page"
, Option "" ["verbose"] , Option "" ["verbose"]
(NoArg (NoArg
(\opt -> return opt { optVerbose = True })) (\opt -> return opt { optVerbose = True }))

View file

@ -5,3 +5,6 @@ import qualified Data.ByteString as B
dataFiles :: [(FilePath, B.ByteString)] dataFiles :: [(FilePath, B.ByteString)]
dataFiles = %blobs "data" dataFiles = %blobs "data"
readmeFile :: B.ByteString
readmeFile = %blob "README"

101
src/Text/Pandoc/ManPages.hs Normal file
View file

@ -0,0 +1,101 @@
{-# LANGUAGE CPP #-}
{-
Copyright (C) 2013-2015 John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Text.Pandoc.ManPages
Copyright : Copyright (C) 2013-2015 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Functions to build pandoc's man pages (pandoc.1 and pandoc_markdown.5)
from pandoc's README.
-}
module Text.Pandoc.ManPages (
manPandoc1,
manPandocMarkdown5
) where
import Text.Pandoc
import Text.Pandoc.Error (handleError)
import Data.Char (toUpper)
import System.FilePath
import Text.Pandoc.Shared (normalize, readDataFileUTF8)
manPandoc1 :: IO String
manPandoc1 = do
readme <- readDataFileUTF8 Nothing "README"
let (Pandoc meta blocks) = normalize $ handleError
$ readMarkdown def readme
let manBlocks = removeSect [Str "Wrappers"]
$ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks
makeManPage "pandoc.1" meta manBlocks
manPandocMarkdown5 :: IO String
manPandocMarkdown5 = do
readme <- readDataFileUTF8 Nothing "README"
let (Pandoc meta blocks) = normalize $ handleError
$ readMarkdown def readme
let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks
makeManPage "pandoc_markdown.5" meta syntaxBlocks
makeManPage :: String -> Meta -> [Block] -> IO String
makeManPage page meta blocks = do
let templ = page <.> "template"
manTemplate <- readDataFileUTF8 Nothing templ
return $ writeManPage manTemplate (Pandoc meta blocks)
writeManPage :: String -> Pandoc -> String
writeManPage templ doc =
writeMan def{ writerStandalone = True
, writerTemplate = templ
, writerVariables = [("version", pandocVersion)] } $
bottomUp (concatMap removeLinks) $
bottomUp capitalizeHeaders doc
removeLinks :: Inline -> [Inline]
removeLinks (Link l _) = l
removeLinks x = [x]
capitalizeHeaders :: Block -> Block
capitalizeHeaders (Header 1 attr xs) = Header 1 attr $ 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) | x == ils =
dropWhile (not . isHeader1) xs
removeSect ils (x:xs) = x : removeSect ils xs
removeSect _ [] = []
extractSect :: [Inline] -> [Block] -> [Block]
extractSect ils (Header 1 _ z:xs) | z == ils =
bottomUp promoteHeader $ takeWhile (not . isHeader1) xs
where promoteHeader (Header n attr x) = Header (n-1) attr x
promoteHeader x = x
extractSect ils (_:xs) = extractSect ils xs
extractSect _ [] = []
isHeader1 :: Block -> Bool
isHeader1 (Header 1 _ _ ) = True
isHeader1 _ = False

View file

@ -132,7 +132,7 @@ import qualified Data.Text as T (toUpper, pack, unpack)
import Data.ByteString.Lazy (toChunks) import Data.ByteString.Lazy (toChunks)
#ifdef EMBED_DATA_FILES #ifdef EMBED_DATA_FILES
import Text.Pandoc.Data (dataFiles) import Text.Pandoc.Data (dataFiles, readmeFile)
#else #else
import Paths_pandoc (getDataFileName) import Paths_pandoc (getDataFileName)
#endif #endif
@ -743,6 +743,12 @@ inDirectory path action = E.bracket
(const $ setCurrentDirectory path >> action) (const $ setCurrentDirectory path >> action)
readDefaultDataFile :: FilePath -> IO BS.ByteString readDefaultDataFile :: FilePath -> IO BS.ByteString
readDefaultDataFile "README" =
#ifdef EMBED_DATA_FILES
return readmeFile
#else
getDataFileName "README" >>= checkExistence >>= BS.readFile
#endif
readDefaultDataFile fname = readDefaultDataFile fname =
#ifdef EMBED_DATA_FILES #ifdef EMBED_DATA_FILES
case lookup (makeCanonical fname) dataFiles of case lookup (makeCanonical fname) dataFiles of
@ -755,13 +761,15 @@ readDefaultDataFile fname =
go as x = x : as go as x = x : as
#else #else
getDataFileName ("data" </> fname) >>= checkExistence >>= BS.readFile getDataFileName ("data" </> fname) >>= checkExistence >>= BS.readFile
where checkExistence fn = do
exists <- doesFileExist fn
if exists
then return fn
else err 97 ("Could not find data file " ++ fname)
#endif #endif
checkExistence :: FilePath -> IO FilePath
checkExistence fn = do
exists <- doesFileExist fn
if exists
then return fn
else err 97 ("Could not find data file " ++ fn)
-- | Read file from specified user data directory or, if not found there, from -- | Read file from specified user data directory or, if not found there, from
-- Cabal data directory. -- Cabal data directory.
readDataFile :: Maybe FilePath -> FilePath -> IO BS.ByteString readDataFile :: Maybe FilePath -> FilePath -> IO BS.ByteString