{-# LANGUAGE CPP #-}

-- | Parsing and lexical analysis functions.
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 GHC.Hs
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
#if MIN_VERSION_ghc_lib_parser(9,4,1)
import GHC.Utils.Error
import GHC.Utils.Outputable hiding ((<>), empty, text)
#endif
-- | This function parses the given Haskell source code with the given file
-- path (if any) and parse options.
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

-- | Lexically analyze the given code.
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."

-- | This function generates a 'ParserOpts' from te given extension.
--
-- The 'StarIsType' extension is always enabled to compile a code using
-- kinds like '* -> *'.
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
    [] -- There are no supported languages and extensions (this list is used only in error messages)
    Bool
False -- Safe imports are off.
    Bool
False -- Haddock comments are treated as normal comments.
    Bool
True -- Comments are kept in an AST.
    Bool
False -- Do not update the internal position of a comment.
  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 -- No compiler warnings are enabled.
    opts'
    False -- Safe imports are off.
    False -- Haddock comments are treated as normal comments.
    True -- Comments are kept in an AST.
    False -- Do not update the internal position of a comment.
  where
    opts' = ES.fromList $ GLP.StarIsType : opts
#endif