{-# 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
  { FromGrepFilenameState -> Int
fromGrepFilenameStatePrevFileNum :: {-# UNPACK #-} !Int
  , FromGrepFilenameState -> Maybe ByteString
fromGrepFilenameStatePrevFilename :: !(Maybe ByteString)
  }

initFromGrepFilenameState :: FromGrepFilenameState
initFromGrepFilenameState :: FromGrepFilenameState
initFromGrepFilenameState =
  FromGrepFilenameState :: Int -> Maybe ByteString -> FromGrepFilenameState
FromGrepFilenameState
  { fromGrepFilenameStatePrevFileNum :: Int
fromGrepFilenameStatePrevFileNum = (-Int
1)
  , fromGrepFilenameStatePrevFilename :: Maybe ByteString
fromGrepFilenameStatePrevFilename = Maybe ByteString
forall a. Maybe a
Nothing
  }

-- | Call 'updateFilename' and return the new file number after doing the
-- update.
updateFilenameM :: MonadState FromGrepFilenameState m => ByteString -> m Int
updateFilenameM :: ByteString -> m Int
updateFilenameM ByteString
nextFilename = do
  (FromGrepFilenameState -> FromGrepFilenameState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FromGrepFilenameState -> FromGrepFilenameState) -> m ())
-> (FromGrepFilenameState -> FromGrepFilenameState) -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> FromGrepFilenameState -> FromGrepFilenameState
updateFilename ByteString
nextFilename
  FromGrepFilenameState Int
newFileNum Maybe ByteString
_ <- m FromGrepFilenameState
forall s (m :: * -> *). MonadState s m => m s
get
  Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
newFileNum

-- | Update the file number in 'FromGrepFilenameState' if the 'ByteString'
-- filename passed in is different from that in 'FromGrepFilenameState'.
updateFilename :: ByteString -> FromGrepFilenameState -> FromGrepFilenameState
updateFilename :: ByteString -> FromGrepFilenameState -> FromGrepFilenameState
updateFilename ByteString
nextFilename (FromGrepFilenameState Int
prevFileNum Maybe ByteString
prevFilename)
  | ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
nextFilename Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ByteString
prevFilename =
    Int -> Maybe ByteString -> FromGrepFilenameState
FromGrepFilenameState Int
prevFileNum Maybe ByteString
prevFilename
  | Bool
otherwise =
    Int -> Maybe ByteString -> FromGrepFilenameState
FromGrepFilenameState (Int
prevFileNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
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 :: Options -> HighlightM a -> IO (Either HighlightErr a)
runHighlightM Options
opts = Options
-> FromGrepFilenameState
-> HighlightM a
-> IO (Either HighlightErr a)
forall r s e a.
r -> s -> CommonHighlightM r s e a -> IO (Either e a)
runCommonHighlightM Options
opts FromGrepFilenameState
initFromGrepFilenameState

----------------------------------
-- Get value of certain options --
----------------------------------

-- | Get the value of the 'ColorGrepFilenames' option.
getColorGrepFilenamesM
  :: (HasColorGrepFilenames r, MonadReader r m) => m ColorGrepFilenames
getColorGrepFilenamesM :: m ColorGrepFilenames
getColorGrepFilenamesM = Getting ColorGrepFilenames r ColorGrepFilenames
-> m ColorGrepFilenames
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ColorGrepFilenames r ColorGrepFilenames
forall r. HasColorGrepFilenames r => Lens' r ColorGrepFilenames
colorGrepFilenamesLens