docbook2txt: clean up some code
- Introduce pattern synonym `TextLeaf` for `TagLeaf (TagText)` - Convert `replaceTagColor` to use "case-of" pattern matchingmain
parent
c1d4bece4a
commit
4099bbce8d
GPG Key ID:
9F2F7D8250F35146
|
|
@ -9,6 +9,8 @@
|
|||
-- consumed by pandoc anyway. So instead, I am just planning on keeping
|
||||
-- my own module parsing raw xml tags (for now).
|
||||
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
import Data.List (find, intersperse)
|
||||
import Data.List.Split (splitOn)
|
||||
import qualified System.Console.ANSI as AN
|
||||
|
|
@ -67,120 +69,121 @@ wrapTxt delimiter string = concat [delimiter, string, delimiter]
|
|||
bold :: AN.SGR
|
||||
bold = AN.SetConsoleIntensity AN.BoldIntensity
|
||||
|
||||
pattern TextLeaf a = TS.TagLeaf (TS.TagText a)
|
||||
|
||||
-- Replace tags with their PCS string equivalent.
|
||||
replaceTagColor :: TS.TagTree String -> PotentiallyColorizedString
|
||||
replaceTagColor (TS.TagLeaf (TS.TagText s)) =
|
||||
PCS
|
||||
{ colorized = putStr s,
|
||||
nonColorized = s
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "para" _ inner) =
|
||||
PCS
|
||||
{ colorized = mapM_ (colorized . replaceTagColor) inner,
|
||||
nonColorized = concatMap (nonColorized . replaceTagColor) inner
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "code" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "command" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "filename" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Yellow content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "emphasis" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapSGR bold content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "literal" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Red content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "varname" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Red content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "link" [("xlink:href", link)] []) =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Blue link,
|
||||
nonColorized = concat ["`", link, "`"]
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "link" [("xlink:href", link)] [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Blue $ concat [content, " (", link, ")"],
|
||||
nonColorized = concat ["`", content, " (", link, ")`"]
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "option" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "envar" _ [TS.TagLeaf (TS.TagText content)]) =
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ concat ["`$", content, "`"],
|
||||
nonColorized = concat ["`$", content, "`"]
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "quote" _ inner) =
|
||||
PCS
|
||||
{ colorized = sequence_ [putStr "\"", mapM_ (colorized . replaceTagColor) inner, putStr "\""],
|
||||
nonColorized = wrapTxt "\"" $ concatMap (nonColorized . replaceTagColor) inner
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "warning" _ inner) =
|
||||
PCS
|
||||
{ colorized = sequence_ [wrapColor AN.Red "WARNING: ", mapM_ (colorized . replaceTagColor) inner],
|
||||
nonColorized = "WARNING: " ++ concatMap (nonColorized . replaceTagColor) inner
|
||||
}
|
||||
replaceTagColor (TS.TagBranch "xref" [("linkend", link)] []) =
|
||||
PCS
|
||||
{ colorized = sequence_ $ [putStr "`"] ++ formattedLink ++ [putStr "`"],
|
||||
nonColorized = wrapTxt "`" link
|
||||
}
|
||||
where
|
||||
removeOptPrefix :: String -> String
|
||||
removeOptPrefix ('o' : 'p' : 't' : '-' : rest) = rest
|
||||
removeOptPrefix x = x
|
||||
replaceTagColor tagtree = case tagtree of
|
||||
TS.TagLeaf (TS.TagText s) ->
|
||||
PCS
|
||||
{ colorized = putStr s,
|
||||
nonColorized = s
|
||||
}
|
||||
TS.TagBranch "para" _ inner ->
|
||||
PCS
|
||||
{ colorized = mapM_ (colorized . replaceTagColor) inner,
|
||||
nonColorized = concatMap (nonColorized . replaceTagColor) inner
|
||||
}
|
||||
TS.TagBranch "code" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "command" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "filename" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Yellow content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "emphasis" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapSGR bold content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "literal" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Red content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "varname" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Red content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "link" [("xlink:href", link)] [] ->
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Blue link,
|
||||
nonColorized = concat ["`", link, "`"]
|
||||
}
|
||||
TS.TagBranch "link" [("xlink:href", link)] [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Blue $ concat [content, " (", link, ")"],
|
||||
nonColorized = concat ["`", content, " (", link, ")`"]
|
||||
}
|
||||
TS.TagBranch "option" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||
nonColorized = wrapTxt "`" content
|
||||
}
|
||||
TS.TagBranch "envar" _ [TextLeaf content] ->
|
||||
PCS
|
||||
{ colorized = wrapSGR bold $ concat ["`$", content, "`"],
|
||||
nonColorized = concat ["`$", content, "`"]
|
||||
}
|
||||
TS.TagBranch "quote" _ inner ->
|
||||
PCS
|
||||
{ colorized = sequence_ [putStr "\"", mapM_ (colorized . replaceTagColor) inner, putStr "\""],
|
||||
nonColorized = wrapTxt "\"" $ concatMap (nonColorized . replaceTagColor) inner
|
||||
}
|
||||
TS.TagBranch "warning" _ inner ->
|
||||
PCS
|
||||
{ colorized = sequence_ [wrapColor AN.Red "WARNING: ", mapM_ (colorized . replaceTagColor) inner],
|
||||
nonColorized = "WARNING: " ++ concatMap (nonColorized . replaceTagColor) inner
|
||||
}
|
||||
TS.TagBranch "xref" [("linkend", link)] [] ->
|
||||
let removeOptPrefix :: String -> String
|
||||
removeOptPrefix ('o' : 'p' : 't' : '-' : rest) = rest
|
||||
removeOptPrefix x = x
|
||||
|
||||
replaceName :: String -> IO ()
|
||||
replaceName x = if x == "_name_" then wrapColor AN.Red "<name>" else wrapSGR bold x
|
||||
replaceName :: String -> IO ()
|
||||
replaceName x = if x == "_name_" then wrapColor AN.Red "<name>" else wrapSGR bold x
|
||||
|
||||
formattedLink :: [IO ()]
|
||||
formattedLink = intersperse (wrapSGR bold ".") $ map replaceName $ splitOn "." $ removeOptPrefix link
|
||||
replaceTagColor (TS.TagBranch "citerefentry" _ content) =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Blue combinedLink,
|
||||
nonColorized = combinedLink
|
||||
}
|
||||
where
|
||||
tagBranchTagMatches :: String -> TS.TagTree String -> Bool
|
||||
tagBranchTagMatches x (TS.TagBranch tag _ _) = tag == x
|
||||
tagBranchTagMatches _ _ = False
|
||||
formattedLink :: [IO ()]
|
||||
formattedLink = intersperse (wrapSGR bold ".") $ map replaceName $ splitOn "." $ removeOptPrefix link
|
||||
in PCS
|
||||
{ colorized = sequence_ $ [putStr "`"] ++ formattedLink ++ [putStr "`"],
|
||||
nonColorized = wrapTxt "`" link
|
||||
}
|
||||
TS.TagBranch "citerefentry" _ content ->
|
||||
let tagBranchTagMatches :: String -> TS.TagTree String -> Bool
|
||||
tagBranchTagMatches x (TS.TagBranch tag _ _) = tag == x
|
||||
tagBranchTagMatches _ _ = False
|
||||
|
||||
title :: Maybe String
|
||||
title = case find (tagBranchTagMatches "refentrytitle") content of
|
||||
Just (TS.TagBranch _ _ [TS.TagLeaf (TS.TagText str)]) -> Just str
|
||||
_ -> Nothing
|
||||
title :: Maybe String
|
||||
title = case find (tagBranchTagMatches "refentrytitle") content of
|
||||
Just (TS.TagBranch _ _ [TextLeaf str]) -> Just str
|
||||
_ -> Nothing
|
||||
|
||||
volumNum :: Maybe String
|
||||
volumNum = case find (tagBranchTagMatches "manvolnum") content of
|
||||
Just (TS.TagBranch _ _ [TS.TagLeaf (TS.TagText str)]) -> Just str
|
||||
_ -> Nothing
|
||||
volumNum :: Maybe String
|
||||
volumNum = case find (tagBranchTagMatches "manvolnum") content of
|
||||
Just (TS.TagBranch _ _ [TextLeaf str]) -> Just str
|
||||
_ -> Nothing
|
||||
|
||||
combinedLink :: String
|
||||
combinedLink = case (title, volumNum) of
|
||||
(Just t, Just vn) -> concat [t, "(", vn, ")"]
|
||||
(Just t, Nothing) -> t
|
||||
_ -> "???"
|
||||
replaceTagColor unknown =
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Red $ TS.renderTree [unknown],
|
||||
nonColorized = TS.renderTree [unknown]
|
||||
}
|
||||
combinedLink :: String
|
||||
combinedLink = case (title, volumNum) of
|
||||
(Just t, Just vn) -> concat [t, "(", vn, ")"]
|
||||
(Just t, Nothing) -> t
|
||||
_ -> "???"
|
||||
in PCS
|
||||
{ colorized = wrapColor AN.Blue combinedLink,
|
||||
nonColorized = combinedLink
|
||||
}
|
||||
unknown ->
|
||||
PCS
|
||||
{ colorized = wrapColor AN.Red $ TS.renderTree [unknown],
|
||||
nonColorized = TS.renderTree [unknown]
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue