git.iko.soy/typeable/pandoc
on master help sign in
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.

commitb3ad94bde9e2d21a7b3823412197976b5454fdbd authorJohn MacFarlane <fiddlosopher@gmail.com> dateMon 15 Oct 2012, 21:26 (14 years ago) parent6f9151c
5 files changed+126−127
compare with master
unifiedsplit
MakeManPage.hs−69 Setup.hs+14−56 man/make-pandoc-man-pages.hs+98 pandoc.cabal+13 windows/make-windows-installer.bat+1−2
MakeManPage.hsdeleted−69
@@ -1,69 +0,0 @@
1−-- Create pandoc.1 man and pandoc_markdown.5 man pages from README
2−import Text.Pandoc
3−import Data.ByteString.UTF8 (toString, fromString)
4−import Data.Char (toUpper)
5−import qualified Data.ByteString as B
6−import Control.Monad
7−import System.FilePath
8−import System.Environment (getArgs)
9−import Text.Pandoc.Shared (normalize)
10−
11−main = do
12− rmContents <- liftM toString $ B.readFile "README"
13− let (Pandoc meta blocks) = readMarkdown def rmContents
14− let manBlocks = removeSect [Str "Wrappers"]
15− $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks
16− let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks
17− args <- getArgs
18− let verbose = "--verbose" `elem` args
19− makeManPage verbose ("man" </> "man1" </> "pandoc.1")
20− meta manBlocks
21− makeManPage verbose ("man" </> "man5" </> "pandoc_markdown.5")
22− meta syntaxBlocks
23−
24−makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO ()
25−makeManPage verbose page meta blocks = do
26− let templ = page <.> "template"
27− manTemplate <- liftM toString $ B.readFile templ
28− writeManPage page manTemplate (Pandoc meta blocks)
29− when verbose $ putStrLn $ "Created " ++ page
30−
31−writeManPage :: FilePath -> String -> Pandoc -> IO ()
32−writeManPage page templ doc = do
33− let opts = def{ writerStandalone = True
34− , writerTemplate = templ }
35− let manPage = writeMan opts $
36− bottomUp (concatMap removeLinks) $
37− bottomUp capitalizeHeaders doc
38− B.writeFile page $ fromString manPage
39−
40−removeLinks :: Inline -> [Inline]
41−removeLinks (Link l _) = l
42−removeLinks x = [x]
43−
44−capitalizeHeaders :: Block -> Block
45−capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs
46−capitalizeHeaders x = x
47−
48−capitalize :: Inline -> Inline
49−capitalize (Str xs) = Str $ map toUpper xs
50−capitalize x = x
51−
52−removeSect :: [Inline] -> [Block] -> [Block]
53−removeSect ils (Header 1 x:xs) | normalize x == normalize ils =
54− dropWhile (not . isHeader1) xs
55−removeSect ils (x:xs) = x : removeSect ils xs
56−removeSect _ [] = []
57−
58−extractSect :: [Inline] -> [Block] -> [Block]
59−extractSect ils (Header 1 z:xs) | normalize z == normalize ils =
60− bottomUp promoteHeader $ takeWhile (not . isHeader1) xs
61− where promoteHeader (Header n x) = Header (n-1) x
62− promoteHeader x = x
63−extractSect ils (x:xs) = extractSect ils xs
64−extractSect _ [] = []
65−
66−isHeader1 :: Block -> Bool
67−isHeader1 (Header 1 _) = True
68−isHeader1 _ = False
69−
Setup.hs+14−56
@@ -3,26 +3,16 @@
33import Distribution.Simple
44import Distribution.Simple.Setup
55 (copyDest, copyVerbosity, fromFlag, installVerbosity, BuildFlags(..))
6−import Distribution.PackageDescription
7− (PackageDescription(..), Executable(..), BuildInfo(..))
6+import Distribution.PackageDescription (PackageDescription(..), Executable(..))
87import Distribution.Simple.LocalBuildInfo
98 (LocalBuildInfo(..), absoluteInstallDirs)
109import Distribution.Verbosity ( Verbosity, silent )
11−import Distribution.Simple.GHC (ghcPackageDbOptions)
12−import Distribution.Simple.InstallDirs (mandir, bindir, CopyDest (NoCopyDest))
10+import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest))
1311import Distribution.Simple.Utils (installOrdinaryFiles)
1412import Prelude hiding (catch)
15−import Control.Exception ( bracket_, catch )
16−import Control.Monad ( unless )
17−import System.Process ( rawSystem, runCommand, waitForProcess )
13+import System.Process ( rawSystem )
1814import System.FilePath ( (</>) )
19−import System.Directory
2015import System.Exit
21−import System.Time
22−import System.IO.Error ( isDoesNotExistError )
23−import Data.Maybe ( catMaybes )
24−import Data.List ( (\\) )
25−import Data.Time.Clock (UTCTime(..))
2616
2717main :: IO ()
2818main = do
@@ -33,39 +23,22 @@ main = do
3323 (fromFlag $ copyDest flags)
3424 , postInst = \ _ flags pkg lbi ->
3525 installManpages pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest
26+ , copyHook = \pkgdescr ->
27+ (copyHook simpleUserHooks) pkgdescr{ executables =
28+ [x | x <- executables pkgdescr, exeName x /= "make-pandoc-man-pages"] }
29+ , instHook = \pkgdescr ->
30+ (instHook simpleUserHooks) pkgdescr{ executables =
31+ [x | x <- executables pkgdescr, exeName x /= "make-pandoc-man-pages"] }
3632 }
3733 exitWith ExitSuccess
3834
3935-- | Build man pages from markdown sources in man/
4036makeManPages :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
41−makeManPages _ flags _ lbi = do
42− ds1 <- modifiedDependencies (manDir </> "man1" </> "pandoc.1")
43− ["README", manDir </> "man1" </> "pandoc.1.template"]
44− ds2 <- modifiedDependencies (manDir </> "man5" </> "pandoc_markdown.5")
45− ["README", manDir </> "man5" </> "pandoc_markdown.5.template"]
46−
47− let distPref = fromFlag (buildDistPref flags)
48− packageDB =
49− withPackageDB lbi
50− ++ [SpecificPackageDB $ distPref </> "package.conf.inplace"]
51−
52− verbosity = fromFlag $ buildVerbosity flags
53−
54− args = makeGhcArgs (ghcPackageDbOptions packageDB)
55− ++ ["MakeManPage.hs"]
56− args' = if verbosity == silent
57− then args
58− else args ++ ["--verbose"]
59− -- Don't run MakeManPage.hs unless we have to
60− unless (null ds1 && null ds2) $ do
61− rawSystem "runghc" args' >>= exitWith
62−
63−-- format arguments to runghc that we wish to pass to ghc
64−-- normally runghc gets it right, unless the argument does
65−-- not begin with a '-' charecter, so we need to give clear
66−-- directions.
67−makeGhcArgs :: [String] -> [String]
68−makeGhcArgs = map ("--ghc-arg="++)
37+makeManPages _ flags _ _ = do
38+ let verbosity = fromFlag $ buildVerbosity flags
39+ let args = ["--verbose" | verbosity /= silent]
40+ rawSystem ("dist" </> "build" </> "make-pandoc-man-pages" </> "make-pandoc-man-pages")
41+ args >>= exitWith
6942
7043manpages :: [FilePath]
7144manpages = ["man1" </> "pandoc.1"
@@ -80,18 +53,3 @@ installManpages pkg lbi verbosity copy =
8053 installOrdinaryFiles verbosity (mandir (absoluteInstallDirs pkg lbi copy))
8154 (zip (repeat manDir) manpages)
8255
83−-- | Returns a list of 'dependencies' that have been modified after 'file'.
84−modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
85−modifiedDependencies file dependencies = do
86− fileModTime <- catch (getModificationTime file) $
87− \e -> if isDoesNotExistError e
88−#if __GLASGOW_HASKELL__ >= 706
89− then return (UTCTime (toEnum 0) 0) -- the minimum ClockTime
90−#else
91− then return (TOD 0 0) -- the minimum ClockTime
92−#endif
93− else ioError e
94− depModTimes <- mapM getModificationTime dependencies
95− let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes
96− return $ catMaybes modified
97−
man/make-pandoc-man-pages.hsnew file+98
@@ -0,0 +1,98 @@
1+-- Create pandoc.1 man and pandoc_markdown.5 man pages from README
2+import Text.Pandoc
3+import qualified Text.Pandoc.UTF8 as UTF8
4+import Data.Char (toUpper)
5+import Control.Monad
6+import System.FilePath
7+import System.Environment (getArgs)
8+import Text.Pandoc.Shared (normalize)
9+import Data.Maybe ( catMaybes )
10+import Data.Time.Clock (UTCTime(..))
11+import Prelude hiding (catch)
12+import Control.Exception ( catch )
13+import System.IO.Error ( isDoesNotExistError )
14+import System.Time (ClockTime(..))
15+import System.Directory
16+
17+main :: IO ()
18+main = do
19+ ds1 <- modifiedDependencies ("man" </> "man1" </> "pandoc.1")
20+ ["README", "man" </> "man1" </> "pandoc.1.template"]
21+ ds2 <- modifiedDependencies ("man" </> "man5" </> "pandoc_markdown.5")
22+ ["README", "man" </> "man5" </> "pandoc_markdown.5.template"]
23+
24+ unless (null ds1 && null ds2) $ do
25+ rmContents <- UTF8.readFile "README"
26+ let (Pandoc meta blocks) = readMarkdown def rmContents
27+ let manBlocks = removeSect [Str "Wrappers"]
28+ $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks
29+ let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks
30+ args <- getArgs
31+ let verbose = "--verbose" `elem` args
32+ unless (null ds1) $
33+ makeManPage verbose ("man" </> "man1" </> "pandoc.1") meta manBlocks
34+ unless (null ds2) $
35+ makeManPage verbose ("man" </> "man5" </> "pandoc_markdown.5") meta syntaxBlocks
36+
37+makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO ()
38+makeManPage verbose page meta blocks = do
39+ let templ = page <.> "template"
40+ manTemplate <- UTF8.readFile templ
41+ writeManPage page manTemplate (Pandoc meta blocks)
42+ when verbose $ putStrLn $ "Created " ++ page
43+
44+writeManPage :: FilePath -> String -> Pandoc -> IO ()
45+writeManPage page templ doc = do
46+ let opts = def{ writerStandalone = True
47+ , writerTemplate = templ }
48+ let manPage = writeMan opts $
49+ bottomUp (concatMap removeLinks) $
50+ bottomUp capitalizeHeaders doc
51+ UTF8.writeFile page manPage
52+
53+removeLinks :: Inline -> [Inline]
54+removeLinks (Link l _) = l
55+removeLinks x = [x]
56+
57+capitalizeHeaders :: Block -> Block
58+capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs
59+capitalizeHeaders x = x
60+
61+capitalize :: Inline -> Inline
62+capitalize (Str xs) = Str $ map toUpper xs
63+capitalize x = x
64+
65+removeSect :: [Inline] -> [Block] -> [Block]
66+removeSect ils (Header 1 x:xs) | normalize x == normalize ils =
67+ dropWhile (not . isHeader1) xs
68+removeSect ils (x:xs) = x : removeSect ils xs
69+removeSect _ [] = []
70+
71+extractSect :: [Inline] -> [Block] -> [Block]
72+extractSect ils (Header 1 z:xs) | normalize z == normalize ils =
73+ bottomUp promoteHeader $ takeWhile (not . isHeader1) xs
74+ where promoteHeader (Header n x) = Header (n-1) x
75+ promoteHeader x = x
76+extractSect ils (x:xs) = extractSect ils xs
77+extractSect _ [] = []
78+
79+isHeader1 :: Block -> Bool
80+isHeader1 (Header 1 _) = True
81+isHeader1 _ = False
82+
83+
84+-- | Returns a list of 'dependencies' that have been modified after 'file'.
85+modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
86+modifiedDependencies file dependencies = do
87+ fileModTime <- catch (getModificationTime file) $
88+ \e -> if isDoesNotExistError e
89+#if __GLASGOW_HASKELL__ >= 706
90+ then return (UTCTime (toEnum 0) 0) -- the minimum ClockTime
91+#else
92+ then return (TOD 0 0) -- the minimum ClockTime
93+#endif
94+ else ioError e
95+ depModTimes <- mapM getModificationTime dependencies
96+ let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes
97+ return $ catMaybes modified
98+
pandoc.cabal+13
@@ -370,6 +370,19 @@ Executable pandoc
370370 else
371371 Buildable: False
372372
373+-- NOTE: A trick in Setup.hs makes sure this won't be installed:
374+Executable make-pandoc-man-pages
375+ Main-Is: make-pandoc-man-pages.hs
376+ Hs-Source-Dirs: man
377+ Build-Depends: base >= 4.2 && < 5,
378+ pandoc,
379+ directory >= 1 && < 1.3,
380+ filepath >= 1.1 && < 1.4,
381+ old-time >= 1.1 && < 1.2,
382+ time >= 1.2 && < 1.5
383+ Default-Language: Haskell98
384+ Default-Extensions: CPP
385+
373386Test-Suite test-pandoc
374387 Type: exitcode-stdio-1.0
375388 Main-Is: test-pandoc.hs
windows/make-windows-installer.bat+1−2
@@ -1,8 +1,7 @@
11@echo off
22cd ..
3−ghc --make MakeManPage
4−MakeManPage.exe
53cabal update
4+cabal-dev clean
65cabal-dev install --disable-library-for-ghci highlighting-kate
76cabal-dev install --flags="embed_data_files" citeproc-hs
87cabal-dev install --flags="executable -library blaze_html_0_5" --datasubdir=