{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                      -- in module Language.Haskell.Syntax.Extension
{-# LANGUAGE DataKinds #-}
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

\section[PatSyntax]{Abstract Haskell syntax---patterns}
-}

-- See Note [Language.Haskell.Syntax.* Hierarchy] for why not GHC.Hs.*
module Language.Haskell.Syntax.Pat (
        Pat(..), LPat,
        ConLikeP, isInvisArgPat,
        isVisArgPat,

        HsConPatDetails, hsConPatArgs, hsConPatTyArgs,
        HsConPatTyArg(..), XConPatTyArg,
        HsRecFields(..), XHsRecFields, HsFieldBind(..), LHsFieldBind,
        HsRecField, LHsRecField,
        HsRecUpdField, LHsRecUpdField,
        RecFieldsDotDot(..),
        hsRecFields, hsRecFieldSel, hsRecFieldsArgs,
    ) where

import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsUntypedSplice)

-- friends:
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Lit
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type

-- libraries:
import Data.Maybe
import Data.Functor
import Data.Foldable
import Data.Traversable
import Data.Bool
import Data.Data
import Data.Eq
import Data.Ord
import Data.Int
import Data.Function
import qualified Data.List
import Data.List.NonEmpty (NonEmpty)

type LPat p = XRec p (Pat p)

-- | Pattern
data Pat p
  =     ------------ Simple patterns ---------------
    WildPat     (XWildPat p)
    -- ^ Wildcard Pattern, i.e. @_@

  | VarPat      (XVarPat p)
                (LIdP p)
    -- ^ Variable Pattern, e.g. @x@

    -- See Note [Located RdrNames] in GHC.Hs.Expr
  | LazyPat     (XLazyPat p)
                (LPat p)
    -- ^ Lazy Pattern, e.g. @~x@
    --
    -- exactprint: the location of @~@ is captured using 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnTilde'

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

  | AsPat       (XAsPat p)
                (LIdP p)
                (LPat p)
    -- ^ As pattern, e.g. @x\@pat@
    --
    -- exactprint: the location of @\@@ is captured using 'GHC.Parser.Annotation.EpToken' @"\@"@

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

  | ParPat      (XParPat p)
                (LPat p)
    -- ^ Parenthesised pattern, e.g. @(x)@
    --
    -- exactprint: the location of parentheses is captured using 'GHC.Parser.Annotation.EpToken' @"("@ and 'GHC.Parser.Annotation.EpToken' @")"@

    -- See Note [Parens in HsSyn] in GHC.Hs.Expr

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
  | BangPat     (XBangPat p)
                (LPat p)
    -- ^ Bang pattern, e.g. @!x@
    --
    -- exactprint: the location of @!@ is captured using 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnBang'

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

        ------------ Lists, tuples, arrays ---------------
  | ListPat     (XListPat p)
                [LPat p]
    -- ^ Syntactic List, e.g. @[x]@ or @[x,y]@.
    -- Note that @[]@ and @(x:xs)@ patterns are both represented using 'ConPat'.
    --
    -- exactprint: the location of brackets is captured using 'GHC.Parser.Annotation.AnnKeywordId' :
    -- 'GHC.Parser.Annotation.AnnOpenS' and 'GHC.Parser.Annotation.AnnCloseS' respectively.

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

  | -- | Tuple pattern, e.g. @(x, y)@ (boxed tuples) or @(# x, y #)@ (requires @-XUnboxedTuples@)
    --
    -- exactprint: the location of parens is captured using 'GHC.Parser.Annotation.AnnKeywordId' :
    -- 'GHC.Parser.Annotation.AnnOpenP' and 'GHC.Parser.Annotation.AnnCloseP' in case of boxed tuples
    -- or 'GHC.Parser.Annotation.AnnOpenPH' and 'GHC.Parser.Annotation.AnnClosePH' in case of unboxed tuples.

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
    TuplePat    (XTuplePat p)    -- ^ After typechecking, holds the types of the tuple components
                [LPat p]         -- ^ Tuple sub-patterns
                Boxity

        -- You might think that the post typechecking Type was redundant,
        -- because we can get the pattern type by getting the types of the
        -- sub-patterns.
        -- But it's essential
        --      data T a where
        --        T1 :: Int -> T Int
        --      f :: (T a, a) -> Int
        --      f (T1 x, z) = z
        -- When desugaring, we must generate
        --      f = /\a. \v::a.  case v of (t::T a, w::a) ->
        --                       case t of (T1 (x::Int)) ->
        -- Note the (w::a), NOT (w::Int), because we have not yet
        -- refined 'a' to Int.  So we must know that the second component
        -- of the tuple is of type 'a' not Int.  See selectMatchVar
        -- (June 14: I'm not sure this comment is right; the sub-patterns
        --           will be wrapped in CoPats, no?)

  | OrPat       (XOrPat p)
                (NonEmpty (LPat p))
    -- ^ Or Pattern, e.g. @(pat_1; ...; pat_n)@. Used by @-XOrPatterns@
    --
    -- @since 9.12.1

  | SumPat      (XSumPat p)        -- after typechecker, types of the alternative
                (LPat p)           -- Sum sub-pattern
                ConTag             -- Alternative (one-based)
                SumWidth           -- Arity (INVARIANT: ≥ 2)

    -- ^ Anonymous sum pattern, e.g. @(# x | #)@. Used by @-XUnboxedSums@
    --
    -- exactprint: the location of @(#@ and @#)@ is captured using 'GHC.Parser.Annotation.AnnKeywordId' :
    -- 'GHC.Parser.Annotation.AnnOpenPH' and 'GHC.Parser.Annotation.AnnClosePH' respectively.

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

        ------------ Constructor patterns ---------------
  | ConPat {
        forall p. Pat p -> XConPat p
pat_con_ext :: XConPat p,
        forall p. Pat p -> XRec p (ConLikeP p)
pat_con     :: XRec p (ConLikeP p),
        forall p. Pat p -> HsConPatDetails p
pat_args    :: HsConPatDetails p
    }
    -- ^ Constructor Pattern, e.g. @()@, @[]@ or @Nothing@

        ------------ View patterns ---------------

  | ViewPat       (XViewPat p)
                  (LHsExpr p)
                  (LPat p)
    -- ^ View Pattern, e.g. @someFun -> pat@. Used by @-XViewPatterns@
    --
    -- exactprint: the location of @->@ is captured using 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnRarrow'

    -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

        ------------ Pattern splices ---------------

  | SplicePat       (XSplicePat p)
                    (HsUntypedSplice p)
  -- ^  Splice Pattern, e.g. @$(pat)@

        ------------ Literal and n+k patterns ---------------
  | LitPat          (XLitPat p)
                    (HsLit p)
    -- ^ Literal Pattern
    --
    -- Used for __non-overloaded__ literal patterns:
    -- Int#, Char#, Int, Char, String, etc.

  | NPat            (XNPat p)            -- Overall type of pattern. Might be
                                         -- different than the literal's type
                                         -- if (==) or negate changes the type
                    (XRec p (HsOverLit p))     -- ALWAYS positive
                    (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
                                           -- negative patterns, Nothing
                                           -- otherwise
                    (SyntaxExpr p)       -- Equality checker, of type t->t->Bool

  -- ^ Natural Pattern, used for all overloaded literals, including overloaded Strings
  -- with @-XOverloadedStrings@
  --
  -- exactprint: the location of @-@ (for negative literals) is captured using 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnMinus'

  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

  | -- | n+k pattern, e.g. @n+1@, used by @-XNPlusKPatterns@
   NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern
                    (LIdP p)                 -- n+k pattern
                    (XRec p (HsOverLit p))   -- It'll always be an HsIntegral
                    (HsOverLit p)            -- See Note [NPlusK patterns] in GHC.Tc.Gen.Pat
                     -- NB: This could be (PostTc ...), but that induced a
                     -- a new hs-boot file. Not worth it.

                    (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool
                    (SyntaxExpr p)   -- Name of '-' (see GHC.Rename.Env.lookupSyntax)

        ------------ Pattern type signatures ---------------

  | SigPat          (XSigPat p)             -- After typechecker: Type
                    (LPat p)                -- Pattern with a type signature
                    (HsPatSigType (NoGhcTc p)) --  Signature can bind both
                                               --  kind and type vars

   -- ^ Pattern with a type signature, e.g. @x :: Int@
   --
   -- exactprint: the location of @::@ is captured using 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDcolon'

  -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation

  | -- | Embed the syntax of types into patterns, e.g. @fn (type t) = rhs@.
    -- Enabled by @-XExplicitNamespaces@ in conjunction with @-XRequiredTypeArguments@.
    --
    -- exactprint: the location of the @type@ keyword is captured using 'GHC.Parser.Annotation.EpToken' @"type"@
    EmbTyPat        (XEmbTyPat p)
                    (HsTyPat (NoGhcTc p))

  | InvisPat (XInvisPat p) (HsTyPat (NoGhcTc p))
  -- ^ Type abstraction which brings into scope type variables associated with invisible forall.
  -- E.g. @fn \@t ... = rhs@. Used by @-XTypeAbstractions@.
  --
  -- exactprint: the location of @\@@ is captured by 'GHC.Parser.Annotation.EpToken' @"\@"@

  -- See Note [Invisible binders in functions] in GHC.Hs.Pat

  | -- | TTG Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension
    XPat !(XXPat p)

type family ConLikeP x


-- ---------------------------------------------------------------------

-- | Type argument in a data constructor pattern,
--   e.g. the @\@a@ in @f (Just \@a x) = ...@.
data HsConPatTyArg p = HsConPatTyArg !(XConPatTyArg p) (HsTyPat p)

type family XConPatTyArg p

isInvisArgPat :: Pat p -> Bool
isInvisArgPat :: forall p. Pat p -> Bool
isInvisArgPat InvisPat{} = Bool
True
isInvisArgPat Pat p
_   = Bool
False

isVisArgPat :: Pat p -> Bool
isVisArgPat :: forall p. Pat p -> Bool
isVisArgPat = Bool -> Bool
not (Bool -> Bool) -> (Pat p -> Bool) -> Pat p -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat p -> Bool
forall p. Pat p -> Bool
isInvisArgPat

-- | Haskell Constructor Pattern Details
type HsConPatDetails p = HsConDetails (HsConPatTyArg (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))

hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p]
hsConPatArgs :: forall p. UnXRec p => HsConPatDetails p -> [LPat p]
hsConPatArgs (PrefixCon [HsConPatTyArg (NoGhcTc p)]
_ [LPat p]
ps) = [LPat p]
ps
hsConPatArgs (RecCon HsRecFields p (LPat p)
fs)      = (XRec p (HsFieldBind (XRec p (FieldOcc p)) (LPat p)) -> LPat p)
-> [XRec p (HsFieldBind (XRec p (FieldOcc p)) (LPat p))]
-> [LPat p]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (HsFieldBind (XRec p (FieldOcc p)) (LPat p) -> LPat p
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind (XRec p (FieldOcc p)) (LPat p) -> LPat p)
-> (XRec p (HsFieldBind (XRec p (FieldOcc p)) (LPat p))
    -> HsFieldBind (XRec p (FieldOcc p)) (LPat p))
-> XRec p (HsFieldBind (XRec p (FieldOcc p)) (LPat p))
-> LPat p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (HsRecFields p (LPat p)
-> [XRec p (HsFieldBind (XRec p (FieldOcc p)) (LPat p))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p (LPat p)
fs)
hsConPatArgs (InfixCon LPat p
p1 LPat p
p2) = [LPat p
p1,LPat p
p2]

hsConPatTyArgs :: forall p. HsConPatDetails p -> [HsConPatTyArg (NoGhcTc p)]
hsConPatTyArgs :: forall p. HsConPatDetails p -> [HsConPatTyArg (NoGhcTc p)]
hsConPatTyArgs (PrefixCon [HsConPatTyArg (NoGhcTc p)]
tyargs [LPat p]
_) = [HsConPatTyArg (NoGhcTc p)]
tyargs
hsConPatTyArgs (RecCon HsRecFields p (LPat p)
_)           = []
hsConPatTyArgs (InfixCon LPat p
_ LPat p
_)       = []

-- | Haskell Record Fields
--
-- HsRecFields is used only for patterns and expressions (not data type
-- declarations)
data HsRecFields p arg         -- A bunch of record fields
                                --      { x = 3, y = True }
        -- Used for both expressions and patterns
  = HsRecFields { forall p arg. HsRecFields p arg -> XHsRecFields p
rec_ext    :: !(XHsRecFields p),
                  forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds   :: [LHsRecField p arg],
                  forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot :: Maybe (XRec p RecFieldsDotDot) }  -- Note [DotDot fields]
  -- AZ:The XRec for LHsRecField makes the derivings fail.
  -- deriving (Functor, Foldable, Traversable)

type family XHsRecFields p

-- | Newtype to be able to have a specific XRec instance for the Int in `rec_dotdot`
newtype RecFieldsDotDot = RecFieldsDotDot { RecFieldsDotDot -> Int
unRecFieldsDotDot :: Int }
    deriving (Typeable RecFieldsDotDot
Typeable RecFieldsDotDot =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RecFieldsDotDot -> c RecFieldsDotDot)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RecFieldsDotDot)
-> (RecFieldsDotDot -> Constr)
-> (RecFieldsDotDot -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RecFieldsDotDot))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RecFieldsDotDot))
-> ((forall b. Data b => b -> b)
    -> RecFieldsDotDot -> RecFieldsDotDot)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RecFieldsDotDot -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecFieldsDotDot -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RecFieldsDotDot -> m RecFieldsDotDot)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecFieldsDotDot -> m RecFieldsDotDot)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecFieldsDotDot -> m RecFieldsDotDot)
-> Data RecFieldsDotDot
RecFieldsDotDot -> Constr
RecFieldsDotDot -> DataType
(forall b. Data b => b -> b) -> RecFieldsDotDot -> RecFieldsDotDot
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RecFieldsDotDot -> u
forall u. (forall d. Data d => d -> u) -> RecFieldsDotDot -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFieldsDotDot
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFieldsDotDot -> c RecFieldsDotDot
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFieldsDotDot)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecFieldsDotDot)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFieldsDotDot -> c RecFieldsDotDot
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFieldsDotDot -> c RecFieldsDotDot
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFieldsDotDot
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFieldsDotDot
$ctoConstr :: RecFieldsDotDot -> Constr
toConstr :: RecFieldsDotDot -> Constr
$cdataTypeOf :: RecFieldsDotDot -> DataType
dataTypeOf :: RecFieldsDotDot -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFieldsDotDot)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFieldsDotDot)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecFieldsDotDot)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RecFieldsDotDot)
$cgmapT :: (forall b. Data b => b -> b) -> RecFieldsDotDot -> RecFieldsDotDot
gmapT :: (forall b. Data b => b -> b) -> RecFieldsDotDot -> RecFieldsDotDot
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFieldsDotDot -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecFieldsDotDot -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RecFieldsDotDot -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RecFieldsDotDot -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RecFieldsDotDot -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecFieldsDotDot -> m RecFieldsDotDot
Data, RecFieldsDotDot -> RecFieldsDotDot -> Bool
(RecFieldsDotDot -> RecFieldsDotDot -> Bool)
-> (RecFieldsDotDot -> RecFieldsDotDot -> Bool)
-> Eq RecFieldsDotDot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
== :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
$c/= :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
/= :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
Eq, Eq RecFieldsDotDot
Eq RecFieldsDotDot =>
(RecFieldsDotDot -> RecFieldsDotDot -> Ordering)
-> (RecFieldsDotDot -> RecFieldsDotDot -> Bool)
-> (RecFieldsDotDot -> RecFieldsDotDot -> Bool)
-> (RecFieldsDotDot -> RecFieldsDotDot -> Bool)
-> (RecFieldsDotDot -> RecFieldsDotDot -> Bool)
-> (RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot)
-> (RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot)
-> Ord RecFieldsDotDot
RecFieldsDotDot -> RecFieldsDotDot -> Bool
RecFieldsDotDot -> RecFieldsDotDot -> Ordering
RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RecFieldsDotDot -> RecFieldsDotDot -> Ordering
compare :: RecFieldsDotDot -> RecFieldsDotDot -> Ordering
$c< :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
< :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
$c<= :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
<= :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
$c> :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
> :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
$c>= :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
>= :: RecFieldsDotDot -> RecFieldsDotDot -> Bool
$cmax :: RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot
max :: RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot
$cmin :: RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot
min :: RecFieldsDotDot -> RecFieldsDotDot -> RecFieldsDotDot
Ord)

-- Note [DotDot fields]
-- ~~~~~~~~~~~~~~~~~~~~
-- The rec_dotdot field means this:
--   Nothing => the normal case
--   Just n  => the group uses ".." notation,
--
-- In the latter case:
--
--   *before* renamer: rec_flds are exactly the n user-written fields
--
--   *after* renamer:  rec_flds includes *all* fields, with
--                     the first 'n' being the user-written ones
--                     and the remainder being 'filled in' implicitly

-- | Located Haskell Record Field
type LHsFieldBind p id arg = XRec p (HsFieldBind id arg)

-- | Located Haskell Record Field
type LHsRecField  p arg = XRec p (HsRecField  p arg)

-- | Located Haskell Record Update Field
type LHsRecUpdField p q = XRec p (HsRecUpdField p q)

-- | Haskell Record Field
type HsRecField p arg   = HsFieldBind (LFieldOcc p) arg

-- | Haskell Record Update Field
type HsRecUpdField p q  = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr q)

-- | Haskell Field Binding
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnEqual'
--
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
data HsFieldBind lhs rhs = HsFieldBind {
        forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
hfbAnn :: XHsFieldBind lhs,
        forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS :: lhs,
        forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS :: rhs,           -- ^ Filled in by renamer when punning
        forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun :: Bool           -- ^ Note [Punning]
  } deriving ((forall a b. (a -> b) -> HsFieldBind lhs a -> HsFieldBind lhs b)
-> (forall a b. a -> HsFieldBind lhs b -> HsFieldBind lhs a)
-> Functor (HsFieldBind lhs)
forall a b. a -> HsFieldBind lhs b -> HsFieldBind lhs a
forall a b. (a -> b) -> HsFieldBind lhs a -> HsFieldBind lhs b
forall lhs a b. a -> HsFieldBind lhs b -> HsFieldBind lhs a
forall lhs a b. (a -> b) -> HsFieldBind lhs a -> HsFieldBind lhs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall lhs a b. (a -> b) -> HsFieldBind lhs a -> HsFieldBind lhs b
fmap :: forall a b. (a -> b) -> HsFieldBind lhs a -> HsFieldBind lhs b
$c<$ :: forall lhs a b. a -> HsFieldBind lhs b -> HsFieldBind lhs a
<$ :: forall a b. a -> HsFieldBind lhs b -> HsFieldBind lhs a
Functor, (forall m. Monoid m => HsFieldBind lhs m -> m)
-> (forall m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m)
-> (forall m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m)
-> (forall a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b)
-> (forall a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b)
-> (forall b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b)
-> (forall b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b)
-> (forall a. (a -> a -> a) -> HsFieldBind lhs a -> a)
-> (forall a. (a -> a -> a) -> HsFieldBind lhs a -> a)
-> (forall a. HsFieldBind lhs a -> [a])
-> (forall a. HsFieldBind lhs a -> Bool)
-> (forall a. HsFieldBind lhs a -> Int)
-> (forall a. Eq a => a -> HsFieldBind lhs a -> Bool)
-> (forall a. Ord a => HsFieldBind lhs a -> a)
-> (forall a. Ord a => HsFieldBind lhs a -> a)
-> (forall a. Num a => HsFieldBind lhs a -> a)
-> (forall a. Num a => HsFieldBind lhs a -> a)
-> Foldable (HsFieldBind lhs)
forall a. Eq a => a -> HsFieldBind lhs a -> Bool
forall a. Num a => HsFieldBind lhs a -> a
forall a. Ord a => HsFieldBind lhs a -> a
forall m. Monoid m => HsFieldBind lhs m -> m
forall a. HsFieldBind lhs a -> Bool
forall a. HsFieldBind lhs a -> Int
forall a. HsFieldBind lhs a -> [a]
forall a. (a -> a -> a) -> HsFieldBind lhs a -> a
forall lhs a. Eq a => a -> HsFieldBind lhs a -> Bool
forall lhs a. Num a => HsFieldBind lhs a -> a
forall lhs a. Ord a => HsFieldBind lhs a -> a
forall lhs m. Monoid m => HsFieldBind lhs m -> m
forall m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m
forall lhs rhs. HsFieldBind lhs rhs -> Bool
forall lhs a. HsFieldBind lhs a -> Int
forall lhs a. HsFieldBind lhs a -> [a]
forall b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b
forall a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b
forall lhs a. (a -> a -> a) -> HsFieldBind lhs a -> a
forall lhs m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m
forall lhs b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b
forall lhs a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall lhs m. Monoid m => HsFieldBind lhs m -> m
fold :: forall m. Monoid m => HsFieldBind lhs m -> m
$cfoldMap :: forall lhs m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m
$cfoldMap' :: forall lhs m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> HsFieldBind lhs a -> m
$cfoldr :: forall lhs a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b
$cfoldr' :: forall lhs a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HsFieldBind lhs a -> b
$cfoldl :: forall lhs b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b
$cfoldl' :: forall lhs b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> HsFieldBind lhs a -> b
$cfoldr1 :: forall lhs a. (a -> a -> a) -> HsFieldBind lhs a -> a
foldr1 :: forall a. (a -> a -> a) -> HsFieldBind lhs a -> a
$cfoldl1 :: forall lhs a. (a -> a -> a) -> HsFieldBind lhs a -> a
foldl1 :: forall a. (a -> a -> a) -> HsFieldBind lhs a -> a
$ctoList :: forall lhs a. HsFieldBind lhs a -> [a]
toList :: forall a. HsFieldBind lhs a -> [a]
$cnull :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
null :: forall a. HsFieldBind lhs a -> Bool
$clength :: forall lhs a. HsFieldBind lhs a -> Int
length :: forall a. HsFieldBind lhs a -> Int
$celem :: forall lhs a. Eq a => a -> HsFieldBind lhs a -> Bool
elem :: forall a. Eq a => a -> HsFieldBind lhs a -> Bool
$cmaximum :: forall lhs a. Ord a => HsFieldBind lhs a -> a
maximum :: forall a. Ord a => HsFieldBind lhs a -> a
$cminimum :: forall lhs a. Ord a => HsFieldBind lhs a -> a
minimum :: forall a. Ord a => HsFieldBind lhs a -> a
$csum :: forall lhs a. Num a => HsFieldBind lhs a -> a
sum :: forall a. Num a => HsFieldBind lhs a -> a
$cproduct :: forall lhs a. Num a => HsFieldBind lhs a -> a
product :: forall a. Num a => HsFieldBind lhs a -> a
Foldable, Functor (HsFieldBind lhs)
Foldable (HsFieldBind lhs)
(Functor (HsFieldBind lhs), Foldable (HsFieldBind lhs)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> HsFieldBind lhs a -> f (HsFieldBind lhs b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    HsFieldBind lhs (f a) -> f (HsFieldBind lhs a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> HsFieldBind lhs a -> m (HsFieldBind lhs b))
-> (forall (m :: * -> *) a.
    Monad m =>
    HsFieldBind lhs (m a) -> m (HsFieldBind lhs a))
-> Traversable (HsFieldBind lhs)
forall lhs. Functor (HsFieldBind lhs)
forall lhs. Foldable (HsFieldBind lhs)
forall lhs (m :: * -> *) a.
Monad m =>
HsFieldBind lhs (m a) -> m (HsFieldBind lhs a)
forall lhs (f :: * -> *) a.
Applicative f =>
HsFieldBind lhs (f a) -> f (HsFieldBind lhs a)
forall lhs (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsFieldBind lhs a -> m (HsFieldBind lhs b)
forall lhs (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsFieldBind lhs a -> f (HsFieldBind lhs b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
HsFieldBind lhs (m a) -> m (HsFieldBind lhs a)
forall (f :: * -> *) a.
Applicative f =>
HsFieldBind lhs (f a) -> f (HsFieldBind lhs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsFieldBind lhs a -> m (HsFieldBind lhs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsFieldBind lhs a -> f (HsFieldBind lhs b)
$ctraverse :: forall lhs (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsFieldBind lhs a -> f (HsFieldBind lhs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsFieldBind lhs a -> f (HsFieldBind lhs b)
$csequenceA :: forall lhs (f :: * -> *) a.
Applicative f =>
HsFieldBind lhs (f a) -> f (HsFieldBind lhs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HsFieldBind lhs (f a) -> f (HsFieldBind lhs a)
$cmapM :: forall lhs (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsFieldBind lhs a -> m (HsFieldBind lhs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsFieldBind lhs a -> m (HsFieldBind lhs b)
$csequence :: forall lhs (m :: * -> *) a.
Monad m =>
HsFieldBind lhs (m a) -> m (HsFieldBind lhs a)
sequence :: forall (m :: * -> *) a.
Monad m =>
HsFieldBind lhs (m a) -> m (HsFieldBind lhs a)
Traversable)


-- Note [Punning]
-- ~~~~~~~~~~~~~~
-- If you write T { x, y = v+1 }, the HsRecFields will be
--      HsRecField x x True ...
--      HsRecField y (v+1) False ...
-- That is, for "punned" field x is expanded (in the renamer)
-- to x=x; but with a punning flag so we can detect it later
-- (e.g. when pretty printing)
--
-- If the original field was qualified, we un-qualify it, thus
--    T { A.x } means T { A.x = x }


-- Note [HsRecField and HsRecUpdField]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-- A HsRecField (used for record construction and pattern matching)
-- contains an unambiguous occurrence of a field (i.e. a FieldOcc).
-- We can't just store the Name, because thanks to
-- DuplicateRecordFields this may not correspond to the label the user
-- wrote.
--
-- A HsRecUpdField (used for record update) contains a potentially
-- ambiguous occurrence of a field (an AmbiguousFieldOcc).  The
-- renamer will fill in the selector function if it can, but if the
-- selector is ambiguous the renamer will defer to the typechecker.
-- After the typechecker, a unique selector will have been determined.
--
-- The renamer produces an Unambiguous result if it can, rather than
-- just doing the lookup in the typechecker, so that completely
-- unambiguous updates can be represented by 'GHC.HsToCore.Quote.repUpdFields'.
--
-- For example, suppose we have:
--
--     data S = MkS { x :: Int }
--     data T = MkT { x :: Int }
--
--     f z = (z { x = 3 }) :: S
--
-- The parsed HsRecUpdField corresponding to the record update will have:
--
--     hfbLHS = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
--
-- After the renamer, this will become:
--
--     hfbLHS = Ambiguous   "x" noExtField :: AmbiguousFieldOcc Name
--
-- (note that the Unambiguous constructor is not type-correct here).
-- The typechecker will determine the particular selector:
--
--     hfbLHS = Unambiguous "x" $sel:x:MkS  :: AmbiguousFieldOcc Id
--
-- See also Note [Disambiguating record updates] in GHC.Rename.Pat.

hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
hsRecFields :: forall p arg. UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
hsRecFields HsRecFields p arg
rbinds = (XRec p (HsFieldBind (XRec p (FieldOcc p)) arg) -> XCFieldOcc p)
-> [XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)]
-> [XCFieldOcc p]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (HsFieldBind (XRec p (FieldOcc p)) arg -> XCFieldOcc p
forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel (HsFieldBind (XRec p (FieldOcc p)) arg -> XCFieldOcc p)
-> (XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)
    -> HsFieldBind (XRec p (FieldOcc p)) arg)
-> XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)
-> XCFieldOcc p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (HsRecFields p arg
-> [XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p arg
rbinds)

hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg]
hsRecFieldsArgs :: forall p arg. UnXRec p => HsRecFields p arg -> [arg]
hsRecFieldsArgs HsRecFields p arg
rbinds = (XRec p (HsFieldBind (XRec p (FieldOcc p)) arg) -> arg)
-> [XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)] -> [arg]
forall a b. (a -> b) -> [a] -> [b]
Data.List.map (HsFieldBind (XRec p (FieldOcc p)) arg -> arg
forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS (HsFieldBind (XRec p (FieldOcc p)) arg -> arg)
-> (XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)
    -> HsFieldBind (XRec p (FieldOcc p)) arg)
-> XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)
-> arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (HsRecFields p arg
-> [XRec p (HsFieldBind (XRec p (FieldOcc p)) arg)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p arg
rbinds)

hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel = FieldOcc p -> XCFieldOcc p
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc p -> XCFieldOcc p)
-> (HsFieldBind (XRec p (FieldOcc p)) arg -> FieldOcc p)
-> HsFieldBind (XRec p (FieldOcc p)) arg
-> XCFieldOcc p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p (XRec p (FieldOcc p) -> FieldOcc p)
-> (HsFieldBind (XRec p (FieldOcc p)) arg -> XRec p (FieldOcc p))
-> HsFieldBind (XRec p (FieldOcc p)) arg
-> FieldOcc p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind (XRec p (FieldOcc p)) arg -> XRec p (FieldOcc p)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS