git.iko.soy/typeable/pandoc
on 1.14.0.3 help sign in
typeable/pandoc/man/make-pandoc-man-pages.hs
104 lines 3.9 kB history raw
1{-# LANGUAGE CPP #-}
2-- Create pandoc.1 man and pandoc_markdown.5 man pages from README
3import Text.Pandoc
4import Text.Pandoc.Error (handleError)
5import qualified Text.Pandoc.UTF8 as UTF8
6import Data.Char (toUpper)
7import Control.Monad
8import System.FilePath
9import System.Environment (getArgs)
10import Text.Pandoc.Shared (normalize)
11import Data.Maybe ( catMaybes )
12import Prelude hiding (catch)
13import Control.Exception ( catch )
14import System.IO.Error ( isDoesNotExistError )
15#if MIN_VERSION_directory(1,2,0)
16import Data.Time.Clock (UTCTime(..))
17#else
18import System.Time (ClockTime(..))
19#endif
20import System.Directory
22main :: IO ()
23main = do
24 ds1 <- modifiedDependencies ("man" </> "man1" </> "pandoc.1")
25 ["README", "man" </> "man1" </> "pandoc.1.template"]
26 ds2 <- modifiedDependencies ("man" </> "man5" </> "pandoc_markdown.5")
27 ["README", "man" </> "man5" </> "pandoc_markdown.5.template"]
29 unless (null ds1 && null ds2) $ do
30 rmContents <- UTF8.readFile "README"
31 let (Pandoc meta blocks) = normalize $ handleError $ readMarkdown def rmContents
32 let manBlocks = removeSect [Str "Wrappers"]
33 $ removeSect [Str "Pandoc's",Space,Str "markdown"] blocks
34 let syntaxBlocks = extractSect [Str "Pandoc's",Space,Str "markdown"] blocks
35 args <- getArgs
36 let verbose = "--verbose" `elem` args
37 unless (null ds1) $
38 makeManPage verbose ("man" </> "man1" </> "pandoc.1") meta manBlocks
39 unless (null ds2) $
40 makeManPage verbose ("man" </> "man5" </> "pandoc_markdown.5") meta syntaxBlocks
42makeManPage :: Bool -> FilePath -> Meta -> [Block] -> IO ()
43makeManPage verbose page meta blocks = do
44 let templ = page <.> "template"
45 manTemplate <- UTF8.readFile templ
46 writeManPage page manTemplate (Pandoc meta blocks)
47 when verbose $ putStrLn $ "Created " ++ page
49writeManPage :: FilePath -> String -> Pandoc -> IO ()
50writeManPage page templ doc = do
51 let version = pandocVersion
52 let opts = def{ writerStandalone = True
53 , writerTemplate = templ
54 , writerVariables = [("version",version)] }
55 let manPage = writeMan opts $
56 bottomUp (concatMap removeLinks) $
57 bottomUp capitalizeHeaders doc
58 UTF8.writeFile page manPage
60removeLinks :: Inline -> [Inline]
61removeLinks (Link l _) = l
62removeLinks x = [x]
64capitalizeHeaders :: Block -> Block
65capitalizeHeaders (Header 1 attr xs) = Header 1 attr $ bottomUp capitalize xs
66capitalizeHeaders x = x
68capitalize :: Inline -> Inline
69capitalize (Str xs) = Str $ map toUpper xs
70capitalize x = x
72removeSect :: [Inline] -> [Block] -> [Block]
73removeSect ils (Header 1 _ x:xs) | x == ils =
74 dropWhile (not . isHeader1) xs
75removeSect ils (x:xs) = x : removeSect ils xs
76removeSect _ [] = []
78extractSect :: [Inline] -> [Block] -> [Block]
79extractSect ils (Header 1 _ z:xs) | z == ils =
80 bottomUp promoteHeader $ takeWhile (not . isHeader1) xs
81 where promoteHeader (Header n attr x) = Header (n-1) attr x
82 promoteHeader x = x
83extractSect ils (x:xs) = extractSect ils xs
84extractSect _ [] = []
86isHeader1 :: Block -> Bool
87isHeader1 (Header 1 _ _ ) = True
88isHeader1 _ = False
91-- | Returns a list of 'dependencies' that have been modified after 'file'.
92modifiedDependencies :: FilePath -> [FilePath] -> IO [FilePath]
93modifiedDependencies file dependencies = do
94 fileModTime <- catch (getModificationTime file) $
95 \e -> if isDoesNotExistError e
96#if MIN_VERSION_directory(1,2,0)
97 then return (UTCTime (toEnum 0) 0) -- the minimum ClockTime
98#else
99 then return (TOD 0 0) -- the minimum ClockTime
100#endif
101 else ioError e
102 depModTimes <- mapM getModificationTime dependencies
103 let modified = zipWith (\dep time -> if time > fileModTime then Just dep else Nothing) dependencies depModTimes
104 return $ catMaybes modified