git.iko.soy/typeable/pandoc
on 1.8 help sign in
typeable/pandoc/MakeManPage.hs
97 lines 3.9 kB history raw
1-- Create pandoc.1 man page from README
2import Text.Pandoc
3import Data.ByteString.UTF8 (toString, fromString)
4import Data.Char (toUpper)
5import qualified Data.ByteString as B
6import Control.Monad
7import System.FilePath
8import System.Environment (getArgs)
9import Text.Pandoc.Shared (normalize)
10import System.Directory (getModificationTime)
11import System.IO.Error (isDoesNotExistError)
12import System.Time (ClockTime(..))
13import Data.Maybe (catMaybes)
15main = do
16 rmContents <- liftM toString $ B.readFile "README"
17 let (Pandoc meta blocks) = readMarkdown defaultParserState rmContents
18 let manBlocks = removeSect [Str "Wrappers"]
19 $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks
20 let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks
21 args <- getArgs
22 let verbose = "--verbose" `elem` args
23 makeManPage verbose ("man" </> "man1" </> "pandoc.1")
24 meta manBlocks
25 makeManPage verbose ("man" </> "man5" </> "pandoc_markdown.5")
26 meta syntaxBlocks
27 let markdown2pdfpage = "man" </> "man1" </> "markdown2pdf.1"
28 modDeps <- modifiedDependencies markdown2pdfpage [markdown2pdfpage <.> "md"]
29 unless (null modDeps) $ do
30 mpdfContents <- liftM toString $ B.readFile $ markdown2pdfpage <.> "md"
31 templ <- liftM toString $ B.readFile $ "templates" </> "man.template"
32 let doc = readMarkdown defaultParserState{ stateStandalone = True }
33 mpdfContents
34 writeManPage markdown2pdfpage templ doc
35 when verbose $
36 putStrLn $ "Created " ++ markdown2pdfpage
38makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO ()
39makeManPage verbose page meta blocks = do
40 let templ = page <.> "template"
41 modDeps <- modifiedDependencies page ["README", templ]
42 unless (null modDeps) $ do
43 manTemplate <- liftM toString $ B.readFile templ
44 writeManPage page manTemplate (Pandoc meta blocks)
45 when verbose $
46 putStrLn $ "Created " ++ page
48writeManPage :: FilePath -> String -> Pandoc -> IO ()
49writeManPage page templ doc = do
50 let opts = defaultWriterOptions{ writerStandalone = True
51 , writerTemplate = templ }
52 let manPage = writeMan opts $
53 bottomUp (concatMap removeLinks) $
54 bottomUp capitalizeHeaders doc
55 B.writeFile page $ fromString manPage
57-- | Returns a list of 'dependencies' that have been modified after 'file'.
58modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
59modifiedDependencies file dependencies = do
60 fileModTime <- catch (getModificationTime file) $
61 \e -> if isDoesNotExistError e
62 then return (TOD 0 0) -- the minimum ClockTime
63 else ioError e
64 depModTimes <- mapM getModificationTime dependencies
65 let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes
66 return $ catMaybes modified
68removeLinks :: Inline -> [Inline]
69removeLinks (Link l _) = l
70removeLinks x = [x]
72capitalizeHeaders :: Block -> Block
73capitalizeHeaders (Header 1 xs) = Header 1 $ bottomUp capitalize xs
74capitalizeHeaders x = x
76capitalize :: Inline -> Inline
77capitalize (Str xs) = Str $ map toUpper xs
78capitalize x = x
80removeSect :: [Inline] -> [Block] -> [Block]
81removeSect ils (Header 1 x:xs) | normalize x == normalize ils =
82 dropWhile (not . isHeader1) xs
83removeSect ils (x:xs) = x : removeSect ils xs
84removeSect _ [] = []
86extractSect :: [Inline] -> [Block] -> [Block]
87extractSect ils (Header 1 z:xs) | normalize z == normalize ils =
88 bottomUp promoteHeader $ takeWhile (not . isHeader1) xs
89 where promoteHeader (Header n x) = Header (n-1) x
90 promoteHeader x = x
91extractSect ils (x:xs) = extractSect ils xs
92extractSect _ [] = []
94isHeader1 :: Block -> Bool
95isHeader1 (Header 1 _) = True
96isHeader1 _ = False