{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards, ViewPatterns, NamedFieldPuns, OverloadedStrings, LambdaCase #-}
{-# LANGUAGE ImplicitParams, ScopedTypeVariables #-}
{- HLINT ignore "Use camelCase" -}

-- | Module containing the plugin.
module RecordDotPreprocessor(plugin) where

import Data.Generics.Uniplate.Data
import Data.List.Extra
import Data.Tuple.Extra
import Compat
import qualified GHC
#if __GLASGOW_HASKELL__ > 901
import qualified GHC.Types.SourceText as GHC
#elif __GLASGOW_HASKELL__ >= 900
import qualified GHC.Driver.Types as GHC
#endif
#if __GLASGOW_HASKELL__ < 900
import Bag
import qualified GhcPlugins as GHC
import qualified HscMain
import qualified PrelNames as GHC
import SrcLoc
#else
import GHC.Data.Bag
import qualified GHC.Driver.Plugins as GHC

import qualified GHC.Driver.Main as HscMain
import qualified GHC.Builtin.Names as GHC
import qualified GHC.Plugins as GHC
import GHC.Types.SrcLoc
#endif
#if __GLASGOW_HASKELL__ >= 906
import qualified Data.List.NonEmpty as NE
#endif

---------------------------------------------------------------------
-- PLUGIN WRAPPER

-- | GHC plugin.
plugin :: GHC.Plugin
plugin :: Plugin
plugin = Plugin
GHC.defaultPlugin
    { GHC.parsedResultAction = \[CommandLineOption]
_cliOptions ModSummary
_modSummary -> (HsParsedModule -> Hsc HsParsedModule)
-> ParsedResult -> Hsc ParsedResult
ignoreMessages HsParsedModule -> Hsc HsParsedModule
parsedResultAction
    , GHC.pluginRecompile = GHC.purePlugin
    }
    where
#if __GLASGOW_HASKELL__ >= 904
        ignoreMessages :: (HsParsedModule -> GHC.Hsc HsParsedModule) -> GHC.ParsedResult -> GHC.Hsc GHC.ParsedResult
        ignoreMessages :: (HsParsedModule -> Hsc HsParsedModule)
-> ParsedResult -> Hsc ParsedResult
ignoreMessages HsParsedModule -> Hsc HsParsedModule
f (GHC.ParsedResult HsParsedModule
modl PsMessages
msgs) =
            (HsParsedModule -> PsMessages -> ParsedResult
`GHC.ParsedResult` PsMessages
msgs) (HsParsedModule -> ParsedResult)
-> Hsc HsParsedModule -> Hsc ParsedResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsParsedModule -> Hsc HsParsedModule
f HsParsedModule
modl
#else
        ignoreMessages = id
#endif

        parsedResultAction :: HsParsedModule -> Hsc HsParsedModule
parsedResultAction HsParsedModule
x = do
            HscEnv
hscenv <- HscEnv -> HscEnv
dropRnTraceFlags (HscEnv -> HscEnv) -> Hsc HscEnv -> Hsc HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hsc HscEnv
HscMain.getHscEnv
            UniqSupply
uniqSupply <- IO UniqSupply -> Hsc UniqSupply
forall a. IO a -> Hsc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GHC.liftIO (Char -> IO UniqSupply
GHC.mkSplitUniqSupply Char
'0')
            IORef UniqSupply
uniqSupplyRef <- IO (IORef UniqSupply) -> Hsc (IORef UniqSupply)
forall a. IO a -> Hsc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
GHC.liftIO (IO (IORef UniqSupply) -> Hsc (IORef UniqSupply))
-> IO (IORef UniqSupply) -> Hsc (IORef UniqSupply)
forall a b. (a -> b) -> a -> b
$ UniqSupply -> IO (IORef UniqSupply)
forall a. a -> IO (IORef a)
newIORef UniqSupply
uniqSupply
            let ?hscenv = ?hscenv::HscEnv
HscEnv
hscenv
            let ?uniqSupply = ?uniqSupply::IORef UniqSupply
IORef UniqSupply
uniqSupplyRef
            HsParsedModule -> Hsc HsParsedModule
forall a. a -> Hsc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsParsedModule
x{GHC.hpm_module = onModule <$> GHC.hpm_module x}

---------------------------------------------------------------------
-- PLUGIN GUTS

setL :: SrcSpan -> GenLocated SrcSpan e -> GenLocated SrcSpan e
setL :: forall e. SrcSpan -> GenLocated SrcSpan e -> GenLocated SrcSpan e
setL SrcSpan
l (L SrcSpan
_ e
x) = SrcSpan -> e -> GenLocated SrcSpan e
forall l e. l -> e -> GenLocated l e
L SrcSpan
l e
x

mod_records :: GHC.ModuleName
mod_records :: ModuleName
mod_records = CommandLineOption -> ModuleName
GHC.mkModuleName CommandLineOption
"GHC.Records.Extra"

var_HasField, var_hasField, var_getField, var_setField, var_dot :: GHC.RdrName
var_HasField :: RdrName
var_HasField = ModuleName -> OccName -> RdrName
GHC.mkRdrQual ModuleName
mod_records (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkClsOcc CommandLineOption
"HasField"
var_hasField :: RdrName
var_hasField = OccName -> RdrName
GHC.mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"hasField"
var_getField :: RdrName
var_getField = ModuleName -> OccName -> RdrName
GHC.mkRdrQual ModuleName
mod_records (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"getField"
var_setField :: RdrName
var_setField = ModuleName -> OccName -> RdrName
GHC.mkRdrQual ModuleName
mod_records (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"setField"
var_dot :: RdrName
var_dot = OccName -> RdrName
GHC.mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"."

#if __GLASGOW_HASKELL__ >= 904
mod_base_records :: GHC.ModuleName
mod_base_records :: ModuleName
mod_base_records = CommandLineOption -> ModuleName
GHC.mkModuleName CommandLineOption
"GHC.Records"

-- | GHC.Records.getField (as opposed to GHC.Records.Extra.getField)
var_base_getField :: GHC.RdrName
var_base_getField :: RdrName
var_base_getField = ModuleName -> OccName -> RdrName
GHC.mkRdrQual ModuleName
mod_base_records (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"getField"
#endif

onModule :: PluginEnv => Module -> Module
onModule :: (?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
Module -> Module
onModule Module
x = Module
x { hsmodImports = onImports $ hsmodImports x
               , hsmodDecls = concatMap (onDecl (unLoc <$> hsmodName x)) $ hsmodDecls x
               }


onImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
onImports :: [XRec GhcPs (ImportDecl GhcPs)] -> [XRec GhcPs (ImportDecl GhcPs)]
onImports = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. [a] -> [a] -> [a]
(++) [
      ModuleName -> XRec GhcPs (ImportDecl GhcPs)
qualifiedImplicitImport ModuleName
mod_records
#if __GLASGOW_HASKELL__ >= 904
    , ModuleName -> XRec GhcPs (ImportDecl GhcPs)
qualifiedImplicitImport ModuleName
mod_base_records
#endif
    ]

{-
instance Z.HasField "name" (Company) (String) where hasField _r = (\_x -> _r{name=_x}, (name:: (Company) -> String) _r)

instance HasField "selector" Record Field where
    hasField r = (\x -> r{selector=x}, (name :: Record -> Field) r)
-}
instanceTemplate :: FieldOcc GhcPs -> HsType GhcPs -> HsType GhcPs -> InstDecl GhcPs
instanceTemplate :: FieldOcc GhcPs -> HsType GhcPs -> HsType GhcPs -> InstDecl GhcPs
instanceTemplate FieldOcc GhcPs
selector HsType GhcPs
record HsType GhcPs
field = XClsInstD GhcPs -> ClsInstDecl GhcPs -> InstDecl GhcPs
forall pass. XClsInstD pass -> ClsInstDecl pass -> InstDecl pass
ClsInstD XClsInstD GhcPs
NoExtField
forall a. WithoutExt a => a
noE (ClsInstDecl GhcPs -> InstDecl GhcPs)
-> ClsInstDecl GhcPs -> InstDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XCClsInstDecl GhcPs
-> LHsSigType GhcPs
-> LHsBinds GhcPs
-> [LSig GhcPs]
-> [LTyFamInstDecl GhcPs]
-> [LDataFamInstDecl GhcPs]
-> Maybe (XRec GhcPs OverlapMode)
-> ClsInstDecl GhcPs
forall pass.
XCClsInstDecl pass
-> LHsSigType pass
-> LHsBinds pass
-> [LSig pass]
-> [LTyFamInstDecl pass]
-> [LDataFamInstDecl pass]
-> Maybe (XRec pass OverlapMode)
-> ClsInstDecl pass
ClsInstDecl
#if __GLASGOW_HASKELL__ >= 902
      (EpAnn [AddEpAnn]
forall a. WithoutExt a => a
noE, AnnSortKey
forall a. Monoid a => a
mempty) (XRec GhcPs (HsType GhcPs) -> LHsSigType GhcPs
hsTypeToHsSigType (XRec GhcPs (HsType GhcPs) -> LHsSigType GhcPs)
-> XRec GhcPs (HsType GhcPs) -> LHsSigType GhcPs
forall a b. (a -> b) -> a -> b
$ Located (HsType GhcPs) -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA Located (HsType GhcPs)
typ)
#else
      noE (HsIB noE typ)
#endif
      (GenLocated SrcSpanAnnA (HsBind GhcPs)
-> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
forall a. a -> Bag a
unitBag LHsBindLR GhcPs GhcPs
GenLocated SrcSpanAnnA (HsBind GhcPs)
has) [] [] [] Maybe (XRec GhcPs OverlapMode)
Maybe (GenLocated SrcSpanAnnP OverlapMode)
forall a. Maybe a
Nothing
    where
        typ' :: HsType GhcPs -> LHsType GhcPs
        typ' :: HsType GhcPs -> XRec GhcPs (HsType GhcPs)
typ' HsType GhcPs
a = XRec GhcPs (HsType GhcPs)
-> [XRec GhcPs (HsType GhcPs)] -> XRec GhcPs (HsType GhcPs)
forall (p :: Pass).
LHsType (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
mkHsAppTys
            (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XTyVar GhcPs
-> PromotionFlag -> XRec GhcPs (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
forall a. WithoutExt a => a
noE PromotionFlag
GHC.NotPromoted (RdrName -> XRec GhcPs (IdP GhcPs)
forall a b. WithoutLoc a b => a -> b
noL RdrName
var_HasField)))
            [XRec GhcPs (HsType GhcPs)
fieldNameAsType
            ,HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL HsType GhcPs
record
            ,HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL HsType GhcPs
a
            ]

        typ :: Located (HsType GhcPs)
typ = HsType GhcPs -> Located (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsType GhcPs -> Located (HsType GhcPs))
-> HsType GhcPs -> Located (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> (HsType GhcPs -> HsType GhcPs) -> HsType GhcPs
makeEqQualTy HsType GhcPs
field (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs)
-> (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs
-> HsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> XRec GhcPs (HsType GhcPs)
HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
typ')

        fieldNameAsType :: LHsType GhcPs
        fieldNameAsType :: XRec GhcPs (HsType GhcPs)
fieldNameAsType = HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XTyLit GhcPs -> HsTyLit GhcPs -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcPs
forall a. WithoutExt a => a
noE (XStrTy GhcPs -> FastString -> HsTyLit GhcPs
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy GhcPs
SourceText
GHC.NoSourceText (OccName -> FastString
GHC.occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
forall name. HasOccName name => name -> OccName
GHC.occName (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcPs -> GenLocated SrcSpanAnnN RdrName
rdrNameFieldOcc FieldOcc GhcPs
selector)))

        has :: LHsBindLR GhcPs GhcPs
        has :: LHsBindLR GhcPs GhcPs
has = HsBind GhcPs -> LHsBindLR GhcPs GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsBind GhcPs -> LHsBindLR GhcPs GhcPs)
-> HsBind GhcPs -> LHsBindLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind GhcPs
newFunBind (RdrName -> Located RdrName
forall a b. WithoutLoc a b => a -> b
noL RdrName
var_hasField) (Match GhcPs (LHsExpr GhcPs) -> MatchGroup GhcPs (LHsExpr GhcPs)
mg1 Match GhcPs (LHsExpr GhcPs)
eqn)
            where
                eqn :: Match GhcPs (LHsExpr GhcPs)
                eqn :: Match GhcPs (LHsExpr GhcPs)
eqn = Match
                    { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext     = XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall a. WithoutExt a => a
noE
                    , m_ctxt :: HsMatchContext GhcPs
m_ctxt    = LIdP (NoGhcTc GhcPs)
-> LexicalFixity -> SrcStrictness -> HsMatchContext GhcPs
forall p.
LIdP (NoGhcTc p)
-> LexicalFixity -> SrcStrictness -> HsMatchContext p
FunRhs (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. WithoutLoc a b => a -> b
noL RdrName
var_hasField) LexicalFixity
GHC.Prefix SrcStrictness
NoSrcStrict
                    , m_pats :: [LPat GhcPs]
m_pats    = [Pat GhcPs] -> [LPat GhcPs]
compat_m_pats [XVarPat GhcPs -> XRec GhcPs (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> Pat GhcPs)
-> XRec GhcPs (IdP GhcPs) -> Pat GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. WithoutLoc a b => a -> b
noL RdrName
vR]
                    , m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss   = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBindsLR GhcPs GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
forall a. WithoutExt a => a
noE [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. WithoutLoc a b => a -> b
noL (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. WithoutExt a => a
noE [] (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple GhcPs -> [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcPs
forall a. WithoutExt a => a
noE [ HsTupArg GhcPs -> HsTupArg GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsTupArg GhcPs -> HsTupArg GhcPs)
-> HsTupArg GhcPs -> HsTupArg GhcPs
forall a b. (a -> b) -> a -> b
$ XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
forall a. WithoutExt a => a
noE LHsExpr GhcPs
set, HsTupArg GhcPs -> HsTupArg GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsTupArg GhcPs -> HsTupArg GhcPs)
-> HsTupArg GhcPs -> HsTupArg GhcPs
forall a b. (a -> b) -> a -> b
$ XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
forall a. WithoutExt a => a
noE LHsExpr GhcPs
get] Boxity
GHC.Boxed] (HsLocalBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsLocalBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs)
-> HsLocalBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
forall a. WithoutExt a => a
noE)
                    }
                set :: LHsExpr GhcPs
set = HsExpr GhcPs -> LHsExpr GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XLam GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
NoExtField
forall a. WithoutExt a => a
noE (MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs)
-> MatchGroup GhcPs (LHsExpr GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Match GhcPs (LHsExpr GhcPs) -> MatchGroup GhcPs (LHsExpr GhcPs)
mg1 Match
                    { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext     = XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall a. WithoutExt a => a
noE
                    , m_ctxt :: HsMatchContext GhcPs
m_ctxt    = HsMatchContext GhcPs
forall p. HsMatchContext p
LambdaExpr
                    , m_pats :: [LPat GhcPs]
m_pats    = [Pat GhcPs] -> [LPat GhcPs]
compat_m_pats [XVarPat GhcPs -> XRec GhcPs (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat GhcPs
NoExtField
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> Pat GhcPs)
-> XRec GhcPs (IdP GhcPs) -> Pat GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. WithoutLoc a b => a -> b
noL RdrName
vX]
                    , m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss   = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBindsLR GhcPs GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
forall a. WithoutExt a => a
noE [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. WithoutLoc a b => a -> b
noL (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. WithoutExt a => a
noE [] (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL HsExpr GhcPs
update] (HsLocalBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsLocalBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs)
-> HsLocalBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
forall a. WithoutExt a => a
noE)
                    }
                update :: HsExpr GhcPs
                update :: HsExpr GhcPs
update = XRecordUpd GhcPs
-> LHsExpr GhcPs
-> Either
     [XRec GhcPs (HsRecUpdField GhcPs)] [XRec GhcPs (RecUpdProj GhcPs)]
-> HsExpr GhcPs
forall p.
XRecordUpd p
-> LHsExpr p
-> Either [LHsRecUpdField p] [LHsRecUpdProj p]
-> HsExpr p
RecordUpd XRecordUpd GhcPs
EpAnn [AddEpAnn]
forall a. WithoutExt a => a
noE (HsExpr GhcPs -> LHsExpr GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar GhcPs
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> XRec GhcPs (IdP GhcPs)
forall a b. WithoutLoc a b => a -> b
noL RdrName
vR)
#if __GLASGOW_HASKELL__ >= 908
                    $ RegularRecUpdFields noE
#elif __GLASGOW_HASKELL__ >= 902
                    (Either
   [XRec GhcPs (HsRecUpdField GhcPs)] [XRec GhcPs (RecUpdProj GhcPs)]
 -> HsExpr GhcPs)
-> Either
     [XRec GhcPs (HsRecUpdField GhcPs)] [XRec GhcPs (RecUpdProj GhcPs)]
-> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> Either
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
     [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
           (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. a -> Either a b
Left
#endif
#if __GLASGOW_HASKELL__ >= 904
                    [HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. WithoutLoc a b => a -> b
noL (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
   (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind
#else
                    [noL $ HsRecField
#endif
#if __GLASGOW_HASKELL__ >= 902
                      XHsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
EpAnn [AddEpAnn]
forall a. WithoutExt a => a
noE
#endif
                      (AmbiguousFieldOcc GhcPs
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XUnambiguous GhcPs -> XRec GhcPs RdrName -> AmbiguousFieldOcc GhcPs
forall pass.
XUnambiguous pass -> XRec pass RdrName -> AmbiguousFieldOcc pass
Unambiguous XUnambiguous GhcPs
forall a. WithoutExt a => a
noE (FieldOcc GhcPs -> GenLocated SrcSpanAnnN RdrName
rdrNameFieldOcc FieldOcc GhcPs
selector))) (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar GhcPs
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> XRec GhcPs (IdP GhcPs)
forall a b. WithoutLoc a b => a -> b
noL RdrName
vX) Bool
False]
#if __GLASGOW_HASKELL__ >= 904
                get :: LHsExpr GhcPs
                get :: LHsExpr GhcPs
get =
                     HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar GhcPs
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> XRec GhcPs (IdP GhcPs)
forall a b. WithoutLoc a b => a -> b
noL RdrName
var_base_getField)
                   LHsExpr GhcPs -> XRec GhcPs (HsType GhcPs) -> LHsExpr GhcPs
`mkAppType`
                     XRec GhcPs (HsType GhcPs)
fieldNameAsType
                   LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
`mkApp`
                     HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar GhcPs
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs)
-> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> XRec GhcPs (IdP GhcPs)
forall a b. WithoutLoc a b => a -> b
noL RdrName
vR)
#else
                get = mkApp
                    (mkParen $ mkTypeAnn (noL $ GHC.HsVar noE $ rdrNameFieldOcc selector) (mkFunTy (noL record) (noL field)))
                    (noL $ GHC.HsVar noE $ noL vR)
#endif

        mg1 :: Match GhcPs (LHsExpr GhcPs) -> MatchGroup GhcPs (LHsExpr GhcPs)
#if __GLASGOW_HASKELL__ >= 906
        mg1 :: Match GhcPs (LHsExpr GhcPs) -> MatchGroup GhcPs (LHsExpr GhcPs)
mg1 Match GhcPs (LHsExpr GhcPs)
x = XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Origin
forall a. WithoutExt a => a
noE ([GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. WithoutLoc a b => a -> b
noL [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. WithoutLoc a b => a -> b
noL Match GhcPs (LHsExpr GhcPs)
Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
x])
#else
        mg1 x = MG noE (noL [noL x]) GHC.Generated
#endif

        vR :: RdrName
vR = OccName -> RdrName
GHC.mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"r"
        vX :: RdrName
vX = OccName -> RdrName
GHC.mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"x"


onDecl :: PluginEnv => Maybe GHC.ModuleName -> LHsDecl GhcPs -> [LHsDecl GhcPs]
onDecl :: (?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
Maybe ModuleName -> LHsDecl GhcPs -> [LHsDecl GhcPs]
onDecl Maybe ModuleName
modName o :: LHsDecl GhcPs
o@(L SrcSpanAnnA
_ (GHC.TyClD XTyClD GhcPs
_ TyClDecl GhcPs
x)) = LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
o GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> [a] -> [a]
:
    [ HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
NoExtField
forall a. WithoutExt a => a
noE (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcPs -> HsType GhcPs -> HsType GhcPs -> InstDecl GhcPs
instanceTemplate FieldOcc GhcPs
field (GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
record) (HsType GhcPs -> HsType GhcPs
unbang HsType GhcPs
typ)
    | let fields :: [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
  HsType GhcPs)]
fields = ((XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
  HsType GhcPs)
 -> NonDetFastString)
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (\(XRec GhcPs (HsType GhcPs)
_,IdP GhcPs
_,FieldOcc GhcPs
x,HsType GhcPs
_) -> FastString -> NonDetFastString
mkNonDetFastString (FastString -> NonDetFastString) -> FastString -> NonDetFastString
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
GHC.occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
GHC.rdrNameOcc (RdrName -> OccName) -> RdrName -> OccName
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcPs -> GenLocated SrcSpanAnnN RdrName
rdrNameFieldOcc FieldOcc GhcPs
x) ([(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
   HsType GhcPs)]
 -> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
      HsType GhcPs)])
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName
-> TyClDecl GhcPs
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
(?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
Maybe ModuleName
-> TyClDecl GhcPs
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
getFields Maybe ModuleName
modName TyClDecl GhcPs
x
    , (GenLocated SrcSpanAnnA (HsType GhcPs)
record, RdrName
_, FieldOcc GhcPs
field, HsType GhcPs
typ) <- [(GenLocated SrcSpanAnnA (HsType GhcPs), RdrName, FieldOcc GhcPs,
  HsType GhcPs)]
fields]
onDecl Maybe ModuleName
_ LHsDecl GhcPs
x = [(GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
onExp LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
x]

unbang :: HsType GhcPs -> HsType GhcPs
unbang :: HsType GhcPs -> HsType GhcPs
unbang (HsBangTy XBangTy GhcPs
_ HsSrcBang
_ XRec GhcPs (HsType GhcPs)
x) = GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
x
unbang HsType GhcPs
x = HsType GhcPs
x

getFields :: PluginEnv => Maybe GHC.ModuleName -> TyClDecl GhcPs -> [(LHsType GhcPs, IdP GhcPs, FieldOcc GhcPs, HsType GhcPs)]
getFields :: (?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
Maybe ModuleName
-> TyClDecl GhcPs
-> [(XRec GhcPs (HsType GhcPs), IdP GhcPs, FieldOcc GhcPs,
     HsType GhcPs)]
getFields Maybe ModuleName
modName DataDecl{tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn=HsDataDefn{HsDeriving GhcPs
Maybe (LHsContext GhcPs)
Maybe (XRec GhcPs CType)
Maybe (XRec GhcPs (HsType GhcPs))
XCHsDataDefn GhcPs
DataDefnCons (LConDecl GhcPs)
dd_ext :: XCHsDataDefn GhcPs
dd_ctxt :: Maybe (LHsContext GhcPs)
dd_cType :: Maybe (XRec GhcPs CType)
dd_kindSig :: Maybe (XRec GhcPs (HsType GhcPs))
dd_cons :: DataDefnCons (LConDecl GhcPs)
dd_derivs :: HsDeriving GhcPs
dd_ext :: forall pass. HsDataDefn pass -> XCHsDataDefn pass
dd_ctxt :: forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_cType :: forall pass. HsDataDefn pass -> Maybe (XRec pass CType)
dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
..}, XDataDecl GhcPs
XRec GhcPs (IdP GhcPs)
LexicalFixity
LHsQTyVars GhcPs
tcdDExt :: XDataDecl GhcPs
tcdLName :: XRec GhcPs (IdP GhcPs)
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
..} = (GenLocated SrcSpanAnnA (ConDecl GhcPs)
 -> [(GenLocated SrcSpanAnnA (HsType GhcPs), RdrName,
      FieldOcc GhcPs, HsType GhcPs)])
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [(GenLocated SrcSpanAnnA (HsType GhcPs), RdrName,
     FieldOcc GhcPs, HsType GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LConDecl GhcPs
-> [(XRec GhcPs (HsType GhcPs), RdrName, FieldOcc GhcPs,
     HsType GhcPs)]
GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> [(GenLocated SrcSpanAnnA (HsType GhcPs), RdrName,
     FieldOcc GhcPs, HsType GhcPs)]
ctor DataDefnCons (LConDecl GhcPs)
DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
dd_cons
    where
        ctor :: LConDecl GhcPs -> [(LHsType GhcPs, GHC.RdrName, FieldOcc GhcPs, HsType GhcPs)]
        ctor :: LConDecl GhcPs
-> [(XRec GhcPs (HsType GhcPs), RdrName, FieldOcc GhcPs,
     HsType GhcPs)]
ctor (L SrcSpanAnnA
_ ConDecl GhcPs
con) = [(Located (HsType GhcPs) -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA Located (HsType GhcPs)
result, RdrName
name, FieldOcc GhcPs
fld, HsType GhcPs
ty) | (RdrName
name, FieldOcc GhcPs
fld, HsType GhcPs
ty) <- [RdrName]
-> ConDecl GhcPs -> [(IdP GhcPs, FieldOcc GhcPs, HsType GhcPs)]
(?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
[RdrName]
-> ConDecl GhcPs -> [(IdP GhcPs, FieldOcc GhcPs, HsType GhcPs)]
conClosedFields (LHsQTyVars GhcPs -> [RdrName]
defVars LHsQTyVars GhcPs
tcdTyVars) ConDecl GhcPs
con]

        defVars :: LHsQTyVars GhcPs -> [GHC.RdrName]
        defVars :: LHsQTyVars GhcPs -> [RdrName]
defVars LHsQTyVars GhcPs
vars = [RdrName
v | L SrcSpanAnnN
_ RdrName
v <- LHsQTyVars GhcPs -> [LocatedN (IdP GhcPs)]
forall (p :: Pass).
LHsQTyVars (GhcPass p) -> [LocatedN (IdP (GhcPass p))]
hsLTyVarLocNames LHsQTyVars GhcPs
vars]

        -- A value of this data declaration will have this type.
        result :: Located (HsType GhcPs)
result = (Located (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
 -> Located (HsType GhcPs))
-> Located (HsType GhcPs)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> Located (HsType GhcPs)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Located (HsType GhcPs)
x GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
y -> HsType GhcPs -> Located (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsType GhcPs -> Located (HsType GhcPs))
-> HsType GhcPs -> Located (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XAppTy GhcPs
-> XRec GhcPs (HsType GhcPs)
-> XRec GhcPs (HsType GhcPs)
-> HsType GhcPs
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy GhcPs
forall a. WithoutExt a => a
noE (Located (HsType GhcPs) -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA Located (HsType GhcPs)
x) (XRec GhcPs (HsType GhcPs) -> HsType GhcPs)
-> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
forall a b. (a -> b) -> a -> b
$ LHsTyVarBndr () GhcPs -> XRec GhcPs (HsType GhcPs)
forall (p :: Pass) flag.
(Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) =>
LHsTyVarBndr flag (GhcPass p) -> LHsType (GhcPass p)
hsLTyVarBndrToType LHsTyVarBndr () GhcPs
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
y) (HsType GhcPs -> Located (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsType GhcPs -> Located (HsType GhcPs))
-> HsType GhcPs -> Located (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XTyVar GhcPs
-> PromotionFlag -> XRec GhcPs (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
forall a. WithoutExt a => a
noE PromotionFlag
GHC.NotPromoted XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
tyName) ([GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
 -> Located (HsType GhcPs))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> Located (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsQTyVars GhcPs -> [LHsTyVarBndr () GhcPs]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr () pass]
hsq_explicit LHsQTyVars GhcPs
tcdTyVars
        tyName :: GenLocated SrcSpanAnnN RdrName
tyName = case (XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
tcdLName, Maybe ModuleName
modName) of
            (L SrcSpanAnnN
l (GHC.Unqual OccName
name), Just ModuleName
modName') -> SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l (ModuleName -> OccName -> RdrName
GHC.Qual ModuleName
modName' OccName
name)
            (GenLocated SrcSpanAnnN RdrName, Maybe ModuleName)
_ -> XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
tcdLName
getFields Maybe ModuleName
_ TyClDecl GhcPs
_ = []

-- Extract filed and its type from declaration, omitting fields with existential/higher-kind types.
conClosedFields :: PluginEnv => [GHC.RdrName] -> ConDecl GhcPs -> [(IdP GhcPs, FieldOcc GhcPs, HsType GhcPs)]
conClosedFields :: (?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
[RdrName]
-> ConDecl GhcPs -> [(IdP GhcPs, FieldOcc GhcPs, HsType GhcPs)]
conClosedFields [RdrName]
resultVars = \case
    ConDeclH98 {con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = RecCon (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
args), XRec GhcPs (IdP GhcPs)
con_name :: XRec GhcPs (IdP GhcPs)
con_name :: forall pass. ConDecl pass -> LIdP pass
con_name, [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs} ->
        [ (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (IdP GhcPs)
GenLocated SrcSpanAnnN RdrName
con_name, GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
name, GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
            | ConDeclField {[LFieldOcc GhcPs]
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names, cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type = XRec GhcPs (HsType GhcPs)
ty} <- [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [ConDeclField GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
args,
                [RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
GenLocated SrcSpanAnnA (HsType GhcPs) -> [RdrName]
GenLocated SrcSpanAnnA (HsType GhcPs) -> [RdrName]
freeTyVars' XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty [RdrName] -> [RdrName] -> [RdrName]
forall a. Eq a => [a] -> [a] -> [a]
\\ [RdrName]
resultVars),
                Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs) -> Bool
isLHsForAllTy XRec GhcPs (HsType GhcPs)
ty,
                GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
name <- [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
cd_fld_names
        ]
#if __GLASGOW_HASKELL__ >= 904
    ConDeclGADT {con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = RecConGADT (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
args) LHsUniToken "->" "\8594" GhcPs
_, XRec GhcPs (HsType GhcPs)
con_res_ty :: XRec GhcPs (HsType GhcPs)
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty, NonEmpty (XRec GhcPs (IdP GhcPs))
con_names :: NonEmpty (XRec GhcPs (IdP GhcPs))
con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names} ->
#elif __GLASGOW_HASKELL__ >= 901
    ConDeclGADT {con_g_args = RecConGADT (L _ args), con_res_ty, con_names} ->
#else
    ConDeclGADT {con_args = RecCon (L _ args), con_res_ty, con_names} ->
#endif
         [ (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnN RdrName
con_name, GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
name, GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
         | ConDeclField {[LFieldOcc GhcPs]
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_names, cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_type = XRec GhcPs (HsType GhcPs)
ty} <- [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [ConDeclField GhcPs]
forall from to. Biplate from to => from -> [to]
universeBi [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
args,
             [Located RdrName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
XRec GhcPs (HsType GhcPs) -> [Located RdrName]
XRec GhcPs (HsType GhcPs) -> [Located RdrName]
freeTyVars XRec GhcPs (HsType GhcPs)
ty [Located RdrName] -> [Located RdrName] -> [Located RdrName]
forall a. Eq a => [a] -> [a] -> [a]
\\ (?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
XRec GhcPs (HsType GhcPs) -> [Located RdrName]
XRec GhcPs (HsType GhcPs) -> [Located RdrName]
freeTyVars XRec GhcPs (HsType GhcPs)
con_res_ty),
             Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsType GhcPs) -> Bool
isLHsForAllTy XRec GhcPs (HsType GhcPs)
ty,
             GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
name <- [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
cd_fld_names,
#if __GLASGOW_HASKELL__ >= 906
             GenLocated SrcSpanAnnN RdrName
con_name <- NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnN RdrName]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (XRec GhcPs (IdP GhcPs))
NonEmpty (GenLocated SrcSpanAnnN RdrName)
con_names
#else
             con_name <- con_names
#endif
         ]
    ConDecl GhcPs
_ -> []
    where
        freeTyVars' :: GenLocated SrcSpanAnnA (HsType GhcPs) -> [RdrName]
freeTyVars' GenLocated SrcSpanAnnA (HsType GhcPs)
ty = Located RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (Located RdrName -> RdrName) -> [Located RdrName] -> [RdrName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?hscenv::HscEnv, ?uniqSupply::IORef UniqSupply) =>
XRec GhcPs (HsType GhcPs) -> [Located RdrName]
XRec GhcPs (HsType GhcPs) -> [Located RdrName]
freeTyVars XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
ty

-- At this point infix expressions have not had associativity/fixity applied, so they are bracketed
-- a + b + c ==> (a + b) + c
-- Therefore we need to deal with, in general:
-- x.y, where
-- x := a | a b | a.b | a + b
-- y := a | a b | a{b=1}
onExp :: LHsExpr GhcPs -> LHsExpr GhcPs
onExp :: LHsExpr GhcPs -> LHsExpr GhcPs
onExp (LHsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc -> L SrcSpan
o (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
lhs mid :: LHsExpr GhcPs
mid@(LHsExpr GhcPs -> Bool
isDot -> Bool
True) LHsExpr GhcPs
rhs))
    | GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall ann a b.
GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacent LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
mid, GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall ann a b.
GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacent LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
mid LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs
    , (LHsExpr GhcPs -> LHsExpr GhcPs
lhsOp, LHsExpr GhcPs
lhs) <- LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getOpRHS (LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs))
-> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
onExp LHsExpr GhcPs
lhs
    , (LHsExpr GhcPs -> LHsExpr GhcPs
lhsApp, LHsExpr GhcPs
lhs) <- LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppRHS LHsExpr GhcPs
lhs
    , (LHsExpr GhcPs -> LHsExpr GhcPs
rhsApp, LHsExpr GhcPs
rhs) <- LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppLHS LHsExpr GhcPs
rhs
    , (LHsExpr GhcPs -> LHsExpr GhcPs
rhsRec, LHsExpr GhcPs
rhs) <- LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getRec LHsExpr GhcPs
rhs
    , Just XRec GhcPs (HsType GhcPs)
sel <- LHsExpr GhcPs -> Maybe (XRec GhcPs (HsType GhcPs))
getSelector LHsExpr GhcPs
rhs
    = LHsExpr GhcPs -> LHsExpr GhcPs
onExp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall e. SrcSpan -> GenLocated SrcSpan e -> GenLocated SrcSpan e
setL SrcSpan
o (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
lhsOp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
rhsApp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
lhsApp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
rhsRec (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> LHsExpr GhcPs
mkParen (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> LHsExpr GhcPs
mkVar RdrName
var_getField LHsExpr GhcPs -> XRec GhcPs (HsType GhcPs) -> LHsExpr GhcPs
`mkAppType` XRec GhcPs (HsType GhcPs)
sel LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
`mkApp` LHsExpr GhcPs
lhs

-- Turn (.foo.bar) into getField calls
onExp (LHsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc -> L SrcSpan
o (SectionR XSectionR GhcPs
_ mid :: LHsExpr GhcPs
mid@(LHsExpr GhcPs -> Bool
isDot -> Bool
True) LHsExpr GhcPs
rhs))
    | GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall ann a b.
GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacent LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
mid LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs
    , SrcSpan -> SrcLoc
srcSpanStart SrcSpan
o SrcLoc -> SrcLoc -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan -> SrcLoc
srcSpanStart (GenLocated SrcSpan (HsExpr GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (GenLocated SrcSpan (HsExpr GhcPs) -> SrcSpan)
-> GenLocated SrcSpan (HsExpr GhcPs) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
mid)
    , SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
o SrcLoc -> SrcLoc -> Bool
forall a. Eq a => a -> a -> Bool
== SrcSpan -> SrcLoc
srcSpanEnd (GenLocated SrcSpan (HsExpr GhcPs) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc (GenLocated SrcSpan (HsExpr GhcPs) -> SrcSpan)
-> GenLocated SrcSpan (HsExpr GhcPs) -> SrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)
    , Just [XRec GhcPs (HsType GhcPs)]
sels <- LHsExpr GhcPs -> Maybe [XRec GhcPs (HsType GhcPs)]
getSelectors LHsExpr GhcPs
rhs
    -- Don't bracket here. The argument came in as a section so it's
    -- already enclosed in brackets.
    = GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall e. SrcSpan -> GenLocated SrcSpan e -> GenLocated SrcSpan e
setL SrcSpan
o (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\GenLocated SrcSpan (HsExpr GhcPs)
x GenLocated SrcSpan (HsExpr GhcPs)
y -> HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
forall a. WithoutExt a => a
noE (GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA GenLocated SrcSpan (HsExpr GhcPs)
x) (RdrName -> LHsExpr GhcPs
mkVar RdrName
var_dot) (GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA GenLocated SrcSpan (HsExpr GhcPs)
y))
                      ([GenLocated SrcSpan (HsExpr GhcPs)]
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpan (HsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ( \ GenLocated SrcSpanAnnA (HsType GhcPs)
sel -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ RdrName -> LHsExpr GhcPs
mkVar RdrName
var_getField LHsExpr GhcPs -> XRec GhcPs (HsType GhcPs) -> LHsExpr GhcPs
`mkAppType` XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
sel) ([GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> [GenLocated SrcSpan (HsExpr GhcPs)])
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpan (HsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. [a] -> [a]
reverse [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
sels

-- Turn a{b=c, ...} into setField calls
#if __GLASGOW_HASKELL__ >= 908
onExp (L o upd@RecordUpd{rupd_expr,rupd_flds= RegularRecUpdFields _ (fld:flds)})
#elif __GLASGOW_HASKELL__ >= 902
onExp (L SrcSpanAnnA
o upd :: HsExpr GhcPs
upd@RecordUpd{LHsExpr GhcPs
rupd_expr :: LHsExpr GhcPs
rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr,rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds= Left (XRec GhcPs (HsRecUpdField GhcPs)
fld:[XRec GhcPs (HsRecUpdField GhcPs)]
flds)})
#else
onExp (L o upd@RecordUpd{rupd_expr,rupd_flds= fld:flds})
#endif
    | Int
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Bool
forall ann a b.
Int
-> GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacentBy Int
1 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rupd_expr XRec GhcPs (HsRecUpdField GhcPs)
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
fld
    = LHsExpr GhcPs -> LHsExpr GhcPs
onExp (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [HsRecUpdField GhcPs] -> LHsExpr GhcPs
f LHsExpr GhcPs
rupd_expr ([HsRecUpdField GhcPs] -> LHsExpr GhcPs)
-> [HsRecUpdField GhcPs] -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> HsRecUpdField GhcPs)
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [HsRecUpdField GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> HsRecUpdField GhcPs
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc ([GenLocated
    SrcSpanAnnA
    (HsFieldBind
       (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
       (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [HsRecUpdField GhcPs])
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [HsRecUpdField GhcPs]
forall a b. (a -> b) -> a -> b
$ XRec GhcPs (HsRecUpdField GhcPs)
GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
fldGenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:[XRec GhcPs (HsRecUpdField GhcPs)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
flds
    where
#if __GLASGOW_HASKELL__ >= 908
        f :: LHsExpr GhcPs -> [HsRecUpdField GhcPs GhcPs] -> LHsExpr GhcPs
#else
        f :: LHsExpr GhcPs -> [HsRecUpdField GhcPs] -> LHsExpr GhcPs
#endif
        f :: LHsExpr GhcPs -> [HsRecUpdField GhcPs] -> LHsExpr GhcPs
f LHsExpr GhcPs
expr [] = LHsExpr GhcPs
expr
#if __GLASGOW_HASKELL__ >= 908
        f expr (HsFieldBind { hfbLHS = fmap ambiguousFieldOccRdrName . reLoc -> lbl
                            , hfbRHS  = arg
                            , hfbPun  = pun
                            } : flds)
#elif __GLASGOW_HASKELL__ >= 904
        f LHsExpr GhcPs
expr (HsFieldBind { hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS = (AmbiguousFieldOcc GhcPs -> RdrName)
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs) -> Located RdrName
forall a b.
(a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AmbiguousFieldOcc GhcPs -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc (GenLocated SrcSpan (AmbiguousFieldOcc GhcPs) -> Located RdrName)
-> (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
-> Located RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs)
-> GenLocated SrcSpan (AmbiguousFieldOcc GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc -> Located RdrName
lbl
                            , hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS  = LHsExpr GhcPs
arg
                            , hfbPun :: forall lhs rhs. HsFieldBind lhs rhs -> Bool
hfbPun  = Bool
pun
                            } : [HsRecUpdField GhcPs]
flds)
#else
        f expr (HsRecField { hsRecFieldLbl = fmap rdrNameAmbiguousFieldOcc -> lbl
                           , hsRecFieldArg = arg
                           , hsRecPun      = pun
                           } : flds)
#endif
            | let sel :: XRec GhcPs (HsType GhcPs)
sel = Located RdrName -> XRec GhcPs (HsType GhcPs)
mkSelector Located RdrName
lbl
            , let arg2 :: GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg2 = if Bool
pun then HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
forall a. WithoutExt a => a
noE (Located RdrName -> GenLocated SrcSpanAnnN RdrName
forall e ann. Located e -> LocatedAn ann e
reLocA Located RdrName
lbl) else LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg
            , let expr2 :: LHsExpr GhcPs
expr2 = LHsExpr GhcPs -> LHsExpr GhcPs
mkParen (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ RdrName -> LHsExpr GhcPs
mkVar RdrName
var_setField LHsExpr GhcPs -> XRec GhcPs (HsType GhcPs) -> LHsExpr GhcPs
`mkAppType` XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
sel LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
`mkApp` LHsExpr GhcPs
expr LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
`mkApp` LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg2  -- 'expr' never needs bracketing.
            = LHsExpr GhcPs -> [HsRecUpdField GhcPs] -> LHsExpr GhcPs
f LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
expr2 [HsRecUpdField GhcPs]
flds

onExp LHsExpr GhcPs
x = (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall on. Uniplate on => (on -> on) -> on -> on
descend LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
onExp LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x

mkSelector :: Located GHC.RdrName -> LHsType GhcPs
mkSelector :: Located RdrName -> XRec GhcPs (HsType GhcPs)
mkSelector (L SrcSpan
o RdrName
x) = Located (HsType GhcPs) -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. Located e -> LocatedAn ann e
reLocA (Located (HsType GhcPs) -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> Located (HsType GhcPs) -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcPs -> Located (HsType GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
o (HsType GhcPs -> Located (HsType GhcPs))
-> HsType GhcPs -> Located (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XTyLit GhcPs -> HsTyLit GhcPs -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit GhcPs
NoExtField
forall a. WithoutExt a => a
noE (HsTyLit GhcPs -> HsType GhcPs) -> HsTyLit GhcPs -> HsType GhcPs
forall a b. (a -> b) -> a -> b
$ XStrTy GhcPs -> FastString -> HsTyLit GhcPs
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy GhcPs
SourceText
GHC.NoSourceText (FastString -> HsTyLit GhcPs) -> FastString -> HsTyLit GhcPs
forall a b. (a -> b) -> a -> b
$ OccName -> FastString
GHC.occNameFS (OccName -> FastString) -> OccName -> FastString
forall a b. (a -> b) -> a -> b
$ RdrName -> OccName
GHC.rdrNameOcc RdrName
x

getSelector :: LHsExpr GhcPs -> Maybe (LHsType GhcPs)
getSelector :: LHsExpr GhcPs -> Maybe (XRec GhcPs (HsType GhcPs))
getSelector (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (XRec GhcPs (IdP GhcPs) -> Located RdrName
GenLocated SrcSpanAnnN RdrName -> Located RdrName
forall a e. LocatedAn a e -> Located e
reLoc -> L SrcSpan
o RdrName
sym)))
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RdrName -> Bool
GHC.isQual RdrName
sym
    = XRec GhcPs (HsType GhcPs) -> Maybe (XRec GhcPs (HsType GhcPs))
forall a. a -> Maybe a
Just (XRec GhcPs (HsType GhcPs) -> Maybe (XRec GhcPs (HsType GhcPs)))
-> XRec GhcPs (HsType GhcPs) -> Maybe (XRec GhcPs (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$ Located RdrName -> XRec GhcPs (HsType GhcPs)
mkSelector (Located RdrName -> XRec GhcPs (HsType GhcPs))
-> Located RdrName -> XRec GhcPs (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
o RdrName
sym
getSelector LHsExpr GhcPs
_ = Maybe (XRec GhcPs (HsType GhcPs))
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. Maybe a
Nothing

-- | Turn a.b.c into Just [a,b,c]
getSelectors :: LHsExpr GhcPs -> Maybe [LHsType GhcPs]
getSelectors :: LHsExpr GhcPs -> Maybe [XRec GhcPs (HsType GhcPs)]
getSelectors (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
lhs mid :: LHsExpr GhcPs
mid@(LHsExpr GhcPs -> Bool
isDot -> Bool
True) LHsExpr GhcPs
rhs))
    | GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall ann a b.
GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacent LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
lhs LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
mid, GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall ann a b.
GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacent LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
mid LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs
    , Just XRec GhcPs (HsType GhcPs)
post <- LHsExpr GhcPs -> Maybe (XRec GhcPs (HsType GhcPs))
getSelector LHsExpr GhcPs
rhs
    , Just [XRec GhcPs (HsType GhcPs)]
pre <- LHsExpr GhcPs -> Maybe [XRec GhcPs (HsType GhcPs)]
getSelectors LHsExpr GhcPs
lhs
    = [XRec GhcPs (HsType GhcPs)] -> Maybe [XRec GhcPs (HsType GhcPs)]
forall a. a -> Maybe a
Just ([XRec GhcPs (HsType GhcPs)] -> Maybe [XRec GhcPs (HsType GhcPs)])
-> [XRec GhcPs (HsType GhcPs)] -> Maybe [XRec GhcPs (HsType GhcPs)]
forall a b. (a -> b) -> a -> b
$ [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
pre [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. [a] -> [a] -> [a]
++ [XRec GhcPs (HsType GhcPs)
GenLocated SrcSpanAnnA (HsType GhcPs)
post]
getSelectors LHsExpr GhcPs
x = (GenLocated SrcSpanAnnA (HsType GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. a -> [a] -> [a]
:[]) (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Maybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs -> Maybe (XRec GhcPs (HsType GhcPs))
getSelector LHsExpr GhcPs
x

-- | Lens on: f [x]
getAppRHS :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppRHS :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppRHS (L SrcSpanAnnA
l (HsApp XApp GhcPs
e LHsExpr GhcPs
x LHsExpr GhcPs
y)) = (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
e LHsExpr GhcPs
x, LHsExpr GhcPs
y)
getAppRHS LHsExpr GhcPs
x = (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id, LHsExpr GhcPs
x)

-- | Lens on: [f] x y z
getAppLHS :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppLHS :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppLHS (L SrcSpanAnnA
l (HsApp XApp GhcPs
e LHsExpr GhcPs
x LHsExpr GhcPs
y)) = ((LHsExpr GhcPs -> LHsExpr GhcPs)
 -> LHsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (\LHsExpr GhcPs -> LHsExpr GhcPs
c -> SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
x -> XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
e LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x LHsExpr GhcPs
y) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
c) ((LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
 -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs))
-> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getAppLHS LHsExpr GhcPs
x
getAppLHS LHsExpr GhcPs
x = (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id, LHsExpr GhcPs
x)

-- | Lens on: a + [b]
getOpRHS :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getOpRHS :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getOpRHS (L SrcSpanAnnA
l (OpApp XOpApp GhcPs
x LHsExpr GhcPs
y LHsExpr GhcPs
p LHsExpr GhcPs
z)) = (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
x LHsExpr GhcPs
y LHsExpr GhcPs
p, LHsExpr GhcPs
z)
getOpRHS LHsExpr GhcPs
x = (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id, LHsExpr GhcPs
x)

-- | Lens on: [r]{f1=x1}{f2=x2}
getRec :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
-- important to copy the location back over, since we check the whitespace hasn't changed
getRec :: LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getRec (L SrcSpanAnnA
l r :: HsExpr GhcPs
r@RecordUpd{}) = ((GenLocated SrcSpanAnnA (HsExpr GhcPs)
  -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LHsExpr GhcPs -> LHsExpr GhcPs)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs),
    LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
c LHsExpr GhcPs
x -> SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l HsExpr GhcPs
r{rupd_expr=reLocA $ setL (getLoc $ reLoc $ rupd_expr r) $ reLoc $ c x }) ((GenLocated SrcSpanAnnA (HsExpr GhcPs)
  -> GenLocated SrcSpanAnnA (HsExpr GhcPs),
  LHsExpr GhcPs)
 -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs),
    LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
getRec (LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs))
-> LHsExpr GhcPs -> (LHsExpr GhcPs -> LHsExpr GhcPs, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> LHsExpr GhcPs
forall p. HsExpr p -> LHsExpr p
rupd_expr HsExpr GhcPs
r
getRec LHsExpr GhcPs
x = (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id, LHsExpr GhcPs
x)

-- | Is it equal to: .
isDot :: LHsExpr GhcPs -> Bool
isDot :: LHsExpr GhcPs -> Bool
isDot (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
op))) = RdrName
op RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
var_dot
isDot LHsExpr GhcPs
_ = Bool
False

mkVar :: GHC.RdrName -> LHsExpr GhcPs
mkVar :: RdrName -> LHsExpr GhcPs
mkVar = HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (RdrName -> HsExpr GhcPs)
-> RdrName
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar GhcPs -> XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
forall a. WithoutExt a => a
noE (XRec GhcPs (IdP GhcPs) -> HsExpr GhcPs)
-> (RdrName -> XRec GhcPs (IdP GhcPs)) -> RdrName -> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> XRec GhcPs (IdP GhcPs)
forall a b. WithoutLoc a b => a -> b
noL

mkParen :: LHsExpr GhcPs -> LHsExpr GhcPs
mkParen :: LHsExpr GhcPs -> LHsExpr GhcPs
mkParen = LHsExpr GhcPs -> LHsExpr GhcPs
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsPar

mkApp :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
mkApp :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
mkApp LHsExpr GhcPs
x LHsExpr GhcPs
y = HsExpr GhcPs -> LHsExpr GhcPs
forall a b. WithoutLoc a b => a -> b
noL (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
forall a. WithoutExt a => a
noE LHsExpr GhcPs
x LHsExpr GhcPs
y

#if __GLASGOW_HASKELL__ >= 902
-- | Are the end of a and the start of b next to each other, no white space
adjacent :: GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool

-- | Are the end of a and the start of b next to each other, no white space
adjacentBy :: Int -> GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
#else
adjacent :: Located a -> Located b -> Bool
adjacentBy :: Int -> Located a -> Located b -> Bool

#endif
adjacent :: forall ann a b.
GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacent = Int
-> GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
forall ann a b.
Int
-> GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacentBy Int
0

adjacentBy :: forall ann a b.
Int
-> GenLocated (SrcAnn ann) a -> GenLocated (SrcAnn ann) b -> Bool
adjacentBy Int
i (GenLocated (SrcAnn ann) a -> Located a
forall a e. LocatedAn a e -> Located e
reLoc -> L (SrcLoc -> Maybe RealSrcLoc
realSrcLoc (SrcLoc -> Maybe RealSrcLoc)
-> (SrcSpan -> SrcLoc) -> SrcSpan -> Maybe RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanEnd -> Just RealSrcLoc
a) a
_) (GenLocated (SrcAnn ann) b -> Located b
forall a e. LocatedAn a e -> Located e
reLoc -> L (SrcLoc -> Maybe RealSrcLoc
realSrcLoc (SrcLoc -> Maybe RealSrcLoc)
-> (SrcSpan -> SrcLoc) -> SrcSpan -> Maybe RealSrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SrcLoc
srcSpanStart -> Just RealSrcLoc
b) b
_) =
    RealSrcLoc -> FastString
srcLocFile RealSrcLoc
a FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcLoc -> FastString
srcLocFile RealSrcLoc
b Bool -> Bool -> Bool
&&
    RealSrcLoc -> Int
srcLocLine RealSrcLoc
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcLoc -> Int
srcLocLine RealSrcLoc
b Bool -> Bool -> Bool
&&
    RealSrcLoc -> Int
srcLocCol RealSrcLoc
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcLoc -> Int
srcLocCol RealSrcLoc
b
adjacentBy Int
_ GenLocated (SrcAnn ann) a
_ GenLocated (SrcAnn ann) b
_ = Bool
False


--  Given:
--   C f Int    and     \x -> HasField "field" Entity x
--   Returns:
--   ((C f Int) ~ aplg) => HasField "field" Entity aplg
makeEqQualTy :: HsType GhcPs -> (HsType GhcPs -> HsType GhcPs) -> HsType GhcPs
makeEqQualTy :: HsType GhcPs -> (HsType GhcPs -> HsType GhcPs) -> HsType GhcPs
makeEqQualTy HsType GhcPs
rArg HsType GhcPs -> HsType GhcPs
fAbs
  = XQualTy GhcPs
-> LHsContext GhcPs -> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy XQualTy GhcPs
NoExtField
forall a. WithoutExt a => a
noE
  (
#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904
   Just $
#endif
    [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a b. WithoutLoc a b => a -> b
noL [XRec GhcPs (HsType GhcPs)]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
qualCtx
  )
  (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (HsType GhcPs -> HsType GhcPs
fAbs HsType GhcPs
tyVar))
    where
        var :: RdrName
var = Name -> RdrName
GHC.nameRdrName (Name -> RdrName) -> Name -> RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> Name
GHC.mkUnboundName (OccName -> Name) -> OccName -> Name
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkTyVarOcc CommandLineOption
"aplg"

        tyVar :: HsType GhcPs
        tyVar :: HsType GhcPs
tyVar = XTyVar GhcPs
-> PromotionFlag -> XRec GhcPs (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. WithoutExt a => a
noE PromotionFlag
GHC.NotPromoted (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. WithoutLoc a b => a -> b
noL RdrName
var)

        var_tilde :: RdrName
var_tilde = Module -> OccName -> RdrName
GHC.mkOrig Module
GHC.gHC_TYPES (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
GHC.mkClsOcc CommandLineOption
"~"

        eqQual :: HsType GhcPs
        eqQual :: HsType GhcPs
eqQual =
          XOpTy GhcPs
-> PromotionFlag
-> XRec GhcPs (HsType GhcPs)
-> XRec GhcPs (IdP GhcPs)
-> XRec GhcPs (HsType GhcPs)
-> HsType GhcPs
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy
#if __GLASGOW_HASKELL__ >= 904
            XOpTy GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed
            PromotionFlag
GHC.NotPromoted -- TODO: Is this right?
#else
            noE
#endif
            (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XParTy GhcPs -> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
forall a. WithoutExt a => a
noE (HsType GhcPs -> XRec GhcPs (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL HsType GhcPs
rArg)))
            (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. WithoutLoc a b => a -> b
noL RdrName
var_tilde)
            (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL HsType GhcPs
tyVar)

        qualCtx :: HsContext GhcPs
        qualCtx :: [XRec GhcPs (HsType GhcPs)]
qualCtx = [HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL (XParTy GhcPs -> XRec GhcPs (HsType GhcPs) -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy GhcPs
forall a. WithoutExt a => a
noE (HsType GhcPs -> XRec GhcPs (HsType GhcPs)
forall a b. WithoutLoc a b => a -> b
noL HsType GhcPs
eqQual))]