{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Ormolu.Parser
( parseModule,
manualExts,
)
where
import Control.Exception
import Control.Monad.Except
import Data.Functor
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import Data.Ord (Down (Down))
import GHC.Data.Bag (bagToList)
import qualified GHC.Data.EnumSet as EnumSet
import qualified GHC.Data.FastString as GHC
import qualified GHC.Data.StringBuffer as GHC
import qualified GHC.Driver.CmdLine as GHC
import GHC.Driver.Session as GHC
import qualified GHC.Driver.Types as GHC
import GHC.DynFlags (baseDynFlags)
import GHC.LanguageExtensions.Type (Extension (..))
import qualified GHC.Parser as GHC
import qualified GHC.Parser.Header as GHC
import qualified GHC.Parser.Lexer as GHC
import GHC.Types.SrcLoc
import GHC.Unit.Module.Name
import GHC.Utils.Error (Severity (..), errMsgSeverity, errMsgSpan)
import qualified GHC.Utils.Panic as GHC
import Ormolu.Config
import Ormolu.Exception
import Ormolu.Parser.Anns
import Ormolu.Parser.CommentStream
import Ormolu.Parser.Result
import Ormolu.Processing.Common
import Ormolu.Processing.Preprocess
import Ormolu.Utils (incSpanLine)
parseModule ::
MonadIO m =>
Config RegionDeltas ->
FilePath ->
String ->
m
( [GHC.Warn],
Either (SrcSpan, String) [SourceSnippet]
)
parseModule :: forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> String
-> String
-> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
parseModule config :: Config RegionDeltas
config@Config {Bool
[DynOption]
ColorMode
RegionDeltas
cfgRegion :: forall region. Config region -> region
cfgColorMode :: forall region. Config region -> ColorMode
cfgCheckIdempotence :: forall region. Config region -> Bool
cfgDebug :: forall region. Config region -> Bool
cfgUnsafe :: forall region. Config region -> Bool
cfgDynOptions :: forall region. Config region -> [DynOption]
cfgRegion :: RegionDeltas
cfgColorMode :: ColorMode
cfgCheckIdempotence :: Bool
cfgDebug :: Bool
cfgUnsafe :: Bool
cfgDynOptions :: [DynOption]
..} String
path String
rawInput = IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
-> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
-> m ([Warn], Either (SrcSpan, String) [SourceSnippet]))
-> IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
-> m ([Warn], Either (SrcSpan, String) [SourceSnippet])
forall a b. (a -> b) -> a -> b
$ do
let baseFlags :: DynFlags
baseFlags =
GeneralFlag -> DynFlags -> DynFlags
GHC.setGeneralFlag'
GeneralFlag
GHC.Opt_Haddock
(DynFlags -> DynFlags
setDefaultExts DynFlags
baseDynFlags)
extraOpts :: [Located String]
extraOpts = DynOption -> Located String
dynOptionToLocatedStr (DynOption -> Located String) -> [DynOption] -> [Located String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DynOption]
cfgDynOptions
([Warn]
warnings, DynFlags
dynFlags) <-
DynFlags
-> [Located String]
-> String
-> String
-> IO (Either String ([Warn], DynFlags))
parsePragmasIntoDynFlags DynFlags
baseFlags [Located String]
extraOpts String
path String
rawInput IO (Either String ([Warn], DynFlags))
-> (Either String ([Warn], DynFlags) -> IO ([Warn], DynFlags))
-> IO ([Warn], DynFlags)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right ([Warn], DynFlags)
res -> ([Warn], DynFlags) -> IO ([Warn], DynFlags)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Warn], DynFlags)
res
Left String
err ->
let loc :: SrcSpan
loc =
SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan
(FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
GHC.mkFastString String
path) Int
1 Int
1)
(FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
GHC.mkFastString String
path) Int
1 Int
1)
in OrmoluException -> IO ([Warn], DynFlags)
forall e a. Exception e => e -> IO a
throwIO (SrcSpan -> String -> OrmoluException
OrmoluParsingFailed SrcSpan
loc String
err)
let cppEnabled :: Bool
cppEnabled = Extension -> EnumSet Extension -> Bool
forall a. Enum a => a -> EnumSet a -> Bool
EnumSet.member Extension
Cpp (DynFlags -> EnumSet Extension
GHC.extensionFlags DynFlags
dynFlags)
Either (SrcSpan, String) [SourceSnippet]
snippets <- ExceptT (SrcSpan, String) IO [SourceSnippet]
-> IO (Either (SrcSpan, String) [SourceSnippet])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (SrcSpan, String) IO [SourceSnippet]
-> IO (Either (SrcSpan, String) [SourceSnippet]))
-> ((Either Text RegionDeltas
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> ExceptT (SrcSpan, String) IO [SourceSnippet])
-> (Either Text RegionDeltas
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> IO (Either (SrcSpan, String) [SourceSnippet])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either Text RegionDeltas]
-> (Either Text RegionDeltas
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> ExceptT (SrcSpan, String) IO [SourceSnippet]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Bool -> RegionDeltas -> String -> [Either Text RegionDeltas]
preprocess Bool
cppEnabled RegionDeltas
cfgRegion String
rawInput) ((Either Text RegionDeltas
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> IO (Either (SrcSpan, String) [SourceSnippet]))
-> (Either Text RegionDeltas
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> IO (Either (SrcSpan, String) [SourceSnippet])
forall a b. (a -> b) -> a -> b
$ \case
Right RegionDeltas
region ->
(ParseResult -> SourceSnippet)
-> ExceptT (SrcSpan, String) IO ParseResult
-> ExceptT (SrcSpan, String) IO SourceSnippet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseResult -> SourceSnippet
ParsedSnippet (ExceptT (SrcSpan, String) IO ParseResult
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> (IO (Either (SrcSpan, String) ParseResult)
-> ExceptT (SrcSpan, String) IO ParseResult)
-> IO (Either (SrcSpan, String) ParseResult)
-> ExceptT (SrcSpan, String) IO SourceSnippet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (SrcSpan, String) ParseResult)
-> ExceptT (SrcSpan, String) IO ParseResult
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either (SrcSpan, String) ParseResult)
-> ExceptT (SrcSpan, String) IO SourceSnippet)
-> IO (Either (SrcSpan, String) ParseResult)
-> ExceptT (SrcSpan, String) IO SourceSnippet
forall a b. (a -> b) -> a -> b
$
Config RegionDeltas
-> DynFlags
-> String
-> String
-> IO (Either (SrcSpan, String) ParseResult)
forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> DynFlags
-> String
-> String
-> m (Either (SrcSpan, String) ParseResult)
parseModuleSnippet (Config RegionDeltas
config Config RegionDeltas -> RegionDeltas -> Config RegionDeltas
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionDeltas
region) DynFlags
dynFlags String
path String
rawInput
Left Text
raw -> SourceSnippet -> ExceptT (SrcSpan, String) IO SourceSnippet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SourceSnippet -> ExceptT (SrcSpan, String) IO SourceSnippet)
-> SourceSnippet -> ExceptT (SrcSpan, String) IO SourceSnippet
forall a b. (a -> b) -> a -> b
$ Text -> SourceSnippet
RawSnippet Text
raw
([Warn], Either (SrcSpan, String) [SourceSnippet])
-> IO ([Warn], Either (SrcSpan, String) [SourceSnippet])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Warn]
warnings, Either (SrcSpan, String) [SourceSnippet]
snippets)
parseModuleSnippet ::
MonadIO m =>
Config RegionDeltas ->
DynFlags ->
FilePath ->
String ->
m (Either (SrcSpan, String) ParseResult)
parseModuleSnippet :: forall (m :: * -> *).
MonadIO m =>
Config RegionDeltas
-> DynFlags
-> String
-> String
-> m (Either (SrcSpan, String) ParseResult)
parseModuleSnippet Config {Bool
[DynOption]
ColorMode
RegionDeltas
cfgRegion :: RegionDeltas
cfgColorMode :: ColorMode
cfgCheckIdempotence :: Bool
cfgDebug :: Bool
cfgUnsafe :: Bool
cfgDynOptions :: [DynOption]
cfgRegion :: forall region. Config region -> region
cfgColorMode :: forall region. Config region -> ColorMode
cfgCheckIdempotence :: forall region. Config region -> Bool
cfgDebug :: forall region. Config region -> Bool
cfgUnsafe :: forall region. Config region -> Bool
cfgDynOptions :: forall region. Config region -> [DynOption]
..} DynFlags
dynFlags String
path String
rawInput = IO (Either (SrcSpan, String) ParseResult)
-> m (Either (SrcSpan, String) ParseResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (SrcSpan, String) ParseResult)
-> m (Either (SrcSpan, String) ParseResult))
-> IO (Either (SrcSpan, String) ParseResult)
-> m (Either (SrcSpan, String) ParseResult)
forall a b. (a -> b) -> a -> b
$ do
let (String
input, Int
indent) = String -> (String, Int)
removeIndentation (String -> (String, Int))
-> (String -> String) -> String -> (String, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegionDeltas -> String -> String
linesInRegion RegionDeltas
cfgRegion (String -> (String, Int)) -> String -> (String, Int)
forall a b. (a -> b) -> a -> b
$ String
rawInput
let useRecordDot :: Bool
useRecordDot =
String
"record-dot-preprocessor" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== DynFlags -> String
pgm_F DynFlags
dynFlags
Bool -> Bool -> Bool
|| (ModuleName -> Bool) -> [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
((String
"RecordDotPreprocessor" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (ModuleName -> String) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString)
(DynFlags -> [ModuleName]
pluginModNames DynFlags
dynFlags)
pStateErrors :: PState -> Maybe (SrcSpan, String)
pStateErrors = \PState
pstate ->
let errs :: [ErrMsg]
errs = Bag ErrMsg -> [ErrMsg]
forall a. Bag a -> [a]
bagToList (Bag ErrMsg -> [ErrMsg]) -> Bag ErrMsg -> [ErrMsg]
forall a b. (a -> b) -> a -> b
$ PState -> DynFlags -> Bag ErrMsg
GHC.getErrorMessages PState
pstate DynFlags
dynFlags
fixupErrSpan :: SrcSpan -> SrcSpan
fixupErrSpan = Int -> SrcSpan -> SrcSpan
incSpanLine (RegionDeltas -> Int
regionPrefixLength RegionDeltas
cfgRegion)
in case (ErrMsg -> Down SeverityOrd) -> [ErrMsg] -> [ErrMsg]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (SeverityOrd -> Down SeverityOrd
forall a. a -> Down a
Down (SeverityOrd -> Down SeverityOrd)
-> (ErrMsg -> SeverityOrd) -> ErrMsg -> Down SeverityOrd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> SeverityOrd
SeverityOrd (Severity -> SeverityOrd)
-> (ErrMsg -> Severity) -> ErrMsg -> SeverityOrd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrMsg -> Severity
errMsgSeverity) [ErrMsg]
errs of
[] -> Maybe (SrcSpan, String)
forall a. Maybe a
Nothing
ErrMsg
err : [ErrMsg]
_ ->
(SrcSpan, String) -> Maybe (SrcSpan, String)
forall a. a -> Maybe a
Just (SrcSpan -> SrcSpan
fixupErrSpan (ErrMsg -> SrcSpan
errMsgSpan ErrMsg
err), ErrMsg -> String
forall a. Show a => a -> String
show ErrMsg
err)
r :: Either (SrcSpan, String) ParseResult
r = case P (Located HsModule)
-> DynFlags -> String -> String -> ParseResult (Located HsModule)
forall a. P a -> DynFlags -> String -> String -> ParseResult a
runParser P (Located HsModule)
GHC.parseModule DynFlags
dynFlags String
path String
input of
GHC.PFailed PState
pstate ->
case PState -> Maybe (SrcSpan, String)
pStateErrors PState
pstate of
Just (SrcSpan, String)
err -> (SrcSpan, String) -> Either (SrcSpan, String) ParseResult
forall a b. a -> Either a b
Left (SrcSpan, String)
err
Maybe (SrcSpan, String)
Nothing -> String -> Either (SrcSpan, String) ParseResult
forall a. HasCallStack => String -> a
error String
"PFailed does not have an error"
GHC.POk PState
pstate (L SrcSpan
_ HsModule
hsModule) ->
case PState -> Maybe (SrcSpan, String)
pStateErrors PState
pstate of
Just (SrcSpan, String)
err -> (SrcSpan, String) -> Either (SrcSpan, String) ParseResult
forall a b. a -> Either a b
Left (SrcSpan, String)
err
Maybe (SrcSpan, String)
Nothing ->
let (Maybe (RealLocated Comment)
stackHeader, [([RealLocated Comment], Pragma)]
pragmas, CommentStream
comments) =
String
-> PState
-> HsModule
-> (Maybe (RealLocated Comment), [([RealLocated Comment], Pragma)],
CommentStream)
mkCommentStream String
input PState
pstate HsModule
hsModule
in ParseResult -> Either (SrcSpan, String) ParseResult
forall a b. b -> Either a b
Right
ParseResult :: HsModule
-> Anns
-> Maybe (RealLocated Comment)
-> [([RealLocated Comment], Pragma)]
-> CommentStream
-> Bool
-> EnumSet Extension
-> Int
-> ParseResult
ParseResult
{ prParsedSource :: HsModule
prParsedSource = HsModule
hsModule,
prAnns :: Anns
prAnns = PState -> Anns
mkAnns PState
pstate,
prStackHeader :: Maybe (RealLocated Comment)
prStackHeader = Maybe (RealLocated Comment)
stackHeader,
prPragmas :: [([RealLocated Comment], Pragma)]
prPragmas = [([RealLocated Comment], Pragma)]
pragmas,
prCommentStream :: CommentStream
prCommentStream = CommentStream
comments,
prUseRecordDot :: Bool
prUseRecordDot = Bool
useRecordDot,
prExtensions :: EnumSet Extension
prExtensions = DynFlags -> EnumSet Extension
GHC.extensionFlags DynFlags
dynFlags,
prIndent :: Int
prIndent = Int
indent
}
Either (SrcSpan, String) ParseResult
-> IO (Either (SrcSpan, String) ParseResult)
forall (m :: * -> *) a. Monad m => a -> m a
return Either (SrcSpan, String) ParseResult
r
setDefaultExts :: DynFlags -> DynFlags
setDefaultExts :: DynFlags -> DynFlags
setDefaultExts DynFlags
flags = (DynFlags -> Extension -> DynFlags)
-> DynFlags -> [Extension] -> DynFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' DynFlags -> Extension -> DynFlags
xopt_set DynFlags
flags [Extension]
autoExts
where
autoExts :: [Extension]
autoExts = [Extension]
allExts [Extension] -> [Extension] -> [Extension]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Extension]
manualExts
allExts :: [Extension]
allExts = [Extension
forall a. Bounded a => a
minBound .. Extension
forall a. Bounded a => a
maxBound]
manualExts :: [Extension]
manualExts :: [Extension]
manualExts =
[ Extension
Arrows,
Extension
Cpp,
Extension
BangPatterns,
Extension
PatternSynonyms,
Extension
RecursiveDo,
Extension
StaticPointers,
Extension
TransformListComp,
Extension
UnboxedTuples,
Extension
MagicHash,
Extension
AlternativeLayoutRule,
Extension
AlternativeLayoutRuleTransitional,
Extension
MonadComprehensions,
Extension
UnboxedSums,
Extension
UnicodeSyntax,
Extension
TemplateHaskell,
Extension
TemplateHaskellQuotes,
Extension
ImportQualifiedPost,
Extension
NegativeLiterals,
Extension
LexicalNegation,
Extension
LinearTypes
]
runParser ::
GHC.P a ->
GHC.DynFlags ->
FilePath ->
String ->
GHC.ParseResult a
runParser :: forall a. P a -> DynFlags -> String -> String -> ParseResult a
runParser P a
parser DynFlags
flags String
filename String
input = P a -> PState -> ParseResult a
forall a. P a -> PState -> ParseResult a
GHC.unP P a
parser PState
parseState
where
location :: RealSrcLoc
location = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
GHC.mkFastString String
filename) Int
1 Int
1
buffer :: StringBuffer
buffer = String -> StringBuffer
GHC.stringToStringBuffer String
input
parseState :: PState
parseState = DynFlags -> StringBuffer -> RealSrcLoc -> PState
GHC.mkPState DynFlags
flags StringBuffer
buffer RealSrcLoc
location
newtype SeverityOrd = SeverityOrd Severity
instance Eq SeverityOrd where
SeverityOrd
s1 == :: SeverityOrd -> SeverityOrd -> Bool
== SeverityOrd
s2 = SeverityOrd -> SeverityOrd -> Ordering
forall a. Ord a => a -> a -> Ordering
compare SeverityOrd
s1 SeverityOrd
s2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord SeverityOrd where
compare :: SeverityOrd -> SeverityOrd -> Ordering
compare (SeverityOrd Severity
s1) (SeverityOrd Severity
s2) =
Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Severity -> Int
f Severity
s1) (Severity -> Int
f Severity
s2)
where
f :: Severity -> Int
f :: Severity -> Int
f Severity
SevOutput = Int
1
f Severity
SevFatal = Int
2
f Severity
SevInteractive = Int
3
f Severity
SevDump = Int
4
f Severity
SevInfo = Int
5
f Severity
SevWarning = Int
6
f Severity
SevError = Int
7
parsePragmasIntoDynFlags ::
DynFlags ->
[Located String] ->
FilePath ->
String ->
IO (Either String ([GHC.Warn], DynFlags))
parsePragmasIntoDynFlags :: DynFlags
-> [Located String]
-> String
-> String
-> IO (Either String ([Warn], DynFlags))
parsePragmasIntoDynFlags DynFlags
flags [Located String]
extraOpts String
filepath String
str =
IO (Either String ([Warn], DynFlags))
-> IO (Either String ([Warn], DynFlags))
forall {m :: * -> *} {b}.
(MonadMask m, MonadIO m) =>
m (Either String b) -> m (Either String b)
catchErrors (IO (Either String ([Warn], DynFlags))
-> IO (Either String ([Warn], DynFlags)))
-> IO (Either String ([Warn], DynFlags))
-> IO (Either String ([Warn], DynFlags))
forall a b. (a -> b) -> a -> b
$ do
let fileOpts :: [Located String]
fileOpts = DynFlags -> StringBuffer -> String -> [Located String]
GHC.getOptions DynFlags
flags (String -> StringBuffer
GHC.stringToStringBuffer String
str) String
filepath
(DynFlags
flags', [Located String]
leftovers, [Warn]
warnings) <-
DynFlags
-> [Located String] -> IO (DynFlags, [Located String], [Warn])
forall (m :: * -> *).
MonadIO m =>
DynFlags
-> [Located String] -> m (DynFlags, [Located String], [Warn])
parseDynamicFilePragma DynFlags
flags ([Located String]
extraOpts [Located String] -> [Located String] -> [Located String]
forall a. Semigroup a => a -> a -> a
<> [Located String]
fileOpts)
case [Located String] -> Maybe (NonEmpty (Located String))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Located String]
leftovers of
Maybe (NonEmpty (Located String))
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just NonEmpty (Located String)
unrecognizedOpts ->
OrmoluException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (NonEmpty String -> OrmoluException
OrmoluUnrecognizedOpts (Located String -> String
forall l e. GenLocated l e -> e
unLoc (Located String -> String)
-> NonEmpty (Located String) -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Located String)
unrecognizedOpts))
let flags'' :: DynFlags
flags'' = DynFlags
flags' DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_KeepRawTokenStream
Either String ([Warn], DynFlags)
-> IO (Either String ([Warn], DynFlags))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ([Warn], DynFlags)
-> IO (Either String ([Warn], DynFlags)))
-> Either String ([Warn], DynFlags)
-> IO (Either String ([Warn], DynFlags))
forall a b. (a -> b) -> a -> b
$ ([Warn], DynFlags) -> Either String ([Warn], DynFlags)
forall a b. b -> Either a b
Right ([Warn]
warnings, DynFlags
flags'')
where
catchErrors :: m (Either String b) -> m (Either String b)
catchErrors m (Either String b)
act =
(GhcException -> m (Either String b))
-> m (Either String b) -> m (Either String b)
forall (m :: * -> *) a.
ExceptionMonad m =>
(GhcException -> m a) -> m a -> m a
GHC.handleGhcException
GhcException -> m (Either String b)
forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
a -> m (Either String b)
reportErr
((SourceError -> m (Either String b))
-> m (Either String b) -> m (Either String b)
forall (m :: * -> *) a.
MonadCatch m =>
(SourceError -> m a) -> m a -> m a
GHC.handleSourceError SourceError -> m (Either String b)
forall {m :: * -> *} {a} {b}.
(Monad m, Show a) =>
a -> m (Either String b)
reportErr m (Either String b)
act)
reportErr :: a -> m (Either String b)
reportErr a
e = Either String b -> m (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> m (Either String b))
-> Either String b -> m (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left (a -> String
forall a. Show a => a -> String
show a
e)