xmldoc2txt: init

xmldoc2txt is a more rigid framework for replacing
xml tags in the documentation. It replaces the clunky
perl substitution expressions.

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};

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)

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]
+    }

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

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