{-# 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)
newtype CommonHighlightM r s e a = CommonHighlightM
{ CommonHighlightM r s e a -> ReaderT r (StateT s (ExceptT e IO)) a
unCommonHighlightM :: ReaderT r (StateT s (ExceptT e IO)) a
} deriving ( a -> CommonHighlightM r s e b -> CommonHighlightM r s e a
(a -> b) -> CommonHighlightM r s e a -> CommonHighlightM r s e b
(forall a b.
(a -> b) -> CommonHighlightM r s e a -> CommonHighlightM r s e b)
-> (forall a b.
a -> CommonHighlightM r s e b -> CommonHighlightM r s e a)
-> Functor (CommonHighlightM r s e)
forall a b.
a -> CommonHighlightM r s e b -> CommonHighlightM r s e a
forall a b.
(a -> b) -> CommonHighlightM r s e a -> CommonHighlightM r s e b
forall r s e a b.
a -> CommonHighlightM r s e b -> CommonHighlightM r s e a
forall r s e a b.
(a -> b) -> CommonHighlightM r s e a -> CommonHighlightM r s e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CommonHighlightM r s e b -> CommonHighlightM r s e a
$c<$ :: forall r s e a b.
a -> CommonHighlightM r s e b -> CommonHighlightM r s e a
fmap :: (a -> b) -> CommonHighlightM r s e a -> CommonHighlightM r s e b
$cfmap :: forall r s e a b.
(a -> b) -> CommonHighlightM r s e a -> CommonHighlightM r s e b
Functor
, Functor (CommonHighlightM r s e)
a -> CommonHighlightM r s e a
Functor (CommonHighlightM r s e)
-> (forall a. a -> CommonHighlightM r s e a)
-> (forall a b.
CommonHighlightM r s e (a -> b)
-> CommonHighlightM r s e a -> CommonHighlightM r s e b)
-> (forall a b c.
(a -> b -> c)
-> CommonHighlightM r s e a
-> CommonHighlightM r s e b
-> CommonHighlightM r s e c)
-> (forall a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b)
-> (forall a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e a)
-> Applicative (CommonHighlightM r s e)
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e a
CommonHighlightM r s e (a -> b)
-> CommonHighlightM r s e a -> CommonHighlightM r s e b
(a -> b -> c)
-> CommonHighlightM r s e a
-> CommonHighlightM r s e b
-> CommonHighlightM r s e c
forall a. a -> CommonHighlightM r s e a
forall a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e a
forall a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
forall a b.
CommonHighlightM r s e (a -> b)
-> CommonHighlightM r s e a -> CommonHighlightM r s e b
forall r s e. Functor (CommonHighlightM r s e)
forall a b c.
(a -> b -> c)
-> CommonHighlightM r s e a
-> CommonHighlightM r s e b
-> CommonHighlightM r s e c
forall r s e a. a -> CommonHighlightM r s e a
forall r s e a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e a
forall r s e a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
forall r s e a b.
CommonHighlightM r s e (a -> b)
-> CommonHighlightM r s e a -> CommonHighlightM r s e b
forall r s e a b c.
(a -> b -> c)
-> CommonHighlightM r s e a
-> CommonHighlightM r s e b
-> CommonHighlightM r s e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e a
$c<* :: forall r s e a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e a
*> :: CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
$c*> :: forall r s e a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
liftA2 :: (a -> b -> c)
-> CommonHighlightM r s e a
-> CommonHighlightM r s e b
-> CommonHighlightM r s e c
$cliftA2 :: forall r s e a b c.
(a -> b -> c)
-> CommonHighlightM r s e a
-> CommonHighlightM r s e b
-> CommonHighlightM r s e c
<*> :: CommonHighlightM r s e (a -> b)
-> CommonHighlightM r s e a -> CommonHighlightM r s e b
$c<*> :: forall r s e a b.
CommonHighlightM r s e (a -> b)
-> CommonHighlightM r s e a -> CommonHighlightM r s e b
pure :: a -> CommonHighlightM r s e a
$cpure :: forall r s e a. a -> CommonHighlightM r s e a
$cp1Applicative :: forall r s e. Functor (CommonHighlightM r s e)
Applicative
, Applicative (CommonHighlightM r s e)
a -> CommonHighlightM r s e a
Applicative (CommonHighlightM r s e)
-> (forall a b.
CommonHighlightM r s e a
-> (a -> CommonHighlightM r s e b) -> CommonHighlightM r s e b)
-> (forall a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b)
-> (forall a. a -> CommonHighlightM r s e a)
-> Monad (CommonHighlightM r s e)
CommonHighlightM r s e a
-> (a -> CommonHighlightM r s e b) -> CommonHighlightM r s e b
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
forall a. a -> CommonHighlightM r s e a
forall a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
forall a b.
CommonHighlightM r s e a
-> (a -> CommonHighlightM r s e b) -> CommonHighlightM r s e b
forall r s e. Applicative (CommonHighlightM r s e)
forall r s e a. a -> CommonHighlightM r s e a
forall r s e a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
forall r s e a b.
CommonHighlightM r s e a
-> (a -> CommonHighlightM r s e b) -> CommonHighlightM r s e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CommonHighlightM r s e a
$creturn :: forall r s e a. a -> CommonHighlightM r s e a
>> :: CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
$c>> :: forall r s e a b.
CommonHighlightM r s e a
-> CommonHighlightM r s e b -> CommonHighlightM r s e b
>>= :: CommonHighlightM r s e a
-> (a -> CommonHighlightM r s e b) -> CommonHighlightM r s e b
$c>>= :: forall r s e a b.
CommonHighlightM r s e a
-> (a -> CommonHighlightM r s e b) -> CommonHighlightM r s e b
$cp1Monad :: forall r s e. Applicative (CommonHighlightM r s e)
Monad
, MonadError e
, Monad (CommonHighlightM r s e)
Monad (CommonHighlightM r s e)
-> (forall a. IO a -> CommonHighlightM r s e a)
-> MonadIO (CommonHighlightM r s e)
IO a -> CommonHighlightM r s e a
forall a. IO a -> CommonHighlightM r s e a
forall r s e. Monad (CommonHighlightM r s e)
forall r s e a. IO a -> CommonHighlightM r s e a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> CommonHighlightM r s e a
$cliftIO :: forall r s e a. IO a -> CommonHighlightM r s e a
$cp1MonadIO :: forall r s e. Monad (CommonHighlightM r s e)
MonadIO
, MonadReader r
, MonadState s
)
runCommonHighlightM :: r -> s -> CommonHighlightM r s e a -> IO (Either e a)
runCommonHighlightM :: r -> s -> CommonHighlightM r s e a -> IO (Either e a)
runCommonHighlightM r
r s
s =
ExceptT e IO a -> IO (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e IO a -> IO (Either e a))
-> (CommonHighlightM r s e a -> ExceptT e IO a)
-> CommonHighlightM r s e a
-> IO (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(StateT s (ExceptT e IO) a -> s -> ExceptT e IO a)
-> s -> StateT s (ExceptT e IO) a -> ExceptT e IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT s (ExceptT e IO) a -> s -> ExceptT e IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT s
s (StateT s (ExceptT e IO) a -> ExceptT e IO a)
-> (CommonHighlightM r s e a -> StateT s (ExceptT e IO) a)
-> CommonHighlightM r s e a
-> ExceptT e IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(ReaderT r (StateT s (ExceptT e IO)) a
-> r -> StateT s (ExceptT e IO) a)
-> r
-> ReaderT r (StateT s (ExceptT e IO)) a
-> StateT s (ExceptT e IO) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r (StateT s (ExceptT e IO)) a
-> r -> StateT s (ExceptT e IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT r
r (ReaderT r (StateT s (ExceptT e IO)) a
-> StateT s (ExceptT e IO) a)
-> (CommonHighlightM r s e a
-> ReaderT r (StateT s (ExceptT e IO)) a)
-> CommonHighlightM r s e a
-> StateT s (ExceptT e IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
CommonHighlightM r s e a -> ReaderT r (StateT s (ExceptT e IO)) a
forall r s e a.
CommonHighlightM r s e a -> ReaderT r (StateT s (ExceptT e IO)) a
unCommonHighlightM
getIgnoreCaseM :: (HasIgnoreCase r, MonadReader r m) => m IgnoreCase
getIgnoreCaseM :: m IgnoreCase
getIgnoreCaseM = Getting IgnoreCase r IgnoreCase -> m IgnoreCase
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IgnoreCase r IgnoreCase
forall r. HasIgnoreCase r => Lens' r IgnoreCase
ignoreCaseLens
getRecursiveM :: (HasRecursive r, MonadReader r m) => m Recursive
getRecursiveM :: m Recursive
getRecursiveM = Getting Recursive r Recursive -> m Recursive
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Recursive r Recursive
forall r. HasRecursive r => Lens' r Recursive
recursiveLens
getRawRegexM :: (HasRawRegex r, MonadReader r m) => m RawRegex
getRawRegexM :: m RawRegex
getRawRegexM = Getting RawRegex r RawRegex -> m RawRegex
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting RawRegex r RawRegex
forall r. HasRawRegex r => Lens' r RawRegex
rawRegexLens
getInputFilenamesM
:: (HasInputFilenames r, MonadReader r m) => m [InputFilename]
getInputFilenamesM :: m [InputFilename]
getInputFilenamesM = Getting [InputFilename] r [InputFilename] -> m [InputFilename]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [InputFilename] r [InputFilename]
forall r. HasInputFilenames r => Lens' r [InputFilename]
inputFilenamesLens
throwHighlightErr :: HighlightErr -> CommonHighlightM r s HighlightErr a
throwHighlightErr :: HighlightErr -> CommonHighlightM r s HighlightErr a
throwHighlightErr = HighlightErr -> CommonHighlightM r s HighlightErr a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
throwRegexCompileErr :: RawRegex -> CommonHighlightM r s HighlightErr a
throwRegexCompileErr :: RawRegex -> CommonHighlightM r s HighlightErr a
throwRegexCompileErr = HighlightErr -> CommonHighlightM r s HighlightErr a
forall r s a. HighlightErr -> CommonHighlightM r s HighlightErr a
throwHighlightErr (HighlightErr -> CommonHighlightM r s HighlightErr a)
-> (RawRegex -> HighlightErr)
-> RawRegex
-> CommonHighlightM r s HighlightErr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawRegex -> HighlightErr
HighlightRegexCompileErr
compileHighlightRegexWithErr
:: (HasIgnoreCase r, HasRawRegex r)
=> CommonHighlightM r s HighlightErr RE
compileHighlightRegexWithErr :: CommonHighlightM r s HighlightErr RE
compileHighlightRegexWithErr = do
IgnoreCase
ignoreCase <- CommonHighlightM r s HighlightErr IgnoreCase
forall r (m :: * -> *).
(HasIgnoreCase r, MonadReader r m) =>
m IgnoreCase
getIgnoreCaseM
RawRegex
rawRegex <- CommonHighlightM r s HighlightErr RawRegex
forall r (m :: * -> *).
(HasRawRegex r, MonadReader r m) =>
m RawRegex
getRawRegexM
case IgnoreCase -> RawRegex -> Maybe RE
compileHighlightRegex IgnoreCase
ignoreCase RawRegex
rawRegex of
Just RE
re -> RE -> CommonHighlightM r s HighlightErr RE
forall (m :: * -> *) a. Monad m => a -> m a
return RE
re
Maybe RE
Nothing -> RawRegex -> CommonHighlightM r s HighlightErr RE
forall r s a. RawRegex -> CommonHighlightM r s HighlightErr a
throwRegexCompileErr RawRegex
rawRegex
compileHighlightRegex :: IgnoreCase -> RawRegex -> Maybe RE
compileHighlightRegex :: IgnoreCase -> RawRegex -> Maybe RE
compileHighlightRegex IgnoreCase
ignoreCase (RawRegex String
rawRegex) =
let simpleREOptions :: SimpleREOptions
simpleREOptions =
case IgnoreCase
ignoreCase of
IgnoreCase
IgnoreCase -> SimpleREOptions
MultilineInsensitive
IgnoreCase
DoNotIgnoreCase -> SimpleREOptions
MultilineSensitive
in SimpleREOptions -> String -> Maybe RE
forall (m :: * -> *).
(Functor m, Monad m, MonadFail m) =>
SimpleREOptions -> String -> m RE
compileRegexWith SimpleREOptions
simpleREOptions String
rawRegex