diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -21,12 +21,12 @@ - env: ARGS="" SKIP_DOCTESTS=false - env: ARGS="--resolver lts" SKIP_DOCTESTS=false - env: ARGS="--resolver nightly" SKIP_DOCTESTS=false - - env: ARGS="--resolver lts-10" SKIP_DOCTESTS=false - - env: ARGS="--resolver lts-9" SKIP_DOCTESTS=true - - env: ARGS="--resolver lts-8" SKIP_DOCTESTS=true - - env: ARGS="--resolver lts-7" SKIP_DOCTESTS=true - - env: ARGS="--resolver lts-6" SKIP_DOCTESTS=true - - env: ARGS="--resolver lts-5" SKIP_DOCTESTS=true + - env: ARGS="--resolver lts-17" SKIP_DOCTESTS=false + - env: ARGS="--resolver lts-16" SKIP_DOCTESTS=false + - env: ARGS="--resolver lts-15" SKIP_DOCTESTS=false + - env: ARGS="--resolver lts-14" SKIP_DOCTESTS=false + - env: ARGS="--resolver lts-13" SKIP_DOCTESTS=false + - env: ARGS="--resolver lts-12" SKIP_DOCTESTS=false before_install: # Download and unpack the stack executable diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,13 @@ Changelog ========= +## v0.2.3 + +* Replace `lens` dependency with `microlens` for faster builds +* Compatibility with GHC 8.4 to 8.10, stackage LTS-12 to LTS-17 +* Explicitly passing a tty to the editor process, rather than stdin, to work + around a vim bug + ## v0.2.2 * Add support for aeson 1.2.x to enable build with Stackage LTS 10.x diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -45,25 +45,22 @@ ## Installation -### Binaries - -Debian/Ubuntu: `.deb` files are available for the [latest release][1]. +### Via [`nix`] from [nixpkgs] -```bash -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 ``` +nix-env -iA nixpkgs.haskellPackages.vgrep +``` -### From [Hackage][2] +### From [Hackage] -Installation from Hackage via [`stack`][3] is recommended: +Installation from Hackage via [`stack`] is recommended: ```bash stack update stack install vgrep ``` This will install `vgrep` to your `~/.local/bin` directory. -### From [source][4] +### From [source] ```bash git clone https://github.com/fmthoma/vgrep.git @@ -72,7 +69,8 @@ stack install ``` -[1]: https://github.com/fmthoma/vgrep/releases/latest -[2]: https://hackage.haskell.org/package/vgrep -[3]: https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md -[4]: https://github.com/fmthoma/vgrep +[`nix`]: https://nixos.org/ +[nixpkgs]: https://github.com/NixOS/nixpkgs +[Hackage]: https://hackage.haskell.org/package/vgrep +[`stack`]: https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md +[source]: https://github.com/fmthoma/vgrep diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -7,15 +7,14 @@ import Control.Lens.Compat import Control.Monad.Reader import Data.Maybe -import Data.Monoid import Data.Ratio -import Data.Sequence (Seq) +import Data.Sequence (Seq, (|>)) import qualified Data.Sequence as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.IO as TL -import Distribution.PackageDescription.TH +import Data.Version (showVersion) import qualified Graphics.Vty as Vty import Graphics.Vty.Input.Events hiding (Event) import Graphics.Vty.Picture @@ -28,7 +27,9 @@ import System.Exit import System.IO import System.Process +import System.Posix.IO +import Paths_vgrep import Vgrep.App as App import Vgrep.Command import Vgrep.Environment @@ -80,9 +81,7 @@ cancel grepThread doNothingJustPipe = runEffect (P.stdinLn >-> P.stdoutLn) printVersion = do - let version = $(packageVariable (pkgVersion . package)) - name = $(packageVariable (pkgName . package)) - putStrLn (name <> " " <> version) + putStrLn ("vgrep " <> showVersion version) putStrLn "" putStrLn "grep version: " runEffect (grepVersion >-> P.take 1 >-> P.map (" " <>) >-> stdoutText) @@ -222,8 +221,7 @@ loadSelectedFileToPager :: MonadIO m => VgrepT AppState m Redraw loadSelectedFileToPager = do - maybeFileName <- uses (results . currentFileName) - (fmap T.unpack) + maybeFileName <- use (results . currentFileName . to (fmap T.unpack)) whenJust maybeFileName $ \selectedFile -> do fileExists <- liftIO (doesFileExist selectedFile) fileContent <- if fileExists @@ -250,10 +248,10 @@ whenJust item action = maybe (pure mempty) action item invokeEditor :: AppState -> Next (VgrepT AppState m Redraw) -invokeEditor state = case views (results . currentFileName) (fmap T.unpack) state of +invokeEditor state = case view (results . currentFileName . to (fmap T.unpack)) state of Just selectedFile -> Interrupt $ Suspend $ \environment -> do let configuredEditor = view (config . editor) environment - selectedLineNumber = views (results . currentLineNumber) (fromMaybe 0) state + selectedLineNumber = view (results . currentLineNumber . to (fromMaybe 0)) state liftIO $ doesFileExist selectedFile >>= \case True -> exec configuredEditor ['+' : show selectedLineNumber, selectedFile] False -> hPutStrLn stderr ("File not found: " ++ show selectedFile) @@ -261,8 +259,10 @@ exec :: MonadIO io => FilePath -> [String] -> io () exec command args = liftIO $ do - (_,_,_,h) <- createProcess (proc command args) + tty <- openFd "/dev/tty" ReadWrite Nothing defaultFileFlags >>= fdToHandle + (_,_,_,h) <- createProcess (proc command args) {std_in = UseHandle tty} void (waitForProcess h) + hClose tty --------------------------------------------------------------------------- -- Lenses diff --git a/src/Control/Lens/Compat.hs b/src/Control/Lens/Compat.hs --- a/src/Control/Lens/Compat.hs +++ b/src/Control/Lens/Compat.hs @@ -1,12 +1,39 @@ +{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-dodgy-imports #-} module Control.Lens.Compat - ( to - , module Control.Lens + ( pre + , assign + , modifying + , traverseOf + + , Getter + + , module Lens.Micro.Platform ) where -import Control.Lens hiding (to) -import qualified Control.Lens as Lens +import Data.Monoid (First) +import Lens.Micro.Platform hiding (assign, modifying, traverseOf) +import Control.Monad.State (MonadState, modify) +pre :: Getting (First a) s a -> Getter s (Maybe a) +pre l = to (preview l) +{-# INLINE pre #-} + +assign :: MonadState s m => ASetter s s a b -> b -> m () +assign l b = modify (set l b) +{-# INLINE assign #-} + +modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m () +modifying l f = modify (over l f) +{-# INLINE modifying #-} + +traverseOf :: a -> a +traverseOf = id +{-# INLINE traverseOf #-} + +type Getter s a = SimpleGetter s a + -- | Build an (index-preserving) 'Getter' from an arbitrary Haskell function. -- See "Control.Lens".'Lens.to' for details. -- @@ -22,8 +49,8 @@ -- because of the redundant @'Functor' f@ constraint. This definition is -- identical to "Control.Lens".'Lens.to' except for the additional constraint -- @'Functor' f@. -to :: (Profunctor p, Functor f, Contravariant f) => (s -> a) -> Optic' p f s a -to k = getter - where - getter = Lens.to k - _fakeFunctorConstraint = rmap (fmap undefined) . getter +-- to :: (Profunctor p, Functor f, Contravariant f) => (s -> a) -> Optic' p f s a +-- to k = getter +-- where +-- getter = Lens.to k +-- _fakeFunctorConstraint = rmap (fmap undefined) . getter diff --git a/src/Vgrep/Ansi.hs b/src/Vgrep/Ansi.hs --- a/src/Vgrep/Ansi.hs +++ b/src/Vgrep/Ansi.hs @@ -31,8 +31,10 @@ -- combined with 'combineStyles'. The given 'Vty.Attr' is used as style for the -- root of the 'Formatted' tree. -- --- >>> renderAnsi Vty.defAttr (bare "Text") --- HorizText "Text"@(Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default},4,4) +-- >>> import Graphics.Vty.Image.Internal (Image (HorizText, attr)) +-- >>> let HorizText { attr = attr } = renderAnsi Vty.defAttr (bare "Text") +-- >>> attr +-- Attr {attrStyle = Default, attrForeColor = Default, attrBackColor = Default, attrURL = Default} -- renderAnsi :: Attr -> AnsiFormatted -> Vty.Image renderAnsi attr = \case diff --git a/src/Vgrep/Ansi/Parser.hs b/src/Vgrep/Ansi/Parser.hs --- a/src/Vgrep/Ansi/Parser.hs +++ b/src/Vgrep/Ansi/Parser.hs @@ -10,7 +10,6 @@ import Data.Attoparsec.Text import Data.Bits import Data.Functor -import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Graphics.Vty.Attributes (Attr) diff --git a/src/Vgrep/Ansi/Type.hs b/src/Vgrep/Ansi/Type.hs --- a/src/Vgrep/Ansi/Type.hs +++ b/src/Vgrep/Ansi/Type.hs @@ -17,7 +17,6 @@ ) where import Data.Foldable (foldl') -import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Graphics.Vty (Attr) @@ -48,9 +47,11 @@ Format l a t -> Format l (f a) (fmap f t) Cat l ts -> Cat l (map (fmap f) ts) -instance (Eq attr, Monoid attr) => Monoid (Formatted attr) where +instance (Eq attr, Semigroup attr) => Semigroup (Formatted attr) where + (<>) = fuse + +instance (Eq attr, Semigroup attr) => Monoid (Formatted attr) where mempty = Empty - mappend = fuse -- | Type alias for Text formatted with 'Attr' from "Graphics.Vty". @@ -120,7 +121,7 @@ -- >>> format (Just ()) (bare "Left") `fuse` format (Just ()) (bare "Right") -- Format 9 (Just ()) (Text 9 "LeftRight") -- -fuse :: (Eq attr, Monoid attr) => Formatted attr -> Formatted attr -> Formatted attr +fuse :: (Eq attr, Semigroup attr) => Formatted attr -> Formatted attr -> Formatted attr fuse left right = case (left, right) of (Empty, formatted) -> formatted (formatted, Empty) -> formatted diff --git a/src/Vgrep/Ansi/Vty/Attributes.hs b/src/Vgrep/Ansi/Vty/Attributes.hs --- a/src/Vgrep/Ansi/Vty/Attributes.hs +++ b/src/Vgrep/Ansi/Vty/Attributes.hs @@ -4,7 +4,6 @@ ) where import Data.Bits ((.|.)) -import Data.Monoid ((<>)) import Graphics.Vty.Attributes (Attr (..), MaybeDefault (..), defAttr) -- | Combines two 'Attr's. This differs from 'mappend' from the 'Monoid' 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 @@ -30,9 +30,11 @@ , _mkeybindings :: KeybindingsMonoid } deriving (Eq, Show, Generic) +instance Semigroup ConfigMonoid where + (<>) = mappenddefault + instance Monoid ConfigMonoid where mempty = memptydefault - mappend = mappenddefault -- | A 'Monoid' for reading partial 'Vgrep.Environment.Config.Colors' @@ -58,9 +60,11 @@ , _mselected :: First Attr } deriving (Eq, Show, Generic) +instance Semigroup ColorsMonoid where + (<>) = mappenddefault + instance Monoid ColorsMonoid where mempty = memptydefault - mappend = mappenddefault -- | A 'Monoid' for reading a partial 'Vgrep.Environment.Config.Keybindings' @@ -91,6 +95,8 @@ , _mglobalKeybindings :: Maybe KeybindingMap } deriving (Eq, Show, Generic) +instance Semigroup KeybindingsMonoid where + (<>) = mappenddefault + instance Monoid KeybindingsMonoid where mempty = memptydefault - mappend = mappenddefault diff --git a/src/Vgrep/Environment/Config/Sources.hs b/src/Vgrep/Environment/Config/Sources.hs --- a/src/Vgrep/Environment/Config/Sources.hs +++ b/src/Vgrep/Environment/Config/Sources.hs @@ -5,4 +5,3 @@ import Vgrep.Environment.Config.Sources.Env (editorConfigFromEnv) import Vgrep.Environment.Config.Sources.File (configFromFile) - 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 @@ -17,6 +17,7 @@ import Data.Aeson.Types ( FromJSON (..) , Options (..) + , Parser , camelTo , defaultOptions , genericParseJSON @@ -44,8 +45,8 @@ import Vgrep.KeybindingMap -- $setup --- >>> import Data.List (isInfixOf) --- >>> import Data.Yaml.Aeson (decodeEither, ParseException) +-- >>> import Data.Either (isLeft) +-- >>> import Data.Yaml.Aeson (decodeEither', ParseException(..)) {- | @@ -167,38 +168,38 @@ JSON example: ->>> decodeEither "{\"fore-color\": \"black\", \"style\": \"standout\"}" :: Either String Attr +>>> decodeEither' "{\"fore-color\": \"black\", \"style\": \"standout\"}" :: Either ParseException Attr Right (Attr {foreColor = Just Black, backColor = Nothing, style = Just Standout}) JSON example without quotes: ->>> decodeEither "{fore-color: black, style: standout}" :: Either String Attr +>>> decodeEither' "{fore-color: black, style: standout}" :: Either ParseException Attr Right (Attr {foreColor = Just Black, backColor = Nothing, style = Just Standout}) YAML example: >>> :{ ->>> decodeEither +>>> decodeEither' >>> $ "fore-color: \"blue\"\n" >>> <> "back-color: \"bright-blue\"\n" >>> <> "style: \"reverse-video\"\n" ->>> :: Either String Attr +>>> :: Either ParseException Attr >>> :} Right (Attr {foreColor = Just Blue, backColor = Just BrightBlue, style = Just ReverseVideo}) YAML example without quotes: >>> :{ ->>> decodeEither +>>> decodeEither' >>> $ "fore-color: blue\n" >>> <> "back-color: bright-blue\n" >>> <> "style: reverse-video\n" ->>> :: Either String Attr +>>> :: Either ParseException 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 +>>> decodeEither' "{}" :: Either ParseException Attr Right (Attr {foreColor = Nothing, backColor = Nothing, style = Nothing}) -} data Attr = Attr @@ -223,18 +224,17 @@ {- | A JSON-parsable data type for 'Vty.Color'. ->>> decodeEither "[\"black\",\"red\",\"bright-black\"]" :: Either String [Color] +>>> decodeEither' "[\"black\",\"red\",\"bright-black\"]" :: Either ParseException [Color] Right [Black,Red,BrightBlack] Also works without quotes: ->>> decodeEither "[black,red,bright-black]" :: Either String [Color] +>>> decodeEither' "[black,red,bright-black]" :: Either ParseException [Color] Right [Black,Red,BrightBlack] Fails with error message if the 'Color' cannot be parsed: ->>> let Left err = decodeEither "foo" :: Either String Color ->>> "The key \"foo\" was not found" `isInfixOf` err +>>> isLeft (decodeEither' "foo" :: Either ParseException Color) True -} data Color @@ -282,18 +282,17 @@ {- | A JSON-parsable data type for 'Vty.Style'. ->>> decodeEither "[\"standout\", \"underline\", \"bold\"]" :: Either String [Style] +>>> decodeEither' "[\"standout\", \"underline\", \"bold\"]" :: Either ParseException [Style] Right [Standout,Underline,Bold] Also works without quotes: ->>> decodeEither "[standout, underline, bold]" :: Either String [Style] +>>> decodeEither' "[standout, underline, bold]" :: Either ParseException [Style] Right [Standout,Underline,Bold] Fails with error message if the 'Style' cannot be parsed: ->>> let Left err = decodeEither "foo" :: Either String Style ->>> "The key \"foo\" was not found" `isInfixOf` err +>>> isLeft (decodeEither' "foo" :: Either ParseException Color) True -} data Style @@ -335,7 +334,7 @@ xs <- mxs pure ((k', x) : xs) -parseChord :: Monad m => String -> m Key.Chord +parseChord :: String -> Parser Key.Chord parseChord = \case 'C' : '-' : t -> fmap (`Key.withModifier` Key.Ctrl) (parseChord t) 'S' : '-' : t -> fmap (`Key.withModifier` Key.Shift) (parseChord t) diff --git a/src/Vgrep/Event.hs b/src/Vgrep/Event.hs --- a/src/Vgrep/Event.hs +++ b/src/Vgrep/Event.hs @@ -58,10 +58,12 @@ -- | The first event handler that triggers (i. e. does not return 'Skip') -- handles the event. +instance Semigroup (Next a) where + Skip <> next = next + next <> _other = next + instance Monoid (Next a) where mempty = Skip - Skip `mappend` next = next - next `mappend` _other = next instance Functor Next where fmap f = \case Skip -> Skip @@ -77,10 +79,12 @@ -- ^ The state has not changed or the change would not be visible, so -- refreshing the screen is not required. +instance Semigroup Redraw where + Unchanged <> Unchanged = Unchanged + _ <> _ = Redraw + instance Monoid Redraw where mempty = Unchanged - Unchanged `mappend` Unchanged = Unchanged - _ `mappend` _ = Redraw data Interrupt diff --git a/src/Vgrep/KeybindingMap.hs b/src/Vgrep/KeybindingMap.hs --- a/src/Vgrep/KeybindingMap.hs +++ b/src/Vgrep/KeybindingMap.hs @@ -8,7 +8,7 @@ newtype KeybindingMap = KeybindingMap { unKeybindingMap :: Map Key.Chord Command } - deriving (Show, Eq, Monoid) + deriving (Show, Eq, Semigroup, Monoid) lookup :: Key.Chord -> KeybindingMap -> Maybe Command lookup chord (KeybindingMap m) = M.lookup chord m diff --git a/src/Vgrep/Parser.hs b/src/Vgrep/Parser.hs --- a/src/Vgrep/Parser.hs +++ b/src/Vgrep/Parser.hs @@ -21,7 +21,7 @@ -- | Parses lines of 'Text', skipping lines that are not valid @grep@ -- output. parseGrepOutput :: [Text] -> [FileLineReference] -parseGrepOutput = catMaybes . fmap parseLine +parseGrepOutput = mapMaybe parseLine -- | Parses a line of @grep@ output. Returns 'Nothing' if the line cannot -- be parsed. diff --git a/src/Vgrep/Results.hs b/src/Vgrep/Results.hs --- a/src/Vgrep/Results.hs +++ b/src/Vgrep/Results.hs @@ -12,7 +12,7 @@ , lineReference ) where -import Control.Lens.TH +import Lens.Micro.Platform import Data.Text (Text) import Vgrep.Ansi (AnsiFormatted) diff --git a/src/Vgrep/Type.hs b/src/Vgrep/Type.hs --- a/src/Vgrep/Type.hs +++ b/src/Vgrep/Type.hs @@ -1,10 +1,13 @@ -- | The 'VgrepT' monad transformer allows reading from the 'Environment' -- and changing the state of the 'Vgrep.App.App' or a 'Vgrep.Widget.Widget'. +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Vgrep.Type ( -- * The 'VgrepT' monad transformer VgrepT () @@ -27,8 +30,7 @@ ) where import qualified Control.Exception as E -import Control.Lens.Internal.Zoom -import Control.Lens.Zoom +import Control.Lens.Compat import Control.Monad.Identity import Control.Monad.Morph import Control.Monad.Reader @@ -44,6 +46,7 @@ , modify , put ) +import Lens.Micro.Mtl.Internal import Vgrep.Environment @@ -72,7 +75,7 @@ instance MFunctor (VgrepT s) where hoist f (VgrepT action) = VgrepT (hoist (hoist f) action) -type instance Zoomed (VgrepT s m) = Focusing (StateT Environment m) +type instance Zoomed (VgrepT s m) = Zoomed (StateT s (StateT Environment m)) instance Monad m => Zoom (VgrepT s m) (VgrepT t m) s t where zoom l (VgrepT m) = VgrepT (zoom l m) 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 @@ -18,10 +18,9 @@ ) where import Control.Applicative (liftA2) -import Control.Lens.Compat hiding ((:<), (:>)) +import Control.Lens.Compat 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) @@ -93,7 +92,7 @@ setPosition :: Monad m => Int -> VgrepT Pager m () setPosition n = view viewportHeight >>= \height -> do - allLines <- liftA2 (+) (uses visible length) (uses above length) + allLines <- liftA2 (+) (use (visible . to length)) (use (above . to length)) let newPosition = if | n < 0 || allLines < height -> 0 | n > allLines - height -> allLines - height @@ -154,11 +153,10 @@ let (renderedLineNumbers, renderedTextLines) = over both fold . unzip - . map renderLine - $ zip [startPosition+1..] visibleLines + $ zipWith renderLine [startPosition+1..] visibleLines where - renderLine :: (Int, Text) -> (Image, Image) - renderLine (num, txt) = case Map.lookup num highlightedLines of + renderLine :: Int -> Text -> (Image, Image) + renderLine num txt = case Map.lookup num highlightedLines of Just formatted -> ( renderLineNumber lineNumberColorHl num , renderFormatted textColorHl formatted ) Nothing -> ( renderLineNumber lineNumberColor num @@ -167,8 +165,8 @@ renderLineNumber :: Attr -> Int -> Image renderLineNumber attr = text' attr - . (`snoc` ' ') - . cons ' ' + . (`T.snoc` ' ') + . T.cons ' ' . T.pack . show @@ -177,7 +175,7 @@ = text' attr . T.justifyLeft width ' ' . T.take width - . cons ' ' + . T.cons ' ' . T.drop startColumn renderFormatted :: Attr -> AnsiFormatted -> Image 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 @@ -31,7 +31,6 @@ import Control.Monad.State.Extended import Data.Foldable import Data.Maybe -import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Graphics.Vty.Attributes diff --git a/src/Vgrep/Widget/Results/Internal.hs b/src/Vgrep/Widget/Results/Internal.hs --- a/src/Vgrep/Widget/Results/Internal.hs +++ b/src/Vgrep/Widget/Results/Internal.hs @@ -24,7 +24,7 @@ ) where import Control.Applicative -import Control.Lens.Compat (Getter, pre, to, view, _Just) +import Control.Lens.Compat import Data.Foldable import Data.Function import Data.IntMap.Strict (IntMap) @@ -199,12 +199,12 @@ -- | The file name of the currently selected item currentFileName :: Getter Results (Maybe Text) currentFileName = - pre (to current . _Just . file . fileName) + to (preview (to current . _Just . file . fileName)) -- | The line number of the currently selected item currentLineNumber :: Getter Results (Maybe Int) currentLineNumber = - pre (to current . _Just . lineReference . lineNumber . _Just) + to (preview (to current . _Just . lineReference . lineNumber . _Just)) current :: Results -> Maybe FileLineReference current = \case 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-10.7 +resolver: lts-17.0 # Local packages, usually specified by relative directory name packages: diff --git a/test/Test/Case.hs b/test/Test/Case.hs --- a/test/Test/Case.hs +++ b/test/Test/Case.hs @@ -21,6 +21,7 @@ import Control.Lens.Compat import Control.Monad +import Data.Functor.Identity import Test.QuickCheck.Monadic import Test.Tasty import Test.Tasty.QuickCheck @@ -57,10 +58,10 @@ pure . monadic (`runVgrepForTest` (initialState, initialEnv)) . void $ do monitor (counterexample (show initialState)) monitor (counterexample (show initialEnv)) - before <- use invariant + invariantBefore <- use invariant void testCase - after <- use invariant - stop (after === before) + invariantAfter <- use invariant + stop (invariantAfter === invariantBefore) runTestCases :: TestName -> [TestCase] -> TestTree 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 @@ -64,7 +64,7 @@ { description = "MoveToLine displays the line on screen" , testData = arbitrary `suchThat` (not . emptyPager) , testCase = do - numLines <- liftA2 (+) (uses above length) (uses visible length) + numLines <- liftA2 (+) (use (above . to length)) (use (visible . to length)) line <- pick ( arbitrary `suchThat` (> 0) `suchThat` (<= numLines) ) run (void (moveToLine line)) @@ -85,7 +85,7 @@ run (void (scroll amount)) , assertion = const $ do pos <- use position - linesVisible <- uses visible length + linesVisible <- use (visible . to length) height <- view viewportHeight pure (pos >= 0 .&&. linesVisible >= height) } @@ -104,8 +104,8 @@ emptyPager :: (Pager, Environment) -> Bool -emptyPager (pager, _env) = views visible length pager == 0 - && views above length pager == 0 +emptyPager (pager, _env) = view (visible . to length) pager == 0 + && view (above . to length) pager == 0 coversScreen :: (Pager, Environment) -> Bool coversScreen (pager, env) = length (view visible pager) >= view viewportHeight env diff --git a/test/Test/Vgrep/Widget/Results.hs b/test/Test/Vgrep/Widget/Results.hs --- a/test/Test/Vgrep/Widget/Results.hs +++ b/test/Test/Vgrep/Widget/Results.hs @@ -6,7 +6,6 @@ import Control.Monad (void) import Data.Map.Strict ((!)) import qualified Data.Map.Strict as Map -import Data.Monoid ((<>)) import Data.Sequence (Seq, ViewR (..)) import qualified Data.Sequence as Seq import Test.Case diff --git a/test/Vgrep/Widget/Results/Testable.hs b/test/Vgrep/Widget/Results/Testable.hs --- a/test/Vgrep/Widget/Results/Testable.hs +++ b/test/Vgrep/Widget/Results/Testable.hs @@ -5,7 +5,6 @@ , module Vgrep.Widget.Results.Internal ) where -import Control.Monad import qualified Data.List as List import qualified Data.Sequence as Seq import Data.Text (Text) @@ -29,7 +28,10 @@ generateResults :: Gen Results generateResults = sized $ \n -> do streamOfResults <- arbitraryGrepResults - [numAs, numBs, numDs, numEs] <- replicateM 4 (choose (0, n)) + numAs <- choose (0, n) + numBs <- choose (0, n) + numDs <- choose (0, n) + numEs <- choose (0, n) let (as, as') = splitAt numAs streamOfResults (bs, bs') = splitAt numBs as' ([c], cs') = splitAt 1 bs' diff --git a/vgrep.cabal b/vgrep.cabal --- a/vgrep.cabal +++ b/vgrep.cabal @@ -1,7 +1,7 @@ name: vgrep -version: 0.2.2.0 +version: 0.2.3.0 synopsis: A pager for grep -description: +description: @vgrep@ is a pager for navigating through @grep@ output. . Usage: @@ -69,16 +69,17 @@ , Vgrep.Widget.Results , Vgrep.Widget.Results.Internal , Vgrep.Widget.Type - build-depends: base >= 4.7 && < 5 - , aeson (>= 0.11 && < 1.3) || (>= 0.9 && < 0.10) + build-depends: base >= 4.11 && < 5 + , aeson (>= 0.11 && < 1.6) || (>= 0.9 && < 0.10) , async >= 2.0.2 , attoparsec >= 0.12.1.6 , containers >= 0.5.6.2 , directory >= 1.2.2 , fingertree >= 0.1.1 , generic-deriving >= 1.5.0 - , lens >= 4.13 , lifted-base >= 0.2.3.6 + , microlens-mtl + , microlens-platform , mmorph >= 1.0.4 , mtl >= 2.2.1 , pipes >= 4.1.6 @@ -98,18 +99,19 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-extensions: LambdaCase , MultiWayIf - build-depends: base >= 4.7 && < 5 + other-modules: Paths_vgrep + build-depends: base >= 4.11 && < 5 , async >= 2.0.2 - , cabal-file-th >= 0.2.3 , containers >= 0.5.6.2 , directory >= 1.2.2 - , lens >= 4.13 + , microlens-platform , mtl >= 2.2.1 , pipes >= 4.1.6 , pipes-concurrency >= 2.0.3 , process >= 1.2.3 , template-haskell >= 2.10 , text >= 1.2.1.3 + , unix >= 2.7.1 , vgrep , vty >= 5.4.0 default-language: Haskell2010 @@ -128,7 +130,6 @@ , Vgrep.Widget.Results.Testable build-depends: base , containers - , lens , QuickCheck , tasty , tasty-quickcheck