Moved man page creation out of Setup.hs.
* MakeManPage.hs has been transformed into man/make-pandoc-man-pages.hs. * There is now a cabal stanza for this, so the dependencies are handled by cabal. * Special treatment in Setup.hs ensures that this never gets installed; it is built and used to create the man pages. * Setup.hs cleaned up.
This commit is contained in:
John MacFarlane
parent
6f9151c64e
commit
b3ad94bde9
5 changed files with 126 additions and 127 deletions
|
|
@ -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
|
||||
|
||||
70
Setup.hs
70
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
|
||||
|
||||
|
|
|
|||
98
man/make-pandoc-man-pages.hs
Normal file
98
man/make-pandoc-man-pages.hs
Normal file
|
|
@ -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
|
||||
|
||||
13
pandoc.cabal
13
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
|
||||
|
|
|
|||
|
|
@ -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=
|
||||
|
|
|
|||
Loading…
Reference in a new issue