diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -22,8 +22,9 @@ - env: ARGS="--resolver lts-5" - env: ARGS="--resolver lts-6" - env: ARGS="--resolver lts-7" + - env: ARGS="--resolver lts-8" + - env: ARGS="--resolver lts-9" - env: ARGS="--resolver lts" - allow_failures: - env: ARGS="--resolver nightly" before_install: diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ Changelog ========= +## v0.2.1 + +* Add support for aeson 1.x to enable build with Stackage LTS 9.x +* Add `less`-like keybindings Ctrl-u, Ctrl-d (half-page-up/down, only in pager) + and Ctrl-b, Ctrl-f (full-page-up/down). + ## v0.2 * Added support for a config file: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -50,7 +50,7 @@ Debian/Ubuntu: `.deb` files are available for the [latest release][1]. ```bash -wget https://github.com/fmthoma/vgrep/releases/download/v0.2.0.0/vgrep_0.2.0.0-1_amd64.deb +wget https://github.com/fmthoma/vgrep/releases/download/v0.2/vgrep_0.2.0.0-1_amd64.deb sudo dpkg -i vgrep_0.2.0.0-1_amd64.deb ``` diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -6,7 +6,6 @@ import Control.Concurrent.Async import Control.Lens.Compat import Control.Monad.Reader -import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid import Data.Ratio @@ -35,6 +34,7 @@ import Vgrep.Environment import Vgrep.Event import qualified Vgrep.Key as Key +import qualified Vgrep.KeybindingMap as KeybindingMap import Vgrep.Parser import Vgrep.System.Grep import Vgrep.Text @@ -59,7 +59,9 @@ outputToTerminal <- hIsTerminalDevice stdout case (inputFromTerminal, outputToTerminal) of (True, False) -> runHeadless (const recursiveGrep) - (False, False) -> runHeadless grep + (False, False) + | null args -> doNothingJustPipe + | otherwise -> runHeadless grep (False, True) | null args -> runGui cfg id | otherwise -> runGui cfg grepForApp @@ -76,6 +78,7 @@ >-> toOutput evSink runApp_ app cfg (fromInput evSource) cancel grepThread + doNothingJustPipe = runEffect (P.stdinLn >-> P.stdoutLn) printVersion = do let version = $(packageVariable (pkgVersion . package)) name = $(packageVariable (pkgName . package)) @@ -178,7 +181,7 @@ localBindings = case view (widgetState . currentWidget) state of Left _ -> resultsBindings Right _ -> pagerBindings - lookupCmd = fromMaybe Unset . M.lookup chord + lookupCmd = fromMaybe Unset . KeybindingMap.lookup chord command = case lookupCmd localBindings of Unset -> lookupCmd globalBindings defined -> defined @@ -195,6 +198,8 @@ PagerDown -> continue (zoom pager (scroll 1)) PagerPageUp -> continue (zoom pager (scrollPage (-1))) PagerPageDown -> continue (zoom pager (scrollPage 1)) + PagerHalfPageUp -> continue (zoom pager (scrollPageFraction (-1%2))) + PagerHalfPageDown -> continue (zoom pager (scrollPageFraction (1%2))) PagerScrollLeft -> continue (zoom pager (hScroll (-1))) PagerScrollRight -> continue (zoom pager (hScroll 1)) ResultsUp -> continue (zoom results prevLine >> pure Redraw) diff --git a/config.yaml.example b/config.yaml.example --- a/config.yaml.example +++ b/config.yaml.example @@ -14,21 +14,37 @@ ## by your terminal. ## ## If a color/style is not given, it falls back to the terminal -## default. If no config is given for a color, the vgrep default -## config steps in (which may differ from your terminal's default). +## default: ## +## # terminal-default back-color and style +## line-numbers: +## fore-color: blue +## ... +## +## # reset line-numbers to terminal default +## line-numbers: {} +## ... +## +## If no config is given for a color, the vgrep default config +## steps in (which may differ from your terminal's default): +## +## # use vgrep default config for line numbers +## line-numbers: +## ... +## colors: # Line numbers line-numbers: fore-color: blue + # Highlighted line numbers line-numbers-hl: fore-color: blue style: bold # Normal text - normal: + normal: {} # Highlighted text normal-hl: @@ -64,14 +80,16 @@ ## * split-focus-results -- Split screen, focus on results list ## * pager-up -- Scroll one line up in pager ## * pager-down -- Scroll one line down in pager -## * pager-page-up -- Scroll one page up in pager -## * pager-page-down -- Scroll one page down in pager +## * pager-page-up -- Scroll one page up in pager +## * pager-page-down -- Scroll one page down in pager +## * pager-half-page-up -- Scroll half a page up in pager +## * pager-half-page-down -- Scroll half a page down in pager ## * pager-scroll-left -- Scroll eight characters left in pager ## * pager-scroll-right -- Scroll eight characters right in pager ## * results-up -- Move to previous result ## * results-down -- Move to next result -## * results-page-up -- Move one page up in results list -## * results-page-down -- Move one page down in results list +## * results-page-up -- Move one page up in results list +## * results-page-down -- Move one page down in results list ## * prev-result -- Move to previous result and update pager ## * next-result -- Move to next result and update pager ## * pager-goto-result -- Update pager with currently selected result @@ -111,6 +129,8 @@ Enter : pager-goto-result k : results-up j : results-down + C-b : results-page-up + C-f : results-page-down f : display-results-only Tab : split-focus-pager @@ -127,6 +147,10 @@ j : pager-down h : pager-scroll-left l : pager-scroll-right + C-u : pager-half-page-up + C-d : pager-half-page-down + C-b : pager-page-up + C-f : pager-page-down Tab : split-focus-results f : display-pager-only q : display-results-only diff --git a/src/Vgrep/App/Internal.hs b/src/Vgrep/App/Internal.hs --- a/src/Vgrep/App/Internal.hs +++ b/src/Vgrep/App/Internal.hs @@ -1,6 +1,5 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} module Vgrep.App.Internal where import Control.Concurrent.Async diff --git a/src/Vgrep/Command.hs b/src/Vgrep/Command.hs --- a/src/Vgrep/Command.hs +++ b/src/Vgrep/Command.hs @@ -13,6 +13,8 @@ | PagerDown -- ^ Scroll one line down in pager | PagerPageUp -- ^ Scroll one page up in pager | PagerPageDown -- ^ Scroll one page down in pager + | PagerHalfPageUp -- ^ Scroll half a page up in pager + | PagerHalfPageDown -- ^ Scroll half a page down in pager | PagerScrollLeft -- ^ Scroll eight characters left in pager | PagerScrollRight -- ^ Scroll eight characters right in pager diff --git a/src/Vgrep/Environment/Config.hs b/src/Vgrep/Environment/Config.hs --- a/src/Vgrep/Environment/Config.hs +++ b/src/Vgrep/Environment/Config.hs @@ -4,11 +4,9 @@ import Control.Lens.Compat import Control.Monad.IO.Class -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid -import Graphics.Vty.Image +import Graphics.Vty.Attributes ( Attr , blue , bold @@ -24,6 +22,8 @@ import Vgrep.Environment.Config.Monoid import Vgrep.Environment.Config.Sources import qualified Vgrep.Key as Key +import Vgrep.KeybindingMap (KeybindingMap (..)) +import qualified Vgrep.KeybindingMap as KeybindingMap -------------------------------------------------------------------------- @@ -68,13 +68,13 @@ } deriving (Eq, Show) data Keybindings = Keybindings - { _resultsKeybindings :: Map Key.Chord Command + { _resultsKeybindings :: KeybindingMap -- ^ Keybindings in effect when results list is focused. - , _pagerKeybindings :: Map Key.Chord Command + , _pagerKeybindings :: KeybindingMap -- ^ Keybindings in effect when pager is focused. - , _globalKeybindings :: Map Key.Chord Command + , _globalKeybindings :: KeybindingMap -- ^ Global keybindings are in effect both for pager and results list, but -- can be overridden by either one. @@ -146,7 +146,7 @@ defaultKeybindings :: Keybindings defaultKeybindings = Keybindings - { _resultsKeybindings = M.fromList + { _resultsKeybindings = KeybindingMap.fromList [ (Key.key Key.Up, ResultsUp) , (Key.key Key.Down, ResultsDown) , (Key.key Key.PageUp, ResultsPageUp) @@ -154,9 +154,11 @@ , (Key.key Key.Enter, PagerGotoResult) , (Key.key (Key.Char 'k'), ResultsUp) , (Key.key (Key.Char 'j'), ResultsDown) + , (Key.key (Key.Char 'b') `Key.withModifier` Key.Ctrl, ResultsPageUp) + , (Key.key (Key.Char 'f') `Key.withModifier` Key.Ctrl, ResultsPageDown) , (Key.key (Key.Char 'f'), DisplayResultsOnly) , (Key.key Key.Tab, SplitFocusPager) ] - , _pagerKeybindings = M.fromList + , _pagerKeybindings = KeybindingMap.fromList [ (Key.key Key.Up, PagerUp) , (Key.key Key.Down, PagerDown) , (Key.key Key.PageUp, PagerPageUp) @@ -167,10 +169,14 @@ , (Key.key (Key.Char 'j'), PagerDown) , (Key.key (Key.Char 'h'), PagerScrollLeft) , (Key.key (Key.Char 'l'), PagerScrollRight) + , (Key.key (Key.Char 'u') `Key.withModifier` Key.Ctrl, PagerHalfPageUp) + , (Key.key (Key.Char 'd') `Key.withModifier` Key.Ctrl, PagerHalfPageDown) + , (Key.key (Key.Char 'b') `Key.withModifier` Key.Ctrl, PagerPageUp) + , (Key.key (Key.Char 'f') `Key.withModifier` Key.Ctrl, PagerPageDown) , (Key.key (Key.Char 'f'), DisplayPagerOnly) , (Key.key Key.Tab, SplitFocusResults) , (Key.key (Key.Char 'q'), DisplayResultsOnly) ] - , _globalKeybindings = M.fromList + , _globalKeybindings = KeybindingMap.fromList [ (Key.key (Key.Char 'e'), OpenFileInEditor) , (Key.key (Key.Char 'q'), Exit) ] } diff --git a/src/Vgrep/Environment/Config/Monoid.hs b/src/Vgrep/Environment/Config/Monoid.hs --- a/src/Vgrep/Environment/Config/Monoid.hs +++ b/src/Vgrep/Environment/Config/Monoid.hs @@ -5,17 +5,17 @@ , KeybindingsMonoid (..) ) where -import Data.Map.Strict (Map) import Data.Monoid import Generics.Deriving.Monoid (mappenddefault, memptydefault) import GHC.Generics import Graphics.Vty.Attributes (Attr) -import Vgrep.Command -import qualified Vgrep.Key as Key +import Vgrep.KeybindingMap (KeybindingMap (..)) -- $setup -- >>> import Data.Map.Strict +-- >>> import Vgrep.Command +-- >>> import qualified Vgrep.Key as Key -- | A 'Monoid' for reading partial configs. The 'ConfigMonoid' can be converted -- to an actual 'Vgrep.Environment.Config.Config' using @@ -68,27 +68,27 @@ -- -- Mappings are combined using left-biased 'Data.Map.Strict.union': -- --- >>> let l = Just (fromList [(Key.Chord mempty Key.Down, ResultsDown), (Key.Chord mempty Key.Up, ResultsUp)]) --- >>> let r = Just (fromList [(Key.Chord mempty Key.Down, PagerDown)]) +-- >>> let l = Just (KeybindingMap (fromList [(Key.Chord mempty Key.Down, ResultsDown), (Key.Chord mempty Key.Up, ResultsUp)])) +-- >>> let r = Just (KeybindingMap (fromList [(Key.Chord mempty Key.Down, PagerDown)])) -- >>> l <> r --- Just (fromList [(Chord (fromList []) Up,ResultsUp),(Chord (fromList []) Down,ResultsDown)]) +-- Just (KeybindingMap {unKeybindingMap = fromList [(Chord (fromList []) Up,ResultsUp),(Chord (fromList []) Down,ResultsDown)]}) -- >>> r <> l --- Just (fromList [(Chord (fromList []) Up,ResultsUp),(Chord (fromList []) Down,PagerDown)]) +-- Just (KeybindingMap {unKeybindingMap = fromList [(Chord (fromList []) Up,ResultsUp),(Chord (fromList []) Down,PagerDown)]}) -- -- In particular, @'Just' ('Data.Map.Strict.fromList' [])@ (declaring an empty -- list of mappings) and @'Nothing'@ (not declaring anything) are equivalent, -- given that there are already default mappings: -- --- >>> l <> Just (fromList []) == l <> Nothing +-- >>> l <> Just (KeybindingMap (fromList [])) == l <> Nothing -- True -- -- This means that new keybindings override the previous ones if they collide, -- otherwise they are simply added. To remove a keybinding, it has to be mapped -- to 'Unset' explicitly. data KeybindingsMonoid = KeybindingsMonoid - { _mresultsKeybindings :: Maybe (Map Key.Chord Command) - , _mpagerKeybindings :: Maybe (Map Key.Chord Command) - , _mglobalKeybindings :: Maybe (Map Key.Chord Command) + { _mresultsKeybindings :: Maybe KeybindingMap + , _mpagerKeybindings :: Maybe KeybindingMap + , _mglobalKeybindings :: Maybe KeybindingMap } deriving (Eq, Show, Generic) instance Monoid KeybindingsMonoid where diff --git a/src/Vgrep/Environment/Config/Sources/File.hs b/src/Vgrep/Environment/Config/Sources/File.hs --- a/src/Vgrep/Environment/Config/Sources/File.hs +++ b/src/Vgrep/Environment/Config/Sources/File.hs @@ -12,20 +12,26 @@ , Style ) where -import Control.Monad ((>=>)) +import Control.Monad ((<=<)) import Control.Monad.IO.Class import Data.Aeson.Types - ( Options (..) + ( FromJSON (..) + , Options (..) , camelTo , defaultOptions , genericParseJSON , withObject + , (.!=) + , (.:?) ) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid import Data.Yaml.Aeson + ( decodeFileEither + , prettyPrintParseException + ) import GHC.Generics import qualified Graphics.Vty.Attributes as Vty import System.Directory @@ -35,9 +41,11 @@ import Vgrep.Command import Vgrep.Environment.Config.Monoid import qualified Vgrep.Key as Key +import Vgrep.KeybindingMap -- $setup -- >>> import Data.List (isInfixOf) +-- >>> import Data.Yaml.Aeson (decodeEither, ParseException) {- | @@ -69,7 +77,7 @@ > line-numbers-hl: > fore-color: blue > style: bold -> normal: +> normal: {} > normal-hl: > style: bold > file-headers: @@ -187,6 +195,11 @@ >>> :: Either String Attr >>> :} Right (Attr {foreColor = Just Blue, backColor = Just BrightBlue, style = Just ReverseVideo}) + +An empty JSON/YAML object yields the default colors: + +>>> decodeEither "{}" :: Either String Attr +Right (Attr {foreColor = Nothing, backColor = Nothing, style = Nothing}) -} data Attr = Attr { foreColor :: Maybe Color @@ -311,8 +324,8 @@ instance FromJSON Command where parseJSON = genericParseJSON jsonOptions -instance FromJSON (Map Key.Chord Command) where - parseJSON = parseJSON >=> mapMKeys parseChord +instance FromJSON KeybindingMap where + parseJSON = fmap KeybindingMap . mapMKeys parseChord <=< parseJSON mapMKeys :: (Monad m, Ord k') => (k -> m k') -> Map k v -> m (Map k' v) mapMKeys f = fmap M.fromList . M.foldrWithKey go (pure []) diff --git a/src/Vgrep/KeybindingMap.hs b/src/Vgrep/KeybindingMap.hs new file mode 100644 --- /dev/null +++ b/src/Vgrep/KeybindingMap.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Vgrep.KeybindingMap where + +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Vgrep.Command +import qualified Vgrep.Key as Key + + +newtype KeybindingMap = KeybindingMap { unKeybindingMap :: Map Key.Chord Command } + deriving (Show, Eq, Monoid) + +lookup :: Key.Chord -> KeybindingMap -> Maybe Command +lookup chord (KeybindingMap m) = M.lookup chord m + +fromList :: [(Key.Chord, Command)] -> KeybindingMap +fromList = KeybindingMap . M.fromList diff --git a/src/Vgrep/Widget/Pager.hs b/src/Vgrep/Widget/Pager.hs --- a/src/Vgrep/Widget/Pager.hs +++ b/src/Vgrep/Widget/Pager.hs @@ -12,20 +12,22 @@ , moveToLine , scroll , scrollPage + , scrollPageFraction , hScroll , replaceBufferContents ) where -import Control.Applicative (liftA2) -import Control.Lens.Compat hiding ((:<), (:>)) +import Control.Applicative (liftA2) +import Control.Lens.Compat hiding ((:<), (:>)) import Data.Foldable -import qualified Data.IntMap.Strict as Map -import Data.Monoid ((<>)) -import Data.Sequence (Seq, (><)) -import qualified Data.Sequence as Seq -import Data.Text (Text) -import qualified Data.Text as T -import Graphics.Vty.Image hiding (resize) +import qualified Data.IntMap.Strict as Map +import Data.Monoid ((<>)) +import Data.Sequence (Seq, (><)) +import qualified Data.Sequence as Seq +import Data.Text (Text) +import qualified Data.Text as T +import Graphics.Vty.Attributes +import Graphics.Vty.Image hiding (resize) import Vgrep.Ansi import Vgrep.Environment @@ -111,6 +113,17 @@ scrollPage n = view viewportHeight >>= \height -> scroll (n * (height - 1)) -- gracefully leave one ^ line on the screen + +-- | Scroll up or down a fraction of a page. For integers, +-- 'scrollPageFraction n == scrollPage n'. +-- +-- > scrollPageFraction (-1%2) -- scroll one half page up +-- > scrollPageFraction (1%2) -- scroll one half page down +-- > scrollPageFraction (fromRational 1) -- scroll one page down +scrollPageFraction :: Monad m => Rational -> VgrepT Pager m Redraw +scrollPageFraction a = view viewportHeight >>= \height -> + scroll (round (a * (fromIntegral height - 1))) + -- gracefully leave one ^ line on the screen -- | Horizontal scrolling. Increment is one 'tabstop'. -- diff --git a/src/Vgrep/Widget/Results.hs b/src/Vgrep/Widget/Results.hs --- a/src/Vgrep/Widget/Results.hs +++ b/src/Vgrep/Widget/Results.hs @@ -34,6 +34,7 @@ import Data.Monoid import Data.Text (Text) import qualified Data.Text as T +import Graphics.Vty.Attributes import Graphics.Vty.Image hiding ((<|>)) import Vgrep.Ansi diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-5.0 +resolver: lts-9.0 # Local packages, usually specified by relative directory name packages: diff --git a/test/Test/Vgrep/Widget/Pager.hs b/test/Test/Vgrep/Widget/Pager.hs --- a/test/Test/Vgrep/Widget/Pager.hs +++ b/test/Test/Vgrep/Widget/Pager.hs @@ -24,6 +24,36 @@ , testCase = run (void (scroll (-1) >> scroll 1)) , invariant = id } + , TestProperty + { description = "Scrolling n pages at once is the same as scrolling n times one page" + , testData = arbitrary + , testCase = do + n <- pick (arbitrary `suchThat` (/= 0)) + initialState <- get + run (void (scrollPage n)) + nPagesAtOnce <- get + put initialState + replicateM_ (abs n) (run (scrollPage (signum n))) + nTimesOnePage <- get + pure (nPagesAtOnce, nTimesOnePage) + , assertion = \(nPagesAtOnce, nTimesOnePage) -> + pure (nPagesAtOnce === nTimesOnePage) + } + , TestProperty + { description = "Scrolling by integral page fractions is the same as scrolling entire pages" + , testData = arbitrary + , testCase = do + n <- pick (arbitrary `suchThat` (/= 0)) + initialState <- get + run (void (scrollPageFraction (fromIntegral n))) + scrollNFractionalPages <- get + put initialState + run (void (scrollPage n)) + scrollNPages <- get + pure (scrollNFractionalPages, scrollNPages) + , assertion = \(scrollNFractionalPages, scrollNPages) -> + pure (scrollNFractionalPages === scrollNPages) + } , TestInvariant { description = "Scrolling right and left leaves pager invariant" , testData = arbitrary diff --git a/vgrep.cabal b/vgrep.cabal --- a/vgrep.cabal +++ b/vgrep.cabal @@ -1,5 +1,5 @@ name: vgrep -version: 0.2.0.0 +version: 0.2.1.0 synopsis: A pager for grep description: @vgrep@ is a pager for navigating through @grep@ output. @@ -55,6 +55,7 @@ , Vgrep.Environment.Config.Sources.File , Vgrep.Event , Vgrep.Key + , Vgrep.KeybindingMap , Vgrep.Parser , Vgrep.Results , Vgrep.System.Grep @@ -69,7 +70,7 @@ , Vgrep.Widget.Results.Internal , Vgrep.Widget.Type build-depends: base >= 4.7 && < 5 - , aeson >= 0.11 || (>= 0.9 && < 0.10) + , aeson (>= 0.11 && < 1.2) || (>= 0.9 && < 0.10) , async >= 2.0.2 , attoparsec >= 0.12.1.6 , containers >= 0.5.6.2