forked from jgm/pandoc
/
MakeManPage.hs
99 lines (85 loc) · 3.55 KB
/
MakeManPage.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
{-# LANGUAGE ScopedTypeVariables #-}
-- 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)
import System.Directory (getModificationTime)
import System.IO.Error (isDoesNotExistError)
import System.Time (ClockTime(..))
import Data.Time.Clock
import Data.Default
import Data.Time.Clock.POSIX
import Data.Maybe (catMaybes)
import qualified Control.Exception as E
instance Default ClockTime where
def = (TOD 0 0)
instance Default UTCTime where
def = posixSecondsToUTCTime (0::NominalDiffTime)
main = do
rmContents <- liftM toString $ B.readFile "README"
let (Pandoc meta blocks) = readMarkdown defaultParserState 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"
modDeps <- modifiedDependencies page ["README", templ]
unless (null modDeps) $ do
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 = defaultWriterOptions{ writerStandalone = True
, writerTemplate = templ }
let manPage = writeMan opts $
bottomUp (concatMap removeLinks) $
bottomUp capitalizeHeaders doc
B.writeFile page $ fromString manPage
-- | Returns a list of 'dependencies' that have been modified after 'file'.
modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
modifiedDependencies file dependencies = do
fileModTime <- E.catch (getModificationTime file) $
\(e::E.IOException) -> if isDoesNotExistError e
then return def -- the minimum ClockTime
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
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