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:
parent
c1d4bece4a
commit
4099bbce8d
GPG Key ID:
9F2F7D8250F35146
|
|
@ -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,120 +69,121 @@ 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
|
||||||
PCS
|
TS.TagLeaf (TS.TagText s) ->
|
||||||
{ colorized = putStr s,
|
PCS
|
||||||
nonColorized = s
|
{ colorized = putStr s,
|
||||||
}
|
nonColorized = s
|
||||||
replaceTagColor (TS.TagBranch "para" _ inner) =
|
}
|
||||||
PCS
|
TS.TagBranch "para" _ inner ->
|
||||||
{ colorized = mapM_ (colorized . replaceTagColor) inner,
|
PCS
|
||||||
nonColorized = concatMap (nonColorized . replaceTagColor) inner
|
{ colorized = mapM_ (colorized . replaceTagColor) inner,
|
||||||
}
|
nonColorized = concatMap (nonColorized . replaceTagColor) inner
|
||||||
replaceTagColor (TS.TagBranch "code" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "code" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "command" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "command" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "filename" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "filename" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapColor AN.Yellow content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapColor AN.Yellow content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "emphasis" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "emphasis" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapSGR bold content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapSGR bold content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "literal" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "literal" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapColor AN.Red content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapColor AN.Red content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "varname" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "varname" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapColor AN.Red content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapColor AN.Red content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "link" [("xlink:href", link)] []) =
|
}
|
||||||
PCS
|
TS.TagBranch "link" [("xlink:href", link)] [] ->
|
||||||
{ colorized = wrapColor AN.Blue link,
|
PCS
|
||||||
nonColorized = concat ["`", link, "`"]
|
{ colorized = wrapColor AN.Blue link,
|
||||||
}
|
nonColorized = concat ["`", link, "`"]
|
||||||
replaceTagColor (TS.TagBranch "link" [("xlink:href", link)] [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "link" [("xlink:href", link)] [TextLeaf content] ->
|
||||||
{ colorized = wrapColor AN.Blue $ concat [content, " (", link, ")"],
|
PCS
|
||||||
nonColorized = concat ["`", content, " (", link, ")`"]
|
{ colorized = wrapColor AN.Blue $ concat [content, " (", link, ")"],
|
||||||
}
|
nonColorized = concat ["`", content, " (", link, ")`"]
|
||||||
replaceTagColor (TS.TagBranch "option" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "option" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
PCS
|
||||||
nonColorized = wrapTxt "`" content
|
{ colorized = wrapSGR bold $ wrapTxt "`" content,
|
||||||
}
|
nonColorized = wrapTxt "`" content
|
||||||
replaceTagColor (TS.TagBranch "envar" _ [TS.TagLeaf (TS.TagText content)]) =
|
}
|
||||||
PCS
|
TS.TagBranch "envar" _ [TextLeaf content] ->
|
||||||
{ colorized = wrapSGR bold $ concat ["`$", content, "`"],
|
PCS
|
||||||
nonColorized = concat ["`$", content, "`"]
|
{ colorized = wrapSGR bold $ concat ["`$", content, "`"],
|
||||||
}
|
nonColorized = concat ["`$", content, "`"]
|
||||||
replaceTagColor (TS.TagBranch "quote" _ inner) =
|
}
|
||||||
PCS
|
TS.TagBranch "quote" _ inner ->
|
||||||
{ colorized = sequence_ [putStr "\"", mapM_ (colorized . replaceTagColor) inner, putStr "\""],
|
PCS
|
||||||
nonColorized = wrapTxt "\"" $ concatMap (nonColorized . replaceTagColor) inner
|
{ colorized = sequence_ [putStr "\"", mapM_ (colorized . replaceTagColor) inner, putStr "\""],
|
||||||
}
|
nonColorized = wrapTxt "\"" $ concatMap (nonColorized . replaceTagColor) inner
|
||||||
replaceTagColor (TS.TagBranch "warning" _ inner) =
|
}
|
||||||
PCS
|
TS.TagBranch "warning" _ inner ->
|
||||||
{ colorized = sequence_ [wrapColor AN.Red "WARNING: ", mapM_ (colorized . replaceTagColor) inner],
|
PCS
|
||||||
nonColorized = "WARNING: " ++ concatMap (nonColorized . replaceTagColor) inner
|
{ colorized = sequence_ [wrapColor AN.Red "WARNING: ", mapM_ (colorized . replaceTagColor) inner],
|
||||||
}
|
nonColorized = "WARNING: " ++ concatMap (nonColorized . replaceTagColor) inner
|
||||||
replaceTagColor (TS.TagBranch "xref" [("linkend", link)] []) =
|
}
|
||||||
PCS
|
TS.TagBranch "xref" [("linkend", link)] [] ->
|
||||||
{ colorized = sequence_ $ [putStr "`"] ++ formattedLink ++ [putStr "`"],
|
let removeOptPrefix :: String -> String
|
||||||
nonColorized = wrapTxt "`" link
|
removeOptPrefix ('o' : 'p' : 't' : '-' : rest) = rest
|
||||||
}
|
removeOptPrefix x = x
|
||||||
where
|
|
||||||
removeOptPrefix :: String -> String
|
|
||||||
removeOptPrefix ('o' : 'p' : 't' : '-' : rest) = rest
|
|
||||||
removeOptPrefix x = x
|
|
||||||
|
|
||||||
replaceName :: String -> IO ()
|
replaceName :: String -> IO ()
|
||||||
replaceName x = if x == "_name_" then wrapColor AN.Red "<name>" else wrapSGR bold x
|
replaceName x = if x == "_name_" then wrapColor AN.Red "<name>" else wrapSGR bold x
|
||||||
|
|
||||||
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
|
}
|
||||||
}
|
TS.TagBranch "citerefentry" _ content ->
|
||||||
where
|
let tagBranchTagMatches :: String -> TS.TagTree String -> Bool
|
||||||
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
|
||||||
combinedLink = case (title, volumNum) of
|
combinedLink = case (title, volumNum) of
|
||||||
(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
|
||||||
PCS
|
{ colorized = wrapColor AN.Blue combinedLink,
|
||||||
{ colorized = wrapColor AN.Red $ TS.renderTree [unknown],
|
nonColorized = combinedLink
|
||||||
nonColorized = TS.renderTree [unknown]
|
}
|
||||||
}
|
unknown ->
|
||||||
|
PCS
|
||||||
|
{ colorized = wrapColor AN.Red $ TS.renderTree [unknown],
|
||||||
|
nonColorized = TS.renderTree [unknown]
|
||||||
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue