-- Copyright (c) 2020-203, Shayne Fletcher. All rights reserved.
-- SPDX-License-Identifier: BSD-3-Clause.

{-# LANGUAGE ViewPatterns #-}
#include "ghclib_api.h"
module Language.Haskell.GhclibParserEx.GHC.Hs.Pat(
    patToStr, strToPat
  , fromPChar
  , hasPFieldsDotDot
  , isPFieldWildcard, isPWildcard, isPFieldPun, isPatTypeSig, isPBangPat, isPViewPat
  , isWildPat {- alias for 'isPWildcard' -}
  , isSplicePat
 ) where

#if defined (GHC_8_8)
import HsSyn
import SrcLoc
import TysWiredIn
import RdrName
import OccName
import FastString
#elif defined (GHC_8_10)
import GHC.Hs
import SrcLoc
import TysWiredIn
import RdrName
import OccName
import FastString
#else
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Builtin.Types
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Data.FastString
#endif

patToStr :: LPat GhcPs -> String
#if defined (GHC_8_8)
patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"
patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"
patToStr (dL -> L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"
patToStr _ = ""
#elif defined (GHC_8_10)
patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"
patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"
patToStr (L _ (ConPatIn (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"
patToStr _ = ""
#elif defined (GHC_9_0)
patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "True" = "True"
patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "False" = "False"
patToStr (L _ (ConPat _ (L _ x) (PrefixCon []))) | occNameString (rdrNameOcc x) == "[]" = "[]"
patToStr _ = ""
#else
patToStr :: LPat GhcPs -> String
patToStr (L SrcSpanAnnA
_ (ConPat XConPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
x) (PrefixCon [] []))) | OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True" = String
"True"
patToStr (L SrcSpanAnnA
_ (ConPat XConPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
x) (PrefixCon [] []))) | OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" = String
"False"
patToStr (L SrcSpanAnnA
_ (ConPat XConPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
x) (PrefixCon [] []))) | OccName -> String
occNameString (RdrName -> OccName
rdrNameOcc RdrName
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"[]" = String
"[]"
patToStr LPat GhcPs
_ = String
""
#endif

strToPat :: String -> LPat GhcPs
strToPat :: String -> LPat GhcPs
strToPat String
z
#if defined (GHC_8_8)
  | z == "True" = ConPatIn (noLoc true_RDR) (PrefixCon [])
  | z == "False" = ConPatIn (noLoc false_RDR) (PrefixCon [])
  | z == "[]" = ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon [])
  | otherwise = VarPat noExt (noLoc $ mkVarUnqual (fsLit z))
#elif defined (GHC_8_10)
  | z == "True" =  noLoc $ ConPatIn (noLoc true_RDR) (PrefixCon [])
  | z == "False" =  noLoc $ ConPatIn (noLoc false_RDR) (PrefixCon [])
  | z == "[]" = noLoc $ ConPatIn (noLoc $ nameRdrName nilDataConName) (PrefixCon [])
  | otherwise = noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z))
#elif defined (GHC_9_0)
  | z == "True" = noLoc $ ConPat noExtField (noLoc true_RDR) (PrefixCon [])
  | z == "False" = noLoc $ ConPat noExtField (noLoc false_RDR) (PrefixCon [])
  | z == "[]" = noLoc $ ConPat noExtField (noLoc $ nameRdrName nilDataConName) (PrefixCon [])
  | otherwise = noLoc $ VarPat noExtField (noLoc $ mkVarUnqual (fsLit z))
#else
  | String
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"True" = Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XConPat GhcPs
-> XRec GhcPs (ConLikeP GhcPs)
-> HsConDetails
     (HsConPatTyArg (NoGhcTc GhcPs))
     (LPat GhcPs)
     (HsRecFields GhcPs (LPat GhcPs))
-> Pat GhcPs
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
true_RDR) ([HsConPatTyArg GhcPs]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> HsConDetails
     (HsConPatTyArg GhcPs)
     (GenLocated SrcSpanAnnA (Pat GhcPs))
     (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [])
  | String
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"False" = Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XConPat GhcPs
-> XRec GhcPs (ConLikeP GhcPs)
-> HsConDetails
     (HsConPatTyArg (NoGhcTc GhcPs))
     (LPat GhcPs)
     (HsRecFields GhcPs (LPat GhcPs))
-> Pat GhcPs
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA RdrName
false_RDR) ([HsConPatTyArg GhcPs]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> HsConDetails
     (HsConPatTyArg GhcPs)
     (GenLocated SrcSpanAnnA (Pat GhcPs))
     (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [])
  | String
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"[]" = Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XConPat GhcPs
-> XRec GhcPs (ConLikeP GhcPs)
-> HsConDetails
     (HsConPatTyArg (NoGhcTc GhcPs))
     (LPat GhcPs)
     (HsRecFields GhcPs (LPat GhcPs))
-> Pat GhcPs
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat XConPat GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ Name -> RdrName
nameRdrName Name
nilDataConName) ([HsConPatTyArg GhcPs]
-> [GenLocated SrcSpanAnnA (Pat GhcPs)]
-> HsConDetails
     (HsConPatTyArg GhcPs)
     (GenLocated SrcSpanAnnA (Pat GhcPs))
     (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [])
  | Bool
otherwise = Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a an. a -> LocatedAn an a
noLocA (Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs))
-> Pat GhcPs -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcPs -> LIdP GhcPs -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
noExtField (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
z))
#endif

fromPChar :: LPat GhcPs -> Maybe Char
#if defined (GHC_8_8)
fromPChar (dL -> L _ (LitPat _ (HsChar _ x))) = Just x
#else
fromPChar :: LPat GhcPs -> Maybe Char
fromPChar (L SrcSpanAnnA
_ (LitPat XLitPat GhcPs
_ (HsChar XHsChar GhcPs
_ Char
x))) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
#endif
fromPChar LPat GhcPs
_ = Maybe Char
forall a. Maybe a
Nothing

-- Contains a '..' as in 'Foo{..}'
hasPFieldsDotDot :: HsRecFields GhcPs (LPat GhcPs) -> Bool
hasPFieldsDotDot :: HsRecFields GhcPs (LPat GhcPs) -> Bool
hasPFieldsDotDot HsRecFields {rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot=Just XRec GhcPs RecFieldsDotDot
_} = Bool
True
hasPFieldsDotDot HsRecFields GhcPs (LPat GhcPs)
_ = Bool
False

-- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.
#if !( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )
-- ghc >= 9.4
isPFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool
#else
isPFieldWildcard :: LHsRecField GhcPs (LPat GhcPs) -> Bool
#endif
#if defined (GHC_8_8)
isPFieldWildcard (dL -> L _ HsRecField {hsRecFieldArg=LL _ WildPat {}}) = True
isPFieldWildcard (dL -> L _ HsRecField {hsRecPun=True}) = True
isPFieldWildcard (dL -> L _ HsRecField {}) = False
#elif defined (GHC_8_10)
isPFieldWildcard (L _ HsRecField {hsRecFieldArg=L _ WildPat {}}) = True
isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True
isPFieldWildcard (L _ HsRecField {}) = False
#elif defined (GHC_9_0) || defined (GHC_9_2)
isPFieldWildcard (L _ HsRecField {hsRecFieldArg=L _ WildPat {}}) = True
isPFieldWildcard (L _ HsRecField {hsRecPun=True}) = True
isPFieldWildcard (L _ HsRecField {}) = False
#else
isPFieldWildcard :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool
isPFieldWildcard (L SrcSpanAnnA
_ HsFieldBind {hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS=L SrcSpanAnnA
_ WildPat {}}) = Bool
True
isPFieldWildcard (L SrcSpanAnnA
_ HsFieldBind {hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun=Bool
True}) = Bool
True
isPFieldWildcard (L SrcSpanAnnA
_ HsFieldBind {}) = Bool
False
#endif

isPWildcard :: LPat GhcPs -> Bool
#if defined (GHC_8_8)
isPWildcard (dL -> L _ (WildPat _)) = True
#else
isPWildcard :: LPat GhcPs -> Bool
isPWildcard (L SrcSpanAnnA
_ (WildPat XWildPat GhcPs
_)) = Bool
True
#endif
isPWildcard LPat GhcPs
_ = Bool
False

isWildPat :: LPat GhcPs -> Bool
isWildPat :: LPat GhcPs -> Bool
isWildPat = LPat GhcPs -> Bool
isPWildcard

#if !( defined (GHC_9_2) || defined (GHC_9_0) || defined (GHC_9_0) || defined (GHC_8_10) || defined (GHC_8_8) )
isPFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool
#else
isPFieldPun :: LHsRecField GhcPs (LPat GhcPs) -> Bool
#endif
#if defined (GHC_8_8)
isPFieldPun (dL -> L _ HsRecField {hsRecPun=True}) = True
#elif defined (GHC_8_10) || defined (GHC_9_0) || defined (GHC_9_2)
isPFieldPun (L _ HsRecField {hsRecPun=True}) = True
#else
isPFieldPun :: LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool
isPFieldPun (L SrcSpanAnnA
_ HsFieldBind {hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun=Bool
True}) = Bool
True
#endif
isPFieldPun LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs)
_ = Bool
False

isPatTypeSig, isPBangPat, isPViewPat :: LPat GhcPs -> Bool
#if defined (GHC_8_8)
isPatTypeSig (dL -> L _ SigPat{}) = True; isPatTypeSig _ = False
isPBangPat (dL -> L _ BangPat{}) = True; isPBangPat _ = False
isPViewPat (dL -> L _ ViewPat{}) = True; isPViewPat _ = False
#else
isPatTypeSig :: LPat GhcPs -> Bool
isPatTypeSig (L SrcSpanAnnA
_ SigPat{}) = Bool
True; isPatTypeSig LPat GhcPs
_ = Bool
False
isPBangPat :: LPat GhcPs -> Bool
isPBangPat (L SrcSpanAnnA
_ BangPat{}) = Bool
True; isPBangPat LPat GhcPs
_ = Bool
False
isPViewPat :: LPat GhcPs -> Bool
isPViewPat (L SrcSpanAnnA
_ ViewPat{}) = Bool
True; isPViewPat LPat GhcPs
_ = Bool
False
#endif

isSplicePat :: LPat GhcPs -> Bool
#if defined (GHC_8_8)
isSplicePat (dL -> L _ SplicePat{}) = True; isSplicePat _ = False
#else
isSplicePat :: LPat GhcPs -> Bool
isSplicePat (L SrcSpanAnnA
_ SplicePat{}) = Bool
True; isSplicePat LPat GhcPs
_ = Bool
False
#endif