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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
-- | This script generates a man page for patat.
{-# LANGUAGE OverloadedStrings #-}
import Control.Exception (throw)
import Control.Monad (guard)
import Control.Monad.Trans (liftIO)
import Data.Char (isSpace, toLower)
import Data.List (isPrefixOf)
import qualified Data.Map as M
import Data.Maybe (isJust)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Time as Time
import qualified GHC.IO.Encoding as Encoding
import Prelude
import System.Environment (getEnv)
import qualified System.IO as IO
import Text.DocTemplates as DT
import qualified Text.Pandoc as Pandoc
getVersion :: IO String
getVersion =
dropWhile isSpace . drop 1 . dropWhile (/= ':') . head .
filter (\l -> "version:" `isPrefixOf` map toLower l) .
map (dropWhile isSpace) . lines <$> readFile "patat.cabal"
getPrettySourceDate :: IO String
getPrettySourceDate = do
epoch <- getEnv "SOURCE_DATE_EPOCH"
utc <- Time.parseTimeM True locale "%s" epoch :: IO Time.UTCTime
return $ Time.formatTime locale "%B %d, %Y" utc
where
locale = Time.defaultTimeLocale
type Sections = [(Int, T.Text, [Pandoc.Block])]
toSections :: Int -> [Pandoc.Block] -> Sections
toSections level = go
where
go [] = []
go (h : xs) = case toSectionHeader h of
Nothing -> go xs
Just (l, title) ->
let (section, cont) = break (isJust . toSectionHeader) xs in
(l, title, section) : go cont
toSectionHeader :: Pandoc.Block -> Maybe (Int, T.Text)
toSectionHeader (Pandoc.Header l _ inlines) = do
guard (l <= level)
let doc = Pandoc.Pandoc Pandoc.nullMeta [Pandoc.Plain inlines]
txt = case Pandoc.runPure (Pandoc.writeMarkdown Pandoc.def doc) of
Left err -> throw err -- Bad!
Right x -> T.strip x
return (l, txt)
toSectionHeader _ = Nothing
fromSections :: Sections -> [Pandoc.Block]
fromSections = concatMap $ \(level, title, blocks) ->
Pandoc.Header level ("", [], []) [Pandoc.Str title] : blocks
reorganizeSections :: Pandoc.Pandoc -> Pandoc.Pandoc
reorganizeSections (Pandoc.Pandoc meta0 blocks0) =
let sections0 = toSections 2 blocks0 in
Pandoc.Pandoc meta0 $ fromSections $
[ (1, "NAME", nameSection)
] ++
[ (1, "SYNOPSIS", s)
| (_, _, s) <- lookupSection "Running" sections0
] ++
[ (1, "DESCRIPTION", [])
] ++
[ (2, n, s)
| (_, n, s) <- lookupSection "Controls" sections0
] ++
[ (2, n, s)
| (_, n, s) <- lookupSection "Input format" sections0
] ++
[ (2, n, s)
| (_, n, s) <- lookupSection "Configuration" sections0
] ++
[ (1, "OPTIONS", s)
| (_, _, s) <- lookupSection "Options" sections0
] ++
[ (1, "SEE ALSO", seeAlsoSection)
]
where
nameSection = mkPara "patat - Presentations Atop The ANSI Terminal"
seeAlsoSection = mkPara "pandoc(1)"
mkPara str = [Pandoc.Para [Pandoc.Str str]]
lookupSection name sections =
[section | section@(_, n, _) <- sections, name == n]
simpleContext :: [(T.Text, T.Text)] -> DT.Context T.Text
simpleContext = DT.toContext . M.fromList
main :: IO ()
main = Pandoc.runIOorExplode $ do
liftIO $ Encoding.setLocaleEncoding Encoding.utf8
let readerOptions = Pandoc.def
{ Pandoc.readerExtensions = Pandoc.pandocExtensions
}
source <- liftIO $ T.readFile "README.md"
pandoc0 <- Pandoc.readMarkdown readerOptions source
template <- Pandoc.compileDefaultTemplate "man"
version <- T.pack <$> liftIO getVersion
date <- T.pack <$> liftIO getPrettySourceDate
let writerOptions = Pandoc.def
{ Pandoc.writerTemplate = Just template
, Pandoc.writerVariables = simpleContext
[ ("author", "Jasper Van der Jeugt")
, ("title", "patat manual")
, ("date", date)
, ("footer", "patat v" <> version)
, ("section", "1")
]
}
let pandoc1 = reorganizeSections $ pandoc0
txt <- Pandoc.writeMan writerOptions pandoc1
liftIO $ do
T.putStr txt
IO.hPutStrLn IO.stderr "Wrote man page."
|
