{-# 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 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 :: Options -> IO ()
run Options
opts = do
  Either HighlightErr ()
eitherRes <- Options -> HighlightM () -> IO (Either HighlightErr ())
forall a. Options -> HighlightM a -> IO (Either HighlightErr a)
runHighlightM Options
opts HighlightM ()
prog
  (HighlightErr -> IO ())
-> (() -> IO ()) -> Either HighlightErr () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HighlightErr -> IO ()
forall a. HighlightErr -> IO a
handleErr () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return Either HighlightErr ()
eitherRes

prog :: HighlightM ()
prog :: HighlightM ()
prog = do
  Producer Output HighlightM ()
outputProducer <- Producer ByteString HighlightM ()
-> HighlightM (Producer Output HighlightM ())
highlightOutputProducer Producer ByteString HighlightM ()
forall (m :: * -> *). MonadIO m => Producer' ByteString m ()
stdinLines
  Producer Output HighlightM () -> HighlightM ()
forall (m :: * -> *). MonadIO m => Producer Output m () -> m ()
runOutputProducer Producer Output HighlightM ()
outputProducer

highlightOutputProducer
  :: Producer ByteString HighlightM ()
  -> HighlightM (Producer Output HighlightM ())
highlightOutputProducer :: Producer ByteString HighlightM ()
-> HighlightM (Producer Output HighlightM ())
highlightOutputProducer Producer ByteString HighlightM ()
stdinProducer = do
  RE
regex <- CommonHighlightM Options FromGrepFilenameState HighlightErr RE
forall r s.
(HasIgnoreCase r, HasRawRegex r) =>
CommonHighlightM r s HighlightErr RE
compileHighlightRegexWithErr
  [InputFilename]
inputFilenames <- CommonHighlightM
  Options FromGrepFilenameState HighlightErr [InputFilename]
forall r (m :: * -> *).
(HasInputFilenames r, MonadReader r m) =>
m [InputFilename]
getInputFilenamesM
  Recursive
recursive <- CommonHighlightM
  Options FromGrepFilenameState HighlightErr Recursive
forall r (m :: * -> *).
(HasRecursive r, MonadReader r m) =>
m Recursive
getRecursiveM
  InputData HighlightM ()
inputData <- Recursive
-> [InputFilename]
-> Producer ByteString HighlightM ()
-> HighlightM (InputData HighlightM ())
forall (m :: * -> *).
MonadIO m =>
Recursive
-> [InputFilename]
-> Producer ByteString m ()
-> m (InputData m ())
createInputData Recursive
recursive [InputFilename]
inputFilenames Producer ByteString HighlightM ()
stdinProducer
  let outputProducer :: Producer Output HighlightM ()
outputProducer =
        (ByteString -> HighlightM [ByteString])
-> (FilenameHandlingFromFiles
    -> ByteString -> Int -> ByteString -> HighlightM [ByteString])
-> (ByteString
    -> IOException -> Maybe IOException -> HighlightM [ByteString])
-> InputData HighlightM ()
-> Producer Output HighlightM ()
forall (m :: * -> *).
MonadIO m =>
(ByteString -> m [ByteString])
-> (FilenameHandlingFromFiles
    -> ByteString -> Int -> ByteString -> m [ByteString])
-> (ByteString
    -> IOException -> Maybe IOException -> m [ByteString])
-> InputData m ()
-> Producer Output m ()
handleInputData
          (RE -> ByteString -> HighlightM [ByteString]
forall r (m :: * -> *).
(HasColorGrepFilenames r, MonadState FromGrepFilenameState m,
 MonadReader r m) =>
RE -> ByteString -> m [ByteString]
handleStdinInput RE
regex)
          (RE
-> FilenameHandlingFromFiles
-> ByteString
-> Int
-> ByteString
-> HighlightM [ByteString]
forall (m :: * -> *).
Monad m =>
RE
-> FilenameHandlingFromFiles
-> ByteString
-> Int
-> ByteString
-> m [ByteString]
handleFileInput RE
regex)
          ByteString
-> IOException -> Maybe IOException -> HighlightM [ByteString]
forall (m :: * -> *).
Monad m =>
ByteString -> IOException -> Maybe IOException -> m [ByteString]
handleError
          InputData HighlightM ()
inputData
  Producer Output HighlightM ()
-> HighlightM (Producer Output HighlightM ())
forall (m :: * -> *) a. Monad m => a -> m a
return Producer Output HighlightM ()
outputProducer

handleStdinInput
  :: ( HasColorGrepFilenames r
     , MonadState FromGrepFilenameState m
     , MonadReader r m
     )
  => RE -> ByteString -> m [ByteString]
handleStdinInput :: RE -> ByteString -> m [ByteString]
handleStdinInput RE
regex ByteString
input = do
  ColorGrepFilenames
colorGrepFilenames <- m ColorGrepFilenames
forall r (m :: * -> *).
(HasColorGrepFilenames r, MonadReader r m) =>
m ColorGrepFilenames
getColorGrepFilenamesM
  case ColorGrepFilenames
colorGrepFilenames of
    ColorGrepFilenames
DoNotColorGrepFileNames -> [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ RE -> ByteString -> [ByteString]
formatNormalLine RE
regex ByteString
input
    ColorGrepFilenames
ColorGrepFilenames -> do
      let (ByteString
beforeColon, ByteString
colonAndAfter) =
            (Char -> Bool) -> ByteString -> (ByteString, ByteString)
Data.ByteString.Char8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') ByteString
input
      if ByteString
colonAndAfter ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
empty
        then [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ RE -> ByteString -> [ByteString]
formatNormalLine RE
regex ByteString
input
        else do
          let filePath :: ByteString
filePath = ByteString
beforeColon
              lineWithoutColon :: ByteString
lineWithoutColon = Int -> ByteString -> ByteString
Data.ByteString.Char8.drop Int
1 ByteString
colonAndAfter
          Int
fileNumber <- ByteString -> m Int
forall (m :: * -> *).
MonadState FromGrepFilenameState m =>
ByteString -> m Int
updateFilenameM ByteString
filePath
          [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$
            RE -> Int -> ByteString -> ByteString -> [ByteString]
formatLineWithFilename RE
regex Int
fileNumber ByteString
filePath ByteString
lineWithoutColon

formatLineWithFilename
  :: RE -> Int -> ByteString -> ByteString -> [ByteString]
formatLineWithFilename :: RE -> Int -> ByteString -> ByteString -> [ByteString]
formatLineWithFilename RE
regex Int
fileNumber ByteString
filePath ByteString
input =
  [ Int -> ByteString
colorForFileNumber Int
fileNumber
  , ByteString
filePath
  , ByteString
colorVividWhiteBold
  ,  ByteString
": "
  , ByteString
colorReset
  , RE -> ByteString -> ByteString
highlightMatchInRed RE
regex ByteString
input
  ]

formatNormalLine :: RE -> ByteString -> [ByteString]
formatNormalLine :: RE -> ByteString -> [ByteString]
formatNormalLine RE
regex ByteString
input =
  [RE -> ByteString -> ByteString
highlightMatchInRed RE
regex ByteString
input]

handleFileInput
  :: Monad m
  => RE
  -> FilenameHandlingFromFiles
  -> ByteString
  -> Int
  -> ByteString
  -> m [ByteString]
handleFileInput :: RE
-> FilenameHandlingFromFiles
-> ByteString
-> Int
-> ByteString
-> m [ByteString]
handleFileInput RE
regex FilenameHandlingFromFiles
NoFilename ByteString
_ Int
_ ByteString
input =
  [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ RE -> ByteString -> [ByteString]
formatNormalLine RE
regex ByteString
input
handleFileInput RE
regex FilenameHandlingFromFiles
PrintFilename ByteString
filePath Int
fileNumber ByteString
input =
  [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ RE -> Int -> ByteString -> ByteString -> [ByteString]
formatLineWithFilename RE
regex Int
fileNumber ByteString
filePath ByteString
input

handleError
  :: Monad m
  => ByteString -> IOException -> Maybe IOException -> m [ByteString]
handleError :: ByteString -> IOException -> Maybe IOException -> m [ByteString]
handleError ByteString
filePath IOException
_ (Just IOException
_) =
  [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
"Error when trying to read file or directory \"", ByteString
filePath , ByteString
"\""]
handleError ByteString
filePath IOException
_ Maybe IOException
Nothing =
  [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
"Error when trying to read file \"", ByteString
filePath , ByteString
"\""]

highlightMatchInRed :: RE -> ByteString -> ByteString
highlightMatchInRed :: RE -> ByteString -> ByteString
highlightMatchInRed RE
regex ByteString
input =
  let matches :: Matches ByteString
matches = ByteString
input ByteString -> RE -> Matches ByteString
forall s. IsRegex RE s => s -> RE -> Matches s
*=~ RE
regex
  in ByteString -> Matches ByteString -> ByteString
forall a. Replace a => a -> Matches a -> a
replaceAll ByteString
replaceInRedByteString Matches ByteString
matches

replaceInRedByteString :: ByteString
replaceInRedByteString :: ByteString
replaceInRedByteString = ByteString
colorVividRedBold ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"$0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
colorReset