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:
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
|
||||||
import Distribution.Simple.Setup
|
import Distribution.Simple.Setup
|
||||||
(copyDest, copyVerbosity, fromFlag, installVerbosity, BuildFlags(..))
|
(copyDest, copyVerbosity, fromFlag, installVerbosity, BuildFlags(..))
|
||||||
import Distribution.PackageDescription
|
import Distribution.PackageDescription (PackageDescription(..), Executable(..))
|
||||||
(PackageDescription(..), Executable(..), BuildInfo(..))
|
|
||||||
import Distribution.Simple.LocalBuildInfo
|
import Distribution.Simple.LocalBuildInfo
|
||||||
(LocalBuildInfo(..), absoluteInstallDirs)
|
(LocalBuildInfo(..), absoluteInstallDirs)
|
||||||
import Distribution.Verbosity ( Verbosity, silent )
|
import Distribution.Verbosity ( Verbosity, silent )
|
||||||
import Distribution.Simple.GHC (ghcPackageDbOptions)
|
import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest))
|
||||||
import Distribution.Simple.InstallDirs (mandir, bindir, CopyDest (NoCopyDest))
|
|
||||||
import Distribution.Simple.Utils (installOrdinaryFiles)
|
import Distribution.Simple.Utils (installOrdinaryFiles)
|
||||||
import Prelude hiding (catch)
|
import Prelude hiding (catch)
|
||||||
import Control.Exception ( bracket_, catch )
|
import System.Process ( rawSystem )
|
||||||
import Control.Monad ( unless )
|
|
||||||
import System.Process ( rawSystem, runCommand, waitForProcess )
|
|
||||||
import System.FilePath ( (</>) )
|
import System.FilePath ( (</>) )
|
||||||
import System.Directory
|
|
||||||
import System.Exit
|
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -33,39 +23,22 @@ main = do
|
||||||
(fromFlag $ copyDest flags)
|
(fromFlag $ copyDest flags)
|
||||||
, postInst = \ _ flags pkg lbi ->
|
, postInst = \ _ flags pkg lbi ->
|
||||||
installManpages pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest
|
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
|
exitWith ExitSuccess
|
||||||
|
|
||||||
-- | Build man pages from markdown sources in man/
|
-- | Build man pages from markdown sources in man/
|
||||||
makeManPages :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
|
makeManPages :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
|
||||||
makeManPages _ flags _ lbi = do
|
makeManPages _ flags _ _ = do
|
||||||
ds1 <- modifiedDependencies (manDir </> "man1" </> "pandoc.1")
|
let verbosity = fromFlag $ buildVerbosity flags
|
||||||
["README", manDir </> "man1" </> "pandoc.1.template"]
|
let args = ["--verbose" | verbosity /= silent]
|
||||||
ds2 <- modifiedDependencies (manDir </> "man5" </> "pandoc_markdown.5")
|
rawSystem ("dist" </> "build" </> "make-pandoc-man-pages" </> "make-pandoc-man-pages")
|
||||||
["README", manDir </> "man5" </> "pandoc_markdown.5.template"]
|
args >>= exitWith
|
||||||
|
|
||||||
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="++)
|
|
||||||
|
|
||||||
manpages :: [FilePath]
|
manpages :: [FilePath]
|
||||||
manpages = ["man1" </> "pandoc.1"
|
manpages = ["man1" </> "pandoc.1"
|
||||||
|
@ -80,18 +53,3 @@ installManpages pkg lbi verbosity copy =
|
||||||
installOrdinaryFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy))
|
installOrdinaryFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy))
|
||||||
(zip (repeat manDir) manpages)
|
(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
|
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: 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
|
Test-Suite test-pandoc
|
||||||
Type: exitcode-stdio-1.0
|
Type: exitcode-stdio-1.0
|
||||||
Main-Is: test-pandoc.hs
|
Main-Is: test-pandoc.hs
|
||||||
|
|
|
@ -1,8 +1,7 @@
|
||||||
@echo off
|
@echo off
|
||||||
cd ..
|
cd ..
|
||||||
ghc --make MakeManPage
|
|
||||||
MakeManPage.exe
|
|
||||||
cabal update
|
cabal update
|
||||||
|
cabal-dev clean
|
||||||
cabal-dev install --disable-library-for-ghci highlighting-kate
|
cabal-dev install --disable-library-for-ghci highlighting-kate
|
||||||
cabal-dev install --flags="embed_data_files" citeproc-hs
|
cabal-dev install --flags="embed_data_files" citeproc-hs
|
||||||
cabal-dev install --flags="executable -library blaze_html_0_5" --datasubdir=
|
cabal-dev install --flags="executable -library blaze_html_0_5" --datasubdir=
|
||||||
|
|
Loading…
Reference in a new issue