docbook2txt: clean up some code

- Introduce pattern synonym `TextLeaf` for `TagLeaf (TagText)`
- Convert `replaceTagColor` to use "case-of" pattern matching
This commit is contained in:
Oystein Kristoffer Tveit 2022-11-30 03:08:01 +01:00
parent c1d4bece4a
commit 4099bbce8d
Signed by: oysteikt
GPG Key ID: 9F2F7D8250F35146
1 changed files with 113 additions and 110 deletions

View File

@ -9,6 +9,8 @@
-- consumed by pandoc anyway. So instead, I am just planning on keeping -- consumed by pandoc anyway. So instead, I am just planning on keeping
-- my own module parsing raw xml tags (for now). -- my own module parsing raw xml tags (for now).
{-# LANGUAGE PatternSynonyms #-}
import Data.List (find, intersperse) import Data.List (find, intersperse)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
import qualified System.Console.ANSI as AN import qualified System.Console.ANSI as AN
@ -67,85 +69,83 @@ wrapTxt delimiter string = concat [delimiter, string, delimiter]
bold :: AN.SGR bold :: AN.SGR
bold = AN.SetConsoleIntensity AN.BoldIntensity bold = AN.SetConsoleIntensity AN.BoldIntensity
pattern TextLeaf a = TS.TagLeaf (TS.TagText a)
-- Replace tags with their PCS string equivalent. -- Replace tags with their PCS string equivalent.
replaceTagColor :: TS.TagTree String -> PotentiallyColorizedString replaceTagColor :: TS.TagTree String -> PotentiallyColorizedString
replaceTagColor (TS.TagLeaf (TS.TagText s)) = replaceTagColor tagtree = case tagtree of
TS.TagLeaf (TS.TagText s) ->
PCS PCS
{ colorized = putStr s, { colorized = putStr s,
nonColorized = s nonColorized = s
} }
replaceTagColor (TS.TagBranch "para" _ inner) = TS.TagBranch "para" _ inner ->
PCS PCS
{ colorized = mapM_ (colorized . replaceTagColor) inner, { colorized = mapM_ (colorized . replaceTagColor) inner,
nonColorized = concatMap (nonColorized . replaceTagColor) inner nonColorized = concatMap (nonColorized . replaceTagColor) inner
} }
replaceTagColor (TS.TagBranch "code" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "code" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapSGR bold $ wrapTxt "`" content, { colorized = wrapSGR bold $ wrapTxt "`" content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "command" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "command" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapSGR bold $ wrapTxt "`" content, { colorized = wrapSGR bold $ wrapTxt "`" content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "filename" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "filename" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapColor AN.Yellow content, { colorized = wrapColor AN.Yellow content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "emphasis" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "emphasis" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapSGR bold content, { colorized = wrapSGR bold content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "literal" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "literal" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapColor AN.Red content, { colorized = wrapColor AN.Red content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "varname" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "varname" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapColor AN.Red content, { colorized = wrapColor AN.Red content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "link" [("xlink:href", link)] []) = TS.TagBranch "link" [("xlink:href", link)] [] ->
PCS PCS
{ colorized = wrapColor AN.Blue link, { colorized = wrapColor AN.Blue link,
nonColorized = concat ["`", link, "`"] nonColorized = concat ["`", link, "`"]
} }
replaceTagColor (TS.TagBranch "link" [("xlink:href", link)] [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "link" [("xlink:href", link)] [TextLeaf content] ->
PCS PCS
{ colorized = wrapColor AN.Blue $ concat [content, " (", link, ")"], { colorized = wrapColor AN.Blue $ concat [content, " (", link, ")"],
nonColorized = concat ["`", content, " (", link, ")`"] nonColorized = concat ["`", content, " (", link, ")`"]
} }
replaceTagColor (TS.TagBranch "option" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "option" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapSGR bold $ wrapTxt "`" content, { colorized = wrapSGR bold $ wrapTxt "`" content,
nonColorized = wrapTxt "`" content nonColorized = wrapTxt "`" content
} }
replaceTagColor (TS.TagBranch "envar" _ [TS.TagLeaf (TS.TagText content)]) = TS.TagBranch "envar" _ [TextLeaf content] ->
PCS PCS
{ colorized = wrapSGR bold $ concat ["`$", content, "`"], { colorized = wrapSGR bold $ concat ["`$", content, "`"],
nonColorized = concat ["`$", content, "`"] nonColorized = concat ["`$", content, "`"]
} }
replaceTagColor (TS.TagBranch "quote" _ inner) = TS.TagBranch "quote" _ inner ->
PCS PCS
{ colorized = sequence_ [putStr "\"", mapM_ (colorized . replaceTagColor) inner, putStr "\""], { colorized = sequence_ [putStr "\"", mapM_ (colorized . replaceTagColor) inner, putStr "\""],
nonColorized = wrapTxt "\"" $ concatMap (nonColorized . replaceTagColor) inner nonColorized = wrapTxt "\"" $ concatMap (nonColorized . replaceTagColor) inner
} }
replaceTagColor (TS.TagBranch "warning" _ inner) = TS.TagBranch "warning" _ inner ->
PCS PCS
{ colorized = sequence_ [wrapColor AN.Red "WARNING: ", mapM_ (colorized . replaceTagColor) inner], { colorized = sequence_ [wrapColor AN.Red "WARNING: ", mapM_ (colorized . replaceTagColor) inner],
nonColorized = "WARNING: " ++ concatMap (nonColorized . replaceTagColor) inner nonColorized = "WARNING: " ++ concatMap (nonColorized . replaceTagColor) inner
} }
replaceTagColor (TS.TagBranch "xref" [("linkend", link)] []) = TS.TagBranch "xref" [("linkend", link)] [] ->
PCS let removeOptPrefix :: String -> String
{ colorized = sequence_ $ [putStr "`"] ++ formattedLink ++ [putStr "`"],
nonColorized = wrapTxt "`" link
}
where
removeOptPrefix :: String -> String
removeOptPrefix ('o' : 'p' : 't' : '-' : rest) = rest removeOptPrefix ('o' : 'p' : 't' : '-' : rest) = rest
removeOptPrefix x = x removeOptPrefix x = x
@ -154,24 +154,23 @@ replaceTagColor (TS.TagBranch "xref" [("linkend", link)] []) =
formattedLink :: [IO ()] formattedLink :: [IO ()]
formattedLink = intersperse (wrapSGR bold ".") $ map replaceName $ splitOn "." $ removeOptPrefix link formattedLink = intersperse (wrapSGR bold ".") $ map replaceName $ splitOn "." $ removeOptPrefix link
replaceTagColor (TS.TagBranch "citerefentry" _ content) = in PCS
PCS { colorized = sequence_ $ [putStr "`"] ++ formattedLink ++ [putStr "`"],
{ colorized = wrapColor AN.Blue combinedLink, nonColorized = wrapTxt "`" link
nonColorized = combinedLink
} }
where TS.TagBranch "citerefentry" _ content ->
tagBranchTagMatches :: String -> TS.TagTree String -> Bool let tagBranchTagMatches :: String -> TS.TagTree String -> Bool
tagBranchTagMatches x (TS.TagBranch tag _ _) = tag == x tagBranchTagMatches x (TS.TagBranch tag _ _) = tag == x
tagBranchTagMatches _ _ = False tagBranchTagMatches _ _ = False
title :: Maybe String title :: Maybe String
title = case find (tagBranchTagMatches "refentrytitle") content of title = case find (tagBranchTagMatches "refentrytitle") content of
Just (TS.TagBranch _ _ [TS.TagLeaf (TS.TagText str)]) -> Just str Just (TS.TagBranch _ _ [TextLeaf str]) -> Just str
_ -> Nothing _ -> Nothing
volumNum :: Maybe String volumNum :: Maybe String
volumNum = case find (tagBranchTagMatches "manvolnum") content of volumNum = case find (tagBranchTagMatches "manvolnum") content of
Just (TS.TagBranch _ _ [TS.TagLeaf (TS.TagText str)]) -> Just str Just (TS.TagBranch _ _ [TextLeaf str]) -> Just str
_ -> Nothing _ -> Nothing
combinedLink :: String combinedLink :: String
@ -179,7 +178,11 @@ replaceTagColor (TS.TagBranch "citerefentry" _ content) =
(Just t, Just vn) -> concat [t, "(", vn, ")"] (Just t, Just vn) -> concat [t, "(", vn, ")"]
(Just t, Nothing) -> t (Just t, Nothing) -> t
_ -> "???" _ -> "???"
replaceTagColor unknown = in PCS
{ colorized = wrapColor AN.Blue combinedLink,
nonColorized = combinedLink
}
unknown ->
PCS PCS
{ colorized = wrapColor AN.Red $ TS.renderTree [unknown], { colorized = wrapColor AN.Red $ TS.renderTree [unknown],
nonColorized = TS.renderTree [unknown] nonColorized = TS.renderTree [unknown]