module GHC.Parser.Utils
( isStmt
, hasImport
, isImport
, isDecl
)
where
import GHC.Prelude
import GHC.Hs
import GHC.Data.StringBuffer
import GHC.Data.FastString
import GHC.Types.SrcLoc
import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState)
import GHC.Parser.Lexer (ParserOpts)
import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport)
isStmt :: ParserOpts -> String -> Bool
isStmt :: ParserOpts -> String -> Bool
isStmt ParserOpts
pflags String
stmt =
case P (Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
-> ParserOpts
-> String
-> ParseResult
(Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
Parser.parseStmt ParserOpts
pflags String
stmt of
Lexer.POk PState
_ Maybe
(GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
_ -> Bool
True
Lexer.PFailed PState
_ -> Bool
False
hasImport :: ParserOpts -> String -> Bool
hasImport :: ParserOpts -> String -> Bool
hasImport ParserOpts
pflags String
stmt =
case P (Located (HsModule GhcPs))
-> ParserOpts -> String -> ParseResult (Located (HsModule GhcPs))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (Located (HsModule GhcPs))
Parser.parseModule ParserOpts
pflags String
stmt of
Lexer.POk PState
_ Located (HsModule GhcPs)
thing -> Located (HsModule GhcPs) -> Bool
forall {l} {p}. GenLocated l (HsModule p) -> Bool
hasImports Located (HsModule GhcPs)
thing
Lexer.PFailed PState
_ -> Bool
False
where
hasImports :: GenLocated l (HsModule p) -> Bool
hasImports = Bool -> Bool
not (Bool -> Bool)
-> (GenLocated l (HsModule p) -> Bool)
-> GenLocated l (HsModule p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XRec p (ImportDecl p)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XRec p (ImportDecl p)] -> Bool)
-> (GenLocated l (HsModule p) -> [XRec p (ImportDecl p)])
-> GenLocated l (HsModule p)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule p -> [XRec p (ImportDecl p)]
forall p. HsModule p -> [LImportDecl p]
hsmodImports (HsModule p -> [XRec p (ImportDecl p)])
-> (GenLocated l (HsModule p) -> HsModule p)
-> GenLocated l (HsModule p)
-> [XRec p (ImportDecl p)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (HsModule p) -> HsModule p
forall l e. GenLocated l e -> e
unLoc
isImport :: ParserOpts -> String -> Bool
isImport :: ParserOpts -> String -> Bool
isImport ParserOpts
pflags String
stmt =
case P (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> ParserOpts
-> String
-> ParseResult (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
Parser.parseImport ParserOpts
pflags String
stmt of
Lexer.POk PState
_ GenLocated SrcSpanAnnA (ImportDecl GhcPs)
_ -> Bool
True
Lexer.PFailed PState
_ -> Bool
False
isDecl :: ParserOpts -> String -> Bool
isDecl :: ParserOpts -> String -> Bool
isDecl ParserOpts
pflags String
stmt =
case P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> ParserOpts
-> String
-> ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (GenLocated SrcSpanAnnA (HsDecl GhcPs))
Parser.parseDeclaration ParserOpts
pflags String
stmt of
Lexer.POk PState
_ GenLocated SrcSpanAnnA (HsDecl GhcPs)
thing ->
case GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsDecl GhcPs)
thing of
SpliceD XSpliceD GhcPs
_ SpliceDecl GhcPs
_ -> Bool
False
HsDecl GhcPs
_ -> Bool
True
Lexer.PFailed PState
_ -> Bool
False
parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing
parseThing :: forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P thing
parser ParserOpts
opts String
stmt = do
let buf :: StringBuffer
buf = String -> StringBuffer
stringToStringBuffer String
stmt
loc :: RealSrcLoc
loc = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (String -> FastString
fsLit String
"<interactive>") Int
1 Int
1
P thing -> PState -> ParseResult thing
forall a. P a -> PState -> ParseResult a
Lexer.unP P thing
parser (ParserOpts -> StringBuffer -> RealSrcLoc -> PState
Lexer.initParserState ParserOpts
opts StringBuffer
buf RealSrcLoc
loc)