summaryrefslogtreecommitdiff
path: root/MakeManPage.hs
blob: ceaedd41249d4a50250be47967be99cc94b882cd (plain)
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
-- Create pandoc.1 man page 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

main = do
  rmContents <- liftM toString $ B.readFile "README"
  let (Pandoc meta blocks) = readMarkdown defaultParserState rmContents
  let newBlocks = removeWrapperSect blocks
  manTemplate <- liftM toString $ B.readFile "manpage.template"
  let opts = defaultWriterOptions{ writerStandalone = True
                                 , writerTemplate = manTemplate }
  let manPage = writeMan opts $
                bottomUp (concatMap removeLinks) $
                bottomUp  capitalizeHeaders $
                Pandoc meta newBlocks
  B.writeFile ("man" </> "man1" </> "pandoc.1") $ 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

removeWrapperSect :: [Block] -> [Block]
removeWrapperSect (Header 1 [Str "Wrappers"]:xs) =
  dropWhile notLevelOneHeader xs
    where notLevelOneHeader (Header 1 _) = False
          notLevelOneHeader _ = True
removeWrapperSect (x:xs) = x : removeWrapperSect xs
removeWrapperSect [] = []