-- Copyright (c) Facebook, Inc. and its affiliates.
--
-- This source code is licensed under the MIT license found in the
-- LICENSE file in the root directory of this source tree.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Retrie.Expr
  ( bitraverseHsConDetails
  , getUnparened
  , grhsToExpr
  , mkApps
  , mkConPatIn
  , mkHsAppsTy
  , mkLams
  , mkLet
  , mkLoc
  , mkLocatedHsVar
  , mkVarPat
  , mkTyVar
  , parenify
  , parenifyT
  , parenifyP
  , patToExpr
  , patToExprA
  , setAnnsFor
  , unparen
  , unparenP
  , unparenT
  , wildSupply
  ) where

import Control.Monad.State.Lazy
import Data.Functor.Identity
import qualified Data.Map as M
import Data.Maybe

import Retrie.AlphaEnv
import Retrie.ExactPrint
import Retrie.Fixity
import Retrie.GHC
import Retrie.SYB
import Retrie.Types

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

mkLocatedHsVar :: Monad m => Located RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar :: Located RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar Located RdrName
v = do
  -- This special casing for [] is gross, but this is apparently how the
  -- annotations work.
  let anns :: [(KeywordId, DeltaPos)]
anns =
        case OccName -> String
occNameString (RdrName -> OccName
forall name. HasOccName name => name -> OccName
occName (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
v)) of
          String
"[]" -> [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenS, (Int, Int) -> DeltaPos
DP (Int
0,Int
0)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseS, (Int, Int) -> DeltaPos
DP (Int
0,Int
0))]
          String
_    -> [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, (Int, Int) -> DeltaPos
DP (Int
0,Int
0))]
  Located RdrName
r <- Located RdrName
-> [(KeywordId, DeltaPos)] -> TransformT m (Located RdrName)
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor Located RdrName
v [(KeywordId, DeltaPos)]
anns
  lv :: LHsExpr GhcPs
lv@(L SrcSpan
_ HsExpr GhcPs
v') <- LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall a (m :: * -> *).
(Data a, Typeable a, Monad m) =>
a -> TransformT m a
cloneT (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField Located (IdP GhcPs)
Located RdrName
r))
  case HsExpr GhcPs
v' of
    HsVar XVar GhcPs
_ Located (IdP GhcPs)
x ->
      Located RdrName -> LHsExpr GhcPs -> TransformT m ()
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
swapEntryDPT Located (IdP GhcPs)
Located RdrName
x LHsExpr GhcPs
lv
    HsExpr GhcPs
_ -> () -> TransformT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
lv

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

setAnnsFor :: (Data e, Monad m)
           => Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor :: Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor Located e
e [(KeywordId, DeltaPos)]
anns = (Anns -> Anns) -> TransformT m ()
forall (m :: * -> *). Monad m => (Anns -> Anns) -> TransformT m ()
modifyAnnsT ((Maybe Annotation -> Maybe Annotation) -> AnnKey -> Anns -> Anns
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter Maybe Annotation -> Maybe Annotation
f (Located e -> AnnKey
forall a. Constraints a => a -> AnnKey
mkAnnKey Located e
e)) TransformT m ()
-> TransformT m (Located e) -> TransformT m (Located e)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Located e -> TransformT m (Located e)
forall (m :: * -> *) a. Monad m => a -> m a
return Located e
e
  where f :: Maybe Annotation -> Maybe Annotation
f Maybe Annotation
Nothing  = Annotation -> Maybe Annotation
forall a. a -> Maybe a
Just Annotation
annNone { annsDP :: [(KeywordId, DeltaPos)]
annsDP = [(KeywordId, DeltaPos)]
anns }
        f (Just Annotation
a) = Annotation -> Maybe Annotation
forall a. a -> Maybe a
Just Annotation
a { annsDP :: [(KeywordId, DeltaPos)]
annsDP = Map KeywordId DeltaPos -> [(KeywordId, DeltaPos)]
forall k a. Map k a -> [(k, a)]
M.toList
                                     (Map KeywordId DeltaPos -> [(KeywordId, DeltaPos)])
-> Map KeywordId DeltaPos -> [(KeywordId, DeltaPos)]
forall a b. (a -> b) -> a -> b
$ Map KeywordId DeltaPos
-> Map KeywordId DeltaPos -> Map KeywordId DeltaPos
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(KeywordId, DeltaPos)] -> Map KeywordId DeltaPos
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(KeywordId, DeltaPos)]
anns)
                                               ([(KeywordId, DeltaPos)] -> Map KeywordId DeltaPos
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (Annotation -> [(KeywordId, DeltaPos)]
annsDP Annotation
a)) }

mkLoc :: (Data e, Monad m) => e -> TransformT m (Located e)
mkLoc :: e -> TransformT m (Located e)
mkLoc e
e = do
  Located e
le <- SrcSpan -> e -> Located e
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> e -> Located e)
-> TransformT m SrcSpan -> TransformT m (e -> Located e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT TransformT m (e -> Located e)
-> TransformT m e -> TransformT m (Located e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> TransformT m e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e
  Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor Located e
le []

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

mkLams
  :: [LPat GhcPs]
  -> LHsExpr GhcPs
  -> TransformT IO (LHsExpr GhcPs)
mkLams :: [LPat GhcPs] -> LHsExpr GhcPs -> TransformT IO (LHsExpr GhcPs)
mkLams [] LHsExpr GhcPs
e = LHsExpr GhcPs -> TransformT IO (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e
mkLams [LPat GhcPs]
vs LHsExpr GhcPs
e = do
  let
    mg :: MatchGroup GhcPs (LHsExpr GhcPs)
mg =
      Origin
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall name (body :: * -> *).
(XMG name (Located (body name)) ~ NoExtField) =>
Origin
-> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
mkMatchGroup Origin
Generated [HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> LHsExpr GhcPs
-> Located (HsLocalBinds GhcPs)
-> LMatch GhcPs (LHsExpr GhcPs)
forall (p :: Pass).
HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> Located (HsLocalBinds (GhcPass p))
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext (NameOrRdrName (IdP GhcPs))
forall id. HsMatchContext id
LambdaExpr [LPat GhcPs]
vs LHsExpr GhcPs
e (SrcSpanLess (Located (HsLocalBinds GhcPs))
-> Located (HsLocalBinds GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located (HsLocalBinds GhcPs))
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds)]
  LMatch GhcPs (LHsExpr GhcPs)
m' <- case Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch GhcPs (LHsExpr GhcPs)]
 -> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)]))
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (LHsExpr GhcPs)
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts MatchGroup GhcPs (LHsExpr GhcPs)
mg of
    [m] -> LMatch GhcPs (LHsExpr GhcPs)
-> [(KeywordId, DeltaPos)]
-> TransformT IO (LMatch GhcPs (LHsExpr GhcPs))
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor LMatch GhcPs (LHsExpr GhcPs)
m [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnLam, (Int, Int) -> DeltaPos
DP (Int
0,Int
0)),(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnRarrow, (Int, Int) -> DeltaPos
DP (Int
0,Int
1))]
    SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
_   -> String -> TransformT IO (LMatch GhcPs (LHsExpr GhcPs))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mkLams: lambda expression can only have a single match!"
  LHsExpr GhcPs -> TransformT IO (LHsExpr GhcPs)
forall a (m :: * -> *).
(Data a, Typeable a, Monad m) =>
a -> TransformT m a
cloneT (LHsExpr GhcPs -> TransformT IO (LHsExpr GhcPs))
-> LHsExpr GhcPs -> TransformT IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr 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 NoExtField
XLam GhcPs
noExtField MatchGroup GhcPs (LHsExpr GhcPs)
mg { mg_alts :: Located [LMatch GhcPs (LHsExpr GhcPs)]
mg_alts = SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc [LMatch GhcPs (LHsExpr GhcPs)
m'] }

mkLet :: Monad m => HsLocalBinds GhcPs -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
mkLet EmptyLocalBinds{} LHsExpr GhcPs
e = LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e
mkLet HsLocalBinds GhcPs
lbs LHsExpr GhcPs
e = do
  Located (HsLocalBinds GhcPs)
llbs <- HsLocalBinds GhcPs -> TransformT m (Located (HsLocalBinds GhcPs))
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc HsLocalBinds GhcPs
lbs
  LHsExpr GhcPs
le <- HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XLet GhcPs
-> Located (HsLocalBinds GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet NoExtField
XLet GhcPs
noExtField Located (HsLocalBinds GhcPs)
llbs LHsExpr GhcPs
e
  LHsExpr GhcPs
-> [(KeywordId, DeltaPos)] -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor LHsExpr GhcPs
le [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnLet, (Int, Int) -> DeltaPos
DP (Int
0,Int
0)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnIn, (Int, Int) -> DeltaPos
DP (Int
1,Int
1))]

mkApps :: Monad m => LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
mkApps :: LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
mkApps LHsExpr GhcPs
e []     = LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e
mkApps LHsExpr GhcPs
f (LHsExpr GhcPs
a:[LHsExpr GhcPs]
as) = do
  LHsExpr GhcPs
f' <- HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcPs
noExtField LHsExpr GhcPs
f LHsExpr GhcPs
a)
  LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
mkApps LHsExpr GhcPs
f' [LHsExpr GhcPs]
as

-- GHC never generates HsAppTy in the parser, using HsAppsTy to keep a list
-- of types.
mkHsAppsTy :: Monad m => [LHsType GhcPs] -> TransformT m (LHsType GhcPs)
mkHsAppsTy :: [LHsType GhcPs] -> TransformT m (LHsType GhcPs)
mkHsAppsTy [] = String -> TransformT m (LHsType GhcPs)
forall a. HasCallStack => String -> a
error String
"mkHsAppsTy: empty list"
mkHsAppsTy (LHsType GhcPs
t:[LHsType GhcPs]
ts) = (LHsType GhcPs -> LHsType GhcPs -> TransformT m (LHsType GhcPs))
-> LHsType GhcPs -> [LHsType GhcPs] -> TransformT m (LHsType GhcPs)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\LHsType GhcPs
t1 LHsType GhcPs
t2 -> HsType GhcPs -> TransformT m (LHsType GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (XAppTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
XAppTy GhcPs
noExtField LHsType GhcPs
t1 LHsType GhcPs
t2)) LHsType GhcPs
t [LHsType GhcPs]
ts

mkTyVar :: Monad m => Located RdrName -> TransformT m (LHsType GhcPs)
mkTyVar :: Located RdrName -> TransformT m (LHsType GhcPs)
mkTyVar Located RdrName
nm = do
  LHsType GhcPs
tv <- HsType GhcPs -> TransformT m (LHsType GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (XTyVar GhcPs
-> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcPs
noExtField PromotionFlag
NotPromoted Located (IdP GhcPs)
Located RdrName
nm)
  Located RdrName
_ <- Located RdrName
-> [(KeywordId, DeltaPos)] -> TransformT m (Located RdrName)
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor Located RdrName
nm [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnVal, (Int, Int) -> DeltaPos
DP (Int
0,Int
0))]
  LHsType GhcPs -> Located RdrName -> TransformT m ()
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
swapEntryDPT LHsType GhcPs
tv Located RdrName
nm
  LHsType GhcPs -> TransformT m (LHsType GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcPs
tv

mkVarPat :: Monad m => Located RdrName -> TransformT m (LPat GhcPs)
mkVarPat :: Located RdrName -> TransformT m (LPat GhcPs)
mkVarPat Located RdrName
nm = Located (Pat GhcPs) -> Located (Pat GhcPs)
forall (p :: Pass). Located (Pat (GhcPass p)) -> LPat (GhcPass p)
cLPat (Located (Pat GhcPs) -> Located (Pat GhcPs))
-> TransformT m (Located (Pat GhcPs))
-> TransformT m (Located (Pat GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pat GhcPs -> TransformT m (Located (Pat GhcPs))
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (XVarPat GhcPs -> Located (IdP GhcPs) -> Pat GhcPs
forall p. XVarPat p -> Located (IdP p) -> Pat p
VarPat NoExtField
XVarPat GhcPs
noExtField Located (IdP GhcPs)
Located RdrName
nm)

mkConPatIn
  :: Monad m
  => Located RdrName
  -> HsConPatDetails GhcPs
  -> TransformT m (Located (Pat GhcPs))
mkConPatIn :: Located RdrName
-> HsConPatDetails GhcPs -> TransformT m (Located (Pat GhcPs))
mkConPatIn Located RdrName
patName HsConPatDetails GhcPs
params = do
#if __GLASGOW_HASKELL__ < 900
  Located (Pat GhcPs)
p <- Pat GhcPs -> TransformT m (Located (Pat GhcPs))
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (Pat GhcPs -> TransformT m (Located (Pat GhcPs)))
-> Pat GhcPs -> TransformT m (Located (Pat GhcPs))
forall a b. (a -> b) -> a -> b
$ Located (IdP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
forall p. Located (IdP p) -> HsConPatDetails p -> Pat p
ConPatIn Located (IdP GhcPs)
Located RdrName
patName HsConPatDetails GhcPs
params
#else
  p <- mkLoc $ ConPat noExtField patName params
#endif
  Located (Pat GhcPs) -> DeltaPos -> TransformT m ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> DeltaPos -> TransformT m ()
setEntryDPT Located (Pat GhcPs)
p ((Int, Int) -> DeltaPos
DP (Int
0,Int
0))
  Located (Pat GhcPs) -> TransformT m (Located (Pat GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (Pat GhcPs)
p

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

-- Note [Wildcards]
-- We need to invent unique binders for wildcard patterns and feed
-- them in as quantified variables for the matcher (they will match
-- some expression and be discarded). We do this hackily here, by
-- generating a supply of w1, w2, etc variables, and filter out any
-- other binders we know about. However, we should also filter out
-- the free variables of the expression, to avoid capture. Haven't found
-- a free variable computation on HsExpr though. :-(

type PatQ m = StateT ([RdrName], [RdrName]) (TransformT m)

newWildVar :: Monad m => PatQ m RdrName
newWildVar :: PatQ m RdrName
newWildVar = do
  ([RdrName]
s, [RdrName]
u) <- StateT ([RdrName], [RdrName]) (TransformT m) ([RdrName], [RdrName])
forall s (m :: * -> *). MonadState s m => m s
get
  case [RdrName]
s of
    (RdrName
r:[RdrName]
s') -> do
      ([RdrName], [RdrName])
-> StateT ([RdrName], [RdrName]) (TransformT m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([RdrName]
s', RdrName
rRdrName -> [RdrName] -> [RdrName]
forall a. a -> [a] -> [a]
:[RdrName]
u)
      RdrName -> PatQ m RdrName
forall (m :: * -> *) a. Monad m => a -> m a
return RdrName
r
    [] -> String -> PatQ m RdrName
forall a. HasCallStack => String -> a
error String
"impossible: empty wild supply"

wildSupply :: [RdrName] -> [RdrName]
wildSupply :: [RdrName] -> [RdrName]
wildSupply [RdrName]
used = (RdrName -> Bool) -> [RdrName]
wildSupplyP (RdrName -> [RdrName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [RdrName]
used)

wildSupplyAlphaEnv :: AlphaEnv -> [RdrName]
wildSupplyAlphaEnv :: AlphaEnv -> [RdrName]
wildSupplyAlphaEnv AlphaEnv
env = (RdrName -> Bool) -> [RdrName]
wildSupplyP (\ RdrName
nm -> Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (RdrName -> AlphaEnv -> Maybe Int
lookupAlphaEnv RdrName
nm AlphaEnv
env))

wildSupplyP :: (RdrName -> Bool) -> [RdrName]
wildSupplyP :: (RdrName -> Bool) -> [RdrName]
wildSupplyP RdrName -> Bool
p =
  [ RdrName
r | Int
i <- [Int
0..]
      , let r :: RdrName
r = FastString -> RdrName
mkVarUnqual (String -> FastString
mkFastString (Char
'w' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show (Int
i :: Int)))
      , RdrName -> Bool
p RdrName
r ]

patToExprA :: AlphaEnv -> AnnotatedPat -> AnnotatedHsExpr
patToExprA :: AlphaEnv -> AnnotatedPat -> AnnotatedHsExpr
patToExprA AlphaEnv
env AnnotatedPat
pat = Identity AnnotatedHsExpr -> AnnotatedHsExpr
forall a. Identity a -> a
runIdentity (Identity AnnotatedHsExpr -> AnnotatedHsExpr)
-> Identity AnnotatedHsExpr -> AnnotatedHsExpr
forall a b. (a -> b) -> a -> b
$ AnnotatedPat
-> (Located (Pat GhcPs) -> TransformT Identity (LHsExpr GhcPs))
-> Identity AnnotatedHsExpr
forall (m :: * -> *) ast1 ast2.
Monad m =>
Annotated ast1 -> (ast1 -> TransformT m ast2) -> m (Annotated ast2)
transformA AnnotatedPat
pat ((Located (Pat GhcPs) -> TransformT Identity (LHsExpr GhcPs))
 -> Identity AnnotatedHsExpr)
-> (Located (Pat GhcPs) -> TransformT Identity (LHsExpr GhcPs))
-> Identity AnnotatedHsExpr
forall a b. (a -> b) -> a -> b
$ \ Located (Pat GhcPs)
p ->
  (LHsExpr GhcPs, ([RdrName], [RdrName])) -> LHsExpr GhcPs
forall a b. (a, b) -> a
fst ((LHsExpr GhcPs, ([RdrName], [RdrName])) -> LHsExpr GhcPs)
-> TransformT Identity (LHsExpr GhcPs, ([RdrName], [RdrName]))
-> TransformT Identity (LHsExpr GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ([RdrName], [RdrName]) (TransformT Identity) (LHsExpr GhcPs)
-> ([RdrName], [RdrName])
-> TransformT Identity (LHsExpr GhcPs, ([RdrName], [RdrName]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (LPat GhcPs
-> StateT
     ([RdrName], [RdrName]) (TransformT Identity) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr (LPat GhcPs
 -> StateT
      ([RdrName], [RdrName]) (TransformT Identity) (LHsExpr GhcPs))
-> LPat GhcPs
-> StateT
     ([RdrName], [RdrName]) (TransformT Identity) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ Located (Pat GhcPs) -> LPat GhcPs
forall (p :: Pass). Located (Pat (GhcPass p)) -> LPat (GhcPass p)
cLPat Located (Pat GhcPs)
p) (AlphaEnv -> [RdrName]
wildSupplyAlphaEnv AlphaEnv
env, [])

patToExpr :: Monad m => LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr :: LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
orig = case LPat GhcPs -> Maybe (Located (Pat GhcPs))
forall (p :: Pass).
LPat (GhcPass p) -> Maybe (Located (Pat (GhcPass p)))
dLPat LPat GhcPs
orig of
  Maybe (Located (Pat GhcPs))
Nothing -> String -> PatQ m (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr: called on unlocated Pat!"
  Just lp :: Located (Pat GhcPs)
lp@(L SrcSpan
_ Pat GhcPs
p) -> do
    LHsExpr GhcPs
e <- Pat GhcPs -> PatQ m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
Pat GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
go Pat GhcPs
p
    TransformT m () -> StateT ([RdrName], [RdrName]) (TransformT m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m ()
 -> StateT ([RdrName], [RdrName]) (TransformT m) ())
-> TransformT m ()
-> StateT ([RdrName], [RdrName]) (TransformT m) ()
forall a b. (a -> b) -> a -> b
$ Located (Pat GhcPs) -> LHsExpr GhcPs -> TransformT m ()
forall a b (m :: * -> *).
(HasCallStack, Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
transferEntryDPT Located (Pat GhcPs)
lp LHsExpr GhcPs
e
    LHsExpr GhcPs -> PatQ m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e
  where
    go :: Pat GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
go WildPat{} = PatQ m RdrName
forall (m :: * -> *). Monad m => PatQ m RdrName
newWildVar PatQ m RdrName
-> (RdrName
    -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> (RdrName -> TransformT m (LHsExpr GhcPs))
-> RdrName
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located RdrName -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
Located RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar (Located RdrName -> TransformT m (LHsExpr GhcPs))
-> (RdrName -> Located RdrName)
-> RdrName
-> TransformT m (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc
#if __GLASGOW_HASKELL__ < 900
    go XPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr XPat"
    go CoPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr CoPat"
    go (ConPatIn Located (IdP GhcPs)
con HsConPatDetails GhcPs
ds) = Located RdrName
-> HsConPatDetails GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
Located RdrName -> HsConPatDetails GhcPs -> PatQ m (LHsExpr GhcPs)
conPatHelper Located (IdP GhcPs)
Located RdrName
con HsConPatDetails GhcPs
ds
    go ConPatOut{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr ConPatOut" -- only exists post-tc
#else
    go (ConPat _ con ds) = conPatHelper con ds
#endif
    go (LazyPat XLazyPat GhcPs
_ LPat GhcPs
pat) = LPat GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
pat
    go (BangPat XBangPat GhcPs
_ LPat GhcPs
pat) = LPat GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
pat
    go (ListPat XListPat GhcPs
_ [LPat GhcPs]
ps) = do
      [LHsExpr GhcPs]
ps' <- (Located (Pat GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> [Located (Pat GhcPs)]
-> StateT ([RdrName], [RdrName]) (TransformT m) [LHsExpr GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Pat GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr [LPat GhcPs]
[Located (Pat GhcPs)]
ps
      TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ do
        LHsExpr GhcPs
el <- HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitList GhcPs
-> Maybe (SyntaxExpr GhcPs) -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList NoExtField
XExplicitList GhcPs
noExtField Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing [LHsExpr GhcPs]
ps'
        LHsExpr GhcPs
-> [(KeywordId, DeltaPos)] -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor LHsExpr GhcPs
el [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenS, (Int, Int) -> DeltaPos
DP (Int
0,Int
0)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseS, (Int, Int) -> DeltaPos
DP (Int
0,Int
0))]
    go (LitPat XLitPat GhcPs
_ HsLit GhcPs
lit) = TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ do
      HsLit GhcPs
lit' <- HsLit GhcPs -> TransformT m (HsLit GhcPs)
forall a (m :: * -> *).
(Data a, Typeable a, Monad m) =>
a -> TransformT m a
cloneT HsLit GhcPs
lit
      HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XLitE GhcPs -> HsLit GhcPs -> HsExpr GhcPs
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit NoExtField
XLitE GhcPs
noExtField HsLit GhcPs
lit'
    go (NPat XNPat GhcPs
_ Located (HsOverLit GhcPs)
llit Maybe (SyntaxExpr GhcPs)
mbNeg SyntaxExpr GhcPs
_) = TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ do
      L SrcSpan
_ HsOverLit GhcPs
lit <- Located (HsOverLit GhcPs)
-> TransformT m (Located (HsOverLit GhcPs))
forall a (m :: * -> *).
(Data a, Typeable a, Monad m) =>
a -> TransformT m a
cloneT Located (HsOverLit GhcPs)
llit
      LHsExpr GhcPs
e <- HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit NoExtField
XOverLitE GhcPs
noExtField HsOverLit GhcPs
lit
      LHsExpr GhcPs
negE <- TransformT m (LHsExpr GhcPs)
-> (SyntaxExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> Maybe (SyntaxExpr GhcPs)
-> TransformT m (LHsExpr GhcPs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e) (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> (SyntaxExpr GhcPs -> HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> TransformT m (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNegApp GhcPs -> LHsExpr GhcPs -> SyntaxExpr GhcPs -> HsExpr GhcPs
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp NoExtField
XNegApp GhcPs
noExtField LHsExpr GhcPs
e) Maybe (SyntaxExpr GhcPs)
mbNeg
      Located (HsOverLit GhcPs) -> LHsExpr GhcPs -> TransformT m ()
forall a b (m :: * -> *).
(HasCallStack, Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
addAllAnnsT Located (HsOverLit GhcPs)
llit LHsExpr GhcPs
negE
      LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
negE
    go (ParPat XParPat GhcPs
_ LPat GhcPs
p') = TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> (LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> LHsExpr GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall x (m :: * -> *).
(Data x, Monad m) =>
(Located x -> x) -> Located x -> TransformT m (Located x)
mkParen (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField) (LHsExpr GhcPs
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LPat GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
p'
    go SigPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr SigPat"
    go (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
boxity) = do
      [Located (HsTupArg GhcPs)]
es <- [Located (Pat GhcPs)]
-> (Located (Pat GhcPs)
    -> StateT
         ([RdrName], [RdrName]) (TransformT m) (Located (HsTupArg GhcPs)))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) [Located (HsTupArg GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LPat GhcPs]
[Located (Pat GhcPs)]
ps ((Located (Pat GhcPs)
  -> StateT
       ([RdrName], [RdrName]) (TransformT m) (Located (HsTupArg GhcPs)))
 -> StateT
      ([RdrName], [RdrName]) (TransformT m) [Located (HsTupArg GhcPs)])
-> (Located (Pat GhcPs)
    -> StateT
         ([RdrName], [RdrName]) (TransformT m) (Located (HsTupArg GhcPs)))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) [Located (HsTupArg GhcPs)]
forall a b. (a -> b) -> a -> b
$ \Located (Pat GhcPs)
pat -> do
        LHsExpr GhcPs
e <- LPat GhcPs
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
Located (Pat GhcPs)
pat
        TransformT m (Located (HsTupArg GhcPs))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (Located (HsTupArg GhcPs))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (Located (HsTupArg GhcPs))
 -> StateT
      ([RdrName], [RdrName]) (TransformT m) (Located (HsTupArg GhcPs)))
-> TransformT m (Located (HsTupArg GhcPs))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (Located (HsTupArg GhcPs))
forall a b. (a -> b) -> a -> b
$ HsTupArg GhcPs -> TransformT m (Located (HsTupArg GhcPs))
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsTupArg GhcPs -> TransformT m (Located (HsTupArg GhcPs)))
-> HsTupArg GhcPs -> TransformT m (Located (HsTupArg GhcPs))
forall a b. (a -> b) -> a -> b
$ XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present NoExtField
XPresent GhcPs
noExtField LHsExpr GhcPs
e
      TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XExplicitTuple GhcPs
-> [Located (HsTupArg GhcPs)] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple NoExtField
XExplicitTuple GhcPs
noExtField [Located (HsTupArg GhcPs)]
es Boxity
boxity
    go (VarPat XVarPat GhcPs
_ Located (IdP GhcPs)
i) = TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
Located RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar Located (IdP GhcPs)
Located RdrName
i
    go AsPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr AsPat"
    go NPlusKPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr NPlusKPat"
    go SplicePat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr SplicePat"
    go SumPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr SumPat"
    go ViewPat{} = String
-> StateT ([RdrName], [RdrName]) (TransformT m) (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"patToExpr ViewPat"

conPatHelper :: Monad m
             => Located RdrName
             -> HsConPatDetails GhcPs
             -> PatQ m (LHsExpr GhcPs)
conPatHelper :: Located RdrName -> HsConPatDetails GhcPs -> PatQ m (LHsExpr GhcPs)
conPatHelper Located RdrName
con (InfixCon LPat GhcPs
x LPat GhcPs
y) =
  TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs))
-> (HsExpr GhcPs -> TransformT m (LHsExpr GhcPs))
-> HsExpr GhcPs
-> PatQ m (LHsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (HsExpr GhcPs -> PatQ m (LHsExpr GhcPs))
-> StateT ([RdrName], [RdrName]) (TransformT m) (HsExpr GhcPs)
-> PatQ m (LHsExpr GhcPs)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NoExtField
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp (NoExtField
 -> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) NoExtField
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NoExtField
-> StateT ([RdrName], [RdrName]) (TransformT m) NoExtField
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoExtField
noExtField
                         StateT
  ([RdrName], [RdrName])
  (TransformT m)
  (LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs)
-> PatQ m (LHsExpr GhcPs)
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LPat GhcPs -> PatQ m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
x
                         StateT
  ([RdrName], [RdrName])
  (TransformT m)
  (LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs)
-> PatQ m (LHsExpr GhcPs)
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LHsExpr GhcPs -> HsExpr GhcPs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Located RdrName -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
Located RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar Located RdrName
con)
                         StateT
  ([RdrName], [RdrName])
  (TransformT m)
  (LHsExpr GhcPs -> HsExpr GhcPs)
-> PatQ m (LHsExpr GhcPs)
-> StateT ([RdrName], [RdrName]) (TransformT m) (HsExpr GhcPs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LPat GhcPs -> PatQ m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr LPat GhcPs
y
conPatHelper Located RdrName
con (PrefixCon [LPat GhcPs]
xs) = do
  LHsExpr GhcPs
f <- TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ Located RdrName -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
Located RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar Located RdrName
con
  [LHsExpr GhcPs]
as <- (Located (Pat GhcPs) -> PatQ m (LHsExpr GhcPs))
-> [Located (Pat GhcPs)]
-> StateT ([RdrName], [RdrName]) (TransformT m) [LHsExpr GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Located (Pat GhcPs) -> PatQ m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr [LPat GhcPs]
[Located (Pat GhcPs)]
xs
  TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs))
-> TransformT m (LHsExpr GhcPs) -> PatQ m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *).
Monad m =>
LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
mkApps LHsExpr GhcPs
f [LHsExpr GhcPs]
as
conPatHelper Located RdrName
_ HsConPatDetails GhcPs
_ = String -> PatQ m (LHsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"conPatHelper RecCon"

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

grhsToExpr :: LGRHS p (LHsExpr p) -> LHsExpr p
grhsToExpr :: LGRHS p (LHsExpr p) -> LHsExpr p
grhsToExpr (L SrcSpan
_ (GRHS XCGRHS p (LHsExpr p)
_ [] LHsExpr p
e)) = LHsExpr p
e
grhsToExpr (L SrcSpan
_ (GRHS XCGRHS p (LHsExpr p)
_ (GuardLStmt p
_:[GuardLStmt p]
_) LHsExpr p
e)) = LHsExpr p
e -- not sure about this
grhsToExpr LGRHS p (LHsExpr p)
_ = String -> LHsExpr p
forall a. HasCallStack => String -> a
error String
"grhsToExpr"

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

precedence :: FixityEnv -> HsExpr GhcPs -> Maybe Fixity
precedence :: FixityEnv -> HsExpr GhcPs -> Maybe Fixity
precedence FixityEnv
_        (HsApp {})       = Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just (Fixity -> Maybe Fixity) -> Fixity -> Maybe Fixity
forall a b. (a -> b) -> a -> b
$ SourceText -> Int -> FixityDirection -> Fixity
Fixity (String -> SourceText
SourceText String
"HsApp") Int
10 FixityDirection
InfixL
precedence FixityEnv
fixities (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
_) = Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just (Fixity -> Maybe Fixity) -> Fixity -> Maybe Fixity
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> FixityEnv -> Fixity
lookupOp LHsExpr GhcPs
op FixityEnv
fixities
precedence FixityEnv
_        HsExpr GhcPs
_                = Maybe Fixity
forall a. Maybe a
Nothing

parenify
  :: Monad m => Context -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
parenify :: Context -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
parenify Context{[RdrName]
Maybe Substitution
FixityEnv
AlphaEnv
Rewriter
ParentPrec
ctxtSubst :: Context -> Maybe Substitution
ctxtRewriter :: Context -> Rewriter
ctxtParentPrec :: Context -> ParentPrec
ctxtInScope :: Context -> AlphaEnv
ctxtFixityEnv :: Context -> FixityEnv
ctxtDependents :: Context -> Rewriter
ctxtBinders :: Context -> [RdrName]
ctxtSubst :: Maybe Substitution
ctxtRewriter :: Rewriter
ctxtParentPrec :: ParentPrec
ctxtInScope :: AlphaEnv
ctxtFixityEnv :: FixityEnv
ctxtDependents :: Rewriter
ctxtBinders :: [RdrName]
..} le :: LHsExpr GhcPs
le@(L SrcSpan
_ HsExpr GhcPs
e)
  | ParentPrec -> Maybe Fixity -> Bool
needed ParentPrec
ctxtParentPrec (FixityEnv -> HsExpr GhcPs -> Maybe Fixity
precedence FixityEnv
ctxtFixityEnv HsExpr GhcPs
e) Bool -> Bool -> Bool
&& HsExpr GhcPs -> Bool
needsParens HsExpr GhcPs
e =
    (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall x (m :: * -> *).
(Data x, Monad m) =>
(Located x -> x) -> Located x -> TransformT m (Located x)
mkParen (XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField) LHsExpr GhcPs
le
  | Bool
otherwise = LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
le
  where
           {- parent -}               {- child -}
    needed :: ParentPrec -> Maybe Fixity -> Bool
needed (HasPrec (Fixity SourceText
_ Int
p1 FixityDirection
d1)) (Just (Fixity SourceText
_ Int
p2 FixityDirection
d2)) =
      Int
p1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
p2 Bool -> Bool -> Bool
|| (Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 Bool -> Bool -> Bool
&& (FixityDirection
d1 FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
/= FixityDirection
d2 Bool -> Bool -> Bool
|| FixityDirection
d2 FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
InfixN))
    needed ParentPrec
NeverParen Maybe Fixity
_ = Bool
False
    needed ParentPrec
_ Maybe Fixity
Nothing = Bool
True
    needed ParentPrec
_ Maybe Fixity
_ = Bool
False

getUnparened :: Data k => k -> k
getUnparened :: k -> k
getUnparened = (LHsExpr GhcPs -> LHsExpr GhcPs) -> k -> k
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT LHsExpr GhcPs -> LHsExpr GhcPs
unparen (k -> k) -> (LHsType GhcPs -> LHsType GhcPs) -> k -> k
forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` LHsType GhcPs -> LHsType GhcPs
unparenT (k -> k) -> (Located (Pat GhcPs) -> Located (Pat GhcPs)) -> k -> k
forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` Located (Pat GhcPs) -> Located (Pat GhcPs)
unparenP

unparen :: LHsExpr GhcPs -> LHsExpr GhcPs
unparen :: LHsExpr GhcPs -> LHsExpr GhcPs
unparen (L SrcSpan
_ (HsPar XPar GhcPs
_ LHsExpr GhcPs
e)) = LHsExpr GhcPs
e
unparen LHsExpr GhcPs
e = LHsExpr GhcPs
e

-- | hsExprNeedsParens is not always up-to-date, so this allows us to override
needsParens :: HsExpr GhcPs -> Bool
needsParens :: HsExpr GhcPs -> Bool
needsParens = PprPrec -> HsExpr GhcPs -> Bool
forall p. PprPrec -> HsExpr p -> Bool
hsExprNeedsParens (Int -> PprPrec
PprPrec Int
10)

mkParen :: (Data x, Monad m) => (Located x -> x) -> Located x -> TransformT m (Located x)
mkParen :: (Located x -> x) -> Located x -> TransformT m (Located x)
mkParen Located x -> x
k Located x
e = do
  Located x
pe <- x -> TransformT m (Located x)
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc (Located x -> x
k Located x
e)
  Located x
_ <- Located x -> [(KeywordId, DeltaPos)] -> TransformT m (Located x)
forall e (m :: * -> *).
(Data e, Monad m) =>
Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
setAnnsFor Located x
pe [(AnnKeywordId -> KeywordId
G AnnKeywordId
AnnOpenP, (Int, Int) -> DeltaPos
DP (Int
0,Int
0)), (AnnKeywordId -> KeywordId
G AnnKeywordId
AnnCloseP, (Int, Int) -> DeltaPos
DP (Int
0,Int
0))]
  Located x -> Located x -> TransformT m ()
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
Located a -> Located b -> TransformT m ()
swapEntryDPT Located x
e Located x
pe
  Located x -> TransformT m (Located x)
forall (m :: * -> *) a. Monad m => a -> m a
return Located x
pe

-- This explicitly operates on 'Located (Pat GhcPs)' instead of 'LPat GhcPs'
-- because it is applied at that type by SYB.
parenifyP
  :: Monad m
  => Context
  -> Located (Pat GhcPs)
  -> TransformT m (Located (Pat GhcPs))
parenifyP :: Context
-> Located (Pat GhcPs) -> TransformT m (Located (Pat GhcPs))
parenifyP Context{[RdrName]
Maybe Substitution
FixityEnv
AlphaEnv
Rewriter
ParentPrec
ctxtSubst :: Maybe Substitution
ctxtRewriter :: Rewriter
ctxtParentPrec :: ParentPrec
ctxtInScope :: AlphaEnv
ctxtFixityEnv :: FixityEnv
ctxtDependents :: Rewriter
ctxtBinders :: [RdrName]
ctxtSubst :: Context -> Maybe Substitution
ctxtRewriter :: Context -> Rewriter
ctxtParentPrec :: Context -> ParentPrec
ctxtInScope :: Context -> AlphaEnv
ctxtFixityEnv :: Context -> FixityEnv
ctxtDependents :: Context -> Rewriter
ctxtBinders :: Context -> [RdrName]
..} p :: Located (Pat GhcPs)
p@(L SrcSpan
_ Pat GhcPs
pat)
  | ParentPrec
IsLhs <- ParentPrec
ctxtParentPrec
  , Pat GhcPs -> Bool
forall p. Pat p -> Bool
needed Pat GhcPs
pat =
    (Located (Pat GhcPs) -> Pat GhcPs)
-> Located (Pat GhcPs) -> TransformT m (Located (Pat GhcPs))
forall x (m :: * -> *).
(Data x, Monad m) =>
(Located x -> x) -> Located x -> TransformT m (Located x)
mkParen (XParPat GhcPs -> LPat GhcPs -> Pat GhcPs
forall p. XParPat p -> LPat p -> Pat p
ParPat NoExtField
XParPat GhcPs
noExtField (Located (Pat GhcPs) -> Pat GhcPs)
-> (Located (Pat GhcPs) -> Located (Pat GhcPs))
-> Located (Pat GhcPs)
-> Pat GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Pat GhcPs) -> Located (Pat GhcPs)
forall (p :: Pass). Located (Pat (GhcPass p)) -> LPat (GhcPass p)
cLPat) Located (Pat GhcPs)
p
  | Bool
otherwise = Located (Pat GhcPs) -> TransformT m (Located (Pat GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (Pat GhcPs)
p
  where
    needed :: Pat p -> Bool
needed BangPat{}                          = Bool
False
    needed LazyPat{}                          = Bool
False
    needed ListPat{}                          = Bool
False
    needed LitPat{}                           = Bool
False
    needed ParPat{}                           = Bool
False
    needed SumPat{}                           = Bool
False
    needed TuplePat{}                         = Bool
False
    needed VarPat{}                           = Bool
False
    needed WildPat{}                          = Bool
False
#if __GLASGOW_HASKELL__ < 900
    needed (ConPatIn Located (IdP p)
_ (PrefixCon []))        = Bool
False
    needed ConPatOut{pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = PrefixCon []} = Bool
False
#else
    needed (ConPat _ _ (PrefixCon []))        = False
#endif
    needed Pat p
_                                  = Bool
True

parenifyT
  :: Monad m => Context -> LHsType GhcPs -> TransformT m (LHsType GhcPs)
parenifyT :: Context -> LHsType GhcPs -> TransformT m (LHsType GhcPs)
parenifyT Context{[RdrName]
Maybe Substitution
FixityEnv
AlphaEnv
Rewriter
ParentPrec
ctxtSubst :: Maybe Substitution
ctxtRewriter :: Rewriter
ctxtParentPrec :: ParentPrec
ctxtInScope :: AlphaEnv
ctxtFixityEnv :: FixityEnv
ctxtDependents :: Rewriter
ctxtBinders :: [RdrName]
ctxtSubst :: Context -> Maybe Substitution
ctxtRewriter :: Context -> Rewriter
ctxtParentPrec :: Context -> ParentPrec
ctxtInScope :: Context -> AlphaEnv
ctxtFixityEnv :: Context -> FixityEnv
ctxtDependents :: Context -> Rewriter
ctxtBinders :: Context -> [RdrName]
..} lty :: LHsType GhcPs
lty@(L SrcSpan
_ HsType GhcPs
ty)
  | HsType GhcPs -> Bool
forall pass. HsType pass -> Bool
needed HsType GhcPs
ty = (LHsType GhcPs -> HsType GhcPs)
-> LHsType GhcPs -> TransformT m (LHsType GhcPs)
forall x (m :: * -> *).
(Data x, Monad m) =>
(Located x -> x) -> Located x -> TransformT m (Located x)
mkParen (XParTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy NoExtField
XParTy GhcPs
noExtField) LHsType GhcPs
lty
  | Bool
otherwise = LHsType GhcPs -> TransformT m (LHsType GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcPs
lty
  where
    needed :: HsType pass -> Bool
needed HsAppTy{}
      | ParentPrec
IsHsAppsTy <- ParentPrec
ctxtParentPrec = Bool
True
      | Bool
otherwise = Bool
False
    needed HsType pass
t = PprPrec -> HsType pass -> Bool
forall pass. PprPrec -> HsType pass -> Bool
hsTypeNeedsParens (Int -> PprPrec
PprPrec Int
10) HsType pass
t

unparenT :: LHsType GhcPs -> LHsType GhcPs
unparenT :: LHsType GhcPs -> LHsType GhcPs
unparenT (L SrcSpan
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty)) = LHsType GhcPs
ty
unparenT LHsType GhcPs
ty = LHsType GhcPs
ty

-- This explicitly operates on 'Located (Pat GhcPs)' instead of 'LPat GhcPs'
-- to ensure 'dLPat' was called on the input.
unparenP :: Located (Pat GhcPs) -> Located (Pat GhcPs)
unparenP :: Located (Pat GhcPs) -> Located (Pat GhcPs)
unparenP (L SrcSpan
_ (ParPat XParPat GhcPs
_ LPat GhcPs
p)) | Just Located (Pat GhcPs)
lp <- LPat GhcPs -> Maybe (Located (Pat GhcPs))
forall (p :: Pass).
LPat (GhcPass p) -> Maybe (Located (Pat (GhcPass p)))
dLPat LPat GhcPs
p = Located (Pat GhcPs)
lp
unparenP Located (Pat GhcPs)
p = Located (Pat GhcPs)
p

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

bitraverseHsConDetails
  :: Applicative m
  => (arg -> m arg')
  -> (rec -> m rec')
  -> HsConDetails arg rec
  -> m (HsConDetails arg' rec')
bitraverseHsConDetails :: (arg -> m arg')
-> (rec -> m rec')
-> HsConDetails arg rec
-> m (HsConDetails arg' rec')
bitraverseHsConDetails arg -> m arg'
argf rec -> m rec'
_ (PrefixCon [arg]
args) =
  [arg'] -> HsConDetails arg' rec'
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ([arg'] -> HsConDetails arg' rec')
-> m [arg'] -> m (HsConDetails arg' rec')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (arg -> m arg'
argf (arg -> m arg') -> [arg] -> m [arg']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
`traverse` [arg]
args)
bitraverseHsConDetails arg -> m arg'
_ rec -> m rec'
recf (RecCon rec
r) =
  rec' -> HsConDetails arg' rec'
forall arg rec. rec -> HsConDetails arg rec
RecCon (rec' -> HsConDetails arg' rec')
-> m rec' -> m (HsConDetails arg' rec')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rec -> m rec'
recf rec
r
bitraverseHsConDetails arg -> m arg'
argf rec -> m rec'
_ (InfixCon arg
a1 arg
a2) =
  arg' -> arg' -> HsConDetails arg' rec'
forall arg rec. arg -> arg -> HsConDetails arg rec
InfixCon (arg' -> arg' -> HsConDetails arg' rec')
-> m arg' -> m (arg' -> HsConDetails arg' rec')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> arg -> m arg'
argf arg
a1 m (arg' -> HsConDetails arg' rec')
-> m arg' -> m (HsConDetails arg' rec')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> arg -> m arg'
argf arg
a2