{-# LANGUAGE MultiParamTypeClasses , FlexibleInstances, FlexibleContexts #-}

module GHC.Util.Pat (
    strToPat', patToStr'
  , Brackets'(..)
  , fromPChar', isPFieldWildcard', hasPFieldsDotDot', isPWildCard'
  , isPFieldPun', isPatTypeSig', isPBangPat', isPViewPat'
  ) where

import HsSyn
import SrcLoc
import TysWiredIn
import FastString
import RdrName

import GHC.Util.Brackets

patToStr' :: Pat GhcPs -> String
patToStr' :: Pat GhcPs -> String
patToStr' (LL _ (ConPatIn (L _ x) (PrefixCon []))) | RdrName
IdP GhcPs
x RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
true_RDR = "True"
patToStr' (LL _ (ConPatIn (L _ x) (PrefixCon []))) | RdrName
IdP GhcPs
x RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
false_RDR = "False"
patToStr' (LL _ (ConPatIn (L _ x) (PrefixCon []))) | RdrName
IdP GhcPs
x RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nameRdrName Name
nilDataConName = "[]"
patToStr' _ = ""

strToPat' :: String -> Pat GhcPs
strToPat' :: String -> Pat GhcPs
strToPat' z :: String
z
  | String
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "True"  = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc RdrName
SrcSpanLess (Located RdrName)
true_RDR) ([Pat GhcPs] -> HsConPatDetails GhcPs
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [])
  | String
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "False" = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc RdrName
SrcSpanLess (Located RdrName)
false_RDR) ([Pat GhcPs] -> HsConPatDetails GhcPs
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [])
  | String
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "[]"    = Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn (SrcSpanLess (Located RdrName) -> Located (IdP GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> Located (IdP GhcPs))
-> SrcSpanLess (Located RdrName) -> Located (IdP GhcPs)
forall a b. (a -> b) -> a -> b
$ Name -> RdrName
nameRdrName Name
nilDataConName) ([Pat GhcPs] -> HsConPatDetails GhcPs
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [])
  | Bool
otherwise    = XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExt
XVarPat GhcPs
noExt (SrcSpanLess (Located RdrName) -> Located (IdP GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> Located (IdP GhcPs))
-> SrcSpanLess (Located RdrName) -> Located (IdP GhcPs)
forall a b. (a -> b) -> a -> b
$ FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
z))

fromPChar' :: Pat GhcPs -> Maybe Char
fromPChar' :: Pat GhcPs -> Maybe Char
fromPChar' (LL _ (LitPat _ (HsChar _ x))) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
fromPChar' _ = Maybe Char
forall a. Maybe a
Nothing

-- Contains a '..' as in 'Foo{..}'
hasPFieldsDotDot' :: HsRecFields GhcPs (Pat GhcPs) -> Bool
hasPFieldsDotDot' :: HsRecFields GhcPs (Pat GhcPs) -> Bool
hasPFieldsDotDot' HsRecFields {rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe Int
rec_dotdot=Just _} = Bool
True
hasPFieldsDotDot' _ = Bool
False -- {-# COMPLETE LL #-}

-- Field has a '_' as in '{foo=_} or is punned e.g. '{foo}'.
isPFieldWildcard' :: LHsRecField GhcPs (Pat GhcPs) -> Bool
isPFieldWildcard' :: LHsRecField GhcPs (Pat GhcPs) -> Bool
isPFieldWildcard' (LL _ HsRecField {hsRecFieldArg=(LL _ (WildPat _))}) = Bool
True
isPFieldWildcard' (LL _ HsRecField {hsRecPun=True}) = Bool
True
isPFieldWildcard' (LL _ HsRecField {}) = Bool
False
isPFieldWildcard' _ = Bool
False -- {-# COMPLETE LL #-}

isPWildCard' :: Pat GhcPs -> Bool
isPWildCard' :: Pat GhcPs -> Bool
isPWildCard' (LL _ (WildPat _)) = Bool
True
isPWildCard' _ = Bool
False

isPFieldPun' :: LHsRecField GhcPs (Pat GhcPs) -> Bool
isPFieldPun' :: LHsRecField GhcPs (Pat GhcPs) -> Bool
isPFieldPun' (LL _ HsRecField {hsRecPun=True}) = Bool
True
isPFieldPun' _ = Bool
False

isPatTypeSig', isPBangPat', isPViewPat' :: Pat GhcPs -> Bool
isPatTypeSig' :: Pat GhcPs -> Bool
isPatTypeSig' (LL _ SigPat{}) = Bool
True; isPatTypeSig' _ = Bool
False
isPBangPat' :: Pat GhcPs -> Bool
isPBangPat' (LL _ BangPat{}) = Bool
True; isPBangPat' _ = Bool
False
isPViewPat' :: Pat GhcPs -> Bool
isPViewPat' (LL _ ViewPat{}) = Bool
True; isPViewPat' _ = Bool
False