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)


-- | Returns @True@ if passed string is a statement.
isStmt :: ParserOpts -> String -> Bool
isStmt :: ParserOpts -> String -> Bool
isStmt ParserOpts
pflags String
stmt =
  case P (Maybe (Located (StmtLR GhcPs GhcPs (Located (HsExpr GhcPs)))))
-> ParserOpts
-> String
-> ParseResult
     (Maybe (Located (StmtLR GhcPs GhcPs (Located (HsExpr GhcPs)))))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (Maybe (Located (StmtLR GhcPs GhcPs (Located (HsExpr GhcPs)))))
Parser.parseStmt ParserOpts
pflags String
stmt of
    Lexer.POk PState
_ Maybe (Located (StmtLR GhcPs GhcPs (Located (HsExpr GhcPs))))
_ -> Bool
True
    Lexer.PFailed PState
_ -> Bool
False

-- | Returns @True@ if passed string has an import declaration.
hasImport :: ParserOpts -> String -> Bool
hasImport :: ParserOpts -> String -> Bool
hasImport ParserOpts
pflags String
stmt =
  case P (Located HsModule)
-> ParserOpts -> String -> ParseResult (Located HsModule)
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (Located HsModule)
Parser.parseModule ParserOpts
pflags String
stmt of
    Lexer.POk PState
_ Located HsModule
thing -> Located HsModule -> Bool
forall l. GenLocated l HsModule -> Bool
hasImports Located HsModule
thing
    Lexer.PFailed PState
_ -> Bool
False
  where
    hasImports :: GenLocated l HsModule -> Bool
hasImports = Bool -> Bool
not (Bool -> Bool)
-> (GenLocated l HsModule -> Bool) -> GenLocated l HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located (ImportDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Located (ImportDecl GhcPs)] -> Bool)
-> (GenLocated l HsModule -> [Located (ImportDecl GhcPs)])
-> GenLocated l HsModule
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule -> [Located (ImportDecl GhcPs)]
HsModule -> [LImportDecl GhcPs]
hsmodImports (HsModule -> [Located (ImportDecl GhcPs)])
-> (GenLocated l HsModule -> HsModule)
-> GenLocated l HsModule
-> [Located (ImportDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l HsModule -> HsModule
forall l e. GenLocated l e -> e
unLoc

-- | Returns @True@ if passed string is an import declaration.
isImport :: ParserOpts -> String -> Bool
isImport :: ParserOpts -> String -> Bool
isImport ParserOpts
pflags String
stmt =
  case P (Located (ImportDecl GhcPs))
-> ParserOpts -> String -> ParseResult (Located (ImportDecl GhcPs))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (Located (ImportDecl GhcPs))
Parser.parseImport ParserOpts
pflags String
stmt of
    Lexer.POk PState
_ Located (ImportDecl GhcPs)
_ -> Bool
True
    Lexer.PFailed PState
_ -> Bool
False

-- | Returns @True@ if passed string is a declaration but __/not a splice/__.
isDecl :: ParserOpts -> String -> Bool
isDecl :: ParserOpts -> String -> Bool
isDecl ParserOpts
pflags String
stmt =
  case P (Located (HsDecl GhcPs))
-> ParserOpts -> String -> ParseResult (Located (HsDecl GhcPs))
forall thing. P thing -> ParserOpts -> String -> ParseResult thing
parseThing P (Located (HsDecl GhcPs))
Parser.parseDeclaration ParserOpts
pflags String
stmt of
    Lexer.POk PState
_ Located (HsDecl GhcPs)
thing ->
      case Located (HsDecl GhcPs) -> HsDecl GhcPs
forall l e. GenLocated l e -> e
unLoc Located (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 :: 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)