rewrite-main-program-in-haskell
Oystein Kristoffer Tveit 2022-11-30 22:45:53 +01:00
parent 51ab2cf393
commit d739cd7fe7
Signed by: oysteikt
GPG Key ID: 9F2F7D8250F35146
17 changed files with 606 additions and 113 deletions

5
CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for nix-attr-search
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

View File

@ -8,11 +8,11 @@
"utils": "utils"
},
"locked": {
"lastModified": 1669071065,
"narHash": "sha256-KBpgj3JkvlPsJ3duOZqFJe6tgr+wc75t8sFmgRbBSbw=",
"lastModified": 1669724862,
"narHash": "sha256-GwLonjmyhnTGQRNfKcUCgMSKYj49ZehjjJulaM/yH18=",
"owner": "nix-community",
"repo": "home-manager",
"rev": "f7641a3ff398ccce952e19a199d775934e518c1d",
"rev": "e891b060e7d11bb8f7dedb86a41d804891a6f5a9",
"type": "github"
},
"original": {
@ -24,11 +24,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1669196922,
"narHash": "sha256-J1fjyUsst3mXxgz2Z1cD7boh1Q5GmfeZjNfW1WVMsr8=",
"lastModified": 1669834992,
"narHash": "sha256-YnhZGHgb4C3Q7DSGisO/stc50jFb9F/MzHeKS4giotg=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "e8016a90db25c48cfe2cb8ab48bbc94a4365dab9",
"rev": "596a8e828c5dfa504f91918d0fa4152db3ab5502",
"type": "github"
},
"original": {

View File

@ -36,27 +36,73 @@
self.packages.${system};
packages.${system} = {
# Applications
home-manager-search =
pkgs.callPackage ./searchers/home-manager-search.nix {
inherit home-manager;
inherit (self.packages.${system}) json2nix docbook2txt;
defaultManualPath =
let pkg = self.packages.${system}.home-manager-json;
in "${pkg}/share/doc/home-manager/options.json";
default = self.packages.${system}.nix-attr-search;
nix-attr-search = let
hPkgs = pkgs.haskell.packages.ghc924.override {
overrides = self: super: with pkgs.haskell.lib; {
text = super.text_2_0_1;
# nixfmt = doJailbreak super.nixfmt;
};
};
nix-option-search = pkgs.callPackage ./searchers/nix-option-search.nix {
inherit nixpkgs;
inherit (self.packages.${system}) json2nix docbook2txt;
defaultManualPath =
let pkg = self.packages.${system}.nix-options-json;
in "${pkg}/share/doc/nixos/options.json";
homeManagerDefaultPath =
let pkg = self.packages.${system}.home-manager-json;
in "${pkg}/share/doc/home-manager/options.json";
src = pkgs.symlinkJoin {
name="nix-attr-search-source";
paths = [
./.
(pkgs.writeTextFile {
name = "nix-attr-search-default-option-paths";
destination = "/src/NAS/DefaultPaths.hs";
text = ''
module NAS.DefaultPaths where
defaultHomeManagerOptionsPath :: String
defaultHomeManagerOptionsPath = "${homeManagerDefaultPath}"
'';
})
];
};
unwrapped = hPkgs.callCabal2nix "nix-attr-search-unwrapped" src { };
in pkgs.symlinkJoin {
name = "hello";
paths = [ unwrapped ];
buildInputs = [ pkgs.makeWrapper ];
postBuild = ''
wrapProgram $out/bin/nix-attr-search \
--set PATH ${pkgs.lib.makeBinPath (with pkgs; [
jq
fzf
bat
unwrapped
])}
'';
};
nix-package-search =
pkgs.callPackage ./searchers/nix-package-search.nix { };
nix-lib-search = pkgs.callPackage ./searchers/nix-lib-search.nix { };
nur-package-search =
pkgs.callPackage ./searchers/nur-package-search.nix { };
# Applications
# home-manager-search =
# pkgs.callPackage ./searchers/home-manager-search.nix {
# inherit home-manager;
# inherit (self.packages.${system}) json2nix docbook2txt;
# 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 docbook2txt;
# defaultManualPath =
# let pkg = self.packages.${system}.nix-options-json;
# in "${pkg}/share/doc/nixos/options.json";
# };
# nix-package-search =
# pkgs.callPackage ./searchers/nix-package-search.nix { };
# nix-lib-search = pkgs.callPackage ./searchers/nix-lib-search.nix { };
# nur-package-search =
# pkgs.callPackage ./searchers/nur-package-search.nix { };
# Data sources
home-manager-json = home-manager.packages.${system}.docs-json;
@ -65,10 +111,10 @@
# nix-packages-json = pkgs.emptyFile;
# Internal Tools
json2nix =
pkgs.callPackage ./internals/json2nix { compiler = "ghc924"; };
docbook2txt =
pkgs.callPackage ./internals/docbook2txt { compiler = "ghc924"; };
# json2nix =
# pkgs.callPackage ./internals/json2nix { compiler = "ghc924"; };
# docbook2txt =
# pkgs.callPackage ./internals/docbook2txt { compiler = "ghc924"; };
};
overlays.default = _: prev: prev // self.packages.${system};

62
nix-attr-search.cabal Normal file
View File

@ -0,0 +1,62 @@
cabal-version: 2.4
name: nix-attr-search
version: 0.1.0.0
synopsis: Easy search mechanism for nix manuals, built on fzf
description:
TODO: Write something here...
stability: alpha
homepage: https://github.com/h7x4/nix-attr-search
bug-reports: https://github.com/h7x4/nix-attr-search/issues
license: MIT
license-file: LICENSE
author: h7x4
maintainer: h7x4@nani.wtf
copyright: (c) 2022 h7x4
category: Development
extra-source-files:
CHANGELOG.md
LICENSE
README.md
source-repository head
type: git
location: git://github.com/h7x4/nix-attr-search.git
executable nix-attr-search
main-is: Main.hs
other-modules:
NAS.Cli.Args
NAS.Cli.Conversion
NAS.Conversion.Docbook2txt
NAS.Conversion.Json2nix
NAS.Searchers.HomeManager
NAS.Searchers.NixosOptions
NAS.Templates.OptionsTemplate
NAS.DefaultPaths
NAS.Preview
NAS.Utils
build-depends:
aeson ^>=2.0,
ansi-terminal ^>=0.11,
base >=4.15,
base64 ^>= 0.4.2,
bytestring >=0.10,
cmdargs ^>= 0.10,
containers ^>= 0.6.5,
extra ^>=1.7,
nixfmt ^>=0.5,
process ^>=1.6.13,
split ^>=0.2.3,
table-layout ^>=0.9.1,
tagsoup ^>=0.14,
text >=2,
vector ^>=0.12
hs-source-dirs: src
default-language: Haskell2010
ghc-options:
-Wall
-Wcompat
-Wincomplete-record-updates
-Wincomplete-uni-patterns
-Wredundant-constraints
-threaded

View File

@ -0,0 +1,148 @@
{-# LANGUAGE DeriveDataTypeable, RecordWildCards, NamedFieldPuns, DeriveGeneric, CPP, TemplateHaskell, LambdaCase #-}
import System.Console.CmdArgs
import System.IO
import System.Process
import System.Exit
import Data.Map
import Data.Maybe (isNothing)
import qualified Data.Aeson as A
import qualified Data.Aeson.TH as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
data Args = MainArgs
{ json :: Bool
, no_color :: Bool
, no_preview :: Bool
, flake :: Maybe String
, ref :: Maybe String
}
| PreviewArgs
{ json :: Bool
, no_color :: Bool
, no_preview :: Bool
, datasource :: Maybe String
}
deriving (Data,Typeable,Show,Eq)
mainArgTemplate :: Args
mainArgTemplate = MainArgs
{ json = False &= help "Show JSON data in preview pane"
, no_color = False &= help "Don't display ANSI colors in preview pane"
, no_preview = False &= help "Don't display preview pane"
, flake = Nothing &= typ "FLAKE_URI" &= groupname "source" &= help "Specify home-manager flake to show manual from"
, ref = Nothing &= typ "REF" &= groupname "source" &= help "Specify git reference for the flake path to show manual from (if applicable)"
}
&= auto
defaultHMSource :: String
defaultHMSource = HOME_MANAGER_DEFAULT_PATH
wrapProgram :: String -> [String] -> Maybe String -> IO String
wrapProgram programName args maybeInput = do
case maybeInput of
Just input -> readProcess programName args input
Nothing -> readProcess programName args ""
-- (mStdin, mStdout, _, _) <- createProcess $ proc programName args
-- case (mStdin, maybeInput) of
-- (Just stdin, Just input) -> hPutStr stdin input
-- _ -> return ()
-- sequence $ hGetContents <$> mStdout
exitWithError :: String -> IO a
exitWithError errorMessage = hPutStrLn stderr errorMessage >> exitFailure
fetchHMSource :: String -> Maybe String -> IO (Either String String)
fetchHMSource flake ref = undefined
data Option = Option {
description :: Either String A.Object
, defaultValue :: Either String A.Object
, example :: Either String A.Object
, loc :: [String]
}
deriving (Show)
$(A.deriveJSON A.defaultOptions {A.fieldLabelModifier = \x -> if x == "default" then "defaultValue" else x} ''Option)
parseOptionList :: String -> IO (Either String String)
parseOptionList path = do
json <- BSL.readFile path
return $ unlines . keys <$> (A.eitherDecode json :: Either String (Map String A.Object))
search :: Args -> IO ()
search args = do
maybeJsonOptionsPath <- case flake args of
Nothing -> return $ Right defaultHMSource
Just flk -> flip fetchHMSource (ref args) flk
jsonOptionsPath <- case maybeJsonOptionsPath of
Left err -> exitWithError $ "Could not fetch json source\n" ++ err
Right src -> return src
optionList <- parseOptionList jsonOptionsPath >>= \case
Left err -> exitWithError $ "Could not parse options:\n" ++ err
Right opts -> return opts
chosenValue <- wrapProgram "fzf" ["--preview", "home-manager-search preview"] $ Just optionList
case chosenValue of
"" -> return ()
v -> putStrLn v
-- TODO: Make this invisible
previewTemplate :: Args
previewTemplate = PreviewArgs
{ json = False
, no_color = False
, no_preview = False
, datasource = Nothing &= typFile
}
&= help "This is a mode that should only be used internally. Please see the main usage"
-- &= helpArg [explicit, name "help", name "h"]
preview :: Args -> IO ()
preview args = do
putStrLn "Hello!"
argModes :: Mode (CmdArgs Args)
argModes = cmdArgsMode $ modes [mainArgTemplate, previewTemplate]
&= help ""
&= verbosity
&= helpArg [explicit, name "help", name "h"]
&= summary "nix-attr-search v1.0.0"
main :: IO ()
main = do
args <- cmdArgsRun argModes
case args of
MainArgs {..} -> search args
PreviewArgs {..} -> preview args
-- preview :: IO ()
-- json <- wrapProgram "jq" [".", defaultHMSource] Nothing
-- case json of
-- Just j -> putStrLn j
-- Nothing -> return ()
-- (_, sout, _, _) <- createProcess $ shell $ "cat " ++ defaultHMSource ++ " | jq -r '.description'"
-- putStrLn defaultHMSource
-- JSON_DATA=$(${jq} ".\"$OPTION_KEY\"" $JSON_MANUAL_PATH)
-- export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${docbook2txt}/bin/docbook2txt ${docbook2txtColorArg})
-- EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} -r ".example.text" 2>/dev/null | ${nixfmt} 2>/dev/null)
-- if [ $? != 0 ]; then
-- EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} ".example" | ${json2nix}/bin/json2nix)
-- fi
-- export EXAMPLE=$(echo $EXAMPLE_DATA | ${bat} ${batColorArg}--style=numbers -lnix)
-- export DEFAULT=$(echo $JSON_DATA | ${jq} ".default" | ${json2nix}/bin/json2nix | ${bat} ${batColorArg}--style=numbers -lnix)
-- echo $JSON_DATA | ${gomplate} --datasource opt=stdin:?type=application/json --file ${template}

View File

@ -56,7 +56,7 @@ let
JSON_DATA=$(${jq} ".\"$OPTION_KEY\"" $JSON_MANUAL_PATH)
export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${docbook2txt}/bin/docbook2txt ${docbook2txtColorArg})
EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} -r ".example.text" 2>/dev/null | ${nixfmt})
EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} -r ".example.text" 2>/dev/null | ${nixfmt} 2>/dev/null)
if [ $? != 0 ]; then
EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} ".example" | ${json2nix}/bin/json2nix)
fi
@ -66,76 +66,90 @@ let
echo $JSON_DATA | ${gomplate} --datasource opt=stdin:?type=application/json --file ${template}
'';
in pkgs.writers.writeBash "search-home-manager-attrs" ''
JSON_MANUAL_PATH="${defaultManualPath}"
for i in "$@"; do
case $i in
-h|--help)
cat ${usage}
exit 0
;;
-j|--json)
PRINT_JSON=1
shift
;;
-np|--no-preview)
NO_PREVIEW=1
shift
;;
-nc|--no-color)
NO_COLOR=1
shift
;;
-f=*|--flake=*)
FLAKE="''${i#*=}"
shift
;;
-r=*|--ref=*)
REF="''${i#*=}"
shift
;;
*|-*|--*)
echo "Unknown option $i"
cat ${usage}
exit 1
;;
esac
done
hms = pkgs.writers.writeHaskellBin "home-manager-search" {
libraries = with pkgs.haskellPackages; [ aeson cmdargs process text ];
ghcArgs = builtins.trace "\"${defaultManualPath}\"" [
"-cpp"
''-DHOME_MANAGER_DEFAULT_PATH="${defaultManualPath}"''
];
# postFixup = ''
# wrapProgram $out/bin/home-manager-search --set PATH "$PATH:$out/bin"
# '';
} (builtins.readFile ./home-manager-search.hs);
in hms
if [ -v PRINT_JSON ] && [ -v NO_PREVIEW ]; then
echo "Cannot preview as json with no-preview enabled"
cat ${usage}
exit 1
fi
if [ -v FLAKE ]; then
FLAKE_URL="''${FLAKE}"
# in pkgs.writers.writeBash "search-home-manager-attrs" ''
# JSON_MANUAL_PATH="${defaultManualPath}"
if [ -v REF ]; then
FLAKE_URL="''${FLAKE_URL}?ref=$REF"
fi
# for i in "$@"; do
# case $i in
# -h|--help)
# cat ${usage}
# exit 0
# ;;
# -j|--json)
# PRINT_JSON=1
# shift
# ;;
# -np|--no-preview)
# NO_PREVIEW=1
# shift
# ;;
# -nc|--no-color)
# NO_COLOR=1
# shift
# ;;
# -f=*|--flake=*)
# FLAKE="''${i#*=}"
# shift
# ;;
# -r=*|--ref=*)
# REF="''${i#*=}"
# shift
# ;;
# *|-*|--*)
# echo "Unknown option $i"
# cat ${usage}
# exit 1
# ;;
# esac
# done
FLAKE_URL="''${FLAKE_URL}#docs-json"
echo "Building docs from $FLAKE_URL"
# if [ -v PRINT_JSON ] && [ -v NO_PREVIEW ]; then
# echo "Cannot preview as json with no-preview enabled"
# cat ${usage}
# exit 1
# fi
OUT_PATH=$(${pkgs.nix}/bin/nix build "$FLAKE_URL" --no-link --print-out-paths --no-write-lock-file)
JSON_MANUAL_PATH="$OUT_PATH/share/doc/home-manager/options.json"
echo "Using docs located at $JSON_MANUAL_PATH"
fi
# if [ -v FLAKE ]; then
# FLAKE_URL="''${FLAKE}"
if [ -v NO_PREVIEW ]; then
${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf}
elif [ -v PRINT_JSON ]; then
${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf} --preview "${previewJson} {} $JSON_MANUAL_PATH"
elif [ -v NO_COLOR ]; then
${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf} --preview "${
previewGomplate false
} {} $JSON_MANUAL_PATH"
else
${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf} --preview "${
previewGomplate true
} {} $JSON_MANUAL_PATH"
fi
''
# if [ -v REF ]; then
# FLAKE_URL="''${FLAKE_URL}?ref=$REF"
# fi
# FLAKE_URL="''${FLAKE_URL}#docs-json"
# echo "Building docs from $FLAKE_URL"
# OUT_PATH=$(${pkgs.nix}/bin/nix build "$FLAKE_URL" --no-link --print-out-paths --no-write-lock-file)
# JSON_MANUAL_PATH="$OUT_PATH/share/doc/home-manager/options.json"
# echo "Using docs located at $JSON_MANUAL_PATH"
# fi
# if [ -v NO_PREVIEW ]; then
# ${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf}
# elif [ -v PRINT_JSON ]; then
# ${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf} --preview "${previewJson} {} $JSON_MANUAL_PATH"
# elif [ -v NO_COLOR ]; then
# ${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf} --preview "${
# previewGomplate false
# } {} $JSON_MANUAL_PATH"
# else
# ${jq} -r 'keys | .[] | .' $JSON_MANUAL_PATH | ${fzf} --preview "${
# previewGomplate true
# } {} $JSON_MANUAL_PATH"
# fi
# ''

30
src/Main.hs Normal file
View File

@ -0,0 +1,30 @@
{-# LANGUAGE NamedFieldPuns #-}
module Main where
import NAS.Cli.Args
import NAS.Searchers.HomeManager (search, mainArgTemplate)
import NAS.Preview (preview)
import System.Console.CmdArgs
import Data.Map
previewTemplate :: Args
previewTemplate = PreviewArgs { optionKey = def &= argPos 0
, base64EncodedOptions = def &= argPos 1
}
&= help "This is a mode that should only be used internally. Please see the main usage"
argModes :: Mode (CmdArgs Args)
argModes = cmdArgsMode $ modes [mainArgTemplate, previewTemplate]
&= help ""
&= verbosity
&= helpArg [explicit, name "help", name "h"]
&= summary "nix-attr-search v1.0.0"
main :: IO ()
main = do
args <- cmdArgsRun argModes
case args of
MainArgs {} -> search args
PreviewArgs {} -> preview (optionKey args) (base64EncodedOptions args)

22
src/NAS/Cli/Args.hs Normal file
View File

@ -0,0 +1,22 @@
{-# LANGUAGE DeriveDataTypeable #-}
module NAS.Cli.Args (Args(..)) where
import Data.Data
data Args = MainArgs
{ json :: Bool
, no_color :: Bool
, no_preview :: Bool
, flake :: Maybe String
, ref :: Maybe String
}
| PreviewArgs
{ optionKey :: String
, base64EncodedOptions :: String
}
-- , no_color :: Bool
-- , no_preview :: Bool
-- , datasource :: Maybe String
-- }
deriving (Data,Typeable,Show,Eq)

17
src/NAS/Cli/Conversion.hs Normal file
View File

@ -0,0 +1,17 @@
module NAS.Cli.Conversion where
import NAS.Conversion.Docbook2txt
-- import NAS.Conversion.Json2nix
import System.Environment (getArgs)
docbook2txtCli :: IO ()
docbook2txtCli = do
stdin <- getContents
args <- getArgs
let colorizedMode = "-C" `elem` args
putStrLn $ processDocs colorizedMode stdin
json2txtCli :: IO ()
json2txtCli = undefined

View File

@ -1,3 +1,10 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
module NAS.Conversion.Docbook2txt where
-- This is a program that converts docbook xml to optionally ANSI colored
-- raw text.
--
@ -8,17 +15,11 @@
-- end up having to write custom conversion logic for every tag to be
-- consumed by pandoc anyway. So instead, I am just planning on keeping
-- my own module parsing raw xml tags (for now).
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
import Data.Char (isSpace)
import Data.List (find, intersperse)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import Data.String (IsString, fromString)
import qualified System.Console.ANSI.Codes 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
-- import qualified Text.Layout.Table as T
@ -60,7 +61,7 @@ instance Monoid Formatted where
realString :: Formatted -> String
realString (FSeveral fs) = concatMap realString fs
realString (FWrapped w1 s w2) = realString s
realString (FWrapped _ s _) = realString s
realString (FPlain s) = s
realLength :: Formatted -> Int
@ -96,19 +97,16 @@ instance Monoid PotentiallyColorizedString where
nonColorized = mempty
}
main :: IO ()
main = do
stdin <- getContents
args <- getArgs
let colorizedMode = "-C" `elem` args
printTags colorizedMode $ map replaceTagColor $ removeParagraphTags $ TS.parseTree stdin
processDocs :: Bool -> String -> String
processDocs isColorized input =
convertTags isColorized $ map replaceTagColor $ removeParagraphTags $ TS.parseTree input
-- Print a list of PCSs.
-- Depending on the first argument, the color can be optionally
-- colored.
printTags :: Bool -> [PotentiallyColorizedString] -> IO ()
printTags False = putStrLn . unwords . map nonColorized
printTags True = putStrLn . mconcatMap (show . colorized)
convertTags :: Bool -> [PotentiallyColorizedString] -> String
convertTags False = unwords . map nonColorized
convertTags True = mconcatMap (show . colorized)
-- ANSI helpers
@ -144,6 +142,7 @@ removeParagraphTags (TS.TagLeaf (TS.TagOpen "para" _) : rest) = removeParagraphT
removeParagraphTags (x : y : rest) = x : removeParagraphTags (y : rest)
removeParagraphTags x = x
pattern TextLeaf :: forall {str}. str -> TS.TagTree str
pattern TextLeaf a = TS.TagLeaf (TS.TagText a)
-- Replace tags with their PCS string equivalent.
@ -303,4 +302,4 @@ replaceTagColor tagtree = case tagtree of
PCS
{ colorized = wrapColor AN.Red $ TS.renderTree [unknown],
nonColorized = TS.renderTree [unknown]
}
}

View File

@ -1,7 +1,9 @@
{-# LANGUAGE OverloadedStrings #-}
module NAS.Conversion.Json2nix where
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as A
-- import qualified Data.Aeson.Key as A
import qualified Data.Aeson.KeyMap as A
import qualified Data.ByteString as BS
import qualified Data.Either.Extra as E

View File

@ -0,0 +1,4 @@
`DefaultPaths.hs` will be generated during running nix build.
See `default.nix` for more info

50
src/NAS/Preview.hs Normal file
View File

@ -0,0 +1,50 @@
module NAS.Preview where
import qualified NAS.Cli.Args as A
import NAS.Templates.OptionsTemplate
import NAS.Utils
-- import NAS.Conversion.Json2nix
-- import NAS.Conversion.Docbook2txt
import System.Console.CmdArgs ((&=), help, typFile)
import Data.Text.Encoding.Base64
import Data.Text
-- TODO: Make this invisible
data PreviewOptions =
PreviewOptions { json :: Bool
, no_color :: Bool
, no_preview :: Bool
, datasource :: Maybe String
}
deriving (Show, Read, Eq)
-- previewTemplate :: Args
-- previewTemplate = PreviewArgs
-- { json = False
-- , no_color = False
-- , no_preview = False
-- , datasource = Nothing &= typFile
-- }
--
preview :: String -> String -> IO ()
preview searchKey base64EncodedOptions = do
options <- case decodeBase64 $ pack base64EncodedOptions of
Right options -> return $ (read :: String -> PreviewOptions) $ unpack options
Left e -> exitWithError $ "Internal error: could not parse options\n" ++ (unpack e)
print options
putStrLn "Hello!"
-- JSON_DATA=$(${jq} ".\"$OPTION_KEY\"" $JSON_MANUAL_PATH)
-- export DESCRIPTION=$(echo $JSON_DATA | ${jq} -r ".description" | ${docbook2txt}/bin/docbook2txt ${docbook2txtColorArg})
-- EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} -r ".example.text" 2>/dev/null | ${nixfmt} 2>/dev/null)
-- if [ $? != 0 ]; then
-- EXAMPLE_DATA=$(echo $JSON_DATA | ${jq} ".example" | ${json2nix}/bin/json2nix)
-- fi
-- export EXAMPLE=$(echo $EXAMPLE_DATA | ${bat} ${batColorArg}--style=numbers -lnix)
-- export DEFAULT=$(echo $JSON_DATA | ${jq} ".default" | ${json2nix}/bin/json2nix | ${bat} ${batColorArg}--style=numbers -lnix)
-- echo $JSON_DATA | ${gomplate} --datasource opt=stdin:?type=application/json --file ${template}

View File

@ -0,0 +1,77 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
-- {-# LANGUAGE DeriveGeneric #-}
module NAS.Searchers.HomeManager where
import qualified NAS.Cli.Args as Arg
import NAS.Utils
import NAS.DefaultPaths (defaultHomeManagerOptionsPath)
import NAS.Preview (PreviewOptions(..))
import System.Console.CmdArgs
import qualified Data.Aeson as A
import qualified Data.Aeson.TH as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import System.IO
import System.Process
import Data.Map as M
import Data.Text.Encoding.Base64
mainArgTemplate :: Arg.Args
mainArgTemplate = Arg.MainArgs
{ Arg.json = False &= help "Show JSON data in preview pane"
, Arg.no_color = False &= help "Don't display ANSI colors in preview pane"
, Arg.no_preview = False &= help "Don't display preview pane"
, Arg.flake = Nothing &= typ "FLAKE_URI" &= groupname "source" &= help "Specify home-manager flake to show manual from"
, Arg.ref = Nothing &= typ "REF" &= groupname "source" &= help "Specify git reference for the flake path to show manual from (if applicable)"
}
&= auto
fetchHMSource :: String -> Maybe String -> IO (Either String String)
fetchHMSource flake ref = undefined
data Option = Option {
description :: Either String A.Object
, defaultValue :: Either String A.Object
, example :: Either String A.Object
, loc :: [String]
}
deriving (Show)
$(A.deriveJSON A.defaultOptions {A.fieldLabelModifier = \x -> if x == "default" then "defaultValue" else x} ''Option)
parseOptionList :: String -> IO (Either String String)
parseOptionList path = do
json <- BSL.readFile path
return $ unlines . keys <$> (A.eitherDecode json :: Either String (M.Map String A.Object))
search :: Arg.Args -> IO ()
search args = do
maybeJsonOptionsPath <- case Arg.flake args of
Nothing -> return $ Right defaultHomeManagerOptionsPath
Just flk -> flip fetchHMSource (Arg.ref args) flk
jsonOptionsPath <- case maybeJsonOptionsPath of
Left err -> exitWithError $ "Could not fetch json source\n" ++ err
Right src -> return src
optionList <- parseOptionList jsonOptionsPath >>= \case
Left err -> exitWithError $ "Could not parse options:\n" ++ err
Right opts -> return opts
let base64EncodedOptions = T.unpack $ encodeBase64 $ T.pack $ show $ PreviewOptions {
json = Arg.json args
, no_color = Arg.no_color args
, no_preview = Arg.no_preview args
, datasource = Just jsonOptionsPath
}
chosenValue <- wrapProgram "fzf" ["--preview", "nix-attr-search preview {} " ++ base64EncodedOptions] $ Just optionList
case chosenValue of
"" -> return ()
v -> putStrLn v

View File

@ -0,0 +1 @@
module NAS.Searchers.NixosOptions where

View File

@ -0,0 +1,2 @@
module NAS.Templates.OptionsTemplate where

14
src/NAS/Utils.hs Normal file
View File

@ -0,0 +1,14 @@
module NAS.Utils where
import System.IO (hPutStrLn, stderr)
import System.Exit (exitFailure)
import System.Process (readProcess)
wrapProgram :: String -> [String] -> Maybe String -> IO String
wrapProgram programName args maybeInput = do
case maybeInput of
Just input -> readProcess programName args input
Nothing -> readProcess programName args ""
exitWithError :: String -> IO a
exitWithError errorMessage = hPutStrLn stderr errorMessage >> exitFailure