diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Dennis Gosnell (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,52 @@ + +Highlight +========= + +[![Build Status](https://secure.travis-ci.org/cdepillabout/highlight.svg)](http://travis-ci.org/cdepillabout/highlight) +[![Hackage](https://img.shields.io/hackage/v/highlight.svg)](https://hackage.haskell.org/package/highlight) +[![Stackage LTS](http://stackage.org/package/highlight/badge/lts)](http://stackage.org/lts/package/highlight) +[![Stackage Nightly](http://stackage.org/package/highlight/badge/nightly)](http://stackage.org/nightly/package/highlight) +![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg) + +`highlight` is a + +For example, imagine the following Haskell data types and values: + +```haskell +data Foo = Foo { foo1 :: Integer , foo2 :: [String] } deriving Show + +foo :: Foo +foo = Foo 3 ["hello", "goodbye"] + +data Bar = Bar { bar1 :: Double , bar2 :: [Foo] } deriving Show + +bar :: Bar +bar = Bar 10.55 [foo, foo] +``` + +If you run this in `ghci` and type `print bar`, you'll get output like this: + +```haskell +> print bar +Bar {bar1 = 10.55, bar2 = [Foo {foo1 = 3, foo2 = ["hello","goodbye"]},Foo {foo1 = 3, foo2 = ["hello","goodbye"]}]} +``` + +This is pretty hard to read. Imagine if there were more fields or it were even +more deeply nested. It would be even more difficult to read. + +`pretty-simple` can be used to print `bar` in an easy-to-read format: + +![example screenshot](/img/pretty-simple-example-screenshot.png?raw=true "example screenshot") + +## Usage + +## Features + +## Why not `(some other package)`? + +## Contributions + +Feel free to open an +[issue](https://github.com/cdepillabout/pretty-simple/issues) or +[PR](https://github.com/cdepillabout/pretty-simple/pulls) for any +bugs/problems/suggestions/improvements. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/highlight/Main.hs b/app/highlight/Main.hs new file mode 100644 --- /dev/null +++ b/app/highlight/Main.hs @@ -0,0 +1,7 @@ + +module Main where + +import Highlight.Highlight (defaultMain) + +main :: IO () +main = defaultMain diff --git a/app/hrep/Main.hs b/app/hrep/Main.hs new file mode 100644 --- /dev/null +++ b/app/hrep/Main.hs @@ -0,0 +1,7 @@ + +module Main where + +import Highlight.Hrep (defaultMain) + +main :: IO () +main = defaultMain diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,14 @@ + +module Main where + +import Criterion.Main (bench, bgroup, defaultMain, nf) + +main :: IO () +main = + defaultMain + [ bgroup + "example1" + [ bench "plus" $ nf (1 +) (1 :: Int) + , bench "minus" $ nf (1 -) (1 :: Int) + ] + ] diff --git a/highlight.cabal b/highlight.cabal new file mode 100644 --- /dev/null +++ b/highlight.cabal @@ -0,0 +1,147 @@ +name: highlight +version: 0.1.0.0 +synopsis: Command line tool for highlighting parts of files matching a regex. +description: Please see . +homepage: https://github.com/cdepillabout/highlight +license: BSD3 +license-file: LICENSE +author: Dennis Gosnell +maintainer: cdep.illabout@gmail.com +copyright: 2017 Dennis Gosnell +category: Text +build-type: Simple +extra-source-files: README.md + , img/highlight-example-screenshot.png + , test/golden/golden-files/highlight/from-grep.stderr + , test/golden/golden-files/highlight/from-grep.stdout + , test/golden/golden-files/highlight/multi-file.stderr + , test/golden/golden-files/highlight/multi-file.stdout + , test/golden/golden-files/highlight/single-file.stderr + , test/golden/golden-files/highlight/single-file.stdout + , test/golden/golden-files/hrep/from-stdin.stderr + , test/golden/golden-files/hrep/from-stdin.stdout + , test/golden/golden-files/hrep/multi-file.stderr + , test/golden/golden-files/hrep/multi-file.stdout + , test/golden/golden-files/hrep/single-file.stderr + , test/golden/golden-files/hrep/single-file.stdout + , test/golden/test-files/dir1/file3 + , test/golden/test-files/dir1/file4 + , test/golden/test-files/dir1/subdir1/file5 + , test/golden/test-files/dir2/file6 + , test/golden/test-files/empty-file + , test/golden/test-files/file1 + , test/golden/test-files/file2 + , test/golden/test-files/from-grep +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Highlight.Common.Color + , Highlight.Common.Error + , Highlight.Common.Monad + , Highlight.Common.Monad.Input + , Highlight.Common.Monad.Output + , Highlight.Common.Options + , Highlight.Highlight + , Highlight.Highlight.Monad + , Highlight.Highlight.Options + , Highlight.Highlight.Run + , Highlight.Hrep + , Highlight.Hrep.Monad + , Highlight.Hrep.Run + , Highlight.Pipes + , Highlight.Util + build-depends: base >= 4.7 && < 5 + , base-compat >= 0.8 + , ansi-terminal >= 0.6 + , bytestring >= 0.9 + , containers >= 0.5 + , directory >= 1.2 + , filepath >= 1 + , lens >= 3 + , mtl >= 2.0 + , mtl-compat >= 0.2 + , optparse-applicative >= 0.11 + , pipes >= 4 + , pipes-bytestring >= 2 + , pipes-group >= 1 + , pipes-safe >= 2 + , regex >= 0.10 + , regex-with-pcre >= 1.0 + , semigroups >= 0.15 + , system-filepath >= 0.4 + , text >= 1.2 + , transformers >= 0.2 + , transformers-compat >= 0.3 + if os(windows) + Build-Depends: Win32 >= 2.0 + else + Build-Depends: unix >= 2.0 + + default-language: Haskell2010 + ghc-options: -Wall + other-extensions: TemplateHaskell + +executable highlight + main-is: Main.hs + hs-source-dirs: app/highlight + build-depends: base + , highlight + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +executable hrep + main-is: Main.hs + hs-source-dirs: app/hrep + build-depends: base + , highlight + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +test-suite highlight-doctest + type: exitcode-stdio-1.0 + main-is: DocTest.hs + hs-source-dirs: test + build-depends: base + , doctest + , QuickCheck + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +test-suite highlight-test + type: exitcode-stdio-1.0 + main-is: Test.hs + other-modules: Test.Golden + hs-source-dirs: test + build-depends: base + , base-compat + , bytestring + , directory + , highlight + , lens + , pipes + , process + , tasty + , tasty-golden + , transformers + , transformers-compat + if os(windows) + Build-Depends: Win32 + else + Build-Depends: unix + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +benchmark highlight-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: bench + build-depends: base + , criterion + , highlight + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +source-repository head + type: git + location: git@github.com:cdepillabout/highlight.git diff --git a/img/highlight-example-screenshot.png b/img/highlight-example-screenshot.png new file mode 100644 Binary files /dev/null and b/img/highlight-example-screenshot.png differ diff --git a/src/Highlight/Common/Color.hs b/src/Highlight/Common/Color.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Common/Color.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Highlight.Common.Color where + +import Prelude () +import Prelude.Compat + +import Data.ByteString.Char8 (ByteString, empty, pack) +import Data.IntMap.Strict (IntMap, (!), fromList) +import System.Console.ANSI + (Color(..), ColorIntensity(..), ConsoleIntensity(..), + ConsoleLayer(..), SGR(..), setSGRCode) + +------------------------ +-- Application Colors -- +------------------------ + +-- | Find the corresponding color for the number in 'allColorsList', taking the +-- mod of the 'Int'. +-- +-- >>> colorForFileNumber 0 +-- "\ESC[1m\ESC[94m" +-- >>> colorForFileNumber 1 +-- "\ESC[1m\ESC[92m" +-- >>> colorForFileNumber 4 +-- "\ESC[1m\ESC[94m" +colorForFileNumber :: Int -> ByteString +colorForFileNumber num = allColorsMap ! (num `mod` allColorsLength) + +-- | 'allColorsList' turned into an 'IntMap' for faster lookup. +allColorsMap :: IntMap ByteString +allColorsMap = fromList $ zip [0..] allColorsList + +-- | 'length' of 'allColorsList'. +allColorsLength :: Int +allColorsLength = length allColorsList + +-- | List of all the colors that are used for highlighting filenames. +allColorsList :: [ByteString] +allColorsList = + [ colorVividBlueBold + , colorVividGreenBold + , colorVividCyanBold + , colorVividMagentaBold + ] + +----------------------- +-- Vivid Bold Colors -- +----------------------- + +colorVividBlackBold :: ByteString +colorVividBlackBold = colorBold `mappend` colorVividBlack + +colorVividBlueBold :: ByteString +colorVividBlueBold = colorBold `mappend` colorVividBlue + +colorVividCyanBold :: ByteString +colorVividCyanBold = colorBold `mappend` colorVividCyan + +colorVividGreenBold :: ByteString +colorVividGreenBold = colorBold `mappend` colorVividGreen + +colorVividMagentaBold :: ByteString +colorVividMagentaBold = colorBold `mappend` colorVividMagenta + +colorVividRedBold :: ByteString +colorVividRedBold = colorBold `mappend` colorVividRed + +colorVividWhiteBold :: ByteString +colorVividWhiteBold = colorBold `mappend` colorVividWhite + +colorVividYellowBold :: ByteString +colorVividYellowBold = colorBold `mappend` colorVividYellow + +----------------------- +-- Dull Bold Colors -- +----------------------- + +colorDullBlackBold :: ByteString +colorDullBlackBold = colorBold `mappend` colorDullBlack + +colorDullBlueBold :: ByteString +colorDullBlueBold = colorBold `mappend` colorDullBlue + +colorDullCyanBold :: ByteString +colorDullCyanBold = colorBold `mappend` colorDullCyan + +colorDullGreenBold :: ByteString +colorDullGreenBold = colorBold `mappend` colorDullGreen + +colorDullMagentaBold :: ByteString +colorDullMagentaBold = colorBold `mappend` colorDullMagenta + +colorDullRedBold :: ByteString +colorDullRedBold = colorBold `mappend` colorDullRed + +colorDullWhiteBold :: ByteString +colorDullWhiteBold = colorBold `mappend` colorDullWhite + +colorDullYellowBold :: ByteString +colorDullYellowBold = colorBold `mappend` colorDullYellow + +------------------ +-- Vivid Colors -- +------------------ + +colorVividBlack :: ByteString +colorVividBlack = colorHelper Vivid Black + +colorVividBlue :: ByteString +colorVividBlue = colorHelper Vivid Blue + +colorVividCyan :: ByteString +colorVividCyan = colorHelper Vivid Cyan + +colorVividGreen :: ByteString +colorVividGreen = colorHelper Vivid Green + +colorVividMagenta :: ByteString +colorVividMagenta = colorHelper Vivid Magenta + +colorVividRed :: ByteString +colorVividRed = colorHelper Vivid Red + +colorVividWhite :: ByteString +colorVividWhite = colorHelper Vivid White + +colorVividYellow :: ByteString +colorVividYellow = colorHelper Vivid Yellow + +------------------ +-- Dull Colors -- +------------------ + +colorDullBlack :: ByteString +colorDullBlack = colorHelper Dull Black + +colorDullBlue :: ByteString +colorDullBlue = colorHelper Dull Blue + +colorDullCyan :: ByteString +colorDullCyan = colorHelper Dull Cyan + +colorDullGreen :: ByteString +colorDullGreen = colorHelper Dull Green + +colorDullMagenta :: ByteString +colorDullMagenta = colorHelper Dull Magenta + +colorDullRed :: ByteString +colorDullRed = colorHelper Dull Red + +colorDullWhite :: ByteString +colorDullWhite = colorHelper Dull White + +colorDullYellow :: ByteString +colorDullYellow = colorHelper Dull Yellow + +-------------------- +-- Special Colors -- +-------------------- + +-- | Change the intensity to 'BoldIntensity'. +colorBold :: ByteString +colorBold = setSGRCodeBuilder [SetConsoleIntensity BoldIntensity] + +-- | 'Reset' the console color back to normal. +colorReset :: ByteString +colorReset = setSGRCodeBuilder [Reset] + +-- | Empty string. +colorNull :: ByteString +colorNull = empty + +------------- +-- Helpers -- +------------- + +-- | Helper for creating a 'ByteString' for an ANSI escape sequence color based on +-- a 'ColorIntensity' and a 'Color'. +colorHelper :: ColorIntensity -> Color -> ByteString +colorHelper colorIntensity color = + setSGRCodeBuilder [SetColor Foreground colorIntensity color] + +-- | Convert a list of 'SGR' to a 'ByteString'. +setSGRCodeBuilder :: [SGR] -> ByteString +setSGRCodeBuilder = pack . setSGRCode diff --git a/src/Highlight/Common/Error.hs b/src/Highlight/Common/Error.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Common/Error.hs @@ -0,0 +1,21 @@ + +module Highlight.Common.Error where + +import Prelude () +import Prelude.Compat + +import Data.Monoid ((<>)) + +import Highlight.Common.Options (RawRegex(RawRegex)) +import Highlight.Util (die) + +-- | Sum-type representing all errors that can be thrown by this application. +data HighlightErr + = HighlightRegexCompileErr RawRegex + -- ^ Error when trying to compile the 'RawRegex' into a regular expression. + deriving Show + +-- | Call 'die' with an error message based on 'HighlightErr'. +handleErr :: HighlightErr -> IO a +handleErr (HighlightRegexCompileErr (RawRegex regex)) = + die 10 $ "Regex not well formed: " <> regex diff --git a/src/Highlight/Common/Monad.hs b/src/Highlight/Common/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Common/Monad.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module Highlight.Common.Monad + ( module Highlight.Common.Monad + , module Highlight.Common.Monad.Input + , module Highlight.Common.Monad.Output + ) where + +import Prelude () +import Prelude.Compat + +import Control.Lens (view) +import Control.Monad.Except (ExceptT, MonadError, runExceptT, throwError) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Reader (MonadReader, ReaderT, runReaderT) +import Control.Monad.State (MonadState, StateT, evalStateT) +import Text.RE.PCRE + (RE, SimpleREOptions(MultilineInsensitive, MultilineSensitive), + compileRegexWith) + +import Highlight.Common.Error (HighlightErr(..)) +import Highlight.Common.Monad.Input + (FilenameHandlingFromFiles(NoFilename, PrintFilename), InputData, + createInputData) +import Highlight.Common.Monad.Output + (Output(OutputStderr, OutputStdout), handleInputData, + runOutputProducer) +import Highlight.Common.Options + (HasIgnoreCase(ignoreCaseLens), + HasInputFilenames(inputFilenamesLens), HasRecursive(recursiveLens), + HasRawRegex(rawRegexLens), IgnoreCase(DoNotIgnoreCase, IgnoreCase), + InputFilename, RawRegex(RawRegex), Recursive) + +-------------------------------- +-- The Common Highlight Monad -- +-------------------------------- + +-- | This is the common monad for both @highlight@ and @hrep@. It has been +-- kept polymorphic here so it can be easily specialized by @highlight@ and +-- @hrep@. +-- +-- @r@ is the options or config type. @s@ is the state. @e@ is the error. +newtype CommonHighlightM r s e a = CommonHighlightM + { unCommonHighlightM :: ReaderT r (StateT s (ExceptT e IO)) a + } deriving ( Functor + , Applicative + , Monad + , MonadError e + , MonadIO + , MonadReader r + , MonadState s + ) + +-- | Given an @r@ and @s@, run 'CommonHighlightM'. +runCommonHighlightM :: r -> s -> CommonHighlightM r s e a -> IO (Either e a) +runCommonHighlightM r s = + runExceptT . + flip evalStateT s . + flip runReaderT r . + unCommonHighlightM + +-- | Get the 'IgnoreCase' option. +getIgnoreCaseM :: (HasIgnoreCase r, MonadReader r m) => m IgnoreCase +getIgnoreCaseM = view ignoreCaseLens + +-- | Get the 'Recursive' option. +getRecursiveM :: (HasRecursive r, MonadReader r m) => m Recursive +getRecursiveM = view recursiveLens + +-- | Get the 'RawRegex' option. +getRawRegexM :: (HasRawRegex r, MonadReader r m) => m RawRegex +getRawRegexM = view rawRegexLens + +-- | Get a list of the 'InputFilename'. +getInputFilenamesM + :: (HasInputFilenames r, MonadReader r m) => m [InputFilename] +getInputFilenamesM = view inputFilenamesLens + +------------------ +-- Throw Errors -- +------------------ + +-- | Throw a 'HighlightErr'. +throwHighlightErr :: HighlightErr -> CommonHighlightM r s HighlightErr a +throwHighlightErr = throwError + +-- | Throw a 'HighlightRegexCompileErr'. +throwRegexCompileErr :: RawRegex -> CommonHighlightM r s HighlightErr a +throwRegexCompileErr = throwHighlightErr . HighlightRegexCompileErr + +----------- +-- Regex -- +----------- + +-- | Call 'compileHighlightRegex'. Throw a 'HighlightErr' if the regex cannot +-- be compiled. +compileHighlightRegexWithErr + :: (HasIgnoreCase r, HasRawRegex r) + => CommonHighlightM r s HighlightErr RE +compileHighlightRegexWithErr = do + ignoreCase <- getIgnoreCaseM + rawRegex <- getRawRegexM + case compileHighlightRegex ignoreCase rawRegex of + Just re -> return re + Nothing -> throwRegexCompileErr rawRegex + +-- | Try compiling a 'RawRegex' into a 'RE'. +-- +-- Setup for examples: +-- +-- >>> import Data.Maybe (isJust) +-- +-- Return 'Just' for a proper regex: +-- +-- >>> isJust $ compileHighlightRegex IgnoreCase (RawRegex "good regex") +-- True +-- +-- Return 'Nothing' for an improper regex: +-- +-- >>> isJust $ compileHighlightRegex IgnoreCase (RawRegex "bad regex (") +-- False +compileHighlightRegex :: IgnoreCase -> RawRegex -> Maybe RE +compileHighlightRegex ignoreCase (RawRegex rawRegex) = + let simpleREOptions = + case ignoreCase of + IgnoreCase -> MultilineInsensitive + DoNotIgnoreCase -> MultilineSensitive + in compileRegexWith simpleREOptions rawRegex diff --git a/src/Highlight/Common/Monad/Input.hs b/src/Highlight/Common/Monad/Input.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Common/Monad/Input.hs @@ -0,0 +1,401 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RankNTypes #-} + +module Highlight.Common.Monad.Input + ( FileOrigin(..) + , FileReader(..) + , getFileOriginFromFileReader + , getFilePathFromFileReader + , InputData(..) + , createInputData + , FilenameHandlingFromFiles(..) + ) where + +import Prelude () +import Prelude.Compat + +import Control.Exception (IOException, try) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Data.ByteString (ByteString) +import Data.List (sort) +import Pipes + (Pipe, Producer, Producer', Proxy, (>->), await, each, for, next, + yield) +import Pipes.Prelude (toListM) +import qualified Pipes.Prelude as Pipes +import System.IO (Handle) + +import Highlight.Common.Options + (InputFilename(unInputFilename), Recursive(Recursive)) +import Highlight.Pipes (childOf, fromHandleLines) +import Highlight.Util (combineApplicatives, openFilePathForReading) + +----------- +-- Pipes -- +----------- + +-- | Place where a file originally came from. +data FileOrigin + = FileSpecifiedByUser FilePath + -- ^ File was specified on the command line by the user. + | FileFoundRecursively FilePath + -- ^ File was found recursively (not directly specified by the user). + | Stdin + -- ^ Standard input. It was either specified on the command line as @-@, or + -- used as default because the user did not specify any files. + deriving (Eq, Read, Show) + +-- | Get a 'FilePath' from a 'FileOrigin'. +-- +-- >>> getFilePathFromFileOrigin $ FileSpecifiedByUser "hello.txt" +-- Just "hello.txt" +-- >>> getFilePathFromFileOrigin $ FileFoundRecursively "bye.txt" +-- Just "bye.txt" +-- >>> getFilePathFromFileOrigin Stdin +-- Nothing +getFilePathFromFileOrigin :: FileOrigin -> Maybe FilePath +getFilePathFromFileOrigin (FileSpecifiedByUser fp) = Just fp +getFilePathFromFileOrigin (FileFoundRecursively fp) = Just fp +getFilePathFromFileOrigin Stdin = Nothing + +-- | This is used in two different places. +-- +-- One is in 'fileListProducer', where @a@ becomes 'Handle'. This represents a +-- single file that has been opened. 'FileReaderSuccess' contains the +-- 'FileOrigin' and the 'Handle'. 'FileReaderErr' contains the 'FileOrigin' +-- and any errors that occurred when trying to open the 'Handle'. +-- +-- The other is in 'fileReaderHandleToLine' and 'InputData', where @a@ becomes +-- 'ByteString'. This represents a single 'ByteString' line from a file, or an +-- error that occurred when trying to read the file. +-- +-- 'FileReader' is usually wrapped in a 'Producer'. This is a stream of either +-- 'Handle's or 'ByteString' lines (with any errors that have occurred). +data FileReader a + = FileReaderSuccess !FileOrigin !a + | FileReaderErr !FileOrigin !IOException !(Maybe IOException) + deriving (Eq, Show) + +-- | Get a 'FileOrigin' from a 'FileReader'. +-- +-- >>> let fileOrigin1 = FileSpecifiedByUser "hello.txt" +-- >>> let fileReader1 = FileReaderSuccess fileOrigin1 "some line" +-- >>> getFileOriginFromFileReader fileReader1 +-- FileSpecifiedByUser "hello.txt" +-- +-- >>> let fileOrigin2 = FileFoundRecursively "bye.txt" +-- >>> let fileReader2 = FileReaderErr fileOrigin2 (userError "err") Nothing +-- >>> getFileOriginFromFileReader fileReader2 +-- FileFoundRecursively "bye.txt" +getFileOriginFromFileReader :: FileReader a -> FileOrigin +getFileOriginFromFileReader (FileReaderSuccess origin _) = origin +getFileOriginFromFileReader (FileReaderErr origin _ _) = origin + +-- | This is just +-- @'getFilePathFromFileOrigin' '.' 'getFileOriginFromFileReader'@. +-- +-- >>> let fileOrigin1 = Stdin +-- >>> let fileReader1 = FileReaderSuccess fileOrigin1 "some line" +-- >>> getFilePathFromFileReader fileReader1 +-- Nothing +-- +-- >>> let fileOrigin2 = FileFoundRecursively "bye.txt" +-- >>> let fileReader2 = FileReaderErr fileOrigin2 (userError "err") Nothing +-- >>> getFilePathFromFileReader fileReader2 +-- Just "bye.txt" +getFilePathFromFileReader :: FileReader a -> Maybe FilePath +getFilePathFromFileReader = + getFilePathFromFileOrigin . getFileOriginFromFileReader + +-- | This wraps up two pieces of information. +-- +-- One is the value of 'FilenameHandlingFromFiles'. This signals as to whether +-- or not we need to print the filename when printing each line of output. +-- +-- This other is a 'Producer' of 'FileReader' 'ByteString's. This is a +-- 'Producer' for each line of each input file. +-- +-- The main job of this module is to define 'createInputData', which produces +-- 'InputData'. 'InputData' is what is processed to figure out what to output. +data InputData m a + = InputData + !FilenameHandlingFromFiles + !(Producer (FileReader ByteString) m a) + +-- | Create 'InputData' based 'InputFilename' list. +-- +-- Setup for examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> import Highlight.Common.Options (InputFilename(InputFilename)) +-- >>> import Highlight.Common.Options (Recursive(NotRecursive)) +-- +-- If the 'InputFilename' list is empty, just create an 'InputData' with +-- 'NoFilename' and the standard input 'Producer' passed in. +-- +-- >>> let stdinProd = yield ("hello" :: ByteString) +-- >>> let create = createInputData NotRecursive [] stdinProd +-- >>> InputData NoFilename prod <- create +-- >>> toListM prod +-- [FileReaderSuccess Stdin "hello"] +-- +-- If the 'InputFilename' list is not empty, create an 'InputData' with lines +-- from each file found on the command line. +-- +-- >>> let inFiles = [InputFilename "test/golden/test-files/file1"] +-- >>> let create = createInputData NotRecursive inFiles stdinProd +-- >>> InputData NoFilename prod <- create +-- >>> Pipes.head prod +-- Just (FileReaderSuccess (FileSpecifiedByUser "test/golden/test-files/file1") "The...") +createInputData + :: forall m. + MonadIO m + => Recursive + -- ^ Whether or not to recursively read in files. + -> [InputFilename] + -- ^ List of files passed in on the command line. + -> Producer ByteString m () + -- ^ A producer for standard input + -> m (InputData m ()) +createInputData recursive inputFilenames stdinProducer = do + let fileOrigins = FileSpecifiedByUser . unInputFilename <$> inputFilenames + case fileOrigins of + [] -> + return $ + InputData NoFilename (stdinProducerToFileReader stdinProducer) + _ -> do + let fileListProducers = fmap (fileListProducer recursive) fileOrigins + fileProducer = foldl1 combineApplicatives fileListProducers + (filenameHandling, newFileProducer) <- + computeFilenameHandlingFromFiles fileProducer + let fileLineProducer = fileReaderHandleToLine newFileProducer + return $ InputData filenameHandling fileLineProducer + +-- | Change a given 'Producer' into a 'FileReader' 'Producer' with the +-- 'FileOrigin' set to 'Stdin'. +-- +-- You can think of this function as having the following type: +-- +-- @ +-- 'stdinProducerToFileReader' +-- :: 'Monad' m +-- => 'Producer' a m r +-- -> 'Producer' ('FileReader' a) m r +-- @ +-- +-- >>> Pipes.head . stdinProducerToFileReader $ yield "hello" +-- Just (FileReaderSuccess Stdin "hello") +stdinProducerToFileReader + :: forall x' x a m r. + Monad m + => Proxy x' x () a m r + -> Proxy x' x () (FileReader a) m r +stdinProducerToFileReader producer = producer >-> Pipes.map go + where + go :: a -> FileReader a + go = FileReaderSuccess Stdin +{-# INLINABLE stdinProducerToFileReader #-} + +-- | Convert a 'Producer' of 'FileReader' 'Handle' into a 'Producer' of +-- 'FileReader' 'ByteString', where each line from the 'Handle' is 'yield'ed. +-- +-- You can think of this function as having the following type: +-- +-- @ +-- 'fileReaderHandleToLine' +-- :: 'MonadIO' m +-- => 'Producer' ('FileReader' 'Handle') m r +-- -> 'Producer' ('FileReader' 'ByteString') m r +-- @ +-- +-- >>> let fileOrigin = FileSpecifiedByUser "test/golden/test-files/file2" +-- >>> let producer = fileListProducer Recursive fileOrigin +-- >>> Pipes.head $ fileReaderHandleToLine producer +-- Just (FileReaderSuccess (FileSpecifiedByUser "test/golden/test-files/file2") "Pr... +fileReaderHandleToLine + :: forall m x' x r. + MonadIO m + => Proxy x' x () (FileReader Handle) m r + -> Proxy x' x () (FileReader ByteString) m r +fileReaderHandleToLine producer = producer >-> pipe + where + pipe :: Pipe (FileReader Handle) (FileReader ByteString) m r + pipe = do + fileReaderHandle <- await + case fileReaderHandle of + FileReaderErr fileOrigin fileErr dirErr -> + yield $ FileReaderErr fileOrigin fileErr dirErr + FileReaderSuccess fileOrigin handle -> do + let linesProducer = fromHandleLines handle + linesProducer >-> Pipes.map (FileReaderSuccess fileOrigin) + pipe + +-- | Create a 'Producer' of 'FileReader' 'Handle' for a given 'FileOrigin'. +-- +-- Setup for examples: +-- +-- >>> import Highlight.Common.Options (Recursive(NotRecursive, Recursive)) +-- +-- If 'NoRecursive' is specified, just try to read 'FileOrigin' as a file. +-- +-- >>> let fileOrigin1 = FileSpecifiedByUser "test/golden/test-files/file2" +-- >>> toListM $ fileListProducer NotRecursive fileOrigin1 +-- [FileReaderSuccess (FileSpecifiedByUser "test/.../file2") {handle: test/.../file2}] +-- +-- If the file cannot be read, return an error. +-- +-- >>> let fileOrigin2 = FileSpecifiedByUser "thisfiledoesnotexist" +-- >>> toListM $ fileListProducer NotRecursive fileOrigin2 +-- [FileReaderErr (FileSpecifiedByUser "thisfiledoesnotexist") thisfiledoesnotexist: openBinaryFile: does not exist (No such file or directory) Nothing] +-- +-- If 'Recursive' is specified, then try to read 'FileOrigin' as a directory'. +-- +-- >>> let fileOrigin3 = FileSpecifiedByUser "test/golden/test-files/dir2" +-- >>> toListM $ fileListProducer Recursive fileOrigin3 +-- [FileReaderSuccess (FileFoundRecursively "test/.../dir2/file6") {handle: test/.../dir2/file6}] +-- +-- If the directory cannot be read, return an error. +-- +-- >>> let fileOrigin4 = FileSpecifiedByUser "thisdirdoesnotexist" +-- >>> toListM $ fileListProducer Recursive fileOrigin4 +-- [FileReaderErr (FileSpecifiedByUser "thisdirdoesnotexist") thisdirdoesnotexist: openBinaryFile: does not exist (No such file or directory) (Just ...)] +fileListProducer + :: forall m. + MonadIO m + => Recursive + -> FileOrigin + -> Producer' (FileReader Handle) m () +fileListProducer recursive = go + where + go :: FileOrigin -> Producer' (FileReader Handle) m () + go fileOrigin = do + let maybeFilePath = getFilePathFromFileOrigin fileOrigin + case maybeFilePath of + -- This is standard input. We don't currently handle this, so just + -- return unit. + Nothing -> return () + -- This is a normal file. Not standard input. + Just filePath -> do + eitherHandle <- openFilePathForReading filePath + case eitherHandle of + Right handle -> yield $ FileReaderSuccess fileOrigin handle + Left fileIOErr -> + if recursive == Recursive + then do + let fileListM = toListM $ childOf filePath + eitherFileList <- liftIO $ try fileListM + case eitherFileList of + Left dirIOErr -> + yield $ + FileReaderErr fileOrigin fileIOErr (Just dirIOErr) + Right fileList -> do + let sortedFileList = sort fileList + let fileOrigins = fmap FileFoundRecursively sortedFileList + let lalas = + fmap + (fileListProducer recursive) + fileOrigins + for (each lalas) id + else + yield $ FileReaderErr fileOrigin fileIOErr Nothing + +----------------------- +-- Filename Handling -- +----------------------- + +-- | This data type specifies how printing filenames will be handled, along +-- with the 'computeFilenameHandlingFromFiles' function. +data FilenameHandlingFromFiles + = NoFilename -- ^ Do not print the filename on stdout. + | PrintFilename -- ^ Print the filename on stdout. + deriving (Eq, Read, Show) + +-- | Given a 'Producer' of 'FileReader's, figure out whether or not we should +-- print the filename of the file to stdout. +-- +-- The following examples walk through possible command lines using @highlight@, and the corresponding return values of this function. +-- +-- @ +-- $ highlight expression +-- @ +-- +-- We want to read from stdin. There should be no 'FileReaders' in the +-- 'Producer'. Do not print the filename. +-- +-- >>> let producerStdin = each [] +-- >>> (fhStdin, _) <- computeFilenameHandlingFromFiles producerStdin +-- >>> fhStdin +-- NoFilename +-- +-- @ +-- $ highlight expression file1 +-- @ +-- +-- We want to highlight a single file. There should only be a single +-- 'FileReader' in the 'Producer', and it should be 'FileSpecifiedByUser'. Do +-- not print the filename. +-- +-- >>> let fileOriginSingleFile = FileSpecifiedByUser "file1" +-- >>> let fileReaderSingleFile = FileReaderSuccess fileOriginSingleFile "hello" +-- >>> let producerSingleFile = each [fileReaderSingleFile] +-- >>> (fhSingleFile, _) <- computeFilenameHandlingFromFiles producerSingleFile +-- >>> fhSingleFile +-- NoFilename +-- +-- @ +-- $ highlight expression file1 file2 +-- @ +-- +-- We want to highlight two files. Print the filename. +-- +-- >>> let fileOriginMulti1 = FileSpecifiedByUser "file1" +-- >>> let fileReaderMulti1 = FileReaderSuccess fileOriginMulti1 "hello" +-- >>> let fileOriginMulti2 = FileSpecifiedByUser "file2" +-- >>> let fileReaderMulti2 = FileReaderSuccess fileOriginMulti2 "bye" +-- >>> let producerMultiFile = each [fileReaderMulti1, fileReaderMulti2] +-- >>> (fhMultiFile, _) <- computeFilenameHandlingFromFiles producerMultiFile +-- >>> fhMultiFile +-- PrintFilename +-- +-- @ +-- $ highlight -r expression dir1 +-- @ +-- +-- We want to highlight all files found in @dir1\/@. Print filenames. +-- +-- >>> let fileOriginRec = FileFoundRecursively "dir1/file1" +-- >>> let fileReaderRec = FileReaderSuccess fileOriginRec "cat" +-- >>> let producerRec = each [fileReaderRec] +-- >>> (fhRec, _) <- computeFilenameHandlingFromFiles producerRec +-- >>> fhRec +-- PrintFilename +computeFilenameHandlingFromFiles + :: forall a m r. + Monad m + => Producer (FileReader a) m r + -> m (FilenameHandlingFromFiles, Producer (FileReader a) m r) +computeFilenameHandlingFromFiles producer1 = do + eitherFileReader1 <- next producer1 + case eitherFileReader1 of + Left ret -> + return (NoFilename, return ret) + Right (fileReader1, producer2) -> do + let fileOrigin1 = getFileOriginFromFileReader fileReader1 + case fileOrigin1 of + Stdin -> error "Not currenty handling stdin..." + FileSpecifiedByUser _ -> do + eitherSecondFile <- next producer2 + case eitherSecondFile of + Left ret2 -> + return (NoFilename, yield fileReader1 *> return ret2) + Right (fileReader2, producer3) -> + return + ( PrintFilename + , yield fileReader1 *> yield fileReader2 *> producer3 + ) + FileFoundRecursively _ -> + return (PrintFilename, yield fileReader1 *> producer2) diff --git a/src/Highlight/Common/Monad/Output.hs b/src/Highlight/Common/Monad/Output.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Common/Monad/Output.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Highlight.Common.Monad.Output + ( Output(..) + , handleInputData + , runOutputProducer + ) where + +import Prelude () +import Prelude.Compat + +import Control.Exception (IOException) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.State (MonadState, StateT, evalStateT, get) +import Control.Monad.Trans.Class (lift) +import Data.ByteString (ByteString) +import Pipes + (Consumer, Pipe, Producer, Producer', Proxy, (>->), await, each, + runEffect, yield) +import Pipes.ByteString (stdout) + +import Highlight.Common.Monad.Input + (FilenameHandlingFromFiles, FileOrigin, + FileReader(FileReaderErr, FileReaderSuccess), + InputData(InputData), getFileOriginFromFileReader, + getFilePathFromFileReader) +import Highlight.Pipes (stderrConsumer) +import Highlight.Util + (convertStringToRawByteString, modify', whenNonNull) + +----------------------------- +-- Convert input to Output -- +----------------------------- + +-- | The current number of the file we are outputting. This is increased by +-- one for each file. +type ColorNum = Int + +-- | The state for which number file we are outputting with its 'FileOrigin'. +data FileColorState + = FileColorState !(Maybe FileOrigin) {-# UNPACK #-} !ColorNum + deriving (Eq, Read, Show) + +-- | Initial value for 'FileColorState'. Defined as the following: +-- +-- >>> defFileColorState +-- FileColorState Nothing 0 +defFileColorState :: FileColorState +defFileColorState = FileColorState Nothing 0 + +-- | Convert 'InputData' to 'Output'. +handleInputData + :: forall m. + MonadIO m + => (ByteString -> m [ByteString]) + -- ^ Function to use for conversion for a line from stdin. + -> (FilenameHandlingFromFiles + -> ByteString + -> Int + -> ByteString + -> m [ByteString] + ) + -- ^ Function to use for conversion for a line from a normal file. + -> (ByteString -> IOException -> Maybe IOException -> m [ByteString]) + -- ^ Function to use for conversion for an io error. + -> InputData m () + -- ^ All of the input lines. + -> Producer Output m () +handleInputData stdinF nonErrF errF (InputData nameHandling producer) = + producer >-> evalStateT go defFileColorState + where + go :: StateT FileColorState (Pipe (FileReader ByteString) Output m) () + go = do + fileReader <- lift await + let maybeFilePath = getFilePathFromFileReader fileReader + fileOrigin = getFileOriginFromFileReader fileReader + colorNumIfNewFile <- getColorNumIfNewFileM fileOrigin + case maybeFilePath of + -- The current @'FileReader' 'ByteString'@ is from stdin. + Nothing -> + case fileReader of + FileReaderSuccess _ line -> do + outByteStrings <- lift . lift $ stdinF line + toStdoutWhenNonNull outByteStrings fileOrigin + FileReaderErr _ _ _ -> return () + -- The current @'FileReader' 'ByteString'@ is from a normal file. + Just filePath -> do + byteStringFilePath <- convertStringToRawByteString filePath + case fileReader of + FileReaderErr _ ioerr maybeioerr -> do + outByteStrings <- + lift . lift $ errF byteStringFilePath ioerr maybeioerr + toStderrWhenNonNull outByteStrings + FileReaderSuccess _ inputLine -> do + outByteStrings <- + lift . lift $ + nonErrF + nameHandling + byteStringFilePath + colorNumIfNewFile + inputLine + toStdoutWhenNonNull outByteStrings fileOrigin + go + +-- | When the list of 'ByteString' is not @[]@, convert them to 'OutputStdout' +-- and return them in a 'Producer'. Call 'updateColorNum' with the passed-in +-- 'FileOrigin'. +toStdoutWhenNonNull + :: forall m x' x. + Monad m + => [ByteString] + -> FileOrigin + -> StateT FileColorState (Proxy x' x () Output m) () +toStdoutWhenNonNull outByteStrings fileOrigin = + whenNonNull outByteStrings $ do + lift $ toStdoutWithNewline outByteStrings + updateColorNumM fileOrigin + +-- | When the list of 'ByteString' is not @[]@, convert them to 'OutputStderr' +-- and return them in a 'Producer'. Do not call 'updateColorNum'. +toStderrWhenNonNull + :: forall m s x' x. + Monad m + => [ByteString] -> StateT s (Proxy x' x () Output m) () +toStderrWhenNonNull outByteStrings = + whenNonNull outByteStrings . lift $ toStderrWithNewline outByteStrings + +-- | Call 'updateColorNum' with the current value of 'FileColorState'. +updateColorNumM + :: MonadState FileColorState m => FileOrigin -> m () +updateColorNumM = modify' . updateColorNum + +-- | Based on the value of the passed in 'FileOrigin' and the 'FileOrigin' in +-- 'FileColorState', update the 'ColorNum' in 'FileColorState'. +-- +-- Setup for examples: +-- +-- >>> import Highlight.Common.Monad.Input (FileOrigin(FileSpecifiedByUser)) +-- +-- If 'defFileColorState' is passed in, then update the 'FileOrigin'. +-- +-- >>> let fileOrigin = FileSpecifiedByUser "hello.txt" +-- >>> updateColorNum fileOrigin defFileColorState +-- FileColorState (Just (FileSpecifiedByUser "hello.txt")) 0 +-- +-- If the 'FileOrigin' is different from the one in 'FileColorState', then +-- increment the 'ColorNum'. +-- +-- >>> let oldFileOrigin = FileSpecifiedByUser "hello.txt" +-- >>> let newFileOrigin = FileSpecifiedByUser "bye.txt" +-- >>> let fileColorStateDiff = FileColorState (Just oldFileOrigin) 5 +-- >>> updateColorNum newFileOrigin fileColorStateDiff +-- FileColorState (Just (FileSpecifiedByUser "bye.txt")) 6 +-- +-- If the 'FileOrigin' is the same as the one in 'FileColorState', then do not +-- increment the 'ColorNum'. +-- +-- >>> let sameFileOrigin = FileSpecifiedByUser "hello.txt" +-- >>> let fileColorStateDiff = FileColorState (Just sameFileOrigin) 5 +-- >>> updateColorNum sameFileOrigin fileColorStateDiff +-- FileColorState (Just (FileSpecifiedByUser "hello.txt")) 5 +updateColorNum + :: FileOrigin + -> FileColorState + -> FileColorState +updateColorNum newFileOrigin (FileColorState Nothing colorNum) = + FileColorState (Just newFileOrigin) colorNum +updateColorNum newFileOrigin (FileColorState (Just prevFileOrigin) colorNum) + | prevFileOrigin == newFileOrigin = + FileColorState (Just newFileOrigin) colorNum + | otherwise = FileColorState (Just newFileOrigin) (colorNum + 1) + +-- | This called 'updateColorNum' and returns the new value of 'ColorNum', but +-- it doesn't update the 'FileColorNum' in 'MonadState'. +getColorNumIfNewFileM + :: MonadState FileColorState m + => FileOrigin -> m ColorNum +getColorNumIfNewFileM newFileOrigin = do + fileColorState <- get + let (FileColorState _ colorNum) = updateColorNum newFileOrigin fileColorState + return colorNum + +-- | This is just 'toOutputWithNewLine' 'OutputStderr'. +toStderrWithNewline :: Monad m => [ByteString] -> Producer' Output m () +toStderrWithNewline = toOutputWithNewline OutputStderr + +-- | This is just 'toOutputWithNewLine' 'OutputStdout'. +toStdoutWithNewline :: Monad m => [ByteString] -> Producer' Output m () +toStdoutWithNewline = toOutputWithNewline OutputStdout + +-- | Convert a list of 'ByteString' to 'Output' with the given function. +-- +-- Setup for examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> import Pipes.Prelude (toListM) +-- +-- If the list of 'ByteString' is empty, then do nothing. +-- +-- >>> toListM $ toOutputWithNewline OutputStdout [] +-- [] +-- +-- If the list of 'ByteString' is not empty, then convert to 'Output' and add +-- an ending newline. +-- +-- >>> toListM $ toOutputWithNewline OutputStderr ["hello", "bye"] +-- [OutputStderr "hello",OutputStderr "bye",OutputStderr "\n"] +toOutputWithNewline + :: Monad m + => (ByteString -> Output) + -- ^ Function to use to convert the 'ByteString' to 'Output'. + -> [ByteString] + -- ^ List of 'ByteString's to convert to 'Output'. + -> Producer' Output m () +toOutputWithNewline _ [] = return () +toOutputWithNewline byteStringToOutput byteStrings = do + each $ fmap byteStringToOutput byteStrings + yield $ byteStringToOutput "\n" + +------------ +-- Output -- +------------ + +-- | Sum-type to represent where a given 'ByteString' should be output, whether +-- it is stdout or stderr. +data Output + = OutputStdout !ByteString + | OutputStderr !ByteString + deriving (Eq, Read, Show) + +-- | Write each 'Output' to either 'stdout' or 'stderrConsumer'. +-- +-- Setup for tests: +-- +-- >>> import Pipes (runEffect) +-- +-- Send 'OutputStdout' to 'stdout'. +-- +-- >>> runEffect $ yield (OutputStdout "this goes to stdout") >-> outputConsumer +-- this goes to stdout +-- +-- Send 'OutputStderr' to 'stderrConsumer'. +-- +-- >>> runEffect $ yield (OutputStderr "this goes to stderr") >-> outputConsumer +-- this goes to stderr +outputConsumer :: MonadIO m => Consumer Output m () +outputConsumer = do + output <- await + case output of + OutputStdout byteString -> + yield byteString >-> stdout + OutputStderr byteString -> + yield byteString >-> stderrConsumer + outputConsumer + +-- | Run a 'Producer' 'Output' by connecting it to 'outputConsumer'. +runOutputProducer :: forall m. MonadIO m => Producer Output m () -> m () +runOutputProducer producer = runEffect $ producer >-> outputConsumer diff --git a/src/Highlight/Common/Options.hs b/src/Highlight/Common/Options.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Common/Options.hs @@ -0,0 +1,172 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} + +module Highlight.Common.Options where + +import Prelude () +import Prelude.Compat + +import Control.Applicative (many) +import Control.Lens (Lens', lens) +import Data.Monoid ((<>)) +import Data.String (IsString) +import Options.Applicative + (Parser, flag, help, long, metavar, short, strArgument) + +----------------- +-- Ignore case -- +----------------- + +-- | Whether or not the case of a regular expression should be ignored. +-- Similar to @grep@'s @--ignore-case@ option. +data IgnoreCase = IgnoreCase | DoNotIgnoreCase + deriving (Eq, Read, Show) + +class HasIgnoreCase r where + ignoreCaseLens :: Lens' r IgnoreCase + default ignoreCaseLens :: HasCommonOptions r => Lens' r IgnoreCase + ignoreCaseLens = commonOptionsLens . ignoreCaseLens + +ignoreCaseParser :: Parser IgnoreCase +ignoreCaseParser = + flag + DoNotIgnoreCase + IgnoreCase + (long "ignore-case" <> short 'i' <> help "ignore case distinctions") + +--------------- +-- Recursive -- +--------------- + +-- | Whether or not files should be searched recursively. Similar to @grep@'s +-- @--recursive@ option. +data Recursive = Recursive | NotRecursive + deriving (Eq, Read, Show) + +class HasRecursive r where + recursiveLens :: Lens' r Recursive + default recursiveLens :: HasCommonOptions r => Lens' r Recursive + recursiveLens = commonOptionsLens . recursiveLens + +recursiveParser :: Parser Recursive +recursiveParser = + let mods = + long "recursive" <> + short 'r' <> + help "recursive operate on files under specified directory" + in flag NotRecursive Recursive mods + +--------------- +-- Raw regex -- +--------------- + +-- | The raw, pre-compiled regular expression passed in on the command line by +-- the user. +newtype RawRegex = RawRegex + { unRawRegex :: String + } deriving (Eq, IsString, Read, Show) + +class HasRawRegex r where + rawRegexLens :: Lens' r RawRegex + default rawRegexLens :: HasCommonOptions r => Lens' r RawRegex + rawRegexLens = commonOptionsLens . rawRegexLens + +rawRegexParser :: Parser RawRegex +rawRegexParser = + let mods = metavar "PATTERN" + in RawRegex <$> strArgument mods + +-------------------- +-- input filename -- +-------------------- + +-- | An input file passed in on the command line by the user. +newtype InputFilename = InputFilename + { unInputFilename :: FilePath + } deriving (Eq, IsString, Read, Show) + +class HasInputFilenames r where + inputFilenamesLens :: Lens' r [InputFilename] + default inputFilenamesLens :: HasCommonOptions r => Lens' r [InputFilename] + inputFilenamesLens = commonOptionsLens . inputFilenamesLens + +inputFilenamesParser :: Parser [InputFilename] +inputFilenamesParser = + let mods = metavar "FILE" + in many $ InputFilename <$> strArgument mods + +-------------------- +-- common options -- +-------------------- + +-- | A set of options that are common to both the @highlight@ and @hrep@ +-- applications. +data CommonOptions = CommonOptions + { commonOptionsIgnoreCase :: IgnoreCase + , commonOptionsRecursive :: Recursive + , commonOptionsRawRegex :: RawRegex + , commonOptionsInputFilenames :: [InputFilename] + } deriving (Eq, Read, Show) + +class HasCommonOptions r where + commonOptionsLens :: Lens' r CommonOptions + +instance HasCommonOptions CommonOptions where + commonOptionsLens :: Lens' CommonOptions CommonOptions + commonOptionsLens = id + +instance HasIgnoreCase CommonOptions where + ignoreCaseLens :: Lens' CommonOptions IgnoreCase + ignoreCaseLens = + lens + commonOptionsIgnoreCase + (\s a -> s {commonOptionsIgnoreCase = a}) + +instance HasRecursive CommonOptions where + recursiveLens :: Lens' CommonOptions Recursive + recursiveLens = + lens + commonOptionsRecursive + (\s a -> s {commonOptionsRecursive = a}) + +instance HasRawRegex CommonOptions where + rawRegexLens :: Lens' CommonOptions RawRegex + rawRegexLens = + lens + commonOptionsRawRegex + (\s a -> s {commonOptionsRawRegex = a}) + +instance HasInputFilenames CommonOptions where + inputFilenamesLens :: Lens' CommonOptions [InputFilename] + inputFilenamesLens = + lens + commonOptionsInputFilenames + (\s a -> s {commonOptionsInputFilenames = a}) + +commonOptionsParser :: Parser CommonOptions +commonOptionsParser = + CommonOptions + <$> ignoreCaseParser + <*> recursiveParser + <*> rawRegexParser + <*> inputFilenamesParser + +-- | A default set of 'CommonOptions'. Defined as the following: +-- +-- >>> :{ +-- let opts = +-- CommonOptions +-- { commonOptionsIgnoreCase = DoNotIgnoreCase +-- , commonOptionsRecursive = NotRecursive +-- , commonOptionsRawRegex = RawRegex { unRawRegex = "" } +-- , commonOptionsInputFilenames = [] +-- } +-- :} +-- +-- >>> opts == defaultCommonOptions +-- True +defaultCommonOptions :: CommonOptions +defaultCommonOptions = + CommonOptions DoNotIgnoreCase NotRecursive (RawRegex "") [] diff --git a/src/Highlight/Highlight.hs b/src/Highlight/Highlight.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Highlight.hs @@ -0,0 +1,35 @@ +{- | +Module : Highlight.Highlight + +Copyright : Dennis Gosnell 2017 +License : BSD3 + +Maintainer : Dennis Gosnell (cdep.illabout@gmail.com) +Stability : experimental +Portability : unknown + +This module contains the 'defaultMain' function for the @highlight@ program. +-} + +module Highlight.Highlight where + +import Data.Monoid ((<>)) +import Options.Applicative + (InfoMod, ParserInfo, (<**>), execParser, fullDesc, helper, + info, progDesc) + +import Highlight.Highlight.Options (Options, optionsParser) +import Highlight.Highlight.Run (run) + +defaultMain :: IO () +defaultMain = do + options <- execParser parserInfo + run options + where + parserInfo :: ParserInfo Options + parserInfo = info (optionsParser <**> helper) infoMod + + infoMod :: InfoMod a + infoMod = + fullDesc <> + progDesc "Highlight PATTERN in a each FILE or standard input" diff --git a/src/Highlight/Highlight/Monad.hs b/src/Highlight/Highlight/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Highlight/Monad.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Highlight.Highlight.Monad + ( module Highlight.Highlight.Monad + , module Highlight.Common.Monad + ) where + +import Prelude () +import Prelude.Compat + +import Control.Lens (view) +import Control.Monad.Reader (MonadReader) +import Control.Monad.State (MonadState, get) +import Data.ByteString (ByteString) + +import Highlight.Common.Error (HighlightErr(..)) +import Highlight.Common.Monad + (CommonHighlightM, + FilenameHandlingFromFiles(NoFilename, PrintFilename), InputData, + Output, compileHighlightRegexWithErr, createInputData, + getInputFilenamesM, getRecursiveM, handleInputData, + runCommonHighlightM, runOutputProducer) +import Highlight.Highlight.Options + (ColorGrepFilenames, HasColorGrepFilenames(colorGrepFilenamesLens), + Options(..)) +import Highlight.Util (modify') + +-- | The internal state that is used to figure out how to color filenames from +-- @grep@. +data FromGrepFilenameState = FromGrepFilenameState + { fromGrepFilenameStatePrevFileNum :: {-# UNPACK #-} !Int + , fromGrepFilenameStatePrevFilename :: !(Maybe ByteString) + } + +initFromGrepFilenameState :: FromGrepFilenameState +initFromGrepFilenameState = + FromGrepFilenameState + { fromGrepFilenameStatePrevFileNum = (-1) + , fromGrepFilenameStatePrevFilename = Nothing + } + +-- | Call 'updateFilename' and return the new file number after doing the +-- update. +updateFilenameM :: MonadState FromGrepFilenameState m => ByteString -> m Int +updateFilenameM nextFilename = do + modify' $ updateFilename nextFilename + FromGrepFilenameState newFileNum _ <- get + return newFileNum + +-- | Update the file number in 'FromGrepFilenameState' if the 'ByteString' +-- filename passed in is different from that in 'FromGrepFilenameState'. +updateFilename :: ByteString -> FromGrepFilenameState -> FromGrepFilenameState +updateFilename nextFilename (FromGrepFilenameState prevFileNum prevFilename) + | Just nextFilename == prevFilename = + FromGrepFilenameState prevFileNum prevFilename + | otherwise = + FromGrepFilenameState (prevFileNum + 1) (Just nextFilename) + +------------------------- +-- The Highlight Monad -- +------------------------- + +-- | 'HighlightM' is just 'CommonHighlightM' specialized for @highlight@. +type HighlightM = CommonHighlightM Options FromGrepFilenameState HighlightErr + +runHighlightM :: Options -> HighlightM a -> IO (Either HighlightErr a) +runHighlightM opts = runCommonHighlightM opts initFromGrepFilenameState + +---------------------------------- +-- Get value of certain options -- +---------------------------------- + +-- | Get the value of the 'ColorGrepFilenames' option. +getColorGrepFilenamesM + :: (HasColorGrepFilenames r, MonadReader r m) => m ColorGrepFilenames +getColorGrepFilenamesM = view colorGrepFilenamesLens diff --git a/src/Highlight/Highlight/Options.hs b/src/Highlight/Highlight/Options.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Highlight/Options.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE OverloadedStrings #-} + +module Highlight.Highlight.Options + ( ColorGrepFilenames(..) + , colorGrepFilenamesParser + , HasColorGrepFilenames(..) + , Options(..) + , defaultOptions + , optionsParser + , HasOptions(..) + , module Highlight.Common.Options + ) where + +import Prelude () +import Prelude.Compat + +import Control.Lens (Lens', lens) +import Data.Monoid ((<>)) +import Options.Applicative (Parser, flag, help, long, short) + +import Highlight.Common.Options + (CommonOptions, HasCommonOptions(commonOptionsLens), + HasIgnoreCase(ignoreCaseLens), HasInputFilenames(inputFilenamesLens), + HasRawRegex(rawRegexLens), HasRecursive(recursiveLens), + IgnoreCase(DoNotIgnoreCase, IgnoreCase), + InputFilename(InputFilename, unInputFilename), RawRegex(RawRegex), + Recursive(Recursive), commonOptionsParser, defaultCommonOptions) + +-------------------------- +-- Color grep filenames -- +-------------------------- + +-- | Whether or not to color filenames output by @grep@ when reading in from +-- stdin. +data ColorGrepFilenames = ColorGrepFilenames | DoNotColorGrepFileNames + deriving (Eq, Read, Show) + +class HasColorGrepFilenames r where + colorGrepFilenamesLens :: Lens' r ColorGrepFilenames + +colorGrepFilenamesParser :: Parser ColorGrepFilenames +colorGrepFilenamesParser = + let mods = + long "from-grep" <> + short 'g' <> + help "highlight output from grep" + in flag DoNotColorGrepFileNames ColorGrepFilenames mods + +------------- +-- Options -- +------------- + +data Options = Options + { optionsColorGrepFilenames :: ColorGrepFilenames + , optionsCommonOptions :: CommonOptions + } deriving (Eq, Read, Show) + +class HasOptions r where + optionsLens :: Lens' r Options + +instance HasOptions Options where + optionsLens :: Lens' Options Options + optionsLens = id + +instance HasColorGrepFilenames Options where + colorGrepFilenamesLens :: Lens' Options ColorGrepFilenames + colorGrepFilenamesLens = + lens + optionsColorGrepFilenames + (\s a -> s {optionsColorGrepFilenames = a}) + +instance HasCommonOptions Options where + commonOptionsLens :: Lens' Options CommonOptions + commonOptionsLens = + lens + optionsCommonOptions + (\s a -> s {optionsCommonOptions = a}) + +instance HasIgnoreCase Options +instance HasRecursive Options +instance HasRawRegex Options +instance HasInputFilenames Options + +optionsParser :: Parser Options +optionsParser = + Options + <$> colorGrepFilenamesParser + <*> commonOptionsParser + +defaultOptions :: Options +defaultOptions = Options DoNotColorGrepFileNames defaultCommonOptions diff --git a/src/Highlight/Highlight/Run.hs b/src/Highlight/Highlight/Run.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Highlight/Run.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Highlight.Highlight.Run where + +import Prelude () +import Prelude.Compat + +import Control.Exception (IOException) +import Control.Monad.Reader (MonadReader) +import Control.Monad.State (MonadState) +import Data.ByteString (ByteString, empty) +import qualified Data.ByteString.Char8 +import Data.Monoid ((<>)) +import Pipes (Producer) +import Text.RE.PCRE (RE, (*=~)) +import Text.RE.Replace (replaceAll) + +import Highlight.Common.Color + (colorForFileNumber, colorReset, colorVividRedBold, + colorVividWhiteBold) +import Highlight.Common.Error (handleErr) +import Highlight.Highlight.Monad + (FilenameHandlingFromFiles(..), FromGrepFilenameState, HighlightM, + Output, compileHighlightRegexWithErr, createInputData, + getColorGrepFilenamesM, getInputFilenamesM, getRecursiveM, + handleInputData, runHighlightM, runOutputProducer, updateFilenameM) +import Highlight.Highlight.Options + (HasColorGrepFilenames, + ColorGrepFilenames(ColorGrepFilenames, DoNotColorGrepFileNames), + Options(..)) +import Highlight.Pipes (stdinLines) + +run :: Options -> IO () +run opts = do + eitherRes <- runHighlightM opts prog + either handleErr return eitherRes + +prog :: HighlightM () +prog = do + outputProducer <- highlightOutputProducer stdinLines + runOutputProducer outputProducer + +highlightOutputProducer + :: Producer ByteString HighlightM () + -> HighlightM (Producer Output HighlightM ()) +highlightOutputProducer stdinProducer = do + regex <- compileHighlightRegexWithErr + inputFilenames <- getInputFilenamesM + recursive <- getRecursiveM + inputData <- createInputData recursive inputFilenames stdinProducer + let outputProducer = + handleInputData + (handleStdinInput regex) + (handleFileInput regex) + handleError + inputData + return outputProducer + +handleStdinInput + :: ( HasColorGrepFilenames r + , MonadState FromGrepFilenameState m + , MonadReader r m + ) + => RE -> ByteString -> m [ByteString] +handleStdinInput regex input = do + colorGrepFilenames <- getColorGrepFilenamesM + case colorGrepFilenames of + DoNotColorGrepFileNames -> return $ formatNormalLine regex input + ColorGrepFilenames -> do + let (beforeColon, colonAndAfter) = + Data.ByteString.Char8.break (== ':') input + if colonAndAfter == empty + then return $ formatNormalLine regex input + else do + let filePath = beforeColon + lineWithoutColon = Data.ByteString.Char8.drop 1 colonAndAfter + fileNumber <- updateFilenameM filePath + return $ + formatLineWithFilename regex fileNumber filePath lineWithoutColon + +formatLineWithFilename + :: RE -> Int -> ByteString -> ByteString -> [ByteString] +formatLineWithFilename regex fileNumber filePath input = + [ colorForFileNumber fileNumber + , filePath + , colorVividWhiteBold + , ": " + , colorReset + , highlightMatchInRed regex input + ] + +formatNormalLine :: RE -> ByteString -> [ByteString] +formatNormalLine regex input = + [highlightMatchInRed regex input] + +handleFileInput + :: Monad m + => RE + -> FilenameHandlingFromFiles + -> ByteString + -> Int + -> ByteString + -> m [ByteString] +handleFileInput regex NoFilename _ _ input = + return $ formatNormalLine regex input +handleFileInput regex PrintFilename filePath fileNumber input = + return $ formatLineWithFilename regex fileNumber filePath input + +handleError + :: Monad m + => ByteString -> IOException -> Maybe IOException -> m [ByteString] +handleError filePath _ (Just _) = + return ["Error when trying to read file or directory \"", filePath , "\""] +handleError filePath _ Nothing = + return ["Error when trying to read file \"", filePath , "\""] + +highlightMatchInRed :: RE -> ByteString -> ByteString +highlightMatchInRed regex input = + let matches = input *=~ regex + in replaceAll replaceInRedByteString matches + +replaceInRedByteString :: ByteString +replaceInRedByteString = colorVividRedBold <> "$0" <> colorReset diff --git a/src/Highlight/Hrep.hs b/src/Highlight/Hrep.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Hrep.hs @@ -0,0 +1,23 @@ + +module Highlight.Hrep where + +import Data.Monoid ((<>)) +import Options.Applicative + (InfoMod, ParserInfo, (<**>), execParser, fullDesc, helper, info, + progDesc) + +import Highlight.Common.Options (CommonOptions, commonOptionsParser) +import Highlight.Hrep.Run (run) + +defaultMain :: IO () +defaultMain = do + options <- execParser parserInfo + run options + where + parserInfo :: ParserInfo CommonOptions + parserInfo = info (commonOptionsParser <**> helper) infoMod + + infoMod :: InfoMod a + infoMod = + fullDesc <> + progDesc "Search for PATTERN in each FILE or standard input." diff --git a/src/Highlight/Hrep/Monad.hs b/src/Highlight/Hrep/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Hrep/Monad.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Highlight.Hrep.Monad + ( module Highlight.Hrep.Monad + , module Highlight.Common.Monad + ) where + +import Prelude () +import Prelude.Compat + +import Highlight.Common.Error (HighlightErr(..)) +import Highlight.Common.Monad + (CommonHighlightM, + FilenameHandlingFromFiles(NoFilename, PrintFilename), InputData, + Output, compileHighlightRegexWithErr, createInputData, + getInputFilenamesM, getRecursiveM, handleInputData, + runCommonHighlightM, runOutputProducer) +import Highlight.Common.Options (CommonOptions) + +-------------------- +-- The Hrep Monad -- +-------------------- + +-- | 'HrepM' is just 'CommonHighlightM' specialized for @hrep@. +type HrepM = CommonHighlightM CommonOptions () HighlightErr + +runHrepM :: CommonOptions -> HrepM a -> IO (Either HighlightErr a) +runHrepM opts = runCommonHighlightM opts () diff --git a/src/Highlight/Hrep/Run.hs b/src/Highlight/Hrep/Run.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Hrep/Run.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Highlight.Hrep.Run where + +import Prelude () +import Prelude.Compat + +import Control.Exception (IOException) +import Data.ByteString (ByteString) +import Data.Maybe (maybeToList) +import Data.Monoid ((<>)) +import Pipes (Producer) +import Text.RE.PCRE (RE, (*=~), anyMatches) +import Text.RE.Replace (replaceAll) + +import Highlight.Common.Color + (colorForFileNumber, colorReset, colorVividRedBold, + colorVividWhiteBold) +import Highlight.Common.Error (handleErr) +import Highlight.Common.Options (CommonOptions(..)) +import Highlight.Hrep.Monad + (FilenameHandlingFromFiles(..), HrepM, Output, + compileHighlightRegexWithErr, createInputData, getInputFilenamesM, + getRecursiveM, handleInputData, runHrepM, runOutputProducer) +import Highlight.Pipes (stdinLines) + +run :: CommonOptions -> IO () +run opts = do + eitherRes <- runHrepM opts prog + either handleErr return eitherRes + +prog :: HrepM () +prog = do + outputProducer <- hrepOutputProducer stdinLines + runOutputProducer outputProducer + +hrepOutputProducer + :: Producer ByteString HrepM () + -> HrepM (Producer Output HrepM ()) +hrepOutputProducer stdinProducer = do + regex <- compileHighlightRegexWithErr + inputFilenames <- getInputFilenamesM + recursive <- getRecursiveM + inputData <- createInputData recursive inputFilenames stdinProducer + let outputProducer = + handleInputData + (handleStdinInput regex) + (handleFileInput regex) + handleError + inputData + return outputProducer + +handleStdinInput + :: Monad m + => RE -> ByteString -> m [ByteString] +handleStdinInput regex input = + return $ formatNormalLine regex input + +formatNormalLine :: RE -> ByteString -> [ByteString] +formatNormalLine regex = + maybeToList . highlightMatchInRed regex + +handleFileInput + :: Monad m + => RE + -> FilenameHandlingFromFiles + -> ByteString + -> Int + -> ByteString + -> m [ByteString] +handleFileInput regex NoFilename _ _ input = + return $ formatNormalLine regex input +handleFileInput regex PrintFilename filePath fileNumber input = + return $ formatLineWithFilename regex fileNumber filePath input + +formatLineWithFilename + :: RE -> Int -> ByteString -> ByteString -> [ByteString] +formatLineWithFilename regex fileNumber filePath input = + case highlightMatchInRed regex input of + Nothing -> [] + Just line -> + [ colorForFileNumber fileNumber + , filePath + , colorVividWhiteBold + , ": " + , colorReset + , line + ] + +handleError + :: Monad m + => ByteString + -> IOException + -> Maybe IOException + -> m [ByteString] +handleError filePath _ (Just _) = + return ["Error when trying to read file or directory \"", filePath, "\""] +handleError filePath _ Nothing = + return ["Error when trying to read file \"", filePath, "\""] + +highlightMatchInRed :: RE -> ByteString -> Maybe ByteString +highlightMatchInRed regex input = + let matches = input *=~ regex + didMatch = anyMatches matches + in if didMatch + then Just $ replaceAll replaceInRedByteString matches + else Nothing + +replaceInRedByteString :: ByteString +replaceInRedByteString = colorVividRedBold <> "$0" <> colorReset diff --git a/src/Highlight/Pipes.hs b/src/Highlight/Pipes.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Pipes.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Highlight.Pipes where + +import Prelude () +import Prelude.Compat + +import Control.Exception (throwIO, try) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Data.ByteString (ByteString, hGetLine, hPutStr) +import Foreign.C.Error (Errno(Errno), ePIPE) +import GHC.IO.Exception + (IOException(IOError), IOErrorType(ResourceVanished), ioe_errno, + ioe_type) +import Pipes (Consumer', Producer', Proxy, await, each, yield) +import System.Directory (getDirectoryContents) +import System.FilePath (()) +import System.IO (Handle, stderr, stdin) + +import Highlight.Util + (closeHandleIfEOFOrThrow, openFilePathForReading) + +-- | Read input from a 'Handle', split it into lines, and return each of those +-- lines as a 'ByteString' in a 'Producer'. +-- +-- This function will close the 'Handle' if the end of the file is reached. +-- However, if an error was thrown while reading input from the 'Handle', the +-- 'Handle' is not closed. +-- +-- Setup for examples: +-- +-- >>> import Pipes.Prelude (toListM) +-- >>> import System.IO (IOMode(ReadMode), openBinaryFile) +-- >>> let goodFilePath = "test/golden/test-files/file2" +-- +-- Examples: +-- +-- >>> handle <- openBinaryFile goodFilePath ReadMode +-- >>> fmap head . toListM $ fromHandleLines handle +-- "Proud Pour is a wine company that funds solutions to local environmental" +fromHandleLines :: forall m. MonadIO m => Handle -> Producer' ByteString m () +fromHandleLines handle = go + where + go :: Producer' ByteString m () + go = do + eitherLine <- liftIO . try $ hGetLine handle + case eitherLine of + Left ioerr -> closeHandleIfEOFOrThrow handle ioerr + Right line -> yield line *> go +{-# INLINABLE fromHandleLines #-} + +-- | Call 'fromHandleLines' on 'stdin'. +stdinLines :: forall m. MonadIO m => Producer' ByteString m () +stdinLines = fromHandleLines stdin +{-# INLINABLE stdinLines #-} + +-- | Try calling 'fromHandleLines' on the 'Handle' obtained from +-- 'openFilePathForReading'. +-- +-- Setup for examples: +-- +-- >>> import Pipes (Producer) +-- >>> import Pipes.Prelude (toListM) +-- +-- >>> let t a = a :: IO (Either IOException (Producer ByteString IO ())) +-- >>> let goodFilePath = "test/golden/test-files/file2" +-- >>> let badFilePath = "thisfiledoesnotexist" +-- >>> let handleErr err = error $ "got following error: " `mappend` show err +-- +-- Example: +-- +-- >>> eitherProducer <- t $ fromFileLines goodFilePath +-- >>> let producer = either handleErr id eitherProducer +-- >>> fmap head $ toListM producer +-- "Proud Pour is a wine company that funds solutions to local environmental" +-- +-- Returns 'IOException' if there was an error when opening the file. +-- +-- >>> eitherProducer <- t $ fromFileLines badFilePath +-- >>> either print (const $ return ()) eitherProducer +-- thisfiledoesnotexist: openBinaryFile: does not exist ... +fromFileLines + :: forall m n x' x. + (MonadIO m, MonadIO n) + => FilePath + -> m (Either IOException (Proxy x' x () ByteString n ())) +fromFileLines filePath = do + eitherHandle <- openFilePathForReading filePath + case eitherHandle of + Left ioerr -> return $ Left ioerr + Right handle -> return . Right $ fromHandleLines handle +{-# INLINABLE fromFileLines #-} + +-- | Output 'ByteString's to 'stderr'. +-- +-- If an 'ePIPE' error is thrown, then just 'return' @()@. If any other error +-- is thrown, rethrow the error. +-- +-- Setup for examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> import Pipes ((>->), runEffect) +-- +-- Example: +-- +-- >>> runEffect $ yield "hello" >-> stderrConsumer +-- hello +stderrConsumer :: forall m. MonadIO m => Consumer' ByteString m () +stderrConsumer = go + where + go :: Consumer' ByteString m () + go = do + bs <- await + x <- liftIO $ try (hPutStr stderr bs) + case x of + Left IOError { ioe_type = ResourceVanished, ioe_errno = Just ioe } + | Errno ioe == ePIPE -> return () + Left e -> liftIO $ throwIO e + Right () -> go +{-# INLINABLE stderrConsumer #-} + +-- | Select all immediate children of the given directory, ignoring @\".\"@ and +-- @\"..\"@. +-- +-- Throws an 'IOException' if the directory is not readable or (on Windows) if +-- the directory is actually a reparse point. +-- +-- Setup for examples: +-- +-- >>> import Data.List (sort) +-- >>> import Pipes.Prelude (toListM) +-- +-- Examples: +-- +-- >>> fmap (head . sort) . toListM $ childOf "test/golden/test-files" +-- "test/golden/test-files/dir1" +-- +-- TODO: This could be rewritten to be faster by using the Windows- and +-- Linux-specific functions to only read one file from a directory at a time +-- like the actual +-- +-- function. +childOf :: MonadIO m => FilePath -> Producer' FilePath m () +childOf path = do + files <- liftIO $ getDirectoryContents path + let filteredFiles = filter isNormalFile files + fullFiles = fmap (path ) filteredFiles + each fullFiles + where + isNormalFile :: FilePath -> Bool + isNormalFile file = file /= "." && file /= ".." +{-# INLINABLE childOf #-} diff --git a/src/Highlight/Util.hs b/src/Highlight/Util.hs new file mode 100644 --- /dev/null +++ b/src/Highlight/Util.hs @@ -0,0 +1,103 @@ +module Highlight.Util where + +import Prelude () +import Prelude.Compat + +import Control.Exception (IOException, try) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Control.Monad.State (MonadState, get, put) +import Data.ByteString (ByteString) +import Data.ByteString.Unsafe (unsafePackMallocCStringLen) +import Data.Semigroup (Semigroup, (<>)) +import Foreign.C (newCStringLen) +import System.Exit (ExitCode(ExitFailure), exitWith) +import System.IO (Handle, IOMode(ReadMode), hClose, hIsEOF, openBinaryFile) + +-- | Convert a 'String' to a 'ByteString' with the encoding for the current +-- locale. +-- +-- >>> convertStringToRawByteString "hello" +-- "hello" +convertStringToRawByteString :: MonadIO m => String -> m ByteString +convertStringToRawByteString str = liftIO $ do + cStringLen <- newCStringLen str + unsafePackMallocCStringLen cStringLen +{-# INLINABLE convertStringToRawByteString #-} + +-- | Open a 'FilePath' in 'ReadMode'. +-- +-- On success, return a 'Right' 'Handle': +-- +-- >>> openFilePathForReading "README.md" +-- Right {handle: README.md} +-- +-- On error, return a 'Left' 'IOException': +-- +-- >>> openFilePathForReading "thisfiledoesntexist" +-- Left thisfiledoesntexist: openBinaryFile: does not exist ... +openFilePathForReading :: MonadIO m => FilePath -> m (Either IOException Handle) +openFilePathForReading filePath = + liftIO . try $ openBinaryFile filePath ReadMode +{-# INLINABLE openFilePathForReading #-} + +-- | Combine values in two 'Applicative's with '<>'. +-- +-- >>> combineApplicatives (Just "hello") (Just " world") +-- Just "hello world" +-- +-- >>> combineApplicatives (Just "hello") Nothing +-- Nothing +combineApplicatives :: (Applicative f, Semigroup a) => f a -> f a -> f a +combineApplicatives action1 action2 = + (<>) <$> action1 <*> action2 +{-# INLINABLE combineApplicatives #-} + +-- | Handle an 'IOException' that occurs when reading from a 'Handle'. Check +-- if the 'IOException' is an EOF exception ('hIsEOF'). If so, then just close +-- the 'Handle'. Otherwise, throw the 'IOException' that is passed in. +closeHandleIfEOFOrThrow :: MonadIO m => Handle -> IOException -> m () +closeHandleIfEOFOrThrow handle ioerr = liftIO $ do + isEOF <- hIsEOF handle + if isEOF + then hClose handle + else ioError ioerr +{-# INLINABLE closeHandleIfEOFOrThrow #-} + +-- | Call 'exitWith' with 'ExitFailure' +-- +-- >>> die 10 "message" +-- ERROR: message +-- *** Exception: ExitFailure 10 +die + :: Int -- ^ exit code + -> String -- ^ error message to print to console + -> IO a +die exitCode msg = do + putStrLn $ "ERROR: " <> msg + exitWith $ ExitFailure exitCode +{-# INLINABLE die #-} + +-- | Perform an action when a list is non-null. +-- +-- >>> whenNonNull [1,2,3] $ putStrLn "hello" +-- hello +-- >>> whenNonNull [] $ putStrLn "bye" +-- +whenNonNull :: Monad m => [a] -> m () -> m () +whenNonNull [] _ = return () +whenNonNull _ action = action +{-# INLINABLE whenNonNull #-} + + +-- | A variant of 'modify' in which the computation is strict in the +-- new state. +-- +-- * @'modify'' f = 'get' >>= (('$!') 'put' . f)@ +-- +-- This is used because 'modify'' is not available in the @tranformers-0.3.0.0@ +-- package. +modify' :: MonadState s m => (s -> s) -> m () +modify' f = do + s <- get + put $! f s +{-# INLINE modify' #-} diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,36 @@ + +module Main (main) where + +import Prelude + +import Data.Monoid ((<>)) +import Test.DocTest (doctest) + +main :: IO () +main = doctest $ ["src/"] <> ghcExtensions + +ghcExtensions :: [String] +ghcExtensions = + [ + -- "-XConstraintKinds" + -- , "-XDataKinds" + -- , "-XDeriveDataTypeable" + -- , "-XDeriveGeneric" + -- , "-XEmptyDataDecls" + -- , "-XFlexibleContexts" + -- , "-XFlexibleInstances" + -- , "-XGADTs" + -- , "-XGeneralizedNewtypeDeriving" + -- , "-XInstanceSigs" + -- , "-XMultiParamTypeClasses" + -- , "-XNoImplicitPrelude" + -- , "-XOverloadedStrings" + -- , "-XPolyKinds" + -- , "-XRankNTypes" + -- , "-XRecordWildCards" + -- , "-XScopedTypeVariables" + -- , "-XStandaloneDeriving" + -- , "-XTupleSections" + -- , "-XTypeFamilies" + -- , "-XTypeOperators" + ] diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,19 @@ +module Main where + +import Prelude () +import Prelude.Compat + +import Test.Tasty (TestTree, defaultMain, testGroup) + +import Test.Golden (goldenTests) + +main :: IO () +main = do + -- createDirectoryIfMissing False (testDir "empty-dir") + tests <- testsIO + defaultMain tests + +testsIO :: IO TestTree +testsIO = do + return $ testGroup "tests" [goldenTests] + diff --git a/test/Test/Golden.hs b/test/Test/Golden.hs new file mode 100644 --- /dev/null +++ b/test/Test/Golden.hs @@ -0,0 +1,310 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Test.Golden where + +import Prelude () +import Prelude.Compat + +import Control.Exception (try) +import Control.Lens ((&), (.~)) +import Control.Monad.IO.Class (MonadIO) +import Data.ByteString (ByteString) +import Data.ByteString.Lazy (fromStrict) +import qualified Data.ByteString.Lazy as LByteString +import Data.Foldable (fold) +import Data.Monoid ((<>)) +import Pipes (Pipe, Producer, (>->)) +import Pipes.Prelude (mapFoldable, toListM) +import System.Directory + (Permissions, emptyPermissions, removeFile, setOwnerReadable, + setOwnerSearchable, setOwnerWritable, setPermissions) +import System.IO (IOMode(WriteMode), hClose, openBinaryFile) +import System.IO.Error (isPermissionError) +import Test.Tasty (TestTree, testGroup, withResource) +import Test.Tasty.Golden (goldenVsString) + +import Highlight.Common.Monad (Output(OutputStderr, OutputStdout)) +import Highlight.Common.Options + (CommonOptions, IgnoreCase(IgnoreCase), Recursive(Recursive), + defaultCommonOptions, ignoreCaseLens, inputFilenamesLens, + rawRegexLens, recursiveLens) +import Highlight.Highlight.Monad (HighlightM, runHighlightM) +import Highlight.Highlight.Options + (ColorGrepFilenames(ColorGrepFilenames), Options, + colorGrepFilenamesLens, defaultOptions) +import Highlight.Highlight.Run (highlightOutputProducer) +import Highlight.Hrep.Monad (HrepM, runHrepM) +import Highlight.Hrep.Run (hrepOutputProducer) +import Highlight.Pipes (fromFileLines, stdinLines) + +runHighlightTestWithStdin + :: Options + -> Producer ByteString HighlightM () + -> (forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString +runHighlightTestWithStdin opts stdinPipe filterPipe = do + eitherByteStrings <- runHighlightM opts $ do + outputProducer <- highlightOutputProducer stdinPipe + toListM $ outputProducer >-> filterPipe + case eitherByteStrings of + Left err -> error $ "unexpected error: " <> show err + Right byteStrings -> return . fromStrict $ fold byteStrings + +runHighlightTest + :: Options + -> (forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString +runHighlightTest opts = + runHighlightTestWithStdin opts stdinLines + +runHrepTestWithStdin + :: CommonOptions + -> (Producer ByteString HrepM ()) + -> (forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString +runHrepTestWithStdin opts stdinPipe filterPipe = do + eitherByteStrings <- runHrepM opts $ do + outputProducer <- hrepOutputProducer stdinPipe + toListM $ outputProducer >-> filterPipe + case eitherByteStrings of + Left err -> error $ "unexpected error: " <> show err + Right byteStrings -> return . fromStrict $ fold byteStrings + +runHrepTest + :: CommonOptions + -> (forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString +runHrepTest opts = + runHrepTestWithStdin opts stdinLines + +filterStdout :: Monad m => Pipe Output ByteString m () +filterStdout = mapFoldable f + where + f :: Output -> Maybe ByteString + f (OutputStderr _) = Nothing + f (OutputStdout byteString) = Just byteString + +filterStderr :: Monad m => Pipe Output ByteString m () +filterStderr = mapFoldable f + where + f :: Output -> Maybe ByteString + f (OutputStderr byteString) = Just byteString + f (OutputStdout _) = Nothing + +getFileOutputProducer + :: MonadIO m + => FilePath -> IO (Producer ByteString m ()) +getFileOutputProducer filePath = do + eitherProducer <- fromFileLines filePath + case eitherProducer of + Left ioerr -> + error $ + "ERROR: following error occured when trying to read \"" <> + filePath <> "\": " <> show ioerr + Right producer -> return producer + +testStderrAndStdout + :: String + -> FilePath + -> ( ( forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString + ) + -> TestTree +testStderrAndStdout msg path runner = + testGroup + msg + [ goldenVsString "stderr" (path <> ".stderr") (runner filterStderr) + , goldenVsString "stdout" (path <> ".stdout") (runner filterStdout) + ] + +goldenTests :: TestTree +goldenTests = + withResource createUnreadableFile (const deleteUnreadableFile) $ + const (testGroup "golden tests" [highlightGoldenTests, hrepGoldenTests]) + +createUnreadableFile :: IO () +createUnreadableFile = do + eitherHandle <- try $ openBinaryFile unreadableFilePath WriteMode + case eitherHandle of + Right handle -> do + hClose handle + makeFileUnreadable unreadableFilePath + Left ioerr + | isPermissionError ioerr -> + -- assume that the file already exists, and just try to make sure that + -- the permissions are null + makeFileUnreadable unreadableFilePath + | otherwise -> + -- we shouldn't have gotten an error here, so just rethrow it + ioError ioerr + +makeFileUnreadable :: FilePath -> IO () +makeFileUnreadable filePath = setPermissions filePath emptyPermissions + +makeFileReadable :: FilePath -> IO () +makeFileReadable filePath = + setPermissions filePath fullPermissions + where + fullPermissions :: Permissions + fullPermissions = + setOwnerWritable True . + setOwnerSearchable True . + setOwnerReadable True $ + emptyPermissions + +deleteUnreadableFile :: IO () +deleteUnreadableFile = do + makeFileReadable unreadableFilePath + eitherRes <- try $ removeFile unreadableFilePath + either ioError return eitherRes + +unreadableFilePath :: FilePath +unreadableFilePath = "test/golden/test-files/dir2/unreadable-file" + +--------------------- +-- Highlight Tests -- +--------------------- + +highlightGoldenTests :: TestTree +highlightGoldenTests = + testGroup + "highlight" + [ testHighlightSingleFile + , testHighlightMultiFile + , testHighlightFromGrep + ] + +testHighlightSingleFile :: TestTree +testHighlightSingleFile = + let opts = + defaultOptions + & rawRegexLens .~ "or" + & inputFilenamesLens .~ ["test/golden/test-files/file1"] + in testStderrAndStdout + "`highlight or 'test/golden/test-files/file1'`" + "test/golden/golden-files/highlight/single-file" + (runHighlightTest opts) + +testHighlightMultiFile :: TestTree +testHighlightMultiFile = + let opts = + defaultOptions + & rawRegexLens .~ "and" + & ignoreCaseLens .~ IgnoreCase + & recursiveLens .~ Recursive + & inputFilenamesLens .~ + [ "test/golden/test-files/dir1" + , "test/golden/test-files/empty-file" + , "test/golden/test-files/dir2" + ] + testName = + "`touch 'test/golden/test-files/dir2/unreadable-file' ; " <> + "chmod 0 'test/golden/test-files/dir2/unreadable-file' ; " <> + "highlight --ignore-case --recursive and " <> + "'test/golden/test-files/dir1' " <> + "'test/golden/test-files/empty-file' " <> + "'test/golden/test-files/dir2' ; " <> + "rm -rf 'test/golden/test-files/dir2/unreadable-file'`" + in testStderrAndStdout + testName + "test/golden/golden-files/highlight/multi-file" + (runHighlightTest opts) + +testHighlightFromGrep :: TestTree +testHighlightFromGrep = + let opts = + defaultOptions + & rawRegexLens .~ "and" + & colorGrepFilenamesLens .~ ColorGrepFilenames + testName = + "`cat test/golden/test-files/from-grep | " <> + "highlight --from-grep and`" + in testStderrAndStdout + testName + "test/golden/golden-files/highlight/from-grep" + (go opts) + where + go + :: Options + -> (forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString + go opts outputPipe = do + -- This is the output file from @grep@ to use for the test + -- 'testHighlightFromGrep'. + -- + -- This file was created with the following command: + -- > $ grep --recursive and 'test/golden/test-files/dir1' + let grepOutputTestFile = "test/golden/test-files/from-grep" + grepOutputProducer <- getFileOutputProducer grepOutputTestFile + runHighlightTestWithStdin opts grepOutputProducer outputPipe + +---------------- +-- Hrep Tests -- +---------------- + +hrepGoldenTests :: TestTree +hrepGoldenTests = + testGroup + "hrep" + [ testHrepSingleFile + , testHrepMultiFile + , testHrepFromStdin + ] + +testHrepSingleFile :: TestTree +testHrepSingleFile = + let opts = + defaultCommonOptions + & rawRegexLens .~ "another" + & inputFilenamesLens .~ ["test/golden/test-files/file1"] + in testStderrAndStdout + "`hrep another 'test/golden/test-files/file1'`" + "test/golden/golden-files/hrep/single-file" + (runHrepTest opts) + +testHrepMultiFile :: TestTree +testHrepMultiFile = + let opts = + defaultCommonOptions + & rawRegexLens .~ "as" + & ignoreCaseLens .~ IgnoreCase + & recursiveLens .~ Recursive + & inputFilenamesLens .~ + [ "test/golden/test-files/dir1" + , "test/golden/test-files/empty-file" + , "test/golden/test-files/dir2" + ] + testName = + "`touch 'test/golden/test-files/dir2/unreadable-file' ; " <> + "chmod 0 'test/golden/test-files/dir2/unreadable-file' ; " <> + "hrep --ignore-case --recursive as " <> + "'test/golden/test-files/dir1' " <> + "'test/golden/test-files/empty-file' " <> + "'test/golden/test-files/dir2' ; " <> + "rm -rf 'test/golden/test-files/dir2/unreadable-file'`" + in testStderrAndStdout + testName + "test/golden/golden-files/hrep/multi-file" + (runHrepTest opts) + +testHrepFromStdin :: TestTree +testHrepFromStdin = + let opts = + defaultCommonOptions & rawRegexLens .~ "co." + stdinInputFile = "test/golden/test-files/file2" + testName = + "`cat '" <> stdinInputFile <> "' | hrep 'co.'`" + in testStderrAndStdout + testName + "test/golden/golden-files/hrep/from-stdin" + (go opts stdinInputFile) + where + go + :: CommonOptions + -> FilePath + -> (forall m. Monad m => Pipe Output ByteString m ()) + -> IO LByteString.ByteString + go opts stdinInputFile outputPipe = do + stdinProducer <- getFileOutputProducer stdinInputFile + runHrepTestWithStdin opts stdinProducer outputPipe diff --git a/test/golden/golden-files/highlight/from-grep.stderr b/test/golden/golden-files/highlight/from-grep.stderr new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/highlight/from-grep.stderr diff --git a/test/golden/golden-files/highlight/from-grep.stdout b/test/golden/golden-files/highlight/from-grep.stdout new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/highlight/from-grep.stdout @@ -0,0 +1,14 @@ +test/golden/test-files/dir1/file3: Brandon is a small town and civil parish in the English county of Suffolk. It +test/golden/test-files/dir1/file3: is in the Forest Heath local government district. Brandon is located in the +test/golden/test-files/dir1/file3: Breckland area on the border of Suffolk with the adjoining county of Norfolk. +test/golden/test-files/dir1/file3: Surrounded by Forestry Commission and agricultural land it is considered a +test/golden/test-files/dir1/file3: English Place Names) the likely origin of the name is "Brandon, usually 'hill +test/golden/test-files/dir1/file3: the town, gradually expanding up and along the rising ground of the river +test/golden/test-files/dir1/subdir1/file5: Laura Belém is a Brazilian artist and lecturer. Her work has been exhibited in +test/golden/test-files/dir1/subdir1/file5: Brazil, Denmark, Canada, France, Japan, Italy and the United Kingdom. Born +test/golden/test-files/dir1/subdir1/file5: Central Saint Martins College of Art and Design in London, UK in 2000. She has +test/golden/test-files/dir1/subdir1/file5: been awarded grants by bodies such as The Triangle Association in Brooklyn and +test/golden/test-files/dir1/file4: Armstrong and aka W. N. Armstrong, was the Attorney General of Hawaii during +test/golden/test-files/dir1/file4: world tour in 1881. He was born in Lahaina on the island of Maui, the third of +test/golden/test-files/dir1/file4: ten children of missionaries Clarissa Chapman Armstrong and Richard Armstrong, +test/golden/test-files/dir1/file4: who later served as the second kahu (pastor) of Kawaiahaʻo Church, and diff --git a/test/golden/golden-files/highlight/multi-file.stderr b/test/golden/golden-files/highlight/multi-file.stderr new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/highlight/multi-file.stderr @@ -0,0 +1,1 @@ +Error when trying to read file or directory "test/golden/test-files/dir2/unreadable-file" diff --git a/test/golden/golden-files/highlight/multi-file.stdout b/test/golden/golden-files/highlight/multi-file.stdout new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/highlight/multi-file.stdout @@ -0,0 +1,29 @@ +test/golden/test-files/dir1/file3: Brandon is a small town and civil parish in the English county of Suffolk. It +test/golden/test-files/dir1/file3: is in the Forest Heath local government district. Brandon is located in the +test/golden/test-files/dir1/file3: Breckland area on the border of Suffolk with the adjoining county of Norfolk. +test/golden/test-files/dir1/file3: Surrounded by Forestry Commission and agricultural land it is considered a +test/golden/test-files/dir1/file3: rural town. According to Eilert Ekwall (The Concise Oxford Dictionary of +test/golden/test-files/dir1/file3: English Place Names) the likely origin of the name is "Brandon, usually 'hill +test/golden/test-files/dir1/file3: where broom grows'", the earliest known spelling being in the 11th century when +test/golden/test-files/dir1/file3: the town, gradually expanding up and along the rising ground of the river +test/golden/test-files/dir1/file3: valley, was called Bromdun. +test/golden/test-files/dir1/file4: William Nevins Armstrong (March 10, 1835 – October 16, 1905), aka Nevins +test/golden/test-files/dir1/file4: Armstrong and aka W. N. Armstrong, was the Attorney General of Hawaii during +test/golden/test-files/dir1/file4: the reign of King David Kalākaua. He is most widely known outside of Hawaii for +test/golden/test-files/dir1/file4: the book Around the World with a King, his insider account of King Kalākaua's +test/golden/test-files/dir1/file4: world tour in 1881. He was born in Lahaina on the island of Maui, the third of +test/golden/test-files/dir1/file4: ten children of missionaries Clarissa Chapman Armstrong and Richard Armstrong, +test/golden/test-files/dir1/file4: who later served as the second kahu (pastor) of Kawaiahaʻo Church, and +test/golden/test-files/dir1/file4: subsequently was appointed President of the Board of Education for the Kingdom +test/golden/test-files/dir1/file4: of Hawaii. +test/golden/test-files/dir1/subdir1/file5: Laura Belém is a Brazilian artist and lecturer. Her work has been exhibited in +test/golden/test-files/dir1/subdir1/file5: Brazil, Denmark, Canada, France, Japan, Italy and the United Kingdom. Born +test/golden/test-files/dir1/subdir1/file5: 1974, Belo Horizonte (Brazil), Belém graduated with an MA degree in Fine Art at +test/golden/test-files/dir1/subdir1/file5: Central Saint Martins College of Art and Design in London, UK in 2000. She has +test/golden/test-files/dir1/subdir1/file5: been awarded grants by bodies such as The Triangle Association in Brooklyn and +test/golden/test-files/dir1/subdir1/file5: The Casa de Velázquez in Madrid. +test/golden/test-files/dir2/file6: Boyde may refer to: Danish orthography is the system used to write the Danish +test/golden/test-files/dir2/file6: language. The oldest preserved examples of written Danish are in the Runic +test/golden/test-files/dir2/file6: alphabet, but by the end of the High Middle Ages the Runes had mostly been +test/golden/test-files/dir2/file6: replaced by the Latin letters. Danish currently uses a 29-letter Latin-script +test/golden/test-files/dir2/file6: alphabet, identical to the Norwegian alphabet. diff --git a/test/golden/golden-files/highlight/single-file.stderr b/test/golden/golden-files/highlight/single-file.stderr new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/highlight/single-file.stderr diff --git a/test/golden/golden-files/highlight/single-file.stdout b/test/golden/golden-files/highlight/single-file.stdout new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/highlight/single-file.stdout @@ -0,0 +1,5 @@ +The parallel novel is a piece of literature written within, derived from, or +taking place during, the framework of another work of fiction by the same or +another author. Parallel novels or "reimagined classics" are works of fiction +that "borrow a character and fill in his story, mirror an 'old' plot, or blend +the characters of one book with those of another". diff --git a/test/golden/golden-files/hrep/from-stdin.stderr b/test/golden/golden-files/hrep/from-stdin.stderr new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/hrep/from-stdin.stderr diff --git a/test/golden/golden-files/hrep/from-stdin.stdout b/test/golden/golden-files/hrep/from-stdin.stdout new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/hrep/from-stdin.stdout @@ -0,0 +1,3 @@ +Proud Pour is a wine company that funds solutions to local environmental +restoration of 100 wild oysters per bottle to New York Harbor and coastal +and the Massachusetts Oyster Project. The company was founded by Berlin Crystal diff --git a/test/golden/golden-files/hrep/multi-file.stderr b/test/golden/golden-files/hrep/multi-file.stderr new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/hrep/multi-file.stderr @@ -0,0 +1,1 @@ +Error when trying to read file or directory "test/golden/test-files/dir2/unreadable-file" diff --git a/test/golden/golden-files/hrep/multi-file.stdout b/test/golden/golden-files/hrep/multi-file.stdout new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/hrep/multi-file.stdout @@ -0,0 +1,9 @@ +test/golden/test-files/dir1/file3: valley, was called Bromdun. +test/golden/test-files/dir1/file4: Armstrong and aka W. N. Armstrong, was the Attorney General of Hawaii during +test/golden/test-files/dir1/file4: world tour in 1881. He was born in Lahaina on the island of Maui, the third of +test/golden/test-files/dir1/file4: who later served as the second kahu (pastor) of Kawaiahaʻo Church, and +test/golden/test-files/dir1/file4: subsequently was appointed President of the Board of Education for the Kingdom +test/golden/test-files/dir1/subdir1/file5: Laura Belém is a Brazilian artist and lecturer. Her work has been exhibited in +test/golden/test-files/dir1/subdir1/file5: Central Saint Martins College of Art and Design in London, UK in 2000. She has +test/golden/test-files/dir1/subdir1/file5: been awarded grants by bodies such as The Triangle Association in Brooklyn and +test/golden/test-files/dir1/subdir1/file5: The Casa de Velázquez in Madrid. diff --git a/test/golden/golden-files/hrep/single-file.stderr b/test/golden/golden-files/hrep/single-file.stderr new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/hrep/single-file.stderr diff --git a/test/golden/golden-files/hrep/single-file.stdout b/test/golden/golden-files/hrep/single-file.stdout new file mode 100644 --- /dev/null +++ b/test/golden/golden-files/hrep/single-file.stdout @@ -0,0 +1,3 @@ +taking place during, the framework of another work of fiction by the same or +another author. Parallel novels or "reimagined classics" are works of fiction +the characters of one book with those of another". diff --git a/test/golden/test-files/dir1/file3 b/test/golden/test-files/dir1/file3 new file mode 100644 --- /dev/null +++ b/test/golden/test-files/dir1/file3 @@ -0,0 +1,9 @@ +Brandon is a small town and civil parish in the English county of Suffolk. It +is in the Forest Heath local government district. Brandon is located in the +Breckland area on the border of Suffolk with the adjoining county of Norfolk. +Surrounded by Forestry Commission and agricultural land it is considered a +rural town. According to Eilert Ekwall (The Concise Oxford Dictionary of +English Place Names) the likely origin of the name is "Brandon, usually 'hill +where broom grows'", the earliest known spelling being in the 11th century when +the town, gradually expanding up and along the rising ground of the river +valley, was called Bromdun. diff --git a/test/golden/test-files/dir1/file4 b/test/golden/test-files/dir1/file4 new file mode 100644 --- /dev/null +++ b/test/golden/test-files/dir1/file4 @@ -0,0 +1,9 @@ +William Nevins Armstrong (March 10, 1835 – October 16, 1905), aka Nevins +Armstrong and aka W. N. Armstrong, was the Attorney General of Hawaii during +the reign of King David Kalākaua. He is most widely known outside of Hawaii for +the book Around the World with a King, his insider account of King Kalākaua's +world tour in 1881. He was born in Lahaina on the island of Maui, the third of +ten children of missionaries Clarissa Chapman Armstrong and Richard Armstrong, +who later served as the second kahu (pastor) of Kawaiahaʻo Church, and +subsequently was appointed President of the Board of Education for the Kingdom +of Hawaii. diff --git a/test/golden/test-files/dir1/subdir1/file5 b/test/golden/test-files/dir1/subdir1/file5 new file mode 100644 --- /dev/null +++ b/test/golden/test-files/dir1/subdir1/file5 @@ -0,0 +1,6 @@ +Laura Belém is a Brazilian artist and lecturer. Her work has been exhibited in +Brazil, Denmark, Canada, France, Japan, Italy and the United Kingdom. Born +1974, Belo Horizonte (Brazil), Belém graduated with an MA degree in Fine Art at +Central Saint Martins College of Art and Design in London, UK in 2000. She has +been awarded grants by bodies such as The Triangle Association in Brooklyn and +The Casa de Velázquez in Madrid. diff --git a/test/golden/test-files/dir2/file6 b/test/golden/test-files/dir2/file6 new file mode 100644 --- /dev/null +++ b/test/golden/test-files/dir2/file6 @@ -0,0 +1,5 @@ +Boyde may refer to: Danish orthography is the system used to write the Danish +language. The oldest preserved examples of written Danish are in the Runic +alphabet, but by the end of the High Middle Ages the Runes had mostly been +replaced by the Latin letters. Danish currently uses a 29-letter Latin-script +alphabet, identical to the Norwegian alphabet. diff --git a/test/golden/test-files/empty-file b/test/golden/test-files/empty-file new file mode 100644 --- /dev/null +++ b/test/golden/test-files/empty-file diff --git a/test/golden/test-files/file1 b/test/golden/test-files/file1 new file mode 100644 --- /dev/null +++ b/test/golden/test-files/file1 @@ -0,0 +1,5 @@ +The parallel novel is a piece of literature written within, derived from, or +taking place during, the framework of another work of fiction by the same or +another author. Parallel novels or "reimagined classics" are works of fiction +that "borrow a character and fill in his story, mirror an 'old' plot, or blend +the characters of one book with those of another". diff --git a/test/golden/test-files/file2 b/test/golden/test-files/file2 new file mode 100644 --- /dev/null +++ b/test/golden/test-files/file2 @@ -0,0 +1,7 @@ +Proud Pour is a wine company that funds solutions to local environmental +problems. Their first product, a Sauvignon Blanc called "The Oyster", funds the +restoration of 100 wild oysters per bottle to New York Harbor and coastal +Massachusetts. Their first restoration partners are the Billion Oyster Project +and the Massachusetts Oyster Project. The company was founded by Berlin Crystal +Kelly in 2014 in New York City, where she was actively involved with the New +York City Homebrewers Guild. diff --git a/test/golden/test-files/from-grep b/test/golden/test-files/from-grep new file mode 100644 --- /dev/null +++ b/test/golden/test-files/from-grep @@ -0,0 +1,14 @@ +test/golden/test-files/dir1/file3:Brandon is a small town and civil parish in the English county of Suffolk. It +test/golden/test-files/dir1/file3:is in the Forest Heath local government district. Brandon is located in the +test/golden/test-files/dir1/file3:Breckland area on the border of Suffolk with the adjoining county of Norfolk. +test/golden/test-files/dir1/file3:Surrounded by Forestry Commission and agricultural land it is considered a +test/golden/test-files/dir1/file3:English Place Names) the likely origin of the name is "Brandon, usually 'hill +test/golden/test-files/dir1/file3:the town, gradually expanding up and along the rising ground of the river +test/golden/test-files/dir1/subdir1/file5:Laura Belém is a Brazilian artist and lecturer. Her work has been exhibited in +test/golden/test-files/dir1/subdir1/file5:Brazil, Denmark, Canada, France, Japan, Italy and the United Kingdom. Born +test/golden/test-files/dir1/subdir1/file5:Central Saint Martins College of Art and Design in London, UK in 2000. She has +test/golden/test-files/dir1/subdir1/file5:been awarded grants by bodies such as The Triangle Association in Brooklyn and +test/golden/test-files/dir1/file4:Armstrong and aka W. N. Armstrong, was the Attorney General of Hawaii during +test/golden/test-files/dir1/file4:world tour in 1881. He was born in Lahaina on the island of Maui, the third of +test/golden/test-files/dir1/file4:ten children of missionaries Clarissa Chapman Armstrong and Richard Armstrong, +test/golden/test-files/dir1/file4:who later served as the second kahu (pastor) of Kawaiahaʻo Church, and