{-# LANGUAGE CPP #-}
module HIndent.Parse
( parseModule
, lexCode
) where
import Data.Maybe
import qualified GHC.Data.EnumSet as ES
import GHC.Data.FastString
import GHC.Data.StringBuffer
import qualified GHC.LanguageExtensions as GLP
import qualified GHC.Parser as GLP
import GHC.Parser.Lexer hiding (buffer)
import GHC.Stack
import GHC.Types.SrcLoc
import HIndent.GhcLibParserWrapper.GHC.Hs
#if MIN_VERSION_ghc_lib_parser(9,4,1)
import GHC.Utils.Error
import GHC.Utils.Outputable hiding ((<>), empty, text)
#endif
parseModule ::
Maybe FilePath -> [GLP.Extension] -> String -> ParseResult HsModule'
parseModule :: Maybe FilePath -> [Extension] -> FilePath -> ParseResult HsModule'
parseModule Maybe FilePath
filepath [Extension]
exts FilePath
src =
case P (Located HsModule') -> PState -> ParseResult (Located HsModule')
forall a. P a -> PState -> ParseResult a
unP P (Located HsModule')
GLP.parseModule PState
initState of
POk PState
s Located HsModule'
m -> PState -> HsModule' -> ParseResult HsModule'
forall a. PState -> a -> ParseResult a
POk PState
s (HsModule' -> ParseResult HsModule')
-> HsModule' -> ParseResult HsModule'
forall a b. (a -> b) -> a -> b
$ Located HsModule' -> HsModule'
forall l e. GenLocated l e -> e
unLoc Located HsModule'
m
PFailed PState
s -> PState -> ParseResult HsModule'
forall a. PState -> ParseResult a
PFailed PState
s
where
initState :: PState
initState = ParserOpts -> StringBuffer -> RealSrcLoc -> PState
initParserState ([Extension] -> ParserOpts
parserOptsFromExtensions [Extension]
exts) StringBuffer
buffer RealSrcLoc
location
location :: RealSrcLoc
location =
FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
mkFastString (FilePath -> FastString) -> FilePath -> FastString
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"<interactive>" Maybe FilePath
filepath) Int
1 Int
1
buffer :: StringBuffer
buffer = FilePath -> StringBuffer
stringToStringBuffer FilePath
src
lexCode :: HasCallStack => String -> [Token]
lexCode :: HasCallStack => FilePath -> [Token]
lexCode FilePath
code
| POk PState
_ [Located Token]
tokens <-
ParserOpts
-> StringBuffer -> RealSrcLoc -> ParseResult [Located Token]
lexTokenStream
([Extension] -> ParserOpts
parserOptsFromExtensions [])
(FilePath -> StringBuffer
stringToStringBuffer FilePath
code)
(FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (FilePath -> FastString
mkFastString FilePath
"<interactive>") Int
1 Int
1) = (Located Token -> Token) -> [Located Token] -> [Token]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located Token -> Token
forall l e. GenLocated l e -> e
unLoc [Located Token]
tokens
| Bool
otherwise = FilePath -> [Token]
forall a. HasCallStack => FilePath -> a
error FilePath
"Failed to lex the code."
parserOptsFromExtensions :: [GLP.Extension] -> ParserOpts
#if MIN_VERSION_ghc_lib_parser(9,4,1)
parserOptsFromExtensions :: [Extension] -> ParserOpts
parserOptsFromExtensions [Extension]
opts =
EnumSet Extension
-> DiagOpts
-> [FilePath]
-> Bool
-> Bool
-> Bool
-> Bool
-> ParserOpts
mkParserOpts
EnumSet Extension
opts'
DiagOpts
diagOpts
[]
Bool
False
Bool
False
Bool
True
Bool
False
where
opts' :: EnumSet Extension
opts' = [Extension] -> EnumSet Extension
forall a. Enum a => [a] -> EnumSet a
ES.fromList ([Extension] -> EnumSet Extension)
-> [Extension] -> EnumSet Extension
forall a b. (a -> b) -> a -> b
$ Extension
GLP.StarIsType Extension -> [Extension] -> [Extension]
forall a. a -> [a] -> [a]
: [Extension]
opts
diagOpts :: DiagOpts
diagOpts =
DiagOpts
{ diag_warning_flags :: EnumSet WarningFlag
diag_warning_flags = EnumSet WarningFlag
forall a. EnumSet a
ES.empty
, diag_fatal_warning_flags :: EnumSet WarningFlag
diag_fatal_warning_flags = EnumSet WarningFlag
forall a. EnumSet a
ES.empty
, diag_warn_is_error :: Bool
diag_warn_is_error = Bool
False
, diag_reverse_errors :: Bool
diag_reverse_errors = Bool
False
, diag_max_errors :: Maybe Int
diag_max_errors = Maybe Int
forall a. Maybe a
Nothing
, diag_ppr_ctx :: SDocContext
diag_ppr_ctx = SDocContext
defaultSDocContext
}
#else
parserOptsFromExtensions opts =
mkParserOpts
ES.empty
opts'
False
False
True
False
where
opts' = ES.fromList $ GLP.StarIsType : opts
#endif