{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
module BNFC.Check.Monad where
import BNFC.Prelude
import BNFC.CF
import BNFC.Types.Position
import BNFC.Types.Regex (Regex)
import qualified BNFC.Abs as A
class Monad m => MonadCheck m where
fatalError :: FatalError -> m a
recoverableError :: RecoverableError -> m ()
warn :: Warning -> m ()
atPosition :: ToPosition' p => p -> m a -> m a
askPosition :: m Position'
default fatalError
:: (MonadTrans t, MonadCheck n, t n ~ m)
=> FatalError -> m a
fatalError = n a -> t n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n a -> t n a) -> (FatalError -> n a) -> FatalError -> t n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FatalError -> n a
forall (m :: * -> *) a. MonadCheck m => FatalError -> m a
fatalError
default recoverableError
:: (MonadTrans t, MonadCheck n, t n ~ m)
=> RecoverableError -> m ()
recoverableError = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> t n ())
-> (RecoverableError -> n ()) -> RecoverableError -> t n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecoverableError -> n ()
forall (m :: * -> *). MonadCheck m => RecoverableError -> m ()
recoverableError
default warn
:: (MonadTrans t, MonadCheck n, t n ~ m)
=> Warning -> m ()
warn = n () -> t n ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (n () -> t n ()) -> (Warning -> n ()) -> Warning -> t n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Warning -> n ()
forall (m :: * -> *). MonadCheck m => Warning -> m ()
warn
default atPosition
:: (MonadTransControl t, MonadCheck n, t n ~ m)
=> ToPosition' p => p -> m a -> m a
atPosition = (n (StT t a) -> n (StT t a)) -> t n a -> t n a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(MonadTransControl t, Monad (t m), Monad m) =>
(m (StT t a) -> m (StT t b)) -> t m a -> t m b
liftThrough ((n (StT t a) -> n (StT t a)) -> t n a -> t n a)
-> (p -> n (StT t a) -> n (StT t a)) -> p -> t n a -> t n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> n (StT t a) -> n (StT t a)
forall (m :: * -> *) p a.
(MonadCheck m, ToPosition' p) =>
p -> m a -> m a
atPosition
default askPosition
:: (MonadTrans t, MonadCheck n, t n ~ m)
=> m Position'
askPosition = n Position' -> t n Position'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Position'
forall (m :: * -> *). MonadCheck m => m Position'
askPosition
instance MonadCheck m => MonadCheck (ExceptT e m)
instance MonadCheck m => MonadCheck (ReaderT r m)
instance MonadCheck m => MonadCheck (StateT s m)
data FatalError = FatalError
| UndefinedLabel LabelName
| ListsDontInhabitType Type
deriving Int -> FatalError -> ShowS
[FatalError] -> ShowS
FatalError -> String
(Int -> FatalError -> ShowS)
-> (FatalError -> String)
-> ([FatalError] -> ShowS)
-> Show FatalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FatalError] -> ShowS
$cshowList :: [FatalError] -> ShowS
show :: FatalError -> String
$cshow :: FatalError -> String
showsPrec :: Int -> FatalError -> ShowS
$cshowsPrec :: Int -> FatalError -> ShowS
Show
data RecoverableError
= DelimitersNotSupported
| IncompatibleDefinition ICat Position
| CoercionsOfCoerceCat
| CoercionsOfBuiltinCat
| CoercionsOfIdentCat
| CoercionsOfTokenCat
| UnknownCatName CatName
| CoerceBuiltinCat BuiltinCat
| CoerceIdentCat IdentCat
| CoerceListCat CatName
| CoerceTokenCat CatName
| DuplicateLabel LabelName Position
| DuplicateRHS Position
| InvalidListRule LabelName
| InvalidListLabel Type
| InvalidLabelNil FunType
| InvalidLabelCons FunType
| InvalidLabelSg FunType
| InvalidLabelWild FunType
| IgnoringUndeclaredFunction
| NotEnoughParameters (List1 String1)
| DroppingSpuriousParameters (List1 A.Arg)
| MissingArguments LabelName (List1 Type)
| DroppingSpuriousArguments LabelName (List1 A.Exp)
| ExpectedVsInferredType Type Type
| NullableToken CatName Regex
|
| ConflictingUsesOfLayoutKeyword Keyword Position
| EmptyGrammar
deriving Int -> RecoverableError -> ShowS
[RecoverableError] -> ShowS
RecoverableError -> String
(Int -> RecoverableError -> ShowS)
-> (RecoverableError -> String)
-> ([RecoverableError] -> ShowS)
-> Show RecoverableError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecoverableError] -> ShowS
$cshowList :: [RecoverableError] -> ShowS
show :: RecoverableError -> String
$cshow :: RecoverableError -> String
showsPrec :: Int -> RecoverableError -> ShowS
$cshowsPrec :: Int -> RecoverableError -> ShowS
Show
data Warning
= FooWarning
| LabelClashesWithCategory LabelName Position
| IgnoringNullCoercions
| NonUniformListRule Cat [Cat]
| ParameterShouldBeLowerCase VarName
| ShadowingParameter VarName
| ShadowedByParameter VarName
| EmptyToken CatName Regex
|
|
| EmptyLayoutKeyword
| UndefinedLayoutKeyword Keyword
| DuplicateLayoutKeyword Keyword Position
| DuplicateLayoutTop Position
deriving Int -> Warning -> ShowS
[Warning] -> ShowS
Warning -> String
(Int -> Warning -> ShowS)
-> (Warning -> String) -> ([Warning] -> ShowS) -> Show Warning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Warning] -> ShowS
$cshowList :: [Warning] -> ShowS
show :: Warning -> String
$cshow :: Warning -> String
showsPrec :: Int -> Warning -> ShowS
$cshowsPrec :: Int -> Warning -> ShowS
Show
type ICat = Cat' CatName
type PFatalError = WithPosition' FatalError
type PRecoverableError = WithPosition' RecoverableError
type PWarning = WithPosition' Warning
type PWarnErr = WithPosition' (Either RecoverableError Warning)
type RecoverableErrors = [PRecoverableError]
type Warnings = [PWarning]
type WarnErrs = [PWarnErr]
newtype Check a = Check { Check a
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
unCheck :: ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a }
deriving (a -> Check b -> Check a
(a -> b) -> Check a -> Check b
(forall a b. (a -> b) -> Check a -> Check b)
-> (forall a b. a -> Check b -> Check a) -> Functor Check
forall a b. a -> Check b -> Check a
forall a b. (a -> b) -> Check a -> Check b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Check b -> Check a
$c<$ :: forall a b. a -> Check b -> Check a
fmap :: (a -> b) -> Check a -> Check b
$cfmap :: forall a b. (a -> b) -> Check a -> Check b
Functor, Functor Check
a -> Check a
Functor Check
-> (forall a. a -> Check a)
-> (forall a b. Check (a -> b) -> Check a -> Check b)
-> (forall a b c. (a -> b -> c) -> Check a -> Check b -> Check c)
-> (forall a b. Check a -> Check b -> Check b)
-> (forall a b. Check a -> Check b -> Check a)
-> Applicative Check
Check a -> Check b -> Check b
Check a -> Check b -> Check a
Check (a -> b) -> Check a -> Check b
(a -> b -> c) -> Check a -> Check b -> Check c
forall a. a -> Check a
forall a b. Check a -> Check b -> Check a
forall a b. Check a -> Check b -> Check b
forall a b. Check (a -> b) -> Check a -> Check b
forall a b c. (a -> b -> c) -> Check a -> Check b -> Check 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
<* :: Check a -> Check b -> Check a
$c<* :: forall a b. Check a -> Check b -> Check a
*> :: Check a -> Check b -> Check b
$c*> :: forall a b. Check a -> Check b -> Check b
liftA2 :: (a -> b -> c) -> Check a -> Check b -> Check c
$cliftA2 :: forall a b c. (a -> b -> c) -> Check a -> Check b -> Check c
<*> :: Check (a -> b) -> Check a -> Check b
$c<*> :: forall a b. Check (a -> b) -> Check a -> Check b
pure :: a -> Check a
$cpure :: forall a. a -> Check a
$cp1Applicative :: Functor Check
Applicative, Applicative Check
a -> Check a
Applicative Check
-> (forall a b. Check a -> (a -> Check b) -> Check b)
-> (forall a b. Check a -> Check b -> Check b)
-> (forall a. a -> Check a)
-> Monad Check
Check a -> (a -> Check b) -> Check b
Check a -> Check b -> Check b
forall a. a -> Check a
forall a b. Check a -> Check b -> Check b
forall a b. Check a -> (a -> Check b) -> Check 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 -> Check a
$creturn :: forall a. a -> Check a
>> :: Check a -> Check b -> Check b
$c>> :: forall a b. Check a -> Check b -> Check b
>>= :: Check a -> (a -> Check b) -> Check b
$c>>= :: forall a b. Check a -> (a -> Check b) -> Check b
$cp1Monad :: Applicative Check
Monad)
runCheck :: Check a -> (Warnings, RecoverableErrors, Either PFatalError a)
runCheck :: Check a -> (Warnings, RecoverableErrors, Either PFatalError a)
runCheck (Check ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
m) = (Warnings
ws, RecoverableErrors
es, Either PFatalError a
res)
where
(Either PFatalError a
res, WarnErrs
wes) = Writer WarnErrs (Either PFatalError a)
-> (Either PFatalError a, WarnErrs)
forall w a. Writer w a -> (a, w)
runWriter (Writer WarnErrs (Either PFatalError a)
-> (Either PFatalError a, WarnErrs))
-> Writer WarnErrs (Either PFatalError a)
-> (Either PFatalError a, WarnErrs)
forall a b. (a -> b) -> a -> b
$ ExceptT PFatalError (Writer WarnErrs) a
-> Writer WarnErrs (Either PFatalError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PFatalError (Writer WarnErrs) a
-> Writer WarnErrs (Either PFatalError a))
-> ExceptT PFatalError (Writer WarnErrs) a
-> Writer WarnErrs (Either PFatalError a)
forall a b. (a -> b) -> a -> b
$ ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
m ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Position' -> ExceptT PFatalError (Writer WarnErrs) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Position'
forall a. Maybe a
Nothing
(RecoverableErrors
es, Warnings
ws) = [Either (WithPosition' RecoverableError) (WithPosition' Warning)]
-> (RecoverableErrors, Warnings)
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (WithPosition' RecoverableError) (WithPosition' Warning)]
-> (RecoverableErrors, Warnings))
-> [Either
(WithPosition' RecoverableError) (WithPosition' Warning)]
-> (RecoverableErrors, Warnings)
forall a b. (a -> b) -> a -> b
$ (WithPosition' (Either RecoverableError Warning)
-> Either (WithPosition' RecoverableError) (WithPosition' Warning))
-> WarnErrs
-> [Either
(WithPosition' RecoverableError) (WithPosition' Warning)]
forall a b. (a -> b) -> [a] -> [b]
map WithPosition' (Either RecoverableError Warning)
-> Either (WithPosition' RecoverableError) (WithPosition' Warning)
forall (t :: * -> *) (m :: * -> * -> *) a b.
(Decoration t, Bifunctor m) =>
t (m a b) -> m (t a) (t b)
distributeF2 WarnErrs
wes
instance MonadCheck Check where
fatalError :: FatalError -> Check a
fatalError :: FatalError -> Check a
fatalError FatalError
e = ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
forall a.
ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
Check (ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a)
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
forall a b. (a -> b) -> a -> b
$ do
Position'
p <- ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) Position'
forall r (m :: * -> *). MonadReader r m => m r
ask
PFatalError
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PFatalError
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a)
-> PFatalError
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
forall a b. (a -> b) -> a -> b
$ Position' -> FatalError -> PFatalError
forall a. Position' -> a -> WithPosition' a
WithPosition' Position'
p FatalError
e
recoverableError :: RecoverableError -> Check ()
recoverableError :: RecoverableError -> Check ()
recoverableError RecoverableError
e = ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
-> Check ()
forall a.
ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
Check (ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
-> Check ())
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
-> Check ()
forall a b. (a -> b) -> a -> b
$ do
Position'
p <- ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) Position'
forall r (m :: * -> *). MonadReader r m => m r
ask
WarnErrs
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position'
-> Either RecoverableError Warning
-> WithPosition' (Either RecoverableError Warning)
forall a. Position' -> a -> WithPosition' a
WithPosition' Position'
p (Either RecoverableError Warning
-> WithPosition' (Either RecoverableError Warning))
-> Either RecoverableError Warning
-> WithPosition' (Either RecoverableError Warning)
forall a b. (a -> b) -> a -> b
$ RecoverableError -> Either RecoverableError Warning
forall a b. a -> Either a b
Left RecoverableError
e]
warn :: Warning -> Check ()
warn :: Warning -> Check ()
warn Warning
w = ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
-> Check ()
forall a.
ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
Check (ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
-> Check ())
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
-> Check ()
forall a b. (a -> b) -> a -> b
$ do
Position'
p <- ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) Position'
forall r (m :: * -> *). MonadReader r m => m r
ask
WarnErrs
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position'
-> Either RecoverableError Warning
-> WithPosition' (Either RecoverableError Warning)
forall a. Position' -> a -> WithPosition' a
WithPosition' Position'
p (Either RecoverableError Warning
-> WithPosition' (Either RecoverableError Warning))
-> Either RecoverableError Warning
-> WithPosition' (Either RecoverableError Warning)
forall a b. (a -> b) -> a -> b
$ Warning -> Either RecoverableError Warning
forall a b. b -> Either a b
Right Warning
w]
atPosition :: ToPosition' p => p -> Check a -> Check a
atPosition :: p -> Check a -> Check a
atPosition p
p (Check ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
m) = ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
forall a.
ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
Check (ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a)
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
forall a b. (a -> b) -> a -> b
$ (Position' -> Position')
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Position' -> Position' -> Position'
forall a b. a -> b -> a
const (Position' -> Position' -> Position')
-> Position' -> Position' -> Position'
forall a b. (a -> b) -> a -> b
$ p -> Position'
forall p. ToPosition' p => p -> Position'
toPosition' p
p) ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
m
askPosition :: Check Position'
askPosition :: Check Position'
askPosition = ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) Position'
-> Check Position'
forall a.
ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) a
-> Check a
Check ReaderT Position' (ExceptT PFatalError (Writer WarnErrs)) Position'
forall r (m :: * -> *). MonadReader r m => m r
ask