From 9d520c49aca2f3dcd8c6e2475b5c39ec36d752a6 Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Fri, 10 May 2024 20:17:46 +0200 Subject: [PATCH 1/7] Add parseColumns --- extra/config.md | 4 +- package.yaml | 1 + src/Nixon/Command.hs | 8 ++-- src/Nixon/Command/Placeholder.hs | 6 ++- src/Nixon/Command/Run.hs | 11 ++++-- src/Nixon/Config/Markdown.hs | 23 +++++++----- src/Nixon/Format.hs | 23 ++++++++++++ src/Nixon/Select.hs | 19 ++++------ src/Nixon/Utils.hs | 12 +++++- test/Main.hs | 60 +++++++++++++++++++++--------- test/Test/Nixon/Backend/Fzf.hs | 3 +- test/Test/Nixon/Config/Markdown.hs | 49 +++++++++++++++++++----- test/Test/Nixon/Format/Columns.hs | 29 +++++++++++++++ 13 files changed, 188 insertions(+), 60 deletions(-) create mode 100644 src/Nixon/Format.hs create mode 100644 test/Test/Nixon/Format/Columns.hs diff --git a/extra/config.md b/extra/config.md index dce965e..e875277 100644 --- a/extra/config.md +++ b/extra/config.md @@ -79,14 +79,14 @@ cat Use `nmcli` to list available networks. ```bash -nmcli -t connection | cut -d':' -f1 +nmcli connection ``` ### `network-connect` Use the `networks` placeholder to select a network to connect to. -```bash ${networks} +```bash ${networks | cols 1} nmcli connection up "$1" ``` diff --git a/package.yaml b/package.yaml index 4e7fc0f..58889a1 100644 --- a/package.yaml +++ b/package.yaml @@ -47,6 +47,7 @@ tests: - test dependencies: - base + - containers - hspec - nixon - QuickCheck diff --git a/src/Nixon/Command.hs b/src/Nixon/Command.hs index 6e81c6e..1d74223 100644 --- a/src/Nixon/Command.hs +++ b/src/Nixon/Command.hs @@ -8,7 +8,7 @@ module Nixon.Command ( Text show_command cmd = T.unwords $ cmdName cmd : map (format ("${" % s % "}") . P.name) (cmdPlaceholders cmd) @@ -83,8 +83,8 @@ description d cmd = cmd {cmdDesc = Just d} bg :: Bool -> Command -> Command bg g cmd = cmd {cmdIsBg = g} -json :: Bool -> Command -> Command -json j cmd = cmd {cmdOutput = if j then JSON else Lines} +outFmt :: CommandOutput -> Command -> Command +outFmt o cmd = cmd {cmdOutput = o} is_bg_command :: Command -> Bool is_bg_command _ = False diff --git a/src/Nixon/Command/Placeholder.hs b/src/Nixon/Command/Placeholder.hs index 6525809..a5c5c8e 100644 --- a/src/Nixon/Command/Placeholder.hs +++ b/src/Nixon/Command/Placeholder.hs @@ -1,5 +1,6 @@ module Nixon.Command.Placeholder ( Placeholder (..), + PlaceholderField (..), PlaceholderType (..), ) where @@ -9,6 +10,9 @@ import Nixon.Prelude data PlaceholderType = Arg | EnvVar {_envName :: Text} | Stdin deriving (Eq, Show) +data PlaceholderField = Col Int | Field Int + deriving (Eq, Show) + -- | Placeholders for environment variables data Placeholder = Placeholder { -- | Type of placeholder @@ -16,7 +20,7 @@ data Placeholder = Placeholder -- | The command it's referencing name :: Text, -- | The field numbers to extract - fields :: [Integer], + fields :: [PlaceholderField], -- | If the placeholder can select multiple multiple :: Bool, -- | Pre-expanded value of the placeholder diff --git a/src/Nixon/Command/Run.hs b/src/Nixon/Command/Run.hs index 4ac7ac8..c771024 100644 --- a/src/Nixon/Command/Run.hs +++ b/src/Nixon/Command/Run.hs @@ -6,7 +6,7 @@ module Nixon.Command.Run where import Control.Monad (foldM) -import Data.Aeson (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict, encode) import Data.Foldable (find) import qualified Data.Text as T import Nixon.Command (Command, CommandOutput (..)) @@ -22,10 +22,11 @@ import qualified Nixon.Project as Project import Nixon.Select (Selection (..), Selector, selector_fields, selector_multiple) import qualified Nixon.Select as Select import Nixon.Types (Nixon) -import Nixon.Utils (toLines) -import Turtle (Shell, cd, format, fp, select, stream) +import Nixon.Utils (toLines, shell_to_list, parseColumns) +import Turtle (Shell, cd, format, fp, select, stream, printf) import qualified Turtle.Bytes as BS import Turtle.Line (lineToText) +import Turtle.Format (w) -- | Actually run a command runCmd :: Selector Nixon -> Project -> Command -> [Text] -> Nixon () @@ -95,6 +96,10 @@ resolveCmd project selector cmd select_opts = do jsonEval <- getEvaluator (run_with_output BS.stream) cmd args projectPath env' (BS.fromUTF8 <$> stdin) selection <- selector select_opts $ do case Cmd.cmdOutput cmd of + Columns -> do + cols <- parseColumns . map lineToText <$> shell_to_list linesEval + printf w (encode cols) + pure $ Select.Identity "asdf" Lines -> Select.Identity . lineToText <$> linesEval JSON -> do output <- BS.strict jsonEval diff --git a/src/Nixon/Config/Markdown.hs b/src/Nixon/Config/Markdown.hs index 2f2cc6c..9b1c937 100644 --- a/src/Nixon/Config/Markdown.hs +++ b/src/Nixon/Config/Markdown.hs @@ -23,7 +23,7 @@ import Data.Text (pack, strip) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Yaml as Yaml -import Nixon.Command (bg, json, ( go (S 0 [] initP | hasArgs "command" attrs = let pt = getKwargs "type" attrs <> st.stateProjectTypes isBg = hasArgs "bg" attrs - isJson = hasArgs "json" attrs + fmt + | hasArgs "json" attrs = Cmd.JSON + | hasArgs "cols" attrs = Cmd.Columns + | otherwise = Cmd.Lines posInfo = PosInfo fileName pos l in case parseCommand posInfo name pt rest of (Left err, _) -> Left err (Right p, rest') -> - let cmd = p P.many P.space *> parseFields p + parsePipeFields p = + (P.string "cols" *> P.many P.space *> parseFields Cmd.Col p) <|> + (P.string "fields" *> P.many P.space *> parseFields Cmd.Field p) parsePipeMultiple p = (P.string "multi" :: Parser String) $> p {Cmd.multiple = True} @@ -372,12 +377,12 @@ parsePlaceholderModifiers placeholder = do parseColonModifiers p = do _ <- P.char ':' -- Accept fields and multiple in any order - (parseFields p >>= perhaps parseMultiple) <|> (parseMultiple p >>= perhaps parseFields) + (parseFields Cmd.Field p >>= perhaps parseMultiple) <|> (parseMultiple p >>= perhaps (parseFields Cmd.Field)) - parseFields :: Cmd.Placeholder -> Parser Cmd.Placeholder - parseFields p' = do - fields <- mapMaybe readMaybe <$> (P.many1 P.digit `P.sepBy1` P.char ',') - pure $ p' {Cmd.fields = fields} + parseFields :: (Int -> Cmd.PlaceholderField) -> Cmd.Placeholder -> Parser Cmd.Placeholder + parseFields fieldType p' = do + fields <- mapMaybe readMaybe <$> (P.many1 P.digit `P.sepBy1` P.char ',') + pure $ p' {Cmd.fields = p'.fields <> (fieldType <$> fields)} parseMultiple :: Cmd.Placeholder -> Parser Cmd.Placeholder parseMultiple p' = do diff --git a/src/Nixon/Format.hs b/src/Nixon/Format.hs new file mode 100644 index 0000000..ac0fe65 --- /dev/null +++ b/src/Nixon/Format.hs @@ -0,0 +1,23 @@ +module Nixon.Format where + +import Data.Char (isSpace) +import qualified Data.Text as T +import Nixon.Prelude + +-- | Parse ouput in column format into a list of rows of columns. +parseColumns :: Text -> [[Text]] +parseColumns input = case T.lines input of + [] -> [] + (header : rows) -> parseColumn (parseWidths header) <$> rows + where + parseWidths t + | T.length t == 0 = [] + | otherwise = + let (word, startOfSpace) = T.span (not . isSpace) t + (space, rest) = T.span isSpace startOfSpace + in T.length word + T.length space : parseWidths rest + parseColumn [] _ = [] + -- The last column runs to the end of line + parseColumn [_] row = [row] + parseColumn (w : ws) row = case T.splitAt w row of + (col, rest) -> T.strip col : parseColumn ws rest diff --git a/src/Nixon/Select.hs b/src/Nixon/Select.hs index efecc49..51ad68a 100644 --- a/src/Nixon/Select.hs +++ b/src/Nixon/Select.hs @@ -33,11 +33,11 @@ import Data.Aeson (.:), ) import Data.Aeson.Types (unexpected) -import Data.Function ((&)) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Text as T import GHC.Generics (Generic) +import qualified Nixon.Command.Placeholder as Cmd import Nixon.Prelude import Turtle (Line, Shell, textToLine) @@ -86,7 +86,7 @@ instance Functor Selection where data SelectorOpts = SelectorOpts { selector_title :: Maybe Text, selector_search :: Maybe Text, - selector_fields :: [Integer], + selector_fields :: [Cmd.PlaceholderField], selector_multiple :: Maybe Bool } @@ -131,12 +131,12 @@ build_map f = Map.fromList . map (f &&& id) runSelect :: Selector m -> Select m a -> m a runSelect = flip runReaderT -select :: MonadIO m => SelectorOpts -> Shell Candidate -> Select m (Selection Text) +select :: (MonadIO m) => SelectorOpts -> Shell Candidate -> Select m (Selection Text) select opts input = do selector <- ask lift $ selector opts input -processSelection :: Monad m => SelectorOpts -> Selection Text -> m (Selection Text) +processSelection :: (Monad m) => SelectorOpts -> Selection Text -> m (Selection Text) processSelection opts selection' | null fields = pure selection' -- NOTE: Unsure about this `T.stripEnd` here. It might remove too much trailing whitespace. @@ -144,15 +144,12 @@ processSelection opts selection' where fields = selector_fields opts pickFields line = - T.words line - -- 1 indexed, to reserve 0 for the whole line - & zip [1 ..] - & filter ((`elem` fields) . fst) - & map snd - & T.unwords + let pickItem (Cmd.Col i) = undefined !! (i - 1) + pickItem (Cmd.Field i) = T.words line !! (i - 1) + in T.unwords $ map pickItem fields withProcessSelection :: - Monad m => + (Monad m) => (SelectorOpts -> a -> m (Selection Text)) -> SelectorOpts -> a -> diff --git a/src/Nixon/Utils.hs b/src/Nixon/Utils.hs index f8b8d8d..ee19033 100644 --- a/src/Nixon/Utils.hs +++ b/src/Nixon/Utils.hs @@ -14,8 +14,9 @@ module Nixon.Utils filter_elems, implode_home, (< MaybeT (need "EDITOR") ) run (editor :| args) Nothing [] empty + +parseColumns :: [Text] -> [Map Text Text] +parseColumns input = case input of + [] -> [] + header : body -> + let headers = T.words header + in map (Map.fromList . zip headers . T.words) body diff --git a/test/Main.hs b/test/Main.hs index 0cfc902..06e89e2 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,6 +1,7 @@ module Main where import Data.Char (isPrint, isSpace) +import qualified Data.Map.Strict as Map import qualified Data.Text as T import Nixon.Prelude import Nixon.Select @@ -13,8 +14,9 @@ import Test.Nixon.Logging import Test.Nixon.Process (process) import Test.QuickCheck import Test.QuickCheck.Instances.Text () +import Test.Nixon.Format.Columns (column_tests) -empty :: Monad m => a -> m (Selection Text) +empty :: (Monad m) => a -> m (Selection Text) empty = const (pure EmptySelection) arbitraryTextOf :: (Char -> Bool) -> Gen Text @@ -44,33 +46,55 @@ main = hspec $ do describe "Config" $ do describe "Markdown" markdown_tests + describe "Format" $ do + describe "Columns" column_tests + describe "Logging" logging describe "Process" process describe "Utils" $ do describe "escape" $ do - it "leaves simple string alone" $ - escape "foo" `shouldBe` "foo" + it "leaves simple string alone" + $ escape "foo" + `shouldBe` "foo" - it "escapes quote character" $ - escape "\"" `shouldBe` "\\\"" + it "escapes quote character" + $ escape "\"" + `shouldBe` "\\\"" - it "escapes backslash character" $ - escape "\\" `shouldBe` "\\\\" + it "escapes backslash character" + $ escape "\\" + `shouldBe` "\\\\" describe "quote" $ do - it "surrounds text in quotes" $ - quote "foo" `shouldBe` "\"foo\"" + it "surrounds text in quotes" + $ quote "foo" + `shouldBe` "\"foo\"" - it "escapes inner text" $ - quote "\"foo\"" `shouldBe` "\"\\\"foo\\\"\"" + it "escapes inner text" + $ quote "\"foo\"" + `shouldBe` "\"\\\"foo\\\"\"" describe "takeToSpace" $ do - it "is empty with leading space" $ - property $ - \text -> takeToSpace (" " <> getWs text) == "" - - it "reads until first space" $ - property $ - \pre ws post -> takeToSpace (getNonWs pre <> getWs ws <> post) == getNonWs pre + it "is empty with leading space" + $ property + $ \text -> takeToSpace (" " <> getWs text) == "" + + it "reads until first space" + $ property + $ \pre ws post -> takeToSpace (getNonWs pre <> getWs ws <> post) == getNonWs pre + + describe "parseColumns" $ do + it "parses empty input" $ do + parseColumns [""] `shouldBe` [] + + it "parses headers" $ do + parseColumns ["foo bar baz"] `shouldBe` [] + + it "parses headers and values" $ do + let input = ["foo bar baz", "1 2 3", "4 5 6"] + parseColumns input + `shouldBe` [ Map.fromList [("foo", "1"), ("bar", "2"), ("baz", "3")], + Map.fromList [("foo", "4"), ("bar", "5"), ("baz", "6")] + ] diff --git a/test/Test/Nixon/Backend/Fzf.hs b/test/Test/Nixon/Backend/Fzf.hs index af4c3c2..fb525e9 100644 --- a/test/Test/Nixon/Backend/Fzf.hs +++ b/test/Test/Nixon/Backend/Fzf.hs @@ -11,6 +11,7 @@ import qualified Nixon.Backend as Backend import Nixon.Backend.Fzf (fzf, fzfBackend, fzfExpect, fzfFilter, fzfProjects) import qualified Nixon.Backend.Fzf as Fzf import qualified Nixon.Command as Cmd +import qualified Nixon.Command.Placeholder as Cmd import Nixon.Config.Types (defaultConfig) import Nixon.Prelude import Nixon.Project (Project (..)) @@ -161,7 +162,7 @@ fzfTests = do it "filters fields based on selector options (words 1 & 3)" $ do let candidates = map Identity ["one two three", "four five six", "seven eight nine"] selector = Backend.selector $ fzfBackend defaultConfig - selectOpts = Select.defaults {Select.selector_fields = [1, 3]} + selectOpts = Select.defaults {Select.selector_fields = Cmd.Field <$> [1, 3]} result <- runProc (ExitSuccess, "1") diff --git a/test/Test/Nixon/Config/Markdown.hs b/test/Test/Nixon/Config/Markdown.hs index 7209079..2d28068 100644 --- a/test/Test/Nixon/Config/Markdown.hs +++ b/test/Test/Nixon/Config/Markdown.hs @@ -4,7 +4,7 @@ import Control.Arrow ((&&&)) import Data.Either (isLeft) import qualified Data.Text as T import qualified Nixon.Command as Cmd -import Nixon.Command.Placeholder (Placeholder (..), PlaceholderType (..)) +import Nixon.Command.Placeholder (Placeholder (..), PlaceholderField (..), PlaceholderType (..)) import Nixon.Config.Markdown (parseCommandName, parseHeaderArgs, parseMarkdown) import Nixon.Config.Types (defaultConfig) import qualified Nixon.Config.Types as Cfg @@ -15,6 +15,9 @@ import Test.Hspec match_error :: Text -> Either Text b -> Bool match_error match = either (T.isInfixOf match) (const False) +fs :: [Int] -> [PlaceholderField] +fs = fmap Field + config_tests :: SpecWith () config_tests = describe "config section" $ do it "allows empty JSON object" @@ -317,6 +320,32 @@ command_tests = describe "commands section" $ do [ ("hello", Bash, "echo Hello World\n", [], False) ] + it "detects columns output format" + $ let result = + parseMarkdown "some-file.md" + $ T.unlines + [ "# `hello`", + "```bash ${placeholder | cols 1}", + "echo Hello World", + "```" + ] + selector = fmap (Cmd.cmdName &&& Cmd.cmdPlaceholders) . Cfg.commands + placeholder = Placeholder Arg "placeholder" [Col 1] False [] + in selector <$> result `shouldBe` Right [("hello", [placeholder])] + + it "combines columns and fields output format" + $ let result = + parseMarkdown "some-file.md" + $ T.unlines + [ "# `hello`", + "```bash ${placeholder | cols 1 | fields 2}", + "echo Hello World", + "```" + ] + selector = fmap (Cmd.cmdName &&& Cmd.cmdPlaceholders) . Cfg.commands + placeholder = Placeholder Arg "placeholder" [Col 1, Field 2] False [] + in selector <$> result `shouldBe` Right [("hello", [placeholder])] + it "detects json output format" $ let result = parseMarkdown "some-file.md" @@ -440,8 +469,8 @@ command_tests = describe "commands section" $ do `shouldBe` Right [ (Bash, [Placeholder Arg "arg-one" [] False []]), (Bash, [Placeholder Arg "arg-two" [] True []]), - (Bash, [Placeholder Arg "arg-three" [1, 2] False []]), - (Bash, [Placeholder Arg "arg-four" [1, 2] True []]) + (Bash, [Placeholder Arg "arg-three" (fs [1, 2]) False []]), + (Bash, [Placeholder Arg "arg-four" (fs [1, 2]) True []]) ] it "complains on both header & code block placeholders" $ do @@ -602,11 +631,11 @@ parse_command_name_tests = describe "parseCommandName" $ do it "parses arg field selector" $ do parseCommandName "cat <{arg:1}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [1] False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1]) False []]) it "parses several arg field selectors" $ do parseCommandName "cat <{arg:1,3,5}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [1, 3, 5] False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) False []]) it "parses arg modifiers" $ do parseCommandName "cat ${arg:m}" @@ -614,7 +643,7 @@ parse_command_name_tests = describe "parseCommandName" $ do it "parses arg modifiers" $ do parseCommandName "cat ${arg | fields 1,3}" - `shouldBe` Right ("cat", [Placeholder Arg "arg" [1, 3] False []]) + `shouldBe` Right ("cat", [Placeholder Arg "arg" (fs [1, 3]) False []]) it "parses arg modifiers" $ do parseCommandName "cat ${arg | multi}" @@ -626,19 +655,19 @@ parse_command_name_tests = describe "parseCommandName" $ do it "parses arg field and multiple selector" $ do parseCommandName "cat <{arg:m1,3,5}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [1, 3, 5] True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) True []]) it "parses arg field and multiple selector (flipped)" $ do parseCommandName "cat <{arg:1,3,5m}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [1, 3, 5] True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) True []]) it "parses arg field and pipe fields" $ do parseCommandName "cat <{arg | fields 1,3,5}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [1, 3, 5] False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) False []]) it "parses arg field, pipe fields and pipe multiple" $ do parseCommandName "cat <{arg | fields 1,3,5 | multi}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [1, 3, 5] True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) True []]) it "parses text and placeholder part" $ do parseCommandName "cat \"${arg}\"" diff --git a/test/Test/Nixon/Format/Columns.hs b/test/Test/Nixon/Format/Columns.hs new file mode 100644 index 0000000..659f16b --- /dev/null +++ b/test/Test/Nixon/Format/Columns.hs @@ -0,0 +1,29 @@ +module Test.Nixon.Format.Columns where + +import qualified Data.Text as T +import Nixon.Format (parseColumns) +import Nixon.Prelude +import Test.Hspec + +column_tests :: SpecWith () +column_tests = do + it "parses columns (empty input)" $ do + parseColumns "" `shouldBe` [] + + it "parses columns (titles only)" $ do + let input = "NAME UUID TYPE DEVICE" + parseColumns input `shouldBe` [] + + it "parses columns" $ do + let input = + T.unlines + [ "NAME UUID TYPE DEVICE", + "My Wifi 845b3837-c78e-44f1-a752-06ecd496599c wifi wlp9s0", + "br-7defdaf327de 1b9a3d7c-d856-498f-ac12-4d79647f116f bridge br-7defdaf327de", + "lo ae505c7d-8596-41b2-9329-c3d31f4c60ef loopback lo" + ] + parseColumns input + `shouldBe` [ ["My Wifi", "845b3837-c78e-44f1-a752-06ecd496599c", "wifi", "wlp9s0"], + ["br-7defdaf327de", "1b9a3d7c-d856-498f-ac12-4d79647f116f", "bridge", "br-7defdaf327de"], + ["lo", "ae505c7d-8596-41b2-9329-c3d31f4c60ef", "loopback", "lo"] + ] From a79302fba3eb97f64491d3122ee396504c168696 Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Sat, 18 May 2024 22:37:30 +0200 Subject: [PATCH 2/7] Handle parseColumns input as lines --- src/Nixon/Format.hs | 9 ++++++--- test/Test/Nixon/Format/Columns.hs | 16 +++++++--------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/Nixon/Format.hs b/src/Nixon/Format.hs index ac0fe65..046d521 100644 --- a/src/Nixon/Format.hs +++ b/src/Nixon/Format.hs @@ -1,12 +1,15 @@ -module Nixon.Format where +module Nixon.Format + ( parseColumns, + ) +where import Data.Char (isSpace) import qualified Data.Text as T import Nixon.Prelude -- | Parse ouput in column format into a list of rows of columns. -parseColumns :: Text -> [[Text]] -parseColumns input = case T.lines input of +parseColumns :: [Text] -> [[Text]] +parseColumns = \case [] -> [] (header : rows) -> parseColumn (parseWidths header) <$> rows where diff --git a/test/Test/Nixon/Format/Columns.hs b/test/Test/Nixon/Format/Columns.hs index 659f16b..3473a9b 100644 --- a/test/Test/Nixon/Format/Columns.hs +++ b/test/Test/Nixon/Format/Columns.hs @@ -1,6 +1,5 @@ module Test.Nixon.Format.Columns where -import qualified Data.Text as T import Nixon.Format (parseColumns) import Nixon.Prelude import Test.Hspec @@ -8,20 +7,19 @@ import Test.Hspec column_tests :: SpecWith () column_tests = do it "parses columns (empty input)" $ do - parseColumns "" `shouldBe` [] + parseColumns [] `shouldBe` [] it "parses columns (titles only)" $ do - let input = "NAME UUID TYPE DEVICE" + let input = ["NAME UUID TYPE DEVICE"] parseColumns input `shouldBe` [] it "parses columns" $ do let input = - T.unlines - [ "NAME UUID TYPE DEVICE", - "My Wifi 845b3837-c78e-44f1-a752-06ecd496599c wifi wlp9s0", - "br-7defdaf327de 1b9a3d7c-d856-498f-ac12-4d79647f116f bridge br-7defdaf327de", - "lo ae505c7d-8596-41b2-9329-c3d31f4c60ef loopback lo" - ] + [ "NAME UUID TYPE DEVICE", + "My Wifi 845b3837-c78e-44f1-a752-06ecd496599c wifi wlp9s0", + "br-7defdaf327de 1b9a3d7c-d856-498f-ac12-4d79647f116f bridge br-7defdaf327de", + "lo ae505c7d-8596-41b2-9329-c3d31f4c60ef loopback lo" + ] parseColumns input `shouldBe` [ ["My Wifi", "845b3837-c78e-44f1-a752-06ecd496599c", "wifi", "wlp9s0"], ["br-7defdaf327de", "1b9a3d7c-d856-498f-ac12-4d79647f116f", "bridge", "br-7defdaf327de"], From 4aa13454713b13810a584026ebac5ac2bebaeb2c Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Sun, 19 May 2024 00:01:39 +0200 Subject: [PATCH 3/7] Remove output format and make JSON a selection fmt Instead of using dedicated output formats per command, make it a property of the placeholder. --- extra/config.md | 11 ++++---- src/Nixon/Backend/Fzf.hs | 4 +-- src/Nixon/Backend/Rofi.hs | 4 +-- src/Nixon/Command.hs | 31 ++++++++++++++++----- src/Nixon/Command/Placeholder.hs | 10 ++++++- src/Nixon/Command/Run.hs | 43 +++++++++++++++++------------- src/Nixon/Config/Markdown.hs | 11 +++----- src/Nixon/Format.hs | 12 ++++++++- src/Nixon/Select.hs | 22 --------------- src/Nixon/Utils.hs | 10 ------- test/Main.hs | 15 ----------- test/Test/Nixon/Backend/Fzf.hs | 2 +- test/Test/Nixon/Config/Markdown.hs | 8 +++--- 13 files changed, 88 insertions(+), 95 deletions(-) diff --git a/extra/config.md b/extra/config.md index e875277..4ed7331 100644 --- a/extra/config.md +++ b/extra/config.md @@ -56,7 +56,7 @@ x-terminal-emulator emacs ``` -### `json-greetings` {.json} +### `json-greetings` ```json [ @@ -70,7 +70,7 @@ emacs Select from one or more greetings in a JSON format. -```bash <{json-greetings | multi} +```bash <{json-greetings | json | multi} cat ``` @@ -87,7 +87,8 @@ nmcli connection Use the `networks` placeholder to select a network to connect to. ```bash ${networks | cols 1} -nmcli connection up "$1" +# nmcli connection up "$1" +echo "$@" ``` ### `pd` @@ -115,7 +116,7 @@ nix-shell ## npm stuff {type="npm"} -### `npm-scripts` {.json} +### `npm-scripts` List all `npm` scripts in a `package.json`. @@ -127,7 +128,7 @@ jq '.scripts | to_entries | map({ title: (.key + " → " + .value), value: .key Run a `npm` script from `package.json`. -```bash ${npm-scripts} +```bash ${npm-scripts | json} npm run "$1" ``` diff --git a/src/Nixon/Backend/Fzf.hs b/src/Nixon/Backend/Fzf.hs index 973364d..6b41775 100644 --- a/src/Nixon/Backend/Fzf.hs +++ b/src/Nixon/Backend/Fzf.hs @@ -41,7 +41,7 @@ import Nixon.Project ( Project (projectDir, projectName), project_path, ) -import Nixon.Select (Candidate, Selection (..), SelectionType (..), withProcessSelection) +import Nixon.Select (Candidate, Selection (..), SelectionType (..)) import qualified Nixon.Select as Select import Nixon.Utils ( implode_home, @@ -77,7 +77,7 @@ fzfBackend cfg = in Backend { projectSelector = fzfProjects . fzf_opts, commandSelector = fzfProjectCommand fzf_opts', - selector = withProcessSelection (fzf . fzf_opts) + selector = fzf . fzf_opts } data FzfOpts = FzfOpts diff --git a/src/Nixon/Backend/Rofi.hs b/src/Nixon/Backend/Rofi.hs index 729465b..0d6dfb2 100644 --- a/src/Nixon/Backend/Rofi.hs +++ b/src/Nixon/Backend/Rofi.hs @@ -26,7 +26,7 @@ import qualified Nixon.Config.Types as Config import Nixon.Prelude import Nixon.Process (arg, arg_fmt, build_args, flag) import Nixon.Project (Project (projectDir, projectName)) -import Nixon.Select (Candidate, Selection (..), SelectionType (..), withProcessSelection) +import Nixon.Select (Candidate, Selection (..), SelectionType (..)) import qualified Nixon.Select as Select import Nixon.Utils (implode_home, shell_to_list, toLines, (< Text show_command cmd = T.unwords $ cmdName cmd : map (format ("${" % s % "}") . P.name) (cmdPlaceholders cmd) +outputFromFields :: [P.PlaceholderField] -> CommandOutput +outputFromFields fields = case fields of + [] -> Lines + (P.Col x : rest) -> case outputFromFields rest of + Lines -> Columns [x] + Columns xs -> Columns (x : xs) + _ -> error "Cannot mix columns and fields" + (P.Field x : rest) -> case outputFromFields rest of + Lines -> Fields [x] + Fields xs -> Fields (x : xs) + _ -> error "Cannot mix columns and fields" + (_ : rest) -> outputFromFields rest + show_command_with_description :: Command -> Text show_command_with_description cmd = format (s % s) (cmdName cmd) desc where @@ -83,8 +103,5 @@ description d cmd = cmd {cmdDesc = Just d} bg :: Bool -> Command -> Command bg g cmd = cmd {cmdIsBg = g} -outFmt :: CommandOutput -> Command -> Command -outFmt o cmd = cmd {cmdOutput = o} - is_bg_command :: Command -> Bool is_bg_command _ = False diff --git a/src/Nixon/Command/Placeholder.hs b/src/Nixon/Command/Placeholder.hs index a5c5c8e..531ef1d 100644 --- a/src/Nixon/Command/Placeholder.hs +++ b/src/Nixon/Command/Placeholder.hs @@ -2,15 +2,17 @@ module Nixon.Command.Placeholder ( Placeholder (..), PlaceholderField (..), PlaceholderType (..), + columns, ) where +import Data.Maybe (mapMaybe) import Nixon.Prelude data PlaceholderType = Arg | EnvVar {_envName :: Text} | Stdin deriving (Eq, Show) -data PlaceholderField = Col Int | Field Int +data PlaceholderField = Col Int | Field Int | Json deriving (Eq, Show) -- | Placeholders for environment variables @@ -27,3 +29,9 @@ data Placeholder = Placeholder value :: [Text] } deriving (Eq, Show) + +columns :: [PlaceholderField] -> [Int] +columns = mapMaybe col + where + col (Col i) = Just i + col _ = Nothing diff --git a/src/Nixon/Command/Run.hs b/src/Nixon/Command/Run.hs index c771024..d8d08ed 100644 --- a/src/Nixon/Command/Run.hs +++ b/src/Nixon/Command/Run.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedRecordDot #-} + module Nixon.Command.Run ( resolveCmd, resolveEnv, @@ -5,8 +7,9 @@ module Nixon.Command.Run ) where +import Control.Arrow ((&&&)) import Control.Monad (foldM) -import Data.Aeson (eitherDecodeStrict, encode) +import Data.Aeson (eitherDecodeStrict) import Data.Foldable (find) import qualified Data.Text as T import Nixon.Command (Command, CommandOutput (..)) @@ -14,6 +17,7 @@ import qualified Nixon.Command as Cmd import Nixon.Command.Find (findProjectCommands) import qualified Nixon.Command.Placeholder as Cmd import Nixon.Evaluator (evaluate, getEvaluator) +import Nixon.Format (parseColumns, pickColumns, pickFields) import Nixon.Prelude import Nixon.Process (run_with_output) import qualified Nixon.Process @@ -22,11 +26,10 @@ import qualified Nixon.Project as Project import Nixon.Select (Selection (..), Selector, selector_fields, selector_multiple) import qualified Nixon.Select as Select import Nixon.Types (Nixon) -import Nixon.Utils (toLines, shell_to_list, parseColumns) -import Turtle (Shell, cd, format, fp, select, stream, printf) +import Nixon.Utils (shell_to_list, toLines) +import Turtle (Shell, cd, format, fp, select, stream) import qualified Turtle.Bytes as BS import Turtle.Line (lineToText) -import Turtle.Format (w) -- | Actually run a command runCmd :: Selector Nixon -> Project -> Command -> [Text] -> Nixon () @@ -50,10 +53,10 @@ resolveEnv project selector cmd args = do -- | Zip placeholders with arguments, filling in missing placeholders with overflow arguments. zipArgs :: [Cmd.Placeholder] -> [Text] -> [(Cmd.Placeholder, Select.SelectorOpts)] -zipArgs [] args' = map ((, Select.defaults) . argOverflow) args' +zipArgs [] args' = map ((,Select.defaults) . argOverflow) args' where argOverflow = Cmd.Placeholder Cmd.Arg "arg" [] False . pure -zipArgs placeholders [] = map (, Select.defaults) placeholders +zipArgs placeholders [] = map (,Select.defaults) placeholders zipArgs (p : ps) (a : as) = (p, Select.search a) : zipArgs ps as -- | Resolve all command placeholders to either stdin input, positional arguments or env vars. @@ -94,18 +97,22 @@ resolveCmd project selector cmd select_opts = do let projectPath = Just (Project.project_path project) linesEval <- getEvaluator (run_with_output stream) cmd args projectPath env' (toLines <$> stdin) jsonEval <- getEvaluator (run_with_output BS.stream) cmd args projectPath env' (BS.fromUTF8 <$> stdin) - selection <- selector select_opts $ do - case Cmd.cmdOutput cmd of - Columns -> do - cols <- parseColumns . map lineToText <$> shell_to_list linesEval - printf w (encode cols) - pure $ Select.Identity "asdf" - Lines -> Select.Identity . lineToText <$> linesEval - JSON -> do - output <- BS.strict jsonEval - case eitherDecodeStrict output :: Either String [Select.Candidate] of - Left err -> error err - Right candidates -> select candidates + let cmdOutput = Cmd.outputFromFields select_opts.selector_fields + selection <- selector select_opts $ case cmdOutput of + Columns cols -> do + let parseColumns' = map T.unwords . pickColumns cols . parseColumns + (title, value) <- (drop 1 &&& parseColumns') . map lineToText <$> shell_to_list linesEval + select $ zipWith Select.WithTitle title value + Fields fields -> do + let parseFields' = T.unwords . pickFields fields . T.words + (title, value) <- (id &&& map parseFields') . map lineToText <$> shell_to_list linesEval + select $ zipWith Select.WithTitle title value + Lines -> Select.Identity . lineToText <$> linesEval + JSON -> do + output <- BS.strict jsonEval + case eitherDecodeStrict output :: Either String [Select.Candidate] of + Left err -> error err + Right candidates -> select candidates case selection of Selection _ result -> pure result _ -> error "Argument expansion aborted" diff --git a/src/Nixon/Config/Markdown.hs b/src/Nixon/Config/Markdown.hs index 9b1c937..f55144a 100644 --- a/src/Nixon/Config/Markdown.hs +++ b/src/Nixon/Config/Markdown.hs @@ -23,7 +23,7 @@ import Data.Text (pack, strip) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Yaml as Yaml -import Nixon.Command (bg, ( go (S 0 [] initP | hasArgs "command" attrs = let pt = getKwargs "type" attrs <> st.stateProjectTypes isBg = hasArgs "bg" attrs - fmt - | hasArgs "json" attrs = Cmd.JSON - | hasArgs "cols" attrs = Cmd.Columns - | otherwise = Cmd.Lines posInfo = PosInfo fileName pos l in case parseCommand posInfo name pt rest of (Left err, _) -> Left err (Right p, rest') -> - let cmd = p P.many P.space *> parseFields Cmd.Col p) <|> - (P.string "fields" *> P.many P.space *> parseFields Cmd.Field p) + (P.string "fields" *> P.many P.space *> parseFields Cmd.Field p) <|> + (P.string "json" $> p {Cmd.fields = [Cmd.Json]}) parsePipeMultiple p = (P.string "multi" :: Parser String) $> p {Cmd.multiple = True} diff --git a/src/Nixon/Format.hs b/src/Nixon/Format.hs index 046d521..a29bdbe 100644 --- a/src/Nixon/Format.hs +++ b/src/Nixon/Format.hs @@ -1,5 +1,7 @@ module Nixon.Format ( parseColumns, + pickColumns, + pickFields, ) where @@ -7,8 +9,10 @@ import Data.Char (isSpace) import qualified Data.Text as T import Nixon.Prelude +type Columns = [Text] + -- | Parse ouput in column format into a list of rows of columns. -parseColumns :: [Text] -> [[Text]] +parseColumns :: [Text] -> [Columns] parseColumns = \case [] -> [] (header : rows) -> parseColumn (parseWidths header) <$> rows @@ -24,3 +28,9 @@ parseColumns = \case parseColumn [_] row = [row] parseColumn (w : ws) row = case T.splitAt w row of (col, rest) -> T.strip col : parseColumn ws rest + +pickColumns :: [Int] -> [Columns] -> [Columns] +pickColumns cols = map (map snd . filter ((`elem` cols) . fst) . zip [1 ..]) + +pickFields :: [Int] -> [Text] -> [Text] +pickFields fields = map snd . filter ((`elem` fields) . fst) . zip [1 ..] diff --git a/src/Nixon/Select.hs b/src/Nixon/Select.hs index 51ad68a..14ab898 100644 --- a/src/Nixon/Select.hs +++ b/src/Nixon/Select.hs @@ -20,7 +20,6 @@ module Nixon.Select title, defaults, catMaybeSelection, - withProcessSelection, ) where @@ -35,7 +34,6 @@ import Data.Aeson import Data.Aeson.Types (unexpected) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe) -import qualified Data.Text as T import GHC.Generics (Generic) import qualified Nixon.Command.Placeholder as Cmd import Nixon.Prelude @@ -136,25 +134,5 @@ select opts input = do selector <- ask lift $ selector opts input -processSelection :: (Monad m) => SelectorOpts -> Selection Text -> m (Selection Text) -processSelection opts selection' - | null fields = pure selection' - -- NOTE: Unsure about this `T.stripEnd` here. It might remove too much trailing whitespace. - | otherwise = pure (T.stripEnd . T.unlines . map pickFields . T.lines <$> selection') - where - fields = selector_fields opts - pickFields line = - let pickItem (Cmd.Col i) = undefined !! (i - 1) - pickItem (Cmd.Field i) = T.words line !! (i - 1) - in T.unwords $ map pickItem fields - -withProcessSelection :: - (Monad m) => - (SelectorOpts -> a -> m (Selection Text)) -> - SelectorOpts -> - a -> - m (Selection Text) -withProcessSelection f opts = f opts >=> processSelection opts - text_to_line :: Text -> Line text_to_line = fromMaybe "" . textToLine diff --git a/src/Nixon/Utils.hs b/src/Nixon/Utils.hs index ee19033..bb5df1f 100644 --- a/src/Nixon/Utils.hs +++ b/src/Nixon/Utils.hs @@ -16,7 +16,6 @@ module Nixon.Utils (< MaybeT (need "EDITOR") ) run (editor :| args) Nothing [] empty - -parseColumns :: [Text] -> [Map Text Text] -parseColumns input = case input of - [] -> [] - header : body -> - let headers = T.words header - in map (Map.fromList . zip headers . T.words) body diff --git a/test/Main.hs b/test/Main.hs index 06e89e2..14cffbe 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,7 +1,6 @@ module Main where import Data.Char (isPrint, isSpace) -import qualified Data.Map.Strict as Map import qualified Data.Text as T import Nixon.Prelude import Nixon.Select @@ -84,17 +83,3 @@ main = hspec $ do it "reads until first space" $ property $ \pre ws post -> takeToSpace (getNonWs pre <> getWs ws <> post) == getNonWs pre - - describe "parseColumns" $ do - it "parses empty input" $ do - parseColumns [""] `shouldBe` [] - - it "parses headers" $ do - parseColumns ["foo bar baz"] `shouldBe` [] - - it "parses headers and values" $ do - let input = ["foo bar baz", "1 2 3", "4 5 6"] - parseColumns input - `shouldBe` [ Map.fromList [("foo", "1"), ("bar", "2"), ("baz", "3")], - Map.fromList [("foo", "4"), ("bar", "5"), ("baz", "6")] - ] diff --git a/test/Test/Nixon/Backend/Fzf.hs b/test/Test/Nixon/Backend/Fzf.hs index fb525e9..aa5b170 100644 --- a/test/Test/Nixon/Backend/Fzf.hs +++ b/test/Test/Nixon/Backend/Fzf.hs @@ -159,7 +159,7 @@ fzfTests = do result `shouldBe` Selection Default ["one two three", "seven eight nine"] - it "filters fields based on selector options (words 1 & 3)" $ do + xit "filters fields based on selector options (words 1 & 3)" $ do let candidates = map Identity ["one two three", "four five six", "seven eight nine"] selector = Backend.selector $ fzfBackend defaultConfig selectOpts = Select.defaults {Select.selector_fields = Cmd.Field <$> [1, 3]} diff --git a/test/Test/Nixon/Config/Markdown.hs b/test/Test/Nixon/Config/Markdown.hs index 2d28068..dfaa7b6 100644 --- a/test/Test/Nixon/Config/Markdown.hs +++ b/test/Test/Nixon/Config/Markdown.hs @@ -350,13 +350,13 @@ command_tests = describe "commands section" $ do $ let result = parseMarkdown "some-file.md" $ T.unlines - [ "# `hello` {.json}", - "```bash", + [ "# `hello`", + "```bash ${placeholder | json}", "echo Hello World", "```" ] - selector = fmap (Cmd.cmdName &&& Cmd.cmdOutput) . Cfg.commands - in selector <$> result `shouldBe` Right [("hello", Cmd.JSON)] + selector = fmap (Cmd.cmdName &&& Cmd.cmdPlaceholders) . Cfg.commands + in selector <$> result `shouldBe` Right [("hello", [Placeholder Arg "placeholder" [Json] False []])] it "detects project type" $ let result = From 3c3ff9b10f4866a0112cbab22cf3c64c7162e07a Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Sun, 19 May 2024 21:51:55 +0200 Subject: [PATCH 4/7] Remove command output format Replace entirely with Placeholder format --- src/Nixon/Command.hs | 26 ------------ src/Nixon/Command/Placeholder.hs | 24 ++++++------ src/Nixon/Command/Run.hs | 29 +++++++------- src/Nixon/Config/Markdown.hs | 51 ++++++++++++------------ src/Nixon/Select.hs | 7 ++-- test/Test/Nixon/Backend/Fzf.hs | 13 ------ test/Test/Nixon/Config/Markdown.hs | 63 ++++++++++++++---------------- 7 files changed, 87 insertions(+), 126 deletions(-) diff --git a/src/Nixon/Command.hs b/src/Nixon/Command.hs index 903506f..f587bd1 100644 --- a/src/Nixon/Command.hs +++ b/src/Nixon/Command.hs @@ -1,7 +1,6 @@ module Nixon.Command ( Command (..), CommandLocation (..), - CommandOutput (..), Language (..), empty, is_bg_command, @@ -10,7 +9,6 @@ module Nixon.Command bg, show_command, show_command_with_description, - outputFromFields, ) where @@ -60,33 +58,9 @@ empty = cmdLocation = Nothing } --- | Command output format used for placeholder extraction -data CommandOutput = - -- | Interpret output as columns and extract the specified columns - Columns [Int] | - -- | Interpret output as fields and extract the specified fields - Fields [Int] | - -- | Interpret output as plain lines - Lines | - -- | Parse output as JSON - JSON deriving (Eq, Show) - show_command :: Command -> Text show_command cmd = T.unwords $ cmdName cmd : map (format ("${" % s % "}") . P.name) (cmdPlaceholders cmd) -outputFromFields :: [P.PlaceholderField] -> CommandOutput -outputFromFields fields = case fields of - [] -> Lines - (P.Col x : rest) -> case outputFromFields rest of - Lines -> Columns [x] - Columns xs -> Columns (x : xs) - _ -> error "Cannot mix columns and fields" - (P.Field x : rest) -> case outputFromFields rest of - Lines -> Fields [x] - Fields xs -> Fields (x : xs) - _ -> error "Cannot mix columns and fields" - (_ : rest) -> outputFromFields rest - show_command_with_description :: Command -> Text show_command_with_description cmd = format (s % s) (cmdName cmd) desc where diff --git a/src/Nixon/Command/Placeholder.hs b/src/Nixon/Command/Placeholder.hs index 531ef1d..57adb6e 100644 --- a/src/Nixon/Command/Placeholder.hs +++ b/src/Nixon/Command/Placeholder.hs @@ -1,18 +1,24 @@ module Nixon.Command.Placeholder ( Placeholder (..), - PlaceholderField (..), - PlaceholderType (..), - columns, + PlaceholderFields (..), + PlaceholderType (..) ) where -import Data.Maybe (mapMaybe) import Nixon.Prelude data PlaceholderType = Arg | EnvVar {_envName :: Text} | Stdin deriving (Eq, Show) -data PlaceholderField = Col Int | Field Int | Json +data PlaceholderFields + = -- | Interpret output as columns and extract the specified columns + Columns [Int] + | -- | Interpret output as fields and extract the specified fields + Fields [Int] + | -- | Interpret output as plain lines + Lines + | -- | Parse output as JSON + JSON deriving (Eq, Show) -- | Placeholders for environment variables @@ -22,16 +28,10 @@ data Placeholder = Placeholder -- | The command it's referencing name :: Text, -- | The field numbers to extract - fields :: [PlaceholderField], + fields :: PlaceholderFields, -- | If the placeholder can select multiple multiple :: Bool, -- | Pre-expanded value of the placeholder value :: [Text] } deriving (Eq, Show) - -columns :: [PlaceholderField] -> [Int] -columns = mapMaybe col - where - col (Col i) = Just i - col _ = Nothing diff --git a/src/Nixon/Command/Run.hs b/src/Nixon/Command/Run.hs index d8d08ed..cd83a9d 100644 --- a/src/Nixon/Command/Run.hs +++ b/src/Nixon/Command/Run.hs @@ -12,10 +12,10 @@ import Control.Monad (foldM) import Data.Aeson (eitherDecodeStrict) import Data.Foldable (find) import qualified Data.Text as T -import Nixon.Command (Command, CommandOutput (..)) +import Nixon.Command (Command) import qualified Nixon.Command as Cmd import Nixon.Command.Find (findProjectCommands) -import qualified Nixon.Command.Placeholder as Cmd +import qualified Nixon.Command.Placeholder as P import Nixon.Evaluator (evaluate, getEvaluator) import Nixon.Format (parseColumns, pickColumns, pickFields) import Nixon.Prelude @@ -52,18 +52,18 @@ resolveEnv project selector cmd args = do nixonEnvs = [("nixon_project_path", format fp (Project.project_path project))] -- | Zip placeholders with arguments, filling in missing placeholders with overflow arguments. -zipArgs :: [Cmd.Placeholder] -> [Text] -> [(Cmd.Placeholder, Select.SelectorOpts)] +zipArgs :: [P.Placeholder] -> [Text] -> [(P.Placeholder, Select.SelectorOpts)] zipArgs [] args' = map ((,Select.defaults) . argOverflow) args' where - argOverflow = Cmd.Placeholder Cmd.Arg "arg" [] False . pure + argOverflow = P.Placeholder P.Arg "arg" P.Lines False . pure zipArgs placeholders [] = map (,Select.defaults) placeholders zipArgs (p : ps) (a : as) = (p, Select.search a) : zipArgs ps as -- | Resolve all command placeholders to either stdin input, positional arguments or env vars. -resolveEnv' :: Project -> Selector Nixon -> [(Cmd.Placeholder, Select.SelectorOpts)] -> Nixon (Maybe (Shell Text), [Text], Nixon.Process.Env) +resolveEnv' :: Project -> Selector Nixon -> [(P.Placeholder, Select.SelectorOpts)] -> Nixon (Maybe (Shell Text), [Text], Nixon.Process.Env) resolveEnv' project selector = foldM resolveEach (Nothing, [], []) where - resolveEach (stdin, args', envs) (Cmd.Placeholder envType cmdName fields multiple value, select_opts) = do + resolveEach (stdin, args', envs) (P.Placeholder envType cmdName fields multiple value, select_opts) = do resolved <- case value of [] -> do cmd' <- assertCommand cmdName @@ -76,15 +76,15 @@ resolveEnv' project selector = foldM resolveEach (Nothing, [], []) _ -> pure value case envType of -- Standard inputs are concatenated - Cmd.Stdin -> + P.Stdin -> let stdinCombined = Just $ case stdin of Nothing -> select resolved Just prev -> prev <|> select resolved in pure (stdinCombined, args', envs) -- Each line counts as one positional argument - Cmd.Arg -> pure (stdin, args' <> resolved, envs) + P.Arg -> pure (stdin, args' <> resolved, envs) -- Environment variables are concatenated into space-separated line - Cmd.EnvVar name -> pure (stdin, args', envs <> [(name, T.unwords resolved)]) + P.EnvVar name -> pure (stdin, args', envs <> [(name, T.unwords resolved)]) assertCommand cmd_name = do cmd' <- find ((==) cmd_name . Cmd.cmdName) <$> findProjectCommands project @@ -97,18 +97,17 @@ resolveCmd project selector cmd select_opts = do let projectPath = Just (Project.project_path project) linesEval <- getEvaluator (run_with_output stream) cmd args projectPath env' (toLines <$> stdin) jsonEval <- getEvaluator (run_with_output BS.stream) cmd args projectPath env' (BS.fromUTF8 <$> stdin) - let cmdOutput = Cmd.outputFromFields select_opts.selector_fields - selection <- selector select_opts $ case cmdOutput of - Columns cols -> do + selection <- selector select_opts $ case select_opts.selector_fields of + P.Columns cols -> do let parseColumns' = map T.unwords . pickColumns cols . parseColumns (title, value) <- (drop 1 &&& parseColumns') . map lineToText <$> shell_to_list linesEval select $ zipWith Select.WithTitle title value - Fields fields -> do + P.Fields fields -> do let parseFields' = T.unwords . pickFields fields . T.words (title, value) <- (id &&& map parseFields') . map lineToText <$> shell_to_list linesEval select $ zipWith Select.WithTitle title value - Lines -> Select.Identity . lineToText <$> linesEval - JSON -> do + P.Lines -> Select.Identity . lineToText <$> linesEval + P.JSON -> do output <- BS.strict jsonEval case eitherDecodeStrict output :: Either String [Select.Candidate] of Left err -> error err diff --git a/src/Nixon/Config/Markdown.hs b/src/Nixon/Config/Markdown.hs index f55144a..87b599c 100644 --- a/src/Nixon/Config/Markdown.hs +++ b/src/Nixon/Config/Markdown.hs @@ -12,6 +12,8 @@ where import CMark (commonmarkToNode) import qualified CMark as M +import Control.Monad (when) +import Control.Monad.Fail (fail) import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor (bimap, first)) import Data.Char (isSpace) @@ -25,7 +27,7 @@ import Data.Text.Encoding (encodeUtf8) import qualified Data.Yaml as Yaml import Nixon.Command (bg, ( Either Text (Text, [Cmd.Placeholder]) +parseCommandName :: Text -> Either Text (Text, [P.Placeholder]) parseCommandName = first (T.pack . show) . P.parse parser "" where parser = do @@ -299,7 +301,7 @@ parseCommandName = first (T.pack . show) . P.parse parser "" args <- parseCommandArgs pure (name, args) -parseCommandArgs :: Parser [Cmd.Placeholder] +parseCommandArgs :: Parser [P.Placeholder] parseCommandArgs = P.choice [ (:) <$> parseCommandPlaceholder <*> parseCommandArgs, @@ -308,24 +310,24 @@ parseCommandArgs = ] -- | Convenience wrapper for running placeholder parser -parseCommandArg :: String -> Either String Cmd.Placeholder +parseCommandArg :: String -> Either String P.Placeholder parseCommandArg = first show . P.parse parseCommandPlaceholder "" . T.pack -parseCommandPlaceholder :: Parser Cmd.Placeholder +parseCommandPlaceholder :: Parser P.Placeholder parseCommandPlaceholder = do let startCmdArg = - (Cmd.Stdin <$ P.char '<') - <|> (Cmd.Arg <$ P.char '$') - <|> (Cmd.EnvVar . T.pack <$> P.many (P.alphaNum <|> P.char '_') <* P.char '=') + (P.Stdin <$ P.char '<') + <|> (P.Arg <$ P.char '$') + <|> (P.EnvVar . T.pack <$> P.many (P.alphaNum <|> P.char '_') <* P.char '=') placeholderType <- P.try $ startCmdArg <* P.char '{' placeholder <- do name <- T.pack <$> P.many1 (P.noneOf " :|}") let fixup = T.replace "-" "_" placeholderWithName = case placeholderType of - Cmd.EnvVar "" -> Cmd.EnvVar $ fixup name - Cmd.EnvVar alias -> Cmd.EnvVar $ fixup alias + P.EnvVar "" -> P.EnvVar $ fixup name + P.EnvVar alias -> P.EnvVar $ fixup alias same -> same - pure $ Cmd.Placeholder placeholderWithName name [] False [] + pure $ P.Placeholder placeholderWithName name P.Lines False [] parsePlaceholderModifiers placeholder <* P.char '}' -- | Parse the "modifiers" which affect how command placeholders are handled. @@ -342,7 +344,7 @@ parseCommandPlaceholder = do -- -- Pipeline: `some-command ${placeholder | multiple | fields 1,3}` -- Shorthand: `some-command ${placeholder:m1,3}` -parsePlaceholderModifiers :: Cmd.Placeholder -> Parser Cmd.Placeholder +parsePlaceholderModifiers :: P.Placeholder -> Parser P.Placeholder parsePlaceholderModifiers placeholder = do P.choice [ parsePipeModifiers placeholder, @@ -351,7 +353,7 @@ parsePlaceholderModifiers placeholder = do ] where -- Parse `command-name | fields 1,2 | multiple` - parsePipeModifiers :: Cmd.Placeholder -> Parser Cmd.Placeholder + parsePipeModifiers :: P.Placeholder -> Parser P.Placeholder parsePipeModifiers p = do _ <- P.many P.space *> P.char '|' *> P.many P.space p' <- @@ -363,28 +365,29 @@ parsePlaceholderModifiers placeholder = do P.option p' (parsePipeModifiers p') parsePipeFields p = - (P.string "cols" *> P.many P.space *> parseFields Cmd.Col p) <|> - (P.string "fields" *> P.many P.space *> parseFields Cmd.Field p) <|> - (P.string "json" $> p {Cmd.fields = [Cmd.Json]}) + (P.string "cols" *> P.many P.space *> parseFields P.Columns p) + <|> (P.string "fields" *> P.many P.space *> parseFields P.Fields p) + <|> (P.string "json" $> p {P.fields = P.JSON}) - parsePipeMultiple p = (P.string "multi" :: Parser String) $> p {Cmd.multiple = True} + parsePipeMultiple p = (P.string "multi" :: Parser String) $> p {P.multiple = True} -- Parse `command-name:1,2` - parseColonModifiers :: Cmd.Placeholder -> Parser Cmd.Placeholder + parseColonModifiers :: P.Placeholder -> Parser P.Placeholder parseColonModifiers p = do _ <- P.char ':' -- Accept fields and multiple in any order - (parseFields Cmd.Field p >>= perhaps parseMultiple) <|> (parseMultiple p >>= perhaps (parseFields Cmd.Field)) + (parseFields P.Fields p >>= perhaps parseMultiple) <|> (parseMultiple p >>= perhaps (parseFields P.Fields)) - parseFields :: (Int -> Cmd.PlaceholderField) -> Cmd.Placeholder -> Parser Cmd.Placeholder + parseFields :: ([Int] -> P.PlaceholderFields) -> P.Placeholder -> Parser P.Placeholder parseFields fieldType p' = do - fields <- mapMaybe readMaybe <$> (P.many1 P.digit `P.sepBy1` P.char ',') - pure $ p' {Cmd.fields = p'.fields <> (fieldType <$> fields)} + fields <- mapMaybe readMaybe <$> (P.many1 P.digit `P.sepBy1` P.char ',') + when (p'.fields /= P.Lines) $ fail "Placeholder format already set" + pure $ p' {P.fields = fieldType fields} - parseMultiple :: Cmd.Placeholder -> Parser Cmd.Placeholder + parseMultiple :: P.Placeholder -> Parser P.Placeholder parseMultiple p' = do multiple <- P.option False (True <$ P.char 'm') - pure $ p' {Cmd.multiple = multiple} + pure $ p' {P.multiple = multiple} -- Try a parser or default to `value` perhaps parser value = P.option value (parser value) diff --git a/src/Nixon/Select.hs b/src/Nixon/Select.hs index 14ab898..bbe0d97 100644 --- a/src/Nixon/Select.hs +++ b/src/Nixon/Select.hs @@ -84,7 +84,7 @@ instance Functor Selection where data SelectorOpts = SelectorOpts { selector_title :: Maybe Text, selector_search :: Maybe Text, - selector_fields :: [Cmd.PlaceholderField], + selector_fields :: Cmd.PlaceholderFields, selector_multiple :: Maybe Bool } @@ -93,7 +93,7 @@ defaults = SelectorOpts { selector_title = Nothing, selector_search = Nothing, - selector_fields = [], + selector_fields = Cmd.Lines, selector_multiple = Nothing } @@ -102,7 +102,8 @@ instance Semigroup SelectorOpts where SelectorOpts { selector_title = selector_title rhs <|> selector_title lhs, selector_search = selector_search rhs <|> selector_search lhs, - selector_fields = selector_fields rhs <> selector_fields lhs, + -- FIXME: Don't use Semigroup for this, this is not monodic. + selector_fields = selector_fields rhs, selector_multiple = selector_multiple rhs <|> selector_multiple lhs } diff --git a/test/Test/Nixon/Backend/Fzf.hs b/test/Test/Nixon/Backend/Fzf.hs index aa5b170..00eed6c 100644 --- a/test/Test/Nixon/Backend/Fzf.hs +++ b/test/Test/Nixon/Backend/Fzf.hs @@ -11,7 +11,6 @@ import qualified Nixon.Backend as Backend import Nixon.Backend.Fzf (fzf, fzfBackend, fzfExpect, fzfFilter, fzfProjects) import qualified Nixon.Backend.Fzf as Fzf import qualified Nixon.Command as Cmd -import qualified Nixon.Command.Placeholder as Cmd import Nixon.Config.Types (defaultConfig) import Nixon.Prelude import Nixon.Project (Project (..)) @@ -159,18 +158,6 @@ fzfTests = do result `shouldBe` Selection Default ["one two three", "seven eight nine"] - xit "filters fields based on selector options (words 1 & 3)" $ do - let candidates = map Identity ["one two three", "four five six", "seven eight nine"] - selector = Backend.selector $ fzfBackend defaultConfig - selectOpts = Select.defaults {Select.selector_fields = Cmd.Field <$> [1, 3]} - - result <- - runProc (ExitSuccess, "1") - $ Select.runSelect selector - $ Select.select selectOpts (select candidates) - - result `shouldBe` Selection Default ["one three"] - describe "Fzf command" ( do diff --git a/test/Test/Nixon/Config/Markdown.hs b/test/Test/Nixon/Config/Markdown.hs index dfaa7b6..e362dc6 100644 --- a/test/Test/Nixon/Config/Markdown.hs +++ b/test/Test/Nixon/Config/Markdown.hs @@ -4,7 +4,7 @@ import Control.Arrow ((&&&)) import Data.Either (isLeft) import qualified Data.Text as T import qualified Nixon.Command as Cmd -import Nixon.Command.Placeholder (Placeholder (..), PlaceholderField (..), PlaceholderType (..)) +import Nixon.Command.Placeholder (Placeholder (..), PlaceholderFields (..), PlaceholderType (..)) import Nixon.Config.Markdown (parseCommandName, parseHeaderArgs, parseMarkdown) import Nixon.Config.Types (defaultConfig) import qualified Nixon.Config.Types as Cfg @@ -15,9 +15,6 @@ import Test.Hspec match_error :: Text -> Either Text b -> Bool match_error match = either (T.isInfixOf match) (const False) -fs :: [Int] -> [PlaceholderField] -fs = fmap Field - config_tests :: SpecWith () config_tests = describe "config section" $ do it "allows empty JSON object" @@ -330,10 +327,10 @@ command_tests = describe "commands section" $ do "```" ] selector = fmap (Cmd.cmdName &&& Cmd.cmdPlaceholders) . Cfg.commands - placeholder = Placeholder Arg "placeholder" [Col 1] False [] + placeholder = Placeholder Arg "placeholder" (Columns [1]) False [] in selector <$> result `shouldBe` Right [("hello", [placeholder])] - it "combines columns and fields output format" + it "errors on combined columns and fields output format" $ let result = parseMarkdown "some-file.md" $ T.unlines @@ -342,9 +339,9 @@ command_tests = describe "commands section" $ do "echo Hello World", "```" ] - selector = fmap (Cmd.cmdName &&& Cmd.cmdPlaceholders) . Cfg.commands - placeholder = Placeholder Arg "placeholder" [Col 1, Field 2] False [] - in selector <$> result `shouldBe` Right [("hello", [placeholder])] + in case result of + Left e -> T.unpack e `shouldContain` "Placeholder format already set" + _ -> expectationFailure "Expected error" it "detects json output format" $ let result = @@ -356,7 +353,7 @@ command_tests = describe "commands section" $ do "```" ] selector = fmap (Cmd.cmdName &&& Cmd.cmdPlaceholders) . Cfg.commands - in selector <$> result `shouldBe` Right [("hello", [Placeholder Arg "placeholder" [Json] False []])] + in selector <$> result `shouldBe` Right [("hello", [Placeholder Arg "placeholder" JSON False []])] it "detects project type" $ let result = @@ -415,7 +412,7 @@ command_tests = describe "commands section" $ do `shouldBe` Right [ ( "hello", True, - [Placeholder Arg "arg" [] False [], Placeholder Arg "another-arg" [] False []] + [Placeholder Arg "arg" Lines False [], Placeholder Arg "another-arg" Lines False []] ) ] @@ -435,7 +432,7 @@ command_tests = describe "commands section" $ do Cmd.cmdPlaceholders = placeholders } = (lang, placeholders) fmap selector . Cfg.commands <$> result - `shouldBe` Right [(Bash, [Placeholder Arg "arg" [] False []])] + `shouldBe` Right [(Bash, [Placeholder Arg "arg" Lines False []])] it "extracts code block placeholders" $ do let result = @@ -467,10 +464,10 @@ command_tests = describe "commands section" $ do } = (lang, placeholders) fmap selector . Cfg.commands <$> result `shouldBe` Right - [ (Bash, [Placeholder Arg "arg-one" [] False []]), - (Bash, [Placeholder Arg "arg-two" [] True []]), - (Bash, [Placeholder Arg "arg-three" (fs [1, 2]) False []]), - (Bash, [Placeholder Arg "arg-four" (fs [1, 2]) True []]) + [ (Bash, [Placeholder Arg "arg-one" Lines False []]), + (Bash, [Placeholder Arg "arg-two" Lines True []]), + (Bash, [Placeholder Arg "arg-three" (Fields [1, 2]) False []]), + (Bash, [Placeholder Arg "arg-four" (Fields [1, 2]) True []]) ] it "complains on both header & code block placeholders" $ do @@ -615,71 +612,71 @@ parse_command_name_tests = describe "parseCommandName" $ do it "parses arg part" $ do parseCommandName "cat ${arg}" - `shouldBe` Right ("cat", [Placeholder Arg "arg" [] False []]) + `shouldBe` Right ("cat", [Placeholder Arg "arg" Lines False []]) it "parses stdin arg part" $ do parseCommandName "cat <{arg}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [] False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" Lines False []]) it "parses envvar arg part" $ do parseCommandName "cat ={arg}" - `shouldBe` Right ("cat", [Placeholder (EnvVar "arg") "arg" [] False []]) + `shouldBe` Right ("cat", [Placeholder (EnvVar "arg") "arg" Lines False []]) it "parses envvar part with alias" $ do parseCommandName "cat FOO={bar}" - `shouldBe` Right ("cat", [Placeholder (EnvVar "FOO") "bar" [] False []]) + `shouldBe` Right ("cat", [Placeholder (EnvVar "FOO") "bar" Lines False []]) it "parses arg field selector" $ do parseCommandName "cat <{arg:1}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1]) False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (Fields [1]) False []]) it "parses several arg field selectors" $ do parseCommandName "cat <{arg:1,3,5}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (Fields [1, 3, 5]) False []]) it "parses arg modifiers" $ do parseCommandName "cat ${arg:m}" - `shouldBe` Right ("cat", [Placeholder Arg "arg" [] True []]) + `shouldBe` Right ("cat", [Placeholder Arg "arg" Lines True []]) it "parses arg modifiers" $ do parseCommandName "cat ${arg | fields 1,3}" - `shouldBe` Right ("cat", [Placeholder Arg "arg" (fs [1, 3]) False []]) + `shouldBe` Right ("cat", [Placeholder Arg "arg" (Fields [1, 3]) False []]) it "parses arg modifiers" $ do parseCommandName "cat ${arg | multi}" - `shouldBe` Right ("cat", [Placeholder Arg "arg" [] True []]) + `shouldBe` Right ("cat", [Placeholder Arg "arg" Lines True []]) it "parses stdin arg modifiers" $ do parseCommandName "cat <{arg:m}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" [] True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" Lines True []]) it "parses arg field and multiple selector" $ do parseCommandName "cat <{arg:m1,3,5}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (Fields [1, 3, 5]) True []]) it "parses arg field and multiple selector (flipped)" $ do parseCommandName "cat <{arg:1,3,5m}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (Fields [1, 3, 5]) True []]) it "parses arg field and pipe fields" $ do parseCommandName "cat <{arg | fields 1,3,5}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) False []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (Fields [1, 3, 5]) False []]) it "parses arg field, pipe fields and pipe multiple" $ do parseCommandName "cat <{arg | fields 1,3,5 | multi}" - `shouldBe` Right ("cat", [Placeholder Stdin "arg" (fs [1, 3, 5]) True []]) + `shouldBe` Right ("cat", [Placeholder Stdin "arg" (Fields [1, 3, 5]) True []]) it "parses text and placeholder part" $ do parseCommandName "cat \"${arg}\"" - `shouldBe` Right ("cat", [Placeholder Arg "arg" [] False []]) + `shouldBe` Right ("cat", [Placeholder Arg "arg" Lines False []]) it "replaces '-' with '_' in env var name" $ do parseCommandName "cat \"={some-arg}\"" - `shouldBe` Right ("cat", [Placeholder (EnvVar "some_arg") "some-arg" [] False []]) + `shouldBe` Right ("cat", [Placeholder (EnvVar "some_arg") "some-arg" Lines False []]) it "supports '_' in env var alias" $ do parseCommandName "cat some_arg={some-arg}" - `shouldBe` Right ("cat", [Placeholder (EnvVar "some_arg") "some-arg" [] False []]) + `shouldBe` Right ("cat", [Placeholder (EnvVar "some_arg") "some-arg" Lines False []]) it "allows use of $ not matching '${'" $ do parseCommandName "echo $SOME_VAR" `shouldBe` Right ("echo", []) From e0e779c2010c6edb5ed2cc7b43dd05245abf90e3 Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Sun, 19 May 2024 21:58:22 +0200 Subject: [PATCH 5/7] Remove broken SelectorOpts Monoid Wasn't a monoid. --- src/Nixon/Command/Run.hs | 4 ++-- src/Nixon/Select.hs | 17 ++--------------- 2 files changed, 4 insertions(+), 17 deletions(-) diff --git a/src/Nixon/Command/Run.hs b/src/Nixon/Command/Run.hs index cd83a9d..2376c0d 100644 --- a/src/Nixon/Command/Run.hs +++ b/src/Nixon/Command/Run.hs @@ -37,7 +37,7 @@ runCmd selector project cmd args = do let projectPath = Project.project_path project project_selector select_opts shell' = cd projectPath - >> selector (select_opts <> Select.title (Cmd.show_command cmd)) shell' + >> selector (select_opts `Select.title` Cmd.show_command cmd) shell' (stdin, args', env') <- resolveEnv project project_selector cmd args let pwd = Cmd.cmdPwd cmd <|> Just projectPath evaluate cmd args' pwd env' (toLines <$> stdin) @@ -45,7 +45,7 @@ runCmd selector project cmd args = do -- | Resolve all command placeholders to either stdin input, positional arguments or env vars. resolveEnv :: Project -> Selector Nixon -> Command -> [Text] -> Nixon (Maybe (Shell Text), [Text], Nixon.Process.Env) resolveEnv project selector cmd args = do - let mappedArgs = zipArgs (Cmd.cmdPlaceholders cmd) args + let mappedArgs = zipArgs cmd.cmdPlaceholders args (stdin, args', envs) <- resolveEnv' project selector mappedArgs pure (stdin, args', nixonEnvs ++ envs) where diff --git a/src/Nixon/Select.hs b/src/Nixon/Select.hs index bbe0d97..4e00788 100644 --- a/src/Nixon/Select.hs +++ b/src/Nixon/Select.hs @@ -97,19 +97,6 @@ defaults = selector_multiple = Nothing } -instance Semigroup SelectorOpts where - (<>) lhs rhs = - SelectorOpts - { selector_title = selector_title rhs <|> selector_title lhs, - selector_search = selector_search rhs <|> selector_search lhs, - -- FIXME: Don't use Semigroup for this, this is not monodic. - selector_fields = selector_fields rhs, - selector_multiple = selector_multiple rhs <|> selector_multiple lhs - } - -instance Monoid SelectorOpts where - mempty = defaults - type Selector m = SelectorOpts -> Shell Candidate -> m (Selection Text) type Select m a = ReaderT (Selector m) m a @@ -118,8 +105,8 @@ default_selection :: [a] -> Selection a -> [a] default_selection _ (Selection _ value) = value default_selection def _ = def -title :: Text -> SelectorOpts -title t = defaults {selector_title = Just t} +title :: SelectorOpts -> Text -> SelectorOpts +title opts t = opts {selector_title = Just t} search :: Text -> SelectorOpts search s = defaults {selector_search = Just s} From d9bfb7cfaef67ece9b56821371c59164f71cfb89 Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Sun, 19 May 2024 21:59:07 +0200 Subject: [PATCH 6/7] Rename Placeholder fields => format --- src/Nixon.hs | 2 +- src/Nixon/Command/Placeholder.hs | 6 +++--- src/Nixon/Command/Run.hs | 8 ++++---- src/Nixon/Config/Markdown.hs | 8 ++++---- src/Nixon/Select.hs | 4 ++-- test/Test/Nixon/Config/Markdown.hs | 2 +- 6 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Nixon.hs b/src/Nixon.hs index de244e7..58cdf23 100644 --- a/src/Nixon.hs +++ b/src/Nixon.hs @@ -34,7 +34,7 @@ import Nixon.Language (Language (..), fromFilePath) import Nixon.Logging (log_error, log_info) import Nixon.Prelude import Nixon.Process (run) -import Nixon.Project (Project, project_path, inspectProjects) +import Nixon.Project (Project, inspectProjects, project_path) import qualified Nixon.Project as P import Nixon.Select (Candidate (..), Selection (..), SelectionType (..)) import qualified Nixon.Select as Select diff --git a/src/Nixon/Command/Placeholder.hs b/src/Nixon/Command/Placeholder.hs index 57adb6e..989c571 100644 --- a/src/Nixon/Command/Placeholder.hs +++ b/src/Nixon/Command/Placeholder.hs @@ -1,6 +1,6 @@ module Nixon.Command.Placeholder ( Placeholder (..), - PlaceholderFields (..), + PlaceholderFormat (..), PlaceholderType (..) ) where @@ -10,7 +10,7 @@ import Nixon.Prelude data PlaceholderType = Arg | EnvVar {_envName :: Text} | Stdin deriving (Eq, Show) -data PlaceholderFields +data PlaceholderFormat = -- | Interpret output as columns and extract the specified columns Columns [Int] | -- | Interpret output as fields and extract the specified fields @@ -28,7 +28,7 @@ data Placeholder = Placeholder -- | The command it's referencing name :: Text, -- | The field numbers to extract - fields :: PlaceholderFields, + format :: PlaceholderFormat, -- | If the placeholder can select multiple multiple :: Bool, -- | Pre-expanded value of the placeholder diff --git a/src/Nixon/Command/Run.hs b/src/Nixon/Command/Run.hs index 2376c0d..fe7f632 100644 --- a/src/Nixon/Command/Run.hs +++ b/src/Nixon/Command/Run.hs @@ -23,7 +23,7 @@ import Nixon.Process (run_with_output) import qualified Nixon.Process import Nixon.Project (Project) import qualified Nixon.Project as Project -import Nixon.Select (Selection (..), Selector, selector_fields, selector_multiple) +import Nixon.Select (Selection (..), Selector, selector_format, selector_multiple) import qualified Nixon.Select as Select import Nixon.Types (Nixon) import Nixon.Utils (shell_to_list, toLines) @@ -63,13 +63,13 @@ zipArgs (p : ps) (a : as) = (p, Select.search a) : zipArgs ps as resolveEnv' :: Project -> Selector Nixon -> [(P.Placeholder, Select.SelectorOpts)] -> Nixon (Maybe (Shell Text), [Text], Nixon.Process.Env) resolveEnv' project selector = foldM resolveEach (Nothing, [], []) where - resolveEach (stdin, args', envs) (P.Placeholder envType cmdName fields multiple value, select_opts) = do + resolveEach (stdin, args', envs) (P.Placeholder envType cmdName format' multiple value, select_opts) = do resolved <- case value of [] -> do cmd' <- assertCommand cmdName let select_opts' = select_opts - { selector_fields = fields, + { selector_format = format', selector_multiple = Just multiple } resolveCmd project selector cmd' select_opts' @@ -97,7 +97,7 @@ resolveCmd project selector cmd select_opts = do let projectPath = Just (Project.project_path project) linesEval <- getEvaluator (run_with_output stream) cmd args projectPath env' (toLines <$> stdin) jsonEval <- getEvaluator (run_with_output BS.stream) cmd args projectPath env' (BS.fromUTF8 <$> stdin) - selection <- selector select_opts $ case select_opts.selector_fields of + selection <- selector select_opts $ case select_opts.selector_format of P.Columns cols -> do let parseColumns' = map T.unwords . pickColumns cols . parseColumns (title, value) <- (drop 1 &&& parseColumns') . map lineToText <$> shell_to_list linesEval diff --git a/src/Nixon/Config/Markdown.hs b/src/Nixon/Config/Markdown.hs index 87b599c..7dacdcf 100644 --- a/src/Nixon/Config/Markdown.hs +++ b/src/Nixon/Config/Markdown.hs @@ -367,7 +367,7 @@ parsePlaceholderModifiers placeholder = do parsePipeFields p = (P.string "cols" *> P.many P.space *> parseFields P.Columns p) <|> (P.string "fields" *> P.many P.space *> parseFields P.Fields p) - <|> (P.string "json" $> p {P.fields = P.JSON}) + <|> (P.string "json" $> p {P.format = P.JSON}) parsePipeMultiple p = (P.string "multi" :: Parser String) $> p {P.multiple = True} @@ -378,11 +378,11 @@ parsePlaceholderModifiers placeholder = do -- Accept fields and multiple in any order (parseFields P.Fields p >>= perhaps parseMultiple) <|> (parseMultiple p >>= perhaps (parseFields P.Fields)) - parseFields :: ([Int] -> P.PlaceholderFields) -> P.Placeholder -> Parser P.Placeholder + parseFields :: ([Int] -> P.PlaceholderFormat) -> P.Placeholder -> Parser P.Placeholder parseFields fieldType p' = do fields <- mapMaybe readMaybe <$> (P.many1 P.digit `P.sepBy1` P.char ',') - when (p'.fields /= P.Lines) $ fail "Placeholder format already set" - pure $ p' {P.fields = fieldType fields} + when (p'.format /= P.Lines) $ fail "Placeholder format already set" + pure $ p' {P.format = fieldType fields} parseMultiple :: P.Placeholder -> Parser P.Placeholder parseMultiple p' = do diff --git a/src/Nixon/Select.hs b/src/Nixon/Select.hs index 4e00788..25547d5 100644 --- a/src/Nixon/Select.hs +++ b/src/Nixon/Select.hs @@ -84,7 +84,7 @@ instance Functor Selection where data SelectorOpts = SelectorOpts { selector_title :: Maybe Text, selector_search :: Maybe Text, - selector_fields :: Cmd.PlaceholderFields, + selector_format :: Cmd.PlaceholderFormat, selector_multiple :: Maybe Bool } @@ -93,7 +93,7 @@ defaults = SelectorOpts { selector_title = Nothing, selector_search = Nothing, - selector_fields = Cmd.Lines, + selector_format = Cmd.Lines, selector_multiple = Nothing } diff --git a/test/Test/Nixon/Config/Markdown.hs b/test/Test/Nixon/Config/Markdown.hs index e362dc6..2295f59 100644 --- a/test/Test/Nixon/Config/Markdown.hs +++ b/test/Test/Nixon/Config/Markdown.hs @@ -4,7 +4,7 @@ import Control.Arrow ((&&&)) import Data.Either (isLeft) import qualified Data.Text as T import qualified Nixon.Command as Cmd -import Nixon.Command.Placeholder (Placeholder (..), PlaceholderFields (..), PlaceholderType (..)) +import Nixon.Command.Placeholder (Placeholder (..), PlaceholderFormat (..), PlaceholderType (..)) import Nixon.Config.Markdown (parseCommandName, parseHeaderArgs, parseMarkdown) import Nixon.Config.Types (defaultConfig) import qualified Nixon.Config.Types as Cfg From f1ae2a380d7a8e6188ff4fdf3dc85834dbbebf6f Mon Sep 17 00:00:00 2001 From: Martin Myrseth Date: Sun, 19 May 2024 23:33:46 +0200 Subject: [PATCH 7/7] cabal: Try to fix some issues with CI --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a5f631c..f5bd71e 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -54,7 +54,7 @@ jobs: - name: Install dependencies run: | cabal update - cabal install hlint + cabal install --overwrite-policy=always hlint cabal build --only-dependencies --enable-tests --enable-benchmarks - name: Hlint