{-# 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 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 :: CommonOptions -> IO ()
run CommonOptions
opts = do
  Either HighlightErr ()
eitherRes <- CommonOptions -> HrepM () -> IO (Either HighlightErr ())
forall a. CommonOptions -> HrepM a -> IO (Either HighlightErr a)
runHrepM CommonOptions
opts HrepM ()
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 :: HrepM ()
prog :: HrepM ()
prog = do
  Producer Output HrepM ()
outputProducer <- Producer ByteString HrepM () -> HrepM (Producer Output HrepM ())
hrepOutputProducer Producer ByteString HrepM ()
forall (m :: * -> *). MonadIO m => Producer' ByteString m ()
stdinLines
  Producer Output HrepM () -> HrepM ()
forall (m :: * -> *). MonadIO m => Producer Output m () -> m ()
runOutputProducer Producer Output HrepM ()
outputProducer

hrepOutputProducer
  :: Producer ByteString HrepM ()
  -> HrepM (Producer Output HrepM ())
hrepOutputProducer :: Producer ByteString HrepM () -> HrepM (Producer Output HrepM ())
hrepOutputProducer Producer ByteString HrepM ()
stdinProducer = do
  RE
regex <- CommonHighlightM CommonOptions () HighlightErr RE
forall r s.
(HasIgnoreCase r, HasRawRegex r) =>
CommonHighlightM r s HighlightErr RE
compileHighlightRegexWithErr
  [InputFilename]
inputFilenames <- CommonHighlightM CommonOptions () HighlightErr [InputFilename]
forall r (m :: * -> *).
(HasInputFilenames r, MonadReader r m) =>
m [InputFilename]
getInputFilenamesM
  Recursive
recursive <- CommonHighlightM CommonOptions () HighlightErr Recursive
forall r (m :: * -> *).
(HasRecursive r, MonadReader r m) =>
m Recursive
getRecursiveM
  InputData HrepM ()
inputData <- Recursive
-> [InputFilename]
-> Producer ByteString HrepM ()
-> HrepM (InputData HrepM ())
forall (m :: * -> *).
MonadIO m =>
Recursive
-> [InputFilename]
-> Producer ByteString m ()
-> m (InputData m ())
createInputData Recursive
recursive [InputFilename]
inputFilenames Producer ByteString HrepM ()
stdinProducer
  let outputProducer :: Producer Output HrepM ()
outputProducer =
        (ByteString -> HrepM [ByteString])
-> (FilenameHandlingFromFiles
    -> ByteString -> Int -> ByteString -> HrepM [ByteString])
-> (ByteString
    -> IOException -> Maybe IOException -> HrepM [ByteString])
-> InputData HrepM ()
-> Producer Output HrepM ()
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 -> HrepM [ByteString]
forall (m :: * -> *). Monad m => RE -> ByteString -> m [ByteString]
handleStdinInput RE
regex)
          (RE
-> FilenameHandlingFromFiles
-> ByteString
-> Int
-> ByteString
-> HrepM [ByteString]
forall (m :: * -> *).
Monad m =>
RE
-> FilenameHandlingFromFiles
-> ByteString
-> Int
-> ByteString
-> m [ByteString]
handleFileInput RE
regex)
          ByteString
-> IOException -> Maybe IOException -> HrepM [ByteString]
forall (m :: * -> *).
Monad m =>
ByteString -> IOException -> Maybe IOException -> m [ByteString]
handleError
          InputData HrepM ()
inputData
  Producer Output HrepM () -> HrepM (Producer Output HrepM ())
forall (m :: * -> *) a. Monad m => a -> m a
return Producer Output HrepM ()
outputProducer

handleStdinInput
  :: Monad m
  => RE -> ByteString -> m [ByteString]
handleStdinInput :: RE -> ByteString -> m [ByteString]
handleStdinInput RE
regex 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

formatNormalLine :: RE -> ByteString -> [ByteString]
formatNormalLine :: RE -> ByteString -> [ByteString]
formatNormalLine RE
regex =
  Maybe ByteString -> [ByteString]
forall a. Maybe a -> [a]
maybeToList (Maybe ByteString -> [ByteString])
-> (ByteString -> Maybe ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE -> ByteString -> Maybe ByteString
highlightMatchInRed RE
regex

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

formatLineWithFilename
  :: RE -> Int -> ByteString -> ByteString -> [ByteString]
formatLineWithFilename :: RE -> Int -> ByteString -> ByteString -> [ByteString]
formatLineWithFilename RE
regex Int
fileNumber ByteString
filePath ByteString
input =
  case RE -> ByteString -> Maybe ByteString
highlightMatchInRed RE
regex ByteString
input of
    Maybe ByteString
Nothing -> []
    Just ByteString
line ->
      [ Int -> ByteString
colorForFileNumber Int
fileNumber
      , ByteString
filePath
      , ByteString
colorVividWhiteBold
      ,  ByteString
": "
      , ByteString
colorReset
      , ByteString
line
      ]

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 -> Maybe ByteString
highlightMatchInRed :: RE -> ByteString -> Maybe 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
      didMatch :: Bool
didMatch = Matches ByteString -> Bool
forall a. Matches a -> Bool
anyMatches Matches ByteString
matches
  in if Bool
didMatch
       then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Matches ByteString -> ByteString
forall a. Replace a => a -> Matches a -> a
replaceAll ByteString
replaceInRedByteString Matches ByteString
matches
       else Maybe ByteString
forall a. Maybe a
Nothing

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