{-# OPTIONS_GHC -Wno-missing-fields #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
#include "ghclib_api.h"
module Language.Haskell.GhclibParserEx.GHC.Hs.Expr(
isTag, isDol, isDot, isReturn, isSection, isRecConstr, isRecUpdate,
isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isLambda, isQuasiQuote,
isDotApp, isTypeApp, isWHNF, isLCase,
isFieldPun, isRecStmt, isParComp, isMDo, isTupleSection, isString, isPrimLiteral,
isSpliceDecl, isFieldWildcard, isUnboxed,
hasFieldsDotDot,
varToStr, strToVar,
fromChar
) where
#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)
import GHC.Hs
#else
import HsSyn
#endif
import SrcLoc
import RdrName
import OccName
import Name
import BasicTypes
import TysWiredIn
isTag :: String -> LHsExpr GhcPs -> Bool
isTag :: String -> LHsExpr GhcPs -> Bool
isTag tag :: String
tag = \case (L _ (HsVar _ (L _ s :: IdP GhcPs
s))) -> OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
IdP GhcPs
s) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
tag; _ -> Bool
False
isDot, isDol, isReturn, isSection, isRecConstr, isRecUpdate,
isVar, isPar, isApp, isOpApp, isAnyApp, isLexeme, isQuasiQuote,
isLambda, isDotApp, isTypeApp, isWHNF, isLCase :: LHsExpr GhcPs -> Bool
isDol :: LHsExpr GhcPs -> Bool
isDol = String -> LHsExpr GhcPs -> Bool
isTag "$"
isDot :: LHsExpr GhcPs -> Bool
isDot = String -> LHsExpr GhcPs -> Bool
isTag "."
isReturn :: LHsExpr GhcPs -> Bool
isReturn x :: LHsExpr GhcPs
x = String -> LHsExpr GhcPs -> Bool
isTag "return" LHsExpr GhcPs
x Bool -> Bool -> Bool
|| String -> LHsExpr GhcPs -> Bool
isTag "pure" LHsExpr GhcPs
x
isSection :: LHsExpr GhcPs -> Bool
isSection = \case (L _ SectionL{}) -> Bool
True ; (L _ SectionR{}) -> Bool
True; _ -> Bool
False
isRecConstr :: LHsExpr GhcPs -> Bool
isRecConstr = \case (L _ RecordCon{}) -> Bool
True; _ -> Bool
False
isRecUpdate :: LHsExpr GhcPs -> Bool
isRecUpdate = \case (L _ RecordUpd{}) -> Bool
True; _ -> Bool
False
isVar :: LHsExpr GhcPs -> Bool
isVar = \case (L _ HsVar{}) -> Bool
True; _ -> Bool
False
isPar :: LHsExpr GhcPs -> Bool
isPar = \case (L _ HsPar{}) -> Bool
True; _ -> Bool
False
isApp :: LHsExpr GhcPs -> Bool
isApp = \case (L _ HsApp{}) -> Bool
True; _ -> Bool
False
isOpApp :: LHsExpr GhcPs -> Bool
isOpApp = \case (L _ OpApp{}) -> Bool
True; _ -> Bool
False
isAnyApp :: LHsExpr GhcPs -> Bool
isAnyApp x :: LHsExpr GhcPs
x = LHsExpr GhcPs -> Bool
isApp LHsExpr GhcPs
x Bool -> Bool -> Bool
|| LHsExpr GhcPs -> Bool
isOpApp LHsExpr GhcPs
x
isLexeme :: LHsExpr GhcPs -> Bool
isLexeme = \case (L _ HsVar{}) -> Bool
True; (L _ HsOverLit{}) -> Bool
True; (L _ HsLit{}) -> Bool
True; _ -> Bool
False
isLambda :: LHsExpr GhcPs -> Bool
isLambda = \case (L _ HsLam{}) -> Bool
True; _ -> Bool
False
isQuasiQuote :: LHsExpr GhcPs -> Bool
isQuasiQuote = \case (L _ (HsSpliceE _ HsQuasiQuote{})) -> Bool
True; _ -> Bool
False
isDotApp :: LHsExpr GhcPs -> Bool
isDotApp = \case (L _ (OpApp _ _ op :: LHsExpr GhcPs
op _)) -> LHsExpr GhcPs -> Bool
isDot LHsExpr GhcPs
op; _ -> Bool
False
isTypeApp :: LHsExpr GhcPs -> Bool
isTypeApp = \case (L _ HsAppType{}) -> Bool
True; _ -> Bool
False
isWHNF :: LHsExpr GhcPs -> Bool
isWHNF = \case
(L _ (HsVar _ (L _ x :: IdP GhcPs
x))) -> RdrName -> Bool
isRdrDataCon RdrName
IdP GhcPs
x
(L _ (HsLit _ x :: HsLit GhcPs
x)) -> case HsLit GhcPs
x of HsString{} -> Bool
False; HsInt{} -> Bool
False; HsRat{} -> Bool
False; _ -> Bool
True
(L _ HsLam{}) -> Bool
True
(L _ ExplicitTuple{}) -> Bool
True
(L _ ExplicitList{}) -> Bool
True
(L _ (HsPar _ x :: LHsExpr GhcPs
x)) -> LHsExpr GhcPs -> Bool
isWHNF LHsExpr GhcPs
x
(L _ (ExprWithTySig _ x :: LHsExpr GhcPs
x _)) -> LHsExpr GhcPs -> Bool
isWHNF LHsExpr GhcPs
x
(L _ (HsApp _ (L _ (HsVar _ (L _ x :: IdP GhcPs
x))) _))
| OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
IdP GhcPs
x) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["Just", "Left", "Right"] -> Bool
True
_ -> Bool
False
isLCase :: LHsExpr GhcPs -> Bool
isLCase = \case (L _ HsLamCase{}) -> Bool
True; _ -> Bool
False
isFieldPun :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldPun :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldPun = \case (L _ HsRecField {hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun=Bool
True}) -> Bool
True; _ -> Bool
False
hasFieldsDotDot :: HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
hasFieldsDotDot :: HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
hasFieldsDotDot = \case HsRecFields {rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe Int
rec_dotdot=Just _} -> Bool
True; _ -> Bool
False
isRecStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isRecStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isRecStmt = \case RecStmt{} -> Bool
True; _ -> Bool
False
isParComp :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isParComp :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isParComp = \case ParStmt{} -> Bool
True; _ -> Bool
False
isMDo :: HsStmtContext Name -> Bool
isMDo :: HsStmtContext Name -> Bool
isMDo = \case MDoExpr -> Bool
True; _ -> Bool
False
isTupleSection :: HsTupArg GhcPs -> Bool
isTupleSection :: HsTupArg GhcPs -> Bool
isTupleSection = \case Missing{} -> Bool
True; _ -> Bool
False
isString :: HsLit GhcPs -> Bool
isString :: HsLit GhcPs -> Bool
isString = \case HsString{} -> Bool
True; _ -> Bool
False
isPrimLiteral :: HsLit GhcPs -> Bool
isPrimLiteral :: HsLit GhcPs -> Bool
isPrimLiteral = \case
HsCharPrim{} -> Bool
True
HsStringPrim{} -> Bool
True
HsIntPrim{} -> Bool
True
HsWordPrim{} -> Bool
True
HsInt64Prim{} -> Bool
True
HsWord64Prim{} -> Bool
True
HsFloatPrim{} -> Bool
True
HsDoublePrim{} -> Bool
True
_ -> Bool
False
isSpliceDecl :: HsExpr GhcPs -> Bool
isSpliceDecl :: HsExpr GhcPs -> Bool
isSpliceDecl = \case HsSpliceE{} -> Bool
True; _ -> Bool
False
isFieldWildcard :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldWildcard :: LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldWildcard = \case
#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)
(L _ HsRecField {hsRecFieldArg=(L _ (HsUnboundVar _ s))}) -> occNameString s == "_"
#else
(L _ HsRecField {hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecFieldArg=(L _ (EWildPat _))}) -> Bool
True
#endif
(L _ HsRecField {hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun=Bool
True}) -> Bool
True
(L _ HsRecField {}) -> Bool
False
isUnboxed :: Boxity -> Bool
isUnboxed :: Boxity -> Bool
isUnboxed = \case Unboxed -> Bool
True; _ -> Bool
False
varToStr :: LHsExpr GhcPs -> String
varToStr :: LHsExpr GhcPs -> String
varToStr (L _ (HsVar _ (L _ n :: IdP GhcPs
n)))
| RdrName
IdP GhcPs
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
consDataCon_RDR = ":"
| RdrName
IdP GhcPs
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nameRdrName Name
nilDataConName = "[]"
| RdrName
IdP GhcPs
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nameRdrName (DataCon -> Name
forall a. NamedThing a => a -> Name
getName (Boxity -> Int -> DataCon
tupleDataCon Boxity
Boxed 0)) = "()"
| Bool
otherwise = OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
IdP GhcPs
n)
varToStr _ = ""
strToVar :: String -> LHsExpr GhcPs
#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)
strToVar x = noLoc $ HsVar noExtField (noLoc $ mkRdrUnqual (mkVarOcc x))
#else
strToVar :: String -> LHsExpr GhcPs
strToVar x :: String
x = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> GenLocated SrcSpan (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExt
XVar GhcPs
noExt (SrcSpanLess (Located RdrName) -> GenLocated SrcSpan (IdP GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> GenLocated SrcSpan (IdP GhcPs))
-> SrcSpanLess (Located RdrName) -> GenLocated SrcSpan (IdP GhcPs)
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc String
x))
#endif
fromChar :: LHsExpr GhcPs -> Maybe Char
fromChar :: LHsExpr GhcPs -> Maybe Char
fromChar = \case (L _ (HsLit _ (HsChar _ x :: Char
x))) -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x; _ -> Maybe Char
forall a. Maybe a
Nothing