Simple manpage viewer for unix.lgbt https://unix.lgbt/~rachel/man/
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

185 lines
4.8 KiB

module Main where
import Data.Char (isDigit)
import Data.Functor.Identity (Identity)
import Data.String.Utils
import GHC.OldList (intercalate)
import Shelly (cp_r, shelly)
import System.Directory (canonicalizePath, createDirectory, listDirectory, removePathForcibly)
import System.FilePath.Posix
import Text.Parsec.Prim (ParsecT, Stream)
import Text.ParserCombinators.Parsec
data ManGroup = Header String | Title String | Paragraph [InlineBlock] | List [InlineBlock]
deriving (Show)
data InlineBlock = Text String | Code String | Link String Int
deriving (Show)
manpage :: Parser [ManGroup]
manpage = do
groups <- many (wss manGroup)
eof
return groups
manGroup = try header <|> try title <|> try list <|> Paragraph <$> paragraph
genericBigText :: Char -> Parser String
genericBigText d = do
text <- many1Till anyChar (char '\n')
count (length text) (char d)
return text
header = Header <$> genericBigText '-'
title =
Title
<$> ( do
text <- lookAhead $ many1Till anyChar (char '\n')
name <- many1 letter
char ' '
version <- many1 digit
many1Till anyChar (char '\n')
count (length text - 5) (char '=')
manyTill (char '=') (char '\n')
return $ name ++ "(" ++ version ++ ")"
)
paragraph =
many1Till
(code <|> try link <|> text)
( try (string "\n\n" >> return "")
<|> try (eof >> return "")
<|> try (lookAhead list >> return "")
)
text = do
text <-
many1Till
anyChar
( try (lookAhead (string "\n\n") >> return "")
<|> try
( lookAhead
( do
char '\n'
list
)
>> return ""
)
<|> try (lookAhead code >> return "")
<|> try (lookAhead link >> return "")
<|> (eof >> return "")
)
return $ Text (replace "\n" " " text)
code = do
try (char '`')
text <- many1Till (noneOf "\n") (try (char '`' >> return "") <|> (lookAhead (char '\n') >> return ""))
return $ Code text
inlineBlock = try code <|> try link <|> text
link = do
text <- many1Till letter (char '(')
number <- many1 digit
char ')'
return $ Link text (read number)
list = do
ws
char '-'
ws
item <- List <$> many1Till inlineBlock (char '\n')
optional (char '\n')
return item
many1Till ::
(Stream s m t, Show end) =>
ParsecT s u m a ->
ParsecT s u m end ->
ParsecT s u m [a]
many1Till a b = do
notFollowedBy b
x <- a
xs <- manyTill a b
return (x : xs)
wss x = ws *> x <* ws
ws :: Parser String
ws = many (oneOf "\n\t \r")
generateHTML :: [ManGroup] -> String
generateHTML = concatMap generateHTMLGroup
generateHTMLGroup :: ManGroup -> String
generateHTMLGroup (Title text) = "<h1>" ++ text ++ "</h1>"
generateHTMLGroup (Header text) = "<h2>" ++ text ++ "</h2>"
generateHTMLGroup (Paragraph blocks) = "<p>" ++ concatMap generateHTMLBlock blocks ++ "</p>"
generateHTMLGroup (List contents) = "<li>" ++ concatMap generateHTMLBlock contents ++ "</li>"
generateHTMLBlock :: InlineBlock -> String
generateHTMLBlock (Text text) = text
generateHTMLBlock (Code text) = "<code>" ++ text ++ "</code>"
generateHTMLBlock (Link text number) =
"<a href=\""
++ text
++ "."
++ show number
++ ".html\">"
++ text
++ "("
++ show number
++ ")</a>"
fromRight' :: Show a => Either a b -> b
fromRight' (Left l) = error ("Data.Either.Combinators.fromRight: " ++ show l)
fromRight' (Right x) = x
getAbsDirectoryContents :: FilePath -> IO [FilePath]
getAbsDirectoryContents dir =
listDirectory dir >>= mapM (canonicalizePath . (dir </>))
processManpage :: FilePath -> IO ()
processManpage path = do
files <- getAbsDirectoryContents "manpages"
markdown <- readFile path
template <- readFile "template.html"
let groups = fromRight' $ parse manpage path markdown
print groups
let html = generateHTML groups
let combined = replace "{{footer}}" (genFooter files) (replace "{{maincontent}}" html template)
-- Write file to out/name.html
let outPath = replaceDirectory (path -<.> "html") "out"
writeFile outPath combined
genFooter :: [FilePath] -> String
genFooter x = intercalate ", " (map genFooterItem x)
genFooterItem :: FilePath -> String
genFooterItem item = do
let name = takeFileName item
let base =
parse
( do
n <- many1Till letter (char '.')
v <- many1 digit
return $ Link n (read v)
)
"name"
name
generateHTMLBlock $ fromRight' base
main :: IO ()
main = do
-- Prepare output directory
removePathForcibly "out"
createDirectory "out"
-- Iterate over all files in static/
files <- getAbsDirectoryContents "static"
mapM_ (\y -> shelly $ do cp_r y "out") files
manpages <- getAbsDirectoryContents "manpages"
mapM_ processManpage manpages