{-# LANGUAGE CPP #-}
module GHC.SourceGen.Binds.Internal where
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Basic (Origin(Generated))
import GHC.Data.Bag (listToBag)
import GHC.Types.SrcLoc (Located)
#else
import BasicTypes (Origin(Generated))
import Bag (listToBag)
import SrcLoc (Located)
#endif
import GHC.Hs.Binds
import GHC.Hs.Decls
import GHC.Hs.Expr (MatchGroup(..), Match(..), GRHSs(..))
#if !MIN_VERSION_ghc(8,6,0)
import PlaceHolder (PlaceHolder(..))
#endif
import GHC.SourceGen.Pat.Internal (parenthesize)
import GHC.SourceGen.Syntax.Internal
data RawValBind
= SigV Sig'
| BindV HsBind'
valBinds :: [RawValBind] -> HsLocalBinds'
valBinds :: [RawValBind] -> HsLocalBinds'
valBinds [] = (NoExtField -> HsLocalBinds') -> HsLocalBinds'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> HsLocalBinds'
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds
valBinds [RawValBind]
vbs =
(NoExtField -> HsValBindsLR GhcPs GhcPs -> HsLocalBinds')
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> HsValBindsLR GhcPs GhcPs -> HsLocalBinds'
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds
#if MIN_VERSION_ghc(8,6,0)
(HsValBindsLR GhcPs GhcPs -> HsLocalBinds')
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds'
forall a b. (a -> b) -> a -> b
$ (NoExtField
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs)
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds
#else
$ noExt ValBindsIn
#endif
([Located HsBind'] -> LHsBindsLR GhcPs GhcPs
forall a. [a] -> Bag a
listToBag ([Located HsBind'] -> LHsBindsLR GhcPs GhcPs)
-> [Located HsBind'] -> LHsBindsLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ (HsBind' -> Located HsBind') -> [HsBind'] -> [Located HsBind']
forall a b. (a -> b) -> [a] -> [b]
map HsBind' -> Located HsBind'
forall e. e -> Located e
builtLoc [HsBind']
binds)
((Sig' -> LSig GhcPs) -> [Sig'] -> [LSig GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map Sig' -> LSig GhcPs
forall e. e -> Located e
builtLoc [Sig']
sigs)
where
sigs :: [Sig']
sigs = [Sig'
s | SigV Sig'
s <- [RawValBind]
vbs]
binds :: [HsBind']
binds = [HsBind'
b | BindV HsBind'
b <- [RawValBind]
vbs]
data RawMatch = RawMatch
{ RawMatch -> [Pat']
rawMatchPats :: [Pat']
, RawMatch -> RawGRHSs
rawMatchGRHSs :: RawGRHSs
}
data RawGRHSs = RawGRHSs
{ RawGRHSs -> [GuardedExpr]
rawGRHSs :: [GuardedExpr]
, RawGRHSs -> [RawValBind]
rawGRHSWhere :: [RawValBind]
}
matchGroup :: HsMatchContext' -> [RawMatch] -> MatchGroup' (Located HsExpr')
matchGroup :: HsMatchContext' -> [RawMatch] -> MatchGroup' (Located HsExpr')
matchGroup HsMatchContext'
context [RawMatch]
matches =
(NoExtField
-> Located [LMatch GhcPs (Located HsExpr')]
-> Origin
-> MatchGroup' (Located HsExpr'))
-> Located [LMatch GhcPs (Located HsExpr')]
-> Origin
-> MatchGroup' (Located HsExpr')
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> Located [LMatch GhcPs (Located HsExpr')]
-> Origin
-> MatchGroup' (Located HsExpr')
forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG ([LMatch GhcPs (Located HsExpr')]
-> Located [LMatch GhcPs (Located HsExpr')]
forall e. e -> Located e
builtLoc ([LMatch GhcPs (Located HsExpr')]
-> Located [LMatch GhcPs (Located HsExpr')])
-> [LMatch GhcPs (Located HsExpr')]
-> Located [LMatch GhcPs (Located HsExpr')]
forall a b. (a -> b) -> a -> b
$ (RawMatch -> LMatch GhcPs (Located HsExpr'))
-> [RawMatch] -> [LMatch GhcPs (Located HsExpr')]
forall a b. (a -> b) -> [a] -> [b]
map (Match' (Located HsExpr') -> LMatch GhcPs (Located HsExpr')
forall e. e -> Located e
builtLoc (Match' (Located HsExpr') -> LMatch GhcPs (Located HsExpr'))
-> (RawMatch -> Match' (Located HsExpr'))
-> RawMatch
-> LMatch GhcPs (Located HsExpr')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawMatch -> Match' (Located HsExpr')
mkMatch) [RawMatch]
matches)
#if !MIN_VERSION_ghc(8,6,0)
[] PlaceHolder
#endif
Origin
Generated
where
mkMatch :: RawMatch -> Match' (Located HsExpr')
mkMatch :: RawMatch -> Match' (Located HsExpr')
mkMatch RawMatch
r = (NoExtField
-> HsMatchContext'
-> [Located Pat']
-> GRHSs' (Located HsExpr')
-> Match' (Located HsExpr'))
-> HsMatchContext'
-> [Located Pat']
-> GRHSs' (Located HsExpr')
-> Match' (Located HsExpr')
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> HsMatchContext'
-> [Located Pat']
-> GRHSs' (Located HsExpr')
-> Match' (Located HsExpr')
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match HsMatchContext'
context
((Pat' -> Located Pat') -> [Pat'] -> [Located Pat']
forall a b. (a -> b) -> [a] -> [b]
map Pat' -> LPat'
Pat' -> Located Pat'
builtPat ([Pat'] -> [Located Pat']) -> [Pat'] -> [Located Pat']
forall a b. (a -> b) -> a -> b
$ (Pat' -> Pat') -> [Pat'] -> [Pat']
forall a b. (a -> b) -> [a] -> [b]
map Pat' -> Pat'
parenthesize ([Pat'] -> [Pat']) -> [Pat'] -> [Pat']
forall a b. (a -> b) -> a -> b
$ RawMatch -> [Pat']
rawMatchPats RawMatch
r)
(RawGRHSs -> GRHSs' (Located HsExpr')
mkGRHSs (RawGRHSs -> GRHSs' (Located HsExpr'))
-> RawGRHSs -> GRHSs' (Located HsExpr')
forall a b. (a -> b) -> a -> b
$ RawMatch -> RawGRHSs
rawMatchGRHSs RawMatch
r)
mkGRHSs :: RawGRHSs -> GRHSs' (Located HsExpr')
mkGRHSs :: RawGRHSs -> GRHSs' (Located HsExpr')
mkGRHSs RawGRHSs
g = (NoExtField
-> [LGRHS GhcPs (Located HsExpr')]
-> LHsLocalBinds GhcPs
-> GRHSs' (Located HsExpr'))
-> [LGRHS GhcPs (Located HsExpr')]
-> LHsLocalBinds GhcPs
-> GRHSs' (Located HsExpr')
forall a. (NoExtField -> a) -> a
noExt NoExtField
-> [LGRHS GhcPs (Located HsExpr')]
-> LHsLocalBinds GhcPs
-> GRHSs' (Located HsExpr')
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs
((GuardedExpr -> LGRHS GhcPs (Located HsExpr'))
-> [GuardedExpr] -> [LGRHS GhcPs (Located HsExpr')]
forall a b. (a -> b) -> [a] -> [b]
map GuardedExpr -> LGRHS GhcPs (Located HsExpr')
forall e. e -> Located e
builtLoc ([GuardedExpr] -> [LGRHS GhcPs (Located HsExpr')])
-> [GuardedExpr] -> [LGRHS GhcPs (Located HsExpr')]
forall a b. (a -> b) -> a -> b
$ RawGRHSs -> [GuardedExpr]
rawGRHSs RawGRHSs
g)
(HsLocalBinds' -> LHsLocalBinds GhcPs
forall e. e -> Located e
builtLoc (HsLocalBinds' -> LHsLocalBinds GhcPs)
-> HsLocalBinds' -> LHsLocalBinds GhcPs
forall a b. (a -> b) -> a -> b
$ [RawValBind] -> HsLocalBinds'
valBinds ([RawValBind] -> HsLocalBinds') -> [RawValBind] -> HsLocalBinds'
forall a b. (a -> b) -> a -> b
$ RawGRHSs -> [RawValBind]
rawGRHSWhere RawGRHSs
g)
type GuardedExpr = GRHS' (Located HsExpr')
class HasValBind t where
sigB :: Sig' -> t
bindB :: HsBind' -> t
instance HasValBind HsDecl' where
sigB :: Sig' -> HsDecl'
sigB = (NoExtField -> Sig' -> HsDecl') -> Sig' -> HsDecl'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> Sig' -> HsDecl'
forall p. XSigD p -> Sig p -> HsDecl p
SigD
bindB :: HsBind' -> HsDecl'
bindB = (NoExtField -> HsBind' -> HsDecl') -> HsBind' -> HsDecl'
forall a. (NoExtField -> a) -> a
noExt NoExtField -> HsBind' -> HsDecl'
forall p. XValD p -> HsBind p -> HsDecl p
ValD
instance HasValBind RawValBind where
sigB :: Sig' -> RawValBind
sigB = Sig' -> RawValBind
SigV
bindB :: HsBind' -> RawValBind
bindB = HsBind' -> RawValBind
BindV