{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.Syntax.Pat (
Pat(..), LPat,
ConLikeP,
HsConPatDetails, hsConPatArgs,
HsRecFields(..), HsRecField'(..), LHsRecField',
HsRecField, LHsRecField,
HsRecUpdField, LHsRecUpdField,
hsRecFields, hsRecFieldSel, hsRecFieldsArgs,
) where
import GHC.Prelude
import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsSplice)
import Language.Haskell.Syntax.Lit
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import GHC.Types.Basic
import GHC.Core.Ppr ( )
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
type LPat p = XRec p (Pat p)
data Pat p
=
WildPat (XWildPat p)
| VarPat (XVarPat p)
(LIdP p)
| LazyPat (XLazyPat p)
(LPat p)
| AsPat (XAsPat p)
(LIdP p) (LPat p)
| ParPat (XParPat p)
(LPat p)
| BangPat (XBangPat p)
(LPat p)
| ListPat (XListPat p)
[LPat p]
| TuplePat (XTuplePat p)
[LPat p]
Boxity
| SumPat (XSumPat p)
(LPat p)
ConTag
Arity
| 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
}
| ViewPat (XViewPat p)
(LHsExpr p)
(LPat p)
| SplicePat (XSplicePat p)
(HsSplice p)
| LitPat (XLitPat p)
(HsLit p)
| NPat
(XNPat p)
(XRec p (HsOverLit p))
(Maybe (SyntaxExpr p))
(SyntaxExpr p)
| NPlusKPat (XNPlusKPat p)
(LIdP p)
(XRec p (HsOverLit p))
(HsOverLit p)
(SyntaxExpr p)
(SyntaxExpr p)
| SigPat (XSigPat p)
(LPat p)
(HsPatSigType (NoGhcTc p))
| XPat
!(XXPat p)
type family ConLikeP x
type HsConPatDetails p = HsConDetails (HsPatSigType (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 [HsPatSigType (NoGhcTc p)]
_ [LPat p]
ps) = [LPat p]
ps
hsConPatArgs (RecCon HsRecFields p (LPat p)
fs) = forall a b. (a -> b) -> [a] -> [b]
map (forall id arg. HsRecField' id arg -> arg
hsRecFieldArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @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]
data HsRecFields p arg
= HsRecFields { forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds :: [LHsRecField p arg],
forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot :: Maybe (Located Int) }
type LHsRecField' p id arg = XRec p (HsRecField' id arg)
type LHsRecField p arg = XRec p (HsRecField p arg)
type LHsRecUpdField p = XRec p (HsRecUpdField p)
type HsRecField p arg = HsRecField' (FieldOcc p) arg
type HsRecUpdField p = HsRecField' (AmbiguousFieldOcc p) (LHsExpr p)
data HsRecField' id arg = HsRecField {
forall id arg. HsRecField' id arg -> XHsRecField id
hsRecFieldAnn :: XHsRecField id,
forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl :: Located id,
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg :: arg,
forall id arg. HsRecField' id arg -> Bool
hsRecPun :: Bool
} deriving (forall a b. a -> HsRecField' id b -> HsRecField' id a
forall a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
forall id a b. a -> HsRecField' id b -> HsRecField' id a
forall id a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> HsRecField' id b -> HsRecField' id a
$c<$ :: forall id a b. a -> HsRecField' id b -> HsRecField' id a
fmap :: forall a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
$cfmap :: forall id a b. (a -> b) -> HsRecField' id a -> HsRecField' id b
Functor, forall a. HsRecField' id a -> Bool
forall id a. Eq a => a -> HsRecField' id a -> Bool
forall id a. Num a => HsRecField' id a -> a
forall id a. Ord a => HsRecField' id a -> a
forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m
forall id m. Monoid m => HsRecField' id m -> m
forall id arg. HsRecField' id arg -> Bool
forall id a. HsRecField' id a -> Int
forall id a. HsRecField' id a -> [a]
forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b
forall id a. (a -> a -> a) -> HsRecField' id a -> a
forall id m a. Monoid m => (a -> m) -> HsRecField' id a -> m
forall id b a. (b -> a -> b) -> b -> HsRecField' id a -> b
forall id a b. (a -> b -> b) -> b -> HsRecField' id 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
product :: forall a. Num a => HsRecField' id a -> a
$cproduct :: forall id a. Num a => HsRecField' id a -> a
sum :: forall a. Num a => HsRecField' id a -> a
$csum :: forall id a. Num a => HsRecField' id a -> a
minimum :: forall a. Ord a => HsRecField' id a -> a
$cminimum :: forall id a. Ord a => HsRecField' id a -> a
maximum :: forall a. Ord a => HsRecField' id a -> a
$cmaximum :: forall id a. Ord a => HsRecField' id a -> a
elem :: forall a. Eq a => a -> HsRecField' id a -> Bool
$celem :: forall id a. Eq a => a -> HsRecField' id a -> Bool
length :: forall a. HsRecField' id a -> Int
$clength :: forall id a. HsRecField' id a -> Int
null :: forall a. HsRecField' id a -> Bool
$cnull :: forall id arg. HsRecField' id arg -> Bool
toList :: forall a. HsRecField' id a -> [a]
$ctoList :: forall id a. HsRecField' id a -> [a]
foldl1 :: forall a. (a -> a -> a) -> HsRecField' id a -> a
$cfoldl1 :: forall id a. (a -> a -> a) -> HsRecField' id a -> a
foldr1 :: forall a. (a -> a -> a) -> HsRecField' id a -> a
$cfoldr1 :: forall id a. (a -> a -> a) -> HsRecField' id a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b
$cfoldl' :: forall id b a. (b -> a -> b) -> b -> HsRecField' id a -> b
foldl :: forall b a. (b -> a -> b) -> b -> HsRecField' id a -> b
$cfoldl :: forall id b a. (b -> a -> b) -> b -> HsRecField' id a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b
$cfoldr' :: forall id a b. (a -> b -> b) -> b -> HsRecField' id a -> b
foldr :: forall a b. (a -> b -> b) -> b -> HsRecField' id a -> b
$cfoldr :: forall id a b. (a -> b -> b) -> b -> HsRecField' id a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m
$cfoldMap' :: forall id m a. Monoid m => (a -> m) -> HsRecField' id a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> HsRecField' id a -> m
$cfoldMap :: forall id m a. Monoid m => (a -> m) -> HsRecField' id a -> m
fold :: forall m. Monoid m => HsRecField' id m -> m
$cfold :: forall id m. Monoid m => HsRecField' id m -> m
Foldable, forall id. Functor (HsRecField' id)
forall id. Foldable (HsRecField' id)
forall id (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
forall id (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
forall id (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
forall id (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
sequence :: forall (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
$csequence :: forall id (m :: * -> *) a.
Monad m =>
HsRecField' id (m a) -> m (HsRecField' id a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
$cmapM :: forall id (m :: * -> *) a b.
Monad m =>
(a -> m b) -> HsRecField' id a -> m (HsRecField' id b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
$csequenceA :: forall id (f :: * -> *) a.
Applicative f =>
HsRecField' id (f a) -> f (HsRecField' id a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
$ctraverse :: forall id (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HsRecField' id a -> f (HsRecField' id b)
Traversable)
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (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 = forall a b. (a -> b) -> [a] -> [b]
map (forall id arg. HsRecField' id arg -> arg
hsRecFieldArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. UnXRec p => XRec p a -> a
unXRec @p) (forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecFields p arg
rbinds)
hsRecFieldSel :: HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel :: forall pass arg. HsRecField pass arg -> Located (XCFieldOcc pass)
hsRecFieldSel = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl
instance (Outputable arg, Outputable (XRec p (HsRecField p arg)))
=> Outputable (HsRecFields p arg) where
ppr :: HsRecFields p arg -> SDoc
ppr (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [XRec p (HsRecField p arg)]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot = Maybe (Located Int)
Nothing })
= SDoc -> SDoc
braces ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr [XRec p (HsRecField p arg)]
flds)))
ppr (HsRecFields { rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds = [XRec p (HsRecField p arg)]
flds, rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot = Just (forall l e. GenLocated l e -> e
unLoc -> Int
n) })
= SDoc -> SDoc
braces ([SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma (forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr (forall a. Int -> [a] -> [a]
take Int
n [XRec p (HsRecField p arg)]
flds) forall a. [a] -> [a] -> [a]
++ [SDoc
dotdot])))
where
dotdot :: SDoc
dotdot = String -> SDoc
text String
".." SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
whenPprDebug (forall a. Outputable a => a -> SDoc
ppr (forall a. Int -> [a] -> [a]
drop Int
n [XRec p (HsRecField p arg)]
flds))
instance (Outputable p, OutputableBndr p, Outputable arg)
=> Outputable (HsRecField' p arg) where
ppr :: HsRecField' p arg -> SDoc
ppr (HsRecField { hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
hsRecFieldLbl = L SrcSpan
_ p
f, hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
hsRecFieldArg = arg
arg,
hsRecPun :: forall id arg. HsRecField' id arg -> Bool
hsRecPun = Bool
pun })
= forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc p
f SDoc -> SDoc -> SDoc
<+> (Bool -> SDoc -> SDoc
ppUnless Bool
pun forall a b. (a -> b) -> a -> b
$ SDoc
equals SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr arg
arg)