From a5c021edc993c2855de71fb0e87ec37e66051670 Mon Sep 17 00:00:00 2001 From: dneaves Date: Sun, 27 Sep 2026 14:58:35 -0400 Subject: [PATCH] Hoogle bits and finish trie walks --- cabal.project.hoogle | 8 ++ glyph.cabal | 2 + justfile | 48 +++++++++- lib/Glyph/Class/Capturable.hs | 26 +++--- lib/Glyph/Class/Stringable.hs | 113 ++++++++--------------- lib/Glyph/Extra/String.hs | 17 +++- lib/Glyph/Key/Chord.hs | 12 +++ lib/Glyph/Key/Trie.hs | 112 +++++++++++++---------- lib/Glyph/Key/Trigger.hs | 56 ++++++++++++ shell.nix | 3 + test/GlyphTest/Key/Trie.hs | 163 ++++++++++++++++++++++++++++++++++ test/Main.hs | 2 + 12 files changed, 422 insertions(+), 140 deletions(-) create mode 100644 cabal.project.hoogle create mode 100644 lib/Glyph/Key/Trigger.hs create mode 100644 test/GlyphTest/Key/Trie.hs diff --git a/cabal.project.hoogle b/cabal.project.hoogle new file mode 100644 index 0000000..813666e --- /dev/null +++ b/cabal.project.hoogle @@ -0,0 +1,8 @@ +packages: . + +package * + documentation: True + haddock-hoogle: True + +package glyph + haddock-internal: True diff --git a/glyph.cabal b/glyph.cabal index e825744..efeeefb 100644 --- a/glyph.cabal +++ b/glyph.cabal @@ -51,6 +51,7 @@ library lib hs-source-dirs: lib exposed-modules: Glyph.Class.All + Glyph.Class.Capturable Glyph.Class.Dhall Glyph.Class.Stringable Glyph.Config.Dhall.Action @@ -135,6 +136,7 @@ test-suite glyph-test GlyphTest.Config.Keymap GlyphTest.Key.Count GlyphTest.Key.Kitty + GlyphTest.Key.Trie build-depends: , containers >=0.6 && <0.9 diff --git a/justfile b/justfile index daf9e69..251b274 100644 --- a/justfile +++ b/justfile @@ -17,8 +17,6 @@ format: stylish-haskell -ir {{ sources }} cabal-fmt -i {{ justfile_directory() }}/glyph.cabal nixfmt {{ justfile_directory() }}/shell.nix - # --no-error-on-unmatched-pattern: the markdown now lives above 'tui', so this glob can - # legitimately match nothing. Without the flag prettier exits 2 and fails the recipe. prettier --write --log-level warn --no-error-on-unmatched-pattern --ignore-path {{ justfile_directory() }}/.gitignore "{{ justfile_directory() }}/**/*.md" # Lint the Haskell sources @@ -57,6 +55,52 @@ watch TARGET="test": esac watchexec --exts hs,cabal --restart -- "${command[@]}" +# Build Haddock docs for glyph and its dependencies, then index them into a local Hoogle database +hoogle-gen: + #!/usr/bin/env bash + set -euo pipefail + if [[ -z "${GLYPH_GHC_DOCS:-}" ]]; then + echo "GLYPH_GHC_DOCS is unset -- run this from inside the project's nix-shell" >&2 + exit 1 + fi + cd "{{ justfile_directory() }}" + cabal haddock all --project-file=cabal.project.hoogle --builddir=dist-newstyle/hoogle + locals=(--local="$GLYPH_GHC_DOCS" --local=dist-newstyle/hoogle) + shopt -s nullglob + for dir in "$(cabal path --store-dir)"/ghc-"$(ghc --numeric-version)"*/*/share/doc/html/; do + locals+=(--local="$dir") + done + mkdir -p .hoogle + hoogle generate --database=.hoogle/glyph.hoo "${locals[@]}" + +# Query the local Hoogle database: `just hoogle search QUERY...` or `just hoogle server [PORT]` +[positional-arguments] +hoogle MODE="server" *ARGS: + #!/usr/bin/env bash + set -euo pipefail + database="{{ justfile_directory() }}/.hoogle/glyph.hoo" + if [[ ! -f "$database" ]]; then + echo "no Hoogle database at $database -- run 'just hoogle-gen' first" >&2 + exit 1 + fi + shift + case "{{ MODE }}" in + search) + if [[ $# -eq 0 ]]; then + echo "usage: just hoogle search QUERY..." >&2 + exit 1 + fi + hoogle search --database="$database" "$@" + ;; + server) + hoogle server --database="$database" --local --port="${1:-8080}" + ;; + *) + echo "unknown hoogle mode '{{ MODE }}' -- expected search or server" >&2 + exit 1 + ;; + esac + # Everything CI would check check: build test lint echo "all checks passed" diff --git a/lib/Glyph/Class/Capturable.hs b/lib/Glyph/Class/Capturable.hs index b8e7238..647b06a 100644 --- a/lib/Glyph/Class/Capturable.hs +++ b/lib/Glyph/Class/Capturable.hs @@ -1,23 +1,19 @@ module Glyph.Class.Capturable where ----- +---------------------------------------------------------------------------------------------------- -import Glyph.Key.Chord (Chord(..)) +import Graphics.Vty.Input.Events ( Key (..) ) -import Graphics.Vty.Input.Events (Key (..)) +---------------------------------------------------------------------------------------------------- ----- - -class Capturable a where - data Captured - = CapturedChar Char - | CapturedNum Natural - | CapturedText Text - - isCapturable :: a -> Bool - Capture :: a -> Captured +class (Ord a) => Capturable a where + capture :: a -> Maybe Char + isUntilTerminator :: Key -> a -> Bool instance Capturable Key where + capture (KChar '\t') = Nothing + capture (KChar '\n') = Nothing + capture (KChar char) = Just char + capture _ = Nothing -instance Capturable Chord where - + isUntilTerminator = (==) diff --git a/lib/Glyph/Class/Stringable.hs b/lib/Glyph/Class/Stringable.hs index e708cfd..28e8d18 100644 --- a/lib/Glyph/Class/Stringable.hs +++ b/lib/Glyph/Class/Stringable.hs @@ -2,8 +2,11 @@ module Glyph.Class.Stringable where ---------------------------------------------------------------------------------------------------- +import qualified Data.List as List import qualified Data.Text as Text +import qualified Glyph.Extra.String as String + import Graphics.Vty.Input.Events ( Key (..), Modifier (..) ) ---------------------------------------------------------------------------------------------------- @@ -72,80 +75,38 @@ instance Stringable Key where toString KPageUp = "" toString KPageDown = "" toString KMenu = "" - toString (KFun 1) = "" - toString (KFun 2) = "" - toString (KFun 3) = "" - toString (KFun 4) = "" - toString (KFun 5) = "" - toString (KFun 6) = "" - toString (KFun 7) = "" - toString (KFun 8) = "" - toString (KFun 9) = "" - toString (KFun 10) = "" - toString (KFun 11) = "" - toString (KFun 12) = "" - toString (KFun 13) = "" - toString (KFun 14) = "" - toString (KFun 15) = "" - toString (KFun 16) = "" - toString (KFun 17) = "" - toString (KFun 18) = "" - toString (KFun 19) = "" - toString (KFun 20) = "" - toString (KFun 21) = "" - toString (KFun 22) = "" - toString (KFun 23) = "" - toString (KFun 24) = "" - - fromString "" = Just (KChar '\t') - fromString "" = Just (KChar ' ') - fromString "" = Just KEsc - fromString "" = Just KBS - fromString "" = Just KEnter - fromString "" = Just KLeft - fromString "" = Just KRight - fromString "" = Just KUp - fromString "" = Just KDown - fromString "" = Just KUpLeft - fromString "" = Just KUpRight - fromString "" = Just KDownLeft + toString (KFun n) = " show n <> ">" + + fromString "" = Just (KChar '\t') + fromString "" = Just (KChar ' ') + fromString "" = Just KEsc + fromString "" = Just KBS + fromString "" = Just KEnter + fromString "" = Just KLeft + fromString "" = Just KRight + fromString "" = Just KUp + fromString "" = Just KDown + fromString "" = Just KUpLeft + fromString "" = Just KUpRight + fromString "" = Just KDownLeft fromString "" = Just KDownRight - fromString "
" = Just KCenter - fromString "" = Just KBackTab - fromString "" = Just KPrtScr - fromString "" = Just KPause - fromString "" = Just KIns - fromString "" = Just KDel - fromString "" = Just KHome - fromString "" = Just KBegin - fromString "" = Just KEnd - fromString "" = Just KPageUp - fromString "" = Just KPageDown - fromString "" = Just KMenu - fromString "" = Just (KFun 1) - fromString "" = Just (KFun 2) - fromString "" = Just (KFun 3) - fromString "" = Just (KFun 4) - fromString "" = Just (KFun 5) - fromString "" = Just (KFun 6) - fromString "" = Just (KFun 7) - fromString "" = Just (KFun 8) - fromString "" = Just (KFun 9) - fromString "" = Just (KFun 10) - fromString "" = Just (KFun 11) - fromString "" = Just (KFun 12) - fromString "" = Just (KFun 13) - fromString "" = Just (KFun 14) - fromString "" = Just (KFun 15) - fromString "" = Just (KFun 16) - fromString "" = Just (KFun 17) - fromString "" = Just (KFun 18) - fromString "" = Just (KFun 19) - fromString "" = Just (KFun 20) - fromString "" = Just (KFun 21) - fromString "" = Just (KFun 22) - fromString "" = Just (KFun 23) - fromString "" = Just (KFun 24) - fromString [char] = Just (KChar char) - fromString (_ : _) = Nothing - fromString _ = Nothing + fromString "
" = Just KCenter + fromString "" = Just KBackTab + fromString "" = Just KPrtScr + fromString "" = Just KPause + fromString "" = Just KIns + fromString "" = Just KDel + fromString "" = Just KHome + fromString "" = Just KBegin + fromString "" = Just KEnd + fromString "" = Just KPageUp + fromString "" = Just KPageDown + fromString "" = Just KMenu + fromString ('<' : 'F' : xs) + | Just (digits@(_ : _), '>') <- List.unsnoc xs + , String.isNumeric digits + , num <- String.toNumber digits + , (num >= 1) `and` (num <= 64) = + Just <| KFun <| fromEnum num + fromString [char] = Just (KChar char) + fromString _ = Nothing diff --git a/lib/Glyph/Extra/String.hs b/lib/Glyph/Extra/String.hs index 84a9a99..9a96154 100644 --- a/lib/Glyph/Extra/String.hs +++ b/lib/Glyph/Extra/String.hs @@ -3,8 +3,10 @@ module Glyph.Extra.String where ---------------------------------------------------------------------------------------------------- -import qualified Data.Char as Char -import qualified Data.List as List +import qualified Data.Char as Char +import qualified Data.List as List + +import Numeric.Natural ( Natural ) ---------------------------------------------------------------------------------------------------- @@ -98,3 +100,14 @@ isPrintable str = , "" ] in List.elem str nonChars |> not + +toNumber :: List Char -> Natural +toNumber chars = + let digitValue :: Char -> Natural + digitValue char + | Char.isDigit char = Char.ord char - Char.ord '0' |> toEnum + | otherwise = 0 + in List.foldl' + (\accum char -> accum * 10 + digitValue char) + 0 + chars diff --git a/lib/Glyph/Key/Chord.hs b/lib/Glyph/Key/Chord.hs index f478396..7a340ed 100644 --- a/lib/Glyph/Key/Chord.hs +++ b/lib/Glyph/Key/Chord.hs @@ -5,6 +5,7 @@ module Glyph.Key.Chord where import qualified Data.List as List import qualified Data.Set as Set +import Glyph.Class.Capturable ( Capturable (..) ) import Glyph.Class.Stringable ( Stringable (..) ) import Graphics.Vty.Input.Events ( Key (..), Modifier (..) ) @@ -37,6 +38,17 @@ instance Stringable Chord where key_ <- fromString keyText Just Chord{modifiers = Set.fromList modifiers_, key = key_} +instance Capturable Chord where + capture chord = + if Set.null chord.modifiers + then capture chord.key + else Nothing + + isUntilTerminator key chord = + if Set.null chord.modifiers + then key == chord.key + else False + ---------------------------------------------------------------------------------------------------- splitKey :: String -> (String, String) diff --git a/lib/Glyph/Key/Trie.hs b/lib/Glyph/Key/Trie.hs index 6ef22aa..31a80db 100644 --- a/lib/Glyph/Key/Trie.hs +++ b/lib/Glyph/Key/Trie.hs @@ -2,23 +2,22 @@ module Glyph.Key.Trie where ---------------------------------------------------------------------------------------------------- -import Data.Either.Validation ( Validation (..) ) -import qualified Data.Either.Validation as Validation +import qualified Data.Char as Char import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import qualified Data.Maybe as Maybe +import Data.Traversable ( Traversable (..) ) -import Glyph.Class.Stringable (Stringable (..)) +import Glyph.Class.Capturable ( Capturable (..) ) +import Glyph.Class.Stringable ( Stringable (..) ) import Glyph.Config.Dhall.Action ( Action (NoOp) ) import qualified Glyph.Extra.String as String -import qualified Glyph.Key.Chord as Chord import Glyph.Key.Edge ( CaptureType (..), Edge (..) ) import Graphics.Vty.Input.Events ( Key (..) ) - -import Numeric.Natural ( Natural ) +import Numeric.Natural ( Natural ) ---------------------------------------------------------------------------------------------------- @@ -57,9 +56,10 @@ data Captured | CapturedText Text deriving (Eq, Show) -data Collection - = Collecting (List Char) - | Collected Captured +data Collected a + = InputCaptureMismatch + | EndOfInput + | Complete Captured (List a) data Step a = DeadEnd @@ -74,61 +74,83 @@ data Binding a } deriving (Eq, Show) -walk :: (Stringable a, Ord a) => List a -> Collections -> KeyTrie a -> Step a -walk [] collected (Leaf action) = Found action collected.collected -walk [] collected _ = Pending collected.collected -walk (_ : _) _ (Leaf _) = DeadEnd -walk list@(x : xs) collected (Branch map) = +walk :: (Capturable a) => List a -> List Captured -> KeyTrie a -> Step a +walk [] cap (Leaf action) = Found action cap +walk [] cap _ = Pending cap +walk _ _ (Leaf _) = DeadEnd +walk list@(x : xs) cap (Branch map) = case Map.lookup (Literal x) map of - Just innerTrie -> walk xs collected innerTrie - Nothing -> - getCaptureType map - -- Don't walk the map just yet, instead capture characters until we're done - |> collectCaptures list + Just innerTrie -> walk xs cap innerTrie + Nothing + | hasCaptures map -> + -- Don't walk the map just yet, instead capture characters until we're done + let captureType = getCaptureType map + in case collectCaptures list captureType of + InputCaptureMismatch -> DeadEnd + EndOfInput -> Pending cap + Complete captured xs' -> + case Map.lookup (Capture captureType) map of + Just innerTrie' -> walk xs' (cap <> [captured]) innerTrie' + -- can't happen, just completeness + Nothing -> Pending (cap <> [captured]) + | otherwise -> DeadEnd collectCaptures - :: (Stringable a, Ord a) + :: (Capturable a) => List a -> CaptureType - -> (Captured, List a) + -> Collected a +collectCaptures [] _ = EndOfInput -- If it's a char capture, capture one and move on -collectCaptures (x:xs) (CaptureChar) = - if String.isPrintable (toString x) - then Captured +collectCaptures (x : xs) (CaptureChar) + | Just cap <- capture x = Complete (CapturedChar cap) xs + | otherwise = InputCaptureMismatch -- If it's a num capture, capture as long as it's a number -collectCaptures (x:xs) (CaptureNum) = +collectCaptures keys (CaptureNum) = + case List.span (capture .> Maybe.maybe False Char.isDigit) keys of + ([], _) -> InputCaptureMismatch + (_, []) -> EndOfInput + (digits, xs) -> + let chars = fmap capture digits |> Maybe.catMaybes + in Complete (CapturedNum <| String.toNumber chars) xs -- If it's an until-char capture, capture until we get that key (and discard it) -collectCaptures (x:xs) (CaptureUntil k) = - -couldBeCapture :: (Stringable a, Ord a) => Map (Edge a) (KeyTrie a) -> a -> Bool -couldBeCapture map a = - let strA = toString a - in Map.keys map - |> List.filter - (\case - Capture _ -> True - _ -> False - ) - |> List.null - |> not - -getCaptureType :: (Stringable a, Ord a) => Map (Edge a) (KeyTrie a) -> CaptureType +collectCaptures keys (CaptureUntil k) = + case List.break (isUntilTerminator k) keys of + (body, _ : rest) -> + traverse capture body + |> Maybe.maybe + InputCaptureMismatch + (\chars -> Complete (CapturedText <| toText chars) rest) + (body, []) + | Maybe.isJust (traverse capture body) -> EndOfInput + | otherwise -> InputCaptureMismatch + +hasCaptures :: (Ord a) => Map (Edge a) (KeyTrie a) -> Bool +hasCaptures map = + Map.keys map + |> List.any + ( \case + Capture _ -> True + _ -> False + ) + +getCaptureType :: (Ord a) => Map (Edge a) (KeyTrie a) -> CaptureType getCaptureType map = Map.keys map |> List.filter - (\case + ( \case Capture _ -> True _ -> False ) |> List.uncons |> \case - Just (Capture (cType), _) -> head + Just (Capture (cType), _) -> cType -- We should have never gotten to this point, technically. -- But we'll solve the completeness, assumptuously - Nothing -> CaptureChar + _ -> CaptureChar -resolve :: (Stringable a, Ord a) => List a -> (List Captured) -> KeyTrie a -> Step a -resolve keys collected kt = walk keys (Collections [] collected) kt +resolve :: (Capturable a) => List a -> KeyTrie a -> Step a +resolve keys kt = walk keys [] kt {- >>> { a: diff --git a/lib/Glyph/Key/Trigger.hs b/lib/Glyph/Key/Trigger.hs new file mode 100644 index 0000000..e6ae635 --- /dev/null +++ b/lib/Glyph/Key/Trigger.hs @@ -0,0 +1,56 @@ +module Glyph.Key.Trigger where + +---------------------------------------------------------------------------------------------------- + + + +---------------------------------------------------------------------------------------------------- + +data Triggered + = Cancelled + | Waiting InputState + | Fire Action Natural (List Captured) + deriving (Eq, Show) + +feedChord :: KeyTrie Chord -> Count -> List Chord -> Chord -> Triggered +feedChord keytrie count previous pressed = + +feedModal :: KeyTrie Key -> List Char -> Key -> Triggered +feedModal keytrie previous pressed = + +{- + +# feedChord # + +1. canCount → Waiting with pushDigit, same as now. +2. KEsc → Cancelled. Decide whether this applies only while input is pending. As written it also blocks anyone binding Esc at the root. +3. Otherwise, resolve (chords <> [chord]): + - DeadEnd → Cancelled, plus a notice like "C-q x is not bound" if you want one + - Pending _ → Waiting (ChordInput count (chords <> [chord])) + - Found act caps → Fire act (Count.settle count) caps + + +# feedModal # + +- Printable KChar c → append it (use Char.isPrint, same as capture) +- KBS → drop the last char; if the buffer is empty → Cancelled (this matches Vim) +- KEsc → Cancelled +- KEnter → resolve (fmap KChar chars <> [KEnter]) + - Found → Fire act (settle NoCount) caps + - Pending or DeadEnd → Cancelled, plus a "Not a command: :…" notice + +# Running Fire # + +Three actions change the input state instead of doing something: +- StartModal → ModalInput []. +- StartCount → ChordInput (Reading []) []. The chords are reset, so canCount accepts digits again even if the prefix was part-way down the trie. +- Everything else → back to "idle", then carry out the action. + +For payloads, you can match on Input directly for now: +- Predetermined n → n +- FromCount → the settled count +- FromCapture → the first capture + +Delete the KChar 'q' → halt placeholder. ensureQuit makes sure there's always a real quit binding now. + +-} diff --git a/shell.nix b/shell.nix index ff443f5..f2e5c3a 100644 --- a/shell.nix +++ b/shell.nix @@ -29,6 +29,7 @@ pkgs.mkShell { pkgs.stylish-haskell pkgs.haskellPackages.fourmolu pkgs.haskellPackages.cabal-fmt + pkgs.haskellPackages.hoogle # C libraries the Haskell dependency tree links against. # zlib: pulled in by dhall (via the `zlib` package, for its binary cache). @@ -44,4 +45,6 @@ pkgs.mkShell { # Nix pkgs.nixfmt ]; + + GLYPH_GHC_DOCS = "${pkgs.haskell.compiler.ghc912.doc}/share/doc/ghc/html/libraries"; } diff --git a/test/GlyphTest/Key/Trie.hs b/test/GlyphTest/Key/Trie.hs new file mode 100644 index 0000000..e58b862 --- /dev/null +++ b/test/GlyphTest/Key/Trie.hs @@ -0,0 +1,163 @@ +module GlyphTest.Key.Trie where + +---------------------------------------------------------------------------------------------------- + +import qualified Data.Map.Strict as Map +import qualified Data.Set as Set + +import Glyph.Config.Dhall.Action ( Action (..) ) +import Glyph.Key.Chord ( Chord (..) ) +import Glyph.Key.Edge ( CaptureType (..), Edge (..) ) +import Glyph.Key.Trie + ( Captured (..) + , KeyTrie (..) + , Step (..) + , resolve + ) + +import Graphics.Vty.Input.Events ( Key (..), Modifier (..) ) + +import Test.Hspec ( Spec, describe, it, shouldBe ) + +---------------------------------------------------------------------------------------------------- + +test :: Spec +test = + describe "Glyph.Key.Trie.resolve" <| do + describe "literals" <| do + it "fires a leaf once the whole path is typed" <| + resolve [KChar 'q', KChar 's'] quitTrie `shouldBe` Found QuitAndSave [] + + it "waits on an interior node" <| + resolve [KChar 'q'] quitTrie `shouldBe` Pending [] + + it "dead-ends on an unbound key rather than waiting for more" <| + resolve [KChar 'x'] quitTrie `shouldBe` DeadEnd + + it "dead-ends when keys continue past a leaf" <| + resolve [KChar 'q', KChar 's', KChar 's'] quitTrie `shouldBe` DeadEnd + + it "prefers a literal over a sibling capture" <| + resolve [KChar 'g'] numberTrie `shouldBe` Found NoOp [] + + describe "{char}" <| do + it "captures one printable key" <| + resolve [KChar 'f', KChar 'x'] charTrie `shouldBe` Found Help [CapturedChar 'x'] + + it "captures space" <| + resolve [KChar 'f', KChar ' '] charTrie `shouldBe` Found Help [CapturedChar ' '] + + it "rejects tab, which vty sends as a KChar" <| + resolve [KChar 'f', KChar '\t'] charTrie `shouldBe` DeadEnd + + it "rejects a non-printable key" <| + resolve [KChar 'f', KEnter] charTrie `shouldBe` DeadEnd + + it "rejects a chord with modifiers" <| + resolve [bare 'f', Chord (Set.fromList [MCtrl]) (KChar 'x')] chordCharTrie + `shouldBe` DeadEnd + + it "accepts a modifier-free chord" <| + resolve [bare 'f', bare 'x'] chordCharTrie `shouldBe` Found Help [CapturedChar 'x'] + + describe "{number}" <| do + it "consumes the whole run of digits" <| + resolve [KChar '1', KChar '2', KEnter] numberTrie `shouldBe` Found Help [CapturedNum 12] + + it "stays pending while more digits could follow, even before a leaf" <| + resolve [KChar '1', KChar '2'] numberLeafTrie `shouldBe` Pending [] + + it "dead-ends when the key after the run matches nothing" <| + resolve [KChar '1', KChar 'x'] numberTrie `shouldBe` DeadEnd + + describe "{until}" <| do + it "captures up to a printable terminator and drops it" <| + resolve [KChar 'a', KChar 'b', KChar ';'] untilSemicolonTrie + `shouldBe` Found Help [CapturedText "ab"] + + it "captures up to a non-printable terminator" <| + resolve [KChar 'a', KChar 'b', KEnter] untilEnterTrie + `shouldBe` Found Help [CapturedText "ab"] + + it "allows an empty capture" <| + resolve [KEnter] untilEnterTrie `shouldBe` Found Help [CapturedText ""] + + it "stays pending until the terminator arrives" <| + resolve [KChar 'a', KChar 'b'] untilSemicolonTrie `shouldBe` Pending [] + + it "dead-ends on a non-printable key before the terminator" <| + resolve [KChar 'a', KLeft, KChar 'b'] untilSemicolonTrie `shouldBe` DeadEnd + + describe "multiple captures" <| + it "reports captures in path order" <| + resolve [KChar 'm', KChar 'x', KChar '4', KChar '2', KEnter] markTrie + `shouldBe` Found Help [CapturedChar 'x', CapturedNum 42] + +---------------------------------------------------------------------------------------------------- + +branch :: (Ord a) => List (Edge a, KeyTrie a) -> KeyTrie a +branch = Map.fromList .> Branch + +bare :: Char -> Chord +bare = KChar .> Chord Set.empty + +-- | `q.a` and `q.s`, literals only. +quitTrie :: KeyTrie Key +quitTrie = + branch + [ + ( Literal <| KChar 'q' + , branch + [ (Literal <| KChar 'a', Leaf QuitAndAbandon) + , (Literal <| KChar 's', Leaf QuitAndSave) + ] + ) + ] + +-- | `f.{char}` +charTrie :: KeyTrie Key +charTrie = + branch [(Literal <| KChar 'f', branch [(Capture CaptureChar, Leaf Help)])] + +-- | `f.{char}`, as chords. +chordCharTrie :: KeyTrie Chord +chordCharTrie = + branch [(Literal <| bare 'f', branch [(Capture CaptureChar, Leaf Help)])] + +-- | `{number}.` beside a literal `g`, which validation allows. +numberTrie :: KeyTrie Key +numberTrie = + branch + [ (Capture CaptureNum, branch [(Literal KEnter, Leaf Help)]) + , (Literal <| KChar 'g', Leaf NoOp) + ] + +-- | `{number}` straight onto a leaf. +numberLeafTrie :: KeyTrie Key +numberLeafTrie = + branch [(Capture CaptureNum, Leaf Help)] + +-- | `{until ;}` +untilSemicolonTrie :: KeyTrie Key +untilSemicolonTrie = + branch [(Capture <| CaptureUntil (KChar ';'), Leaf Help)] + +-- | `{until }` +untilEnterTrie :: KeyTrie Key +untilEnterTrie = + branch [(Capture <| CaptureUntil KEnter, Leaf Help)] + +-- | `m.{char}.{number}.` +markTrie :: KeyTrie Key +markTrie = + branch + [ + ( Literal <| KChar 'm' + , branch + [ + ( Capture CaptureChar + , branch [(Capture CaptureNum, branch [(Literal KEnter, Leaf Help)])] + ) + ] + ) + ] diff --git a/test/Main.hs b/test/Main.hs index 5427c54..f887c91 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -7,6 +7,7 @@ module Main import qualified GlyphTest.Config.Keymap import qualified GlyphTest.Key.Count import qualified GlyphTest.Key.Kitty +import qualified GlyphTest.Key.Trie import Test.Hspec ( hspec ) @@ -18,3 +19,4 @@ main = GlyphTest.Config.Keymap.test GlyphTest.Key.Count.test GlyphTest.Key.Kitty.test + GlyphTest.Key.Trie.test -- knotmirror 0.0.1