module Checks.ExtensionCheck (extensionCheck) where
import qualified Control.Monad.State as S (State, execState, modify)
import Curry.Base.SpanInfo
import Curry.Base.Pretty
import Curry.Syntax
import Base.Messages (Message, spanInfoMessage)
import CompilerOpts
extensionCheck :: Options -> Module a -> ([KnownExtension], [Message])
extensionCheck :: Options -> Module a -> ([KnownExtension], [Message])
extensionCheck opts :: Options
opts mdl :: Module a
mdl = EXCM () -> EXCState -> ([KnownExtension], [Message])
forall a. EXCM a -> EXCState -> ([KnownExtension], [Message])
execEXC (Module a -> EXCM ()
forall a. Module a -> EXCM ()
checkModule Module a
mdl) EXCState
initState
where
initState :: EXCState
initState = [KnownExtension] -> [Message] -> EXCState
EXCState (Options -> [KnownExtension]
optExtensions Options
opts) []
type EXCM = S.State EXCState
data EXCState = EXCState
{ EXCState -> [KnownExtension]
extensions :: [KnownExtension]
, EXCState -> [Message]
errors :: [Message]
}
execEXC :: EXCM a -> EXCState -> ([KnownExtension], [Message])
execEXC :: EXCM a -> EXCState -> ([KnownExtension], [Message])
execEXC ecm :: EXCM a
ecm s :: EXCState
s =
let s' :: EXCState
s' = EXCM a -> EXCState -> EXCState
forall s a. State s a -> s -> s
S.execState EXCM a
ecm EXCState
s in (EXCState -> [KnownExtension]
extensions EXCState
s', [Message] -> [Message]
forall a. [a] -> [a]
reverse ([Message] -> [Message]) -> [Message] -> [Message]
forall a b. (a -> b) -> a -> b
$ EXCState -> [Message]
errors EXCState
s')
enableExtension :: KnownExtension -> EXCM ()
enableExtension :: KnownExtension -> EXCM ()
enableExtension e :: KnownExtension
e = (EXCState -> EXCState) -> EXCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((EXCState -> EXCState) -> EXCM ())
-> (EXCState -> EXCState) -> EXCM ()
forall a b. (a -> b) -> a -> b
$ \s :: EXCState
s -> EXCState
s { extensions :: [KnownExtension]
extensions = KnownExtension
e KnownExtension -> [KnownExtension] -> [KnownExtension]
forall a. a -> [a] -> [a]
: EXCState -> [KnownExtension]
extensions EXCState
s }
report :: Message -> EXCM ()
report :: Message -> EXCM ()
report msg :: Message
msg = (EXCState -> EXCState) -> EXCM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((EXCState -> EXCState) -> EXCM ())
-> (EXCState -> EXCState) -> EXCM ()
forall a b. (a -> b) -> a -> b
$ \s :: EXCState
s -> EXCState
s { errors :: [Message]
errors = Message
msg Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: EXCState -> [Message]
errors EXCState
s }
ok :: EXCM ()
ok :: EXCM ()
ok = () -> EXCM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
checkModule :: Module a -> EXCM ()
checkModule :: Module a -> EXCM ()
checkModule (Module _ _ ps :: [ModulePragma]
ps _ _ _ _) = (ModulePragma -> EXCM ()) -> [ModulePragma] -> EXCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ModulePragma -> EXCM ()
checkPragma [ModulePragma]
ps
checkPragma :: ModulePragma -> EXCM ()
checkPragma :: ModulePragma -> EXCM ()
checkPragma (LanguagePragma _ exts :: [Extension]
exts) = (Extension -> EXCM ()) -> [Extension] -> EXCM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Extension -> EXCM ()
checkExtension [Extension]
exts
checkPragma (OptionsPragma _ _ _) = EXCM ()
ok
checkExtension :: Extension -> EXCM ()
checkExtension :: Extension -> EXCM ()
checkExtension (KnownExtension _ e :: KnownExtension
e) = KnownExtension -> EXCM ()
enableExtension KnownExtension
e
checkExtension (UnknownExtension p :: SpanInfo
p e :: String
e) = Message -> EXCM ()
report (Message -> EXCM ()) -> Message -> EXCM ()
forall a b. (a -> b) -> a -> b
$ SpanInfo -> String -> Message
errUnknownExtension SpanInfo
p String
e
errUnknownExtension :: SpanInfo -> String -> Message
errUnknownExtension :: SpanInfo -> String -> Message
errUnknownExtension p :: SpanInfo
p e :: String
e = SpanInfo -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage SpanInfo
p (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "Unknown language extension:" Doc -> Doc -> Doc
<+> String -> Doc
text String
e