From e17274e94d8115bc8e2a39e9549cfa8bb003eef1 Mon Sep 17 00:00:00 2001
From: h7x4 <h7x4@nani.wtf>
Date: Tue, 29 Nov 2022 15:48:31 +0100
Subject: [PATCH] xmldoc2txt: init
xmldoc2txt is a more rigid framework for replacing
xml tags in the documentation. It replaces the clunky
perl substitution expressions.
---
flake.nix | 6 +-
internals/xmldoc2txt/default.nix | 4 +
internals/xmldoc2txt/xmldoc2txt.hs | 113 +++++++++++++++++++++++++++++
searchers/home-manager-search.nix | 51 +------------
searchers/nix-option-search.nix | 50 +------------
5 files changed, 128 insertions(+), 96 deletions(-)
create mode 100644 internals/xmldoc2txt/default.nix
create mode 100644 internals/xmldoc2txt/xmldoc2txt.hs
diff --git a/flake.nix b/flake.nix
index f80bab0..3e22526 100644
--- a/flake.nix
+++ b/flake.nix
@@ -31,14 +31,14 @@
home-manager-search =
pkgs.callPackage ./searchers/home-manager-search.nix {
inherit home-manager;
- inherit (self.packages.${system}) json2nix;
+ inherit (self.packages.${system}) json2nix xmldoc2txt;
defaultManualPath =
let pkg = self.packages.${system}.home-manager-json;
in "${pkg}/share/doc/home-manager/options.json";
};
nix-option-search = pkgs.callPackage ./searchers/nix-option-search.nix {
inherit nixpkgs;
- inherit (self.packages.${system}) json2nix;
+ inherit (self.packages.${system}) json2nix xmldoc2txt;
defaultManualPath =
let pkg = self.packages.${system}.nix-options-json;
in "${pkg}/share/doc/nixos/options.json";
@@ -58,6 +58,8 @@
# Internal Tools
json2nix =
pkgs.callPackage ./internals/json2nix { compiler = "ghc924"; };
+ xmldoc2txt =
+ pkgs.callPackage ./internals/xmldoc2txt { compiler = "ghc924"; };
};
overlays.default = _: prev: prev // self.packages.${system};
diff --git a/internals/xmldoc2txt/default.nix b/internals/xmldoc2txt/default.nix
new file mode 100644
index 0000000..793439b
--- /dev/null
+++ b/internals/xmldoc2txt/default.nix
@@ -0,0 +1,4 @@
+{ pkgs, compiler ? "ghc924", ... }:
+pkgs.writers.writeHaskellBin "xmldoc2txt" {
+ libraries = with pkgs.haskellPackages; [ tagsoup ansi-terminal split text ];
+} (builtins.readFile ./xmldoc2txt.hs)
diff --git a/internals/xmldoc2txt/xmldoc2txt.hs b/internals/xmldoc2txt/xmldoc2txt.hs
new file mode 100644
index 0000000..76679bd
--- /dev/null
+++ b/internals/xmldoc2txt/xmldoc2txt.hs
@@ -0,0 +1,113 @@
+import Data.List (intersperse)
+import Data.List.Split (splitOn)
+import qualified System.Console.ANSI as AN
+import qualified System.Console.ANSI.Types as AN
+import System.Environment (getArgs)
+import qualified Text.HTML.TagSoup as TS
+import qualified Text.HTML.TagSoup.Tree as TS
+
+main :: IO ()
+main = do
+ stdin <- getContents
+ args <- getArgs
+ let colorizedMode = "-C" `elem` args
+ printTags colorizedMode $ map replaceTagColor $ removeParagraphTags $ TS.parseTree stdin
+
+data PotentiallyColorizedString = PCS
+ { colorized :: IO (),
+ nonColorized :: String
+ }
+
+removeParagraphTags :: [TS.TagTree String] -> [TS.TagTree String]
+removeParagraphTags (TS.TagLeaf (TS.TagClose "para") : TS.TagLeaf (TS.TagOpen "para" []) : rest) =
+ TS.TagLeaf (TS.TagText "\n") : removeParagraphTags rest
+removeParagraphTags (x : y : rest) = x : removeParagraphTags (y : rest)
+removeParagraphTags x = x
+
+printTags :: Bool -> [PotentiallyColorizedString] -> IO ()
+printTags False = putStrLn . unwords . map nonColorized
+printTags True = mapM_ colorized
+
+wrapSGR :: AN.SGR -> String -> IO ()
+wrapSGR sgr str = do
+ AN.setSGR [sgr]
+ putStr str
+ AN.setSGR [AN.Reset]
+
+wrapColor :: AN.Color -> String -> IO ()
+wrapColor c = wrapSGR (AN.SetColor AN.Foreground AN.Vivid c)
+
+bold :: AN.SGR
+bold = AN.SetConsoleIntensity AN.BoldIntensity
+
+replaceTagColor :: TS.TagTree String -> PotentiallyColorizedString
+replaceTagColor (TS.TagLeaf (TS.TagText s)) =
+ PCS
+ { colorized = putStr s,
+ nonColorized = s
+ }
+replaceTagColor (TS.TagBranch "code" _ [TS.TagLeaf (TS.TagText content)]) =
+ PCS
+ { colorized = wrapSGR bold $ concat ["`", content, "`"],
+ nonColorized = concat ["`", content, "`"]
+ }
+replaceTagColor (TS.TagBranch "command" _ [TS.TagLeaf (TS.TagText content)]) =
+ PCS
+ { colorized = wrapSGR bold $ concat ["`", content, "`"],
+ nonColorized = concat ["`", content, "`"]
+ }
+replaceTagColor (TS.TagBranch "filename" _ [TS.TagLeaf (TS.TagText content)]) =
+ PCS
+ { colorized = wrapColor AN.Yellow content,
+ nonColorized = concat ["`", content, "`"]
+ }
+replaceTagColor (TS.TagBranch "emphasis" _ [TS.TagLeaf (TS.TagText content)]) =
+ PCS
+ { colorized = wrapSGR bold content,
+ nonColorized = concat ["`", content, "`"]
+ }
+replaceTagColor (TS.TagBranch "literal" _ [TS.TagLeaf (TS.TagText content)]) =
+ PCS
+ { colorized = wrapColor AN.Red content,
+ nonColorized = concat ["`", content, "`"]
+ }
+replaceTagColor (TS.TagBranch "varname" _ [TS.TagLeaf (TS.TagText content)]) =
+ PCS
+ { colorized = wrapColor AN.Red content,
+ nonColorized = concat ["`", 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 $ concat ["`", content, "`"],
+ nonColorized = concat ["`", content, "`"]
+ }
+replaceTagColor (TS.TagBranch "xref" [("linkend", link)] []) =
+ PCS
+ { colorized = sequence_ $ [putStr "`"] ++ formattedLink ++ [putStr "`"],
+ nonColorized = concat ["`", link, "`"]
+ }
+ where
+ 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
+
+ formattedLink :: [IO ()]
+ formattedLink = intersperse (wrapSGR bold ".") $ map replaceName $ splitOn "." $ removeOptPrefix link
+replaceTagColor unknown =
+ PCS
+ { colorized = wrapColor AN.Red $ TS.renderTree [unknown],
+ nonColorized = TS.renderTree [unknown]
+ }
diff --git a/searchers/home-manager-search.nix b/searchers/home-manager-search.nix
index 6107b96..fb77f07 100644
--- a/searchers/home-manager-search.nix
+++ b/searchers/home-manager-search.nix
@@ -1,4 +1,5 @@
-{ pkgs, lib, home-manager, defaultManualPath, system, json2nix, ... }:
+{ pkgs, lib, home-manager, defaultManualPath, system, json2nix, xmldoc2txt, ...
+}:
let
usage = pkgs.writeText "home-manager-search-usage" ''
Usage:
@@ -26,50 +27,6 @@ let
jq fzf gomplate nixfmt bat perl blinkred bold red green yellow blue magenta
clear flatten;
- # TODO: Preprocess all XML tags in description.
- substitutionsColor = let s = "\\s*";
- in {
- "<code>([^>]*)</code>" = "${bold}`$1`${clear}";
- "<command>([^>]*)</command>" = "${bold}`$1`${clear}";
- "<filename>([^>]*)</filename>" = "${yellow}$1${clear}";
- "<emphasis>([^>]*)</emphasis>" = "${bold}$1${clear}";
- "<literal>([^>]*)</literal>" = "${red}$1${clear}";
- "<varname>([^>]*)</varname>" = "${red}$1${clear}";
- "</para><para>" = "\\n";
- "<link${s}xlink:href=\"([^>]*)\"${s}/>" = "${blue}$1${clear}";
- "<link${s}xlink:href=\"([^>]*)\"${s}>([^<]*)</link>" =
- "${bold}$2 ${clear}(${blue}$1${clear})";
- "<xref${s}linkend=\"opt-([^>]*)\"${s}/>" = "${blue}$1${clear}";
- };
-
- substitutions = let s = "\\s*";
- in {
- "<code>([^>]*)</code>" = "`$1`";
- "<command>([^>]*)</command>" = "`$1`";
- "<filename>([^>]*)</filename>" = "`$1`";
- "<emphasis>([^>]*)</emphasis>" = "`$1`";
- "<literal>([^>]*)</literal>" = "`$1`";
- "<varname>([^>]*)</varname>" = "`$1`";
- "</para><para>" = "\\n";
- "<link${s}xlink:href=\"([^>]*)\"${s}/>" = "`$1`";
- "<link${s}xlink:href=\"([^>]*)\"${s}>([^<]*)</link>" = "`$2 ($1)`";
- "<xref${s}linkend=\"opt-([^>]*)\"${s}/>" = "`$1`";
- };
-
- perlArgsColor = with lib;
- pipe substitutionsColor [
- (mapAttrsToList (name: value: "s|${name}|${value}|gm"))
- (concatStringsSep ";")
- (x: "-pe '${x}'")
- ];
-
- perlArgs = with lib;
- pipe substitutions [
- (mapAttrsToList (name: value: "s|${name}|${value}|gm"))
- (concatStringsSep ";")
- (x: "-pe '${x}'")
- ];
-
optionTemplateColor =
pkgs.callPackage ../templates/option-preview-template-color.nix { };
@@ -87,9 +44,9 @@ let
previewGomplate = isColorized:
let
# TODO: Color management here needs a refactoring badly...
- pArgs = if isColorized then perlArgsColor else perlArgs;
colorSuffix = if isColorized then "-color" else "";
batColorArg = if isColorized then "--color=always " else "";
+ xmldoc2textColorArg = if isColorized then "-C " else "";
template = if isColorized then optionTemplateColor else optionTemplate;
in pkgs.writers.writeBash
"preview-home-manager-attrs-gomplate${colorSuffix}" ''
@@ -97,7 +54,7 @@ let
JSON_MANUAL_PATH=$2
JSON_DATA=$(${jq} ".\"$OPTION_KEY\"" $JSON_MANUAL_PATH)
- export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${perl} ${pArgs})
+ export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${xmldoc2txt}/bin/xmldoc2txt ${xmldoc2textColorArg})
EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} -r ".example.text" 2>/dev/null | ${nixfmt})
if [ $? != 0 ]; then
diff --git a/searchers/nix-option-search.nix b/searchers/nix-option-search.nix
index b3daf7f..85bbb93 100644
--- a/searchers/nix-option-search.nix
+++ b/searchers/nix-option-search.nix
@@ -1,5 +1,5 @@
# TODO:
-{ pkgs, lib, nixpkgs, defaultManualPath, system, json2nix, ... }:
+{ pkgs, lib, nixpkgs, defaultManualPath, system, json2nix, xmldoc2txt, ... }:
let
usage = pkgs.writeText "nix-option-search-usage" ''
Usage:
@@ -27,50 +27,6 @@ let
jq fzf gomplate nixfmt bat perl blinkred bold red green yellow blue magenta
clear flatten;
- # TODO: Preprocess all XML tags in description.
- substitutionsColor = let s = "\\s*";
- in {
- "<code>([^>]*)</code>" = "${bold}`$1`${clear}";
- "<command>([^>]*)</command>" = "${bold}`$1`${clear}";
- "<filename>([^>]*)</filename>" = "${yellow}$1${clear}";
- "<emphasis>([^>]*)</emphasis>" = "${bold}$1${clear}";
- "<literal>([^>]*)</literal>" = "${red}$1${clear}";
- "<varname>([^>]*)</varname>" = "${red}$1${clear}";
- "</para><para>" = "\\n";
- "<link${s}xlink:href=\"([^>]*)\"${s}/>" = "${blue}$1${clear}";
- "<link${s}xlink:href=\"([^>]*)\"${s}>([^<]*)</link>" =
- "${bold}$2 ${clear}(${blue}$1${clear})";
- "<xref${s}linkend=\"opt-([^>]*)\"${s}/>" = "${blue}$1${clear}";
- };
-
- substitutions = let s = "\\s*";
- in {
- "<code>([^>]*)</code>" = "`$1`";
- "<command>([^>]*)</command>" = "`$1`";
- "<filename>([^>]*)</filename>" = "`$1`";
- "<emphasis>([^>]*)</emphasis>" = "`$1`";
- "<literal>([^>]*)</literal>" = "`$1`";
- "<varname>([^>]*)</varname>" = "`$1`";
- "</para><para>" = "\\n";
- "<link${s}xlink:href=\"([^>]*)\"${s}/>" = "`$1`";
- "<link${s}xlink:href=\"([^>]*)\"${s}>([^<]*)</link>" = "`$2 ($1)`";
- "<xref${s}linkend=\"opt-([^>]*)\"${s}/>" = "`$1`";
- };
-
- perlArgsColor = with lib;
- pipe substitutionsColor [
- (mapAttrsToList (name: value: "s|${name}|${value}|gm"))
- (concatStringsSep ";")
- (x: "-pe '${x}'")
- ];
-
- perlArgs = with lib;
- pipe substitutions [
- (mapAttrsToList (name: value: "s|${name}|${value}|gm"))
- (concatStringsSep ";")
- (x: "-pe '${x}'")
- ];
-
optionTemplateColor =
pkgs.callPackage ../templates/option-preview-template-color.nix { };
@@ -88,9 +44,9 @@ let
previewGomplate = isColorized:
let
# TODO: Color management here needs a refactoring badly...
- pArgs = if isColorized then perlArgsColor else perlArgs;
colorSuffix = if isColorized then "-color" else "";
batColorArg = if isColorized then "--color=always " else "";
+ xmldoc2textColorArg = if isColorized then "-C " else "";
template = if isColorized then optionTemplateColor else optionTemplate;
in pkgs.writers.writeBash
"preview-nix-option-attrs-gomplate${colorSuffix}" ''
@@ -98,7 +54,7 @@ let
JSON_MANUAL_PATH=$2
JSON_DATA=$(${jq} ".\"$OPTION_KEY\"" $JSON_MANUAL_PATH)
- export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${perl} ${pArgs})
+ export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${xmldoc2txt}/bin/xmldoc2txt ${xmldoc2textColorArg})
EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} -r ".example.text" 2>/dev/null)
if [ $? != 0 ]; then