-- 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
  , mkLocA
  , 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 Data.Void

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

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

mkLocatedHsVar :: Monad m => LocatedN RdrName -> TransformT m (LHsExpr GhcPs)
mkLocatedHsVar :: forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
mkLocatedHsVar ln :: LocatedN RdrName
ln@(L SrcSpanAnnN
l RdrName
n) = do
  -- This special casing for [] is gross, but this is apparently how the
  -- annotations work.
  -- let anns =
  --       case occNameString (occName (unLoc v)) of
  --         "[]" -> [(G AnnOpenS, DP (0,0)), (G AnnCloseS, DP (0,0))]
  --         _    -> [(G AnnVal, DP (0,0))]
  -- r <- setAnnsFor v anns
  -- return (L (moveAnchor l)  (HsVar noExtField n))
  DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
0)  (XVar (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar (GhcPass 'Parsed)
NoExtField
noExtField (SrcSpanAnnN -> RdrName -> LocatedN RdrName
forall l e. l -> e -> GenLocated l e
L (DeltaPos -> SrcSpanAnnN -> SrcSpanAnnN
forall an. Monoid an => DeltaPos -> SrcAnn an -> SrcAnn an
setMoveAnchor (Int -> DeltaPos
SameLine Int
0) SrcSpanAnnN
l) RdrName
n))

-- TODO: move to ghc-exactprint
setMoveAnchor :: (Monoid an) => DeltaPos -> SrcAnn an -> SrcAnn an
setMoveAnchor :: forall an. Monoid an => DeltaPos -> SrcAnn an -> SrcAnn an
setMoveAnchor DeltaPos
dp (SrcSpanAnn EpAnn an
EpAnnNotUsed SrcSpan
l)
  = EpAnn an -> SrcSpan -> SrcSpanAnn' (EpAnn an)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> an -> EpAnnComments -> EpAnn an
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (SrcSpan -> DeltaPos -> Anchor
dpAnchor SrcSpan
l DeltaPos
dp) an
forall a. Monoid a => a
mempty EpAnnComments
emptyComments) SrcSpan
l
setMoveAnchor DeltaPos
dp (SrcSpanAnn (EpAnn (Anchor RealSrcSpan
a AnchorOperation
_) an
an EpAnnComments
cs) SrcSpan
l)
  = EpAnn an -> SrcSpan -> SrcSpanAnn' (EpAnn an)
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> an -> EpAnnComments -> EpAnn an
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn (RealSrcSpan -> AnchorOperation -> Anchor
Anchor RealSrcSpan
a (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)) an
an EpAnnComments
cs) SrcSpan
l

-- TODO: move to ghc-exactprint
dpAnchor :: SrcSpan -> DeltaPos -> Anchor
dpAnchor :: SrcSpan -> DeltaPos -> Anchor
dpAnchor SrcSpan
l DeltaPos
dp = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)

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

-- setAnnsFor :: (Data e, Monad m)
--            => Located e -> [(KeywordId, DeltaPos)] -> TransformT m (Located e)
-- setAnnsFor e anns = modifyAnnsT (M.alter f (mkAnnKey e)) >> return e
--   where f Nothing  = Just annNone { annsDP = anns }
--         f (Just a) = Just a { annsDP = M.toList
--                                      $ M.union (M.fromList anns)
--                                                (M.fromList (annsDP a)) }

mkLoc :: (Data e, Monad m) => e -> TransformT m (Located e)
mkLoc :: forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc e
e = do
  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

-- ++AZ++:TODO: move to ghc-exactprint
mkLocA :: (Data e, Monad m, Monoid an)
  => DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA :: forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA DeltaPos
dp e
e = DeltaPos -> an -> e -> TransformT m (LocatedAn an e)
forall e (m :: * -> *) an.
(Data e, Monad m) =>
DeltaPos -> an -> e -> TransformT m (LocatedAn an e)
mkLocAA DeltaPos
dp an
forall a. Monoid a => a
mempty e
e

-- ++AZ++:TODO: move to ghc-exactprint
mkLocAA :: (Data e, Monad m) => DeltaPos -> an -> e -> TransformT m (LocatedAn an e)
mkLocAA :: forall e (m :: * -> *) an.
(Data e, Monad m) =>
DeltaPos -> an -> e -> TransformT m (LocatedAn an e)
mkLocAA DeltaPos
dp an
an e
e = do
  SrcSpan
l <- TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
  let anc :: Anchor
anc = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp)
  LocatedAn an e -> TransformT m (LocatedAn an e)
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcAnn an -> e -> LocatedAn an e
forall l e. l -> e -> GenLocated l e
L (EpAnn an -> SrcSpan -> SrcAnn an
forall a. a -> SrcSpan -> SrcSpanAnn' a
SrcSpanAnn (Anchor -> an -> EpAnnComments -> EpAnn an
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc an
an EpAnnComments
emptyComments) SrcSpan
l) e
e)


-- ++AZ++:TODO: move to ghc-exactprint
mkEpAnn :: Monad m => DeltaPos -> an -> TransformT m (EpAnn an)
mkEpAnn :: forall (m :: * -> *) an.
Monad m =>
DeltaPos -> an -> TransformT m (EpAnn an)
mkEpAnn DeltaPos
dp an
an = do
  Anchor
anc <- DeltaPos -> TransformT m Anchor
forall (m :: * -> *). Monad m => DeltaPos -> TransformT m Anchor
mkAnchor DeltaPos
dp
  EpAnn an -> TransformT m (EpAnn an)
forall (m :: * -> *) a. Monad m => a -> m a
return (EpAnn an -> TransformT m (EpAnn an))
-> EpAnn an -> TransformT m (EpAnn an)
forall a b. (a -> b) -> a -> b
$ Anchor -> an -> EpAnnComments -> EpAnn an
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc an
an EpAnnComments
emptyComments

mkAnchor :: Monad m => DeltaPos -> TransformT m (Anchor)
mkAnchor :: forall (m :: * -> *). Monad m => DeltaPos -> TransformT m Anchor
mkAnchor DeltaPos
dp = do
  SrcSpan
l <- TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
  Anchor -> TransformT m Anchor
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (DeltaPos -> AnchorOperation
MovedAnchor DeltaPos
dp))

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

mkLams
  :: [LPat GhcPs]
  -> LHsExpr GhcPs
  -> TransformT IO (LHsExpr GhcPs)
mkLams :: [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> TransformT IO (LHsExpr (GhcPass 'Parsed))
mkLams [] LHsExpr (GhcPass 'Parsed)
e = LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT IO (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
mkLams [LPat (GhcPass 'Parsed)]
vs LHsExpr (GhcPass 'Parsed)
e = do
  Anchor
ancg <- DeltaPos -> TransformT IO Anchor
forall (m :: * -> *). Monad m => DeltaPos -> TransformT m Anchor
mkAnchor (Int -> DeltaPos
SameLine Int
0)
  Anchor
ancm <- DeltaPos -> TransformT IO Anchor
forall (m :: * -> *). Monad m => DeltaPos -> TransformT m Anchor
mkAnchor (Int -> DeltaPos
SameLine Int
0)
  let
    ga :: GrhsAnn
ga = Maybe EpaLocation -> AddEpAnn -> GrhsAnn
GrhsAnn Maybe EpaLocation
forall a. Maybe a
Nothing (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnRarrow (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
1) []))
    ang :: EpAnn GrhsAnn
ang = Anchor -> GrhsAnn -> EpAnnComments -> EpAnn GrhsAnn
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
ancg GrhsAnn
ga EpAnnComments
emptyComments
    anm :: EpAnn [AddEpAnn]
anm = Anchor -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
ancm [(AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnLam (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) []))] EpAnnComments
emptyComments
    L SrcSpanAnnA
l (Match XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
x HsMatchContext (NoGhcTc (GhcPass 'Parsed))
ctxt [LPat (GhcPass 'Parsed)]
pats (GRHSs XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
cs [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
grhs HsLocalBinds (GhcPass 'Parsed)
binds)) = HsMatchContext (NoGhcTc (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall (p :: Pass).
IsPass p =>
HsMatchContext (NoGhcTc (GhcPass p))
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext (NoGhcTc (GhcPass 'Parsed))
forall p. HsMatchContext p
LambdaExpr [LPat (GhcPass 'Parsed)]
vs LHsExpr (GhcPass 'Parsed)
e HsLocalBinds (GhcPass 'Parsed)
forall (a :: Pass) (b :: Pass).
HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds
    grhs' :: [GenLocated
   SrcSpan
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
grhs' = case [GenLocated
   SrcSpan
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
grhs of
      [L SrcSpan
lg (GRHS XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
an [GuardLStmt (GhcPass 'Parsed)]
guards LocatedA (HsExpr (GhcPass 'Parsed))
rhs)] -> [SrcSpan
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
     SrcSpan
     (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall l e. l -> e -> GenLocated l e
L SrcSpan
lg (XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [GuardLStmt (GhcPass 'Parsed)]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS EpAnn GrhsAnn
XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
ang [GuardLStmt (GhcPass 'Parsed)]
guards LocatedA (HsExpr (GhcPass 'Parsed))
rhs)]
      [GenLocated
   SrcSpan
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
_ -> String
-> [GenLocated
      SrcSpan
      (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mkLams: lambda expression can only have a single grhs!"
  LocatedAn
  AnnList
  [GenLocated
     SrcSpanAnnA
     (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches <- DeltaPos
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> TransformT
     IO
     (LocatedAn
        AnnList
        [GenLocated
           SrcSpanAnnA
           (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))])
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
0) [SrcSpanAnnA
-> Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
     SrcSpanAnnA
     (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> HsMatchContext (NoGhcTc (GhcPass 'Parsed))
-> [LPat (GhcPass 'Parsed)]
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match EpAnn [AddEpAnn]
XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
anm HsMatchContext (GhcPass 'Parsed)
HsMatchContext (NoGhcTc (GhcPass 'Parsed))
ctxt [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
pats (XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
-> HsLocalBinds (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs EpAnnComments
XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
cs [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
[GenLocated
   SrcSpan
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
grhs' HsLocalBinds (GhcPass 'Parsed)
binds))]
  let
    mg :: MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
mg =
      Origin
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
-> MatchGroup
     (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (p :: Pass) (body :: * -> *).
AnnoBody p body =>
Origin
-> LocatedL
     [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
-> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mkMatchGroup Origin
Generated LocatedAn
  AnnList
  [GenLocated
     SrcSpanAnnA
     (Match (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
matches
  DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT IO (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (HsExpr (GhcPass 'Parsed)
 -> TransformT IO (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> TransformT IO (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XLam (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam (GhcPass 'Parsed)
NoExtField
noExtField MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
mg

mkLet :: Monad m => HsLocalBinds GhcPs -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
mkLet :: forall (m :: * -> *).
Monad m =>
HsLocalBinds (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> TransformT m (LHsExpr (GhcPass 'Parsed))
mkLet EmptyLocalBinds{} LHsExpr (GhcPass 'Parsed)
e = LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
mkLet HsLocalBinds (GhcPass 'Parsed)
lbs LHsExpr (GhcPass 'Parsed)
e = do
  EpAnn AnnsLet
an <- DeltaPos -> AnnsLet -> TransformT m (EpAnn AnnsLet)
forall (m :: * -> *) an.
Monad m =>
DeltaPos -> an -> TransformT m (EpAnn an)
mkEpAnn (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
5)
                (AnnsLet {
                   alLet :: EpaLocation
alLet = DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [],
                   alIn :: EpaLocation
alIn = DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
1) []
                 })
  LocatedA (HsExpr (GhcPass 'Parsed))
le <- DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (HsExpr (GhcPass 'Parsed)
 -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XLet (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet EpAnn AnnsLet
XLet (GhcPass 'Parsed)
an HsLocalBinds (GhcPass 'Parsed)
lbs LHsExpr (GhcPass 'Parsed)
e
  LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (HsExpr (GhcPass 'Parsed))
le



mkApps :: MonadIO m => LHsExpr GhcPs -> [LHsExpr GhcPs] -> TransformT m (LHsExpr GhcPs)
mkApps :: forall (m :: * -> *).
MonadIO m =>
LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)]
-> TransformT m (LHsExpr (GhcPass 'Parsed))
mkApps LHsExpr (GhcPass 'Parsed)
e []     = LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
mkApps LHsExpr (GhcPass 'Parsed)
f (LHsExpr (GhcPass 'Parsed)
a:[LHsExpr (GhcPass 'Parsed)]
as) = do
  -- lift $ liftIO $ debugPrint Loud "mkApps:f="  [showAst f]
  LocatedA (HsExpr (GhcPass 'Parsed))
f' <- DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
0) (XApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp (GhcPass 'Parsed)
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
f LHsExpr (GhcPass 'Parsed)
a)
  LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)]
-> TransformT m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)]
-> TransformT m (LHsExpr (GhcPass 'Parsed))
mkApps LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
f' [LHsExpr (GhcPass 'Parsed)]
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 :: forall (m :: * -> *).
Monad m =>
[LHsType (GhcPass 'Parsed)]
-> TransformT m (LHsType (GhcPass 'Parsed))
mkHsAppsTy [] = String
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"mkHsAppsTy: empty list"
mkHsAppsTy (LHsType (GhcPass 'Parsed)
t:[LHsType (GhcPass 'Parsed)]
ts) = (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
 -> TransformT
      m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t1 GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2 -> DeltaPos
-> HsType (GhcPass 'Parsed)
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (XAppTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy (GhcPass 'Parsed)
NoExtField
noExtField LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t1 LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t2)) LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
t [LHsType (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))]
ts

mkTyVar :: Monad m => LocatedN RdrName -> TransformT m (LHsType GhcPs)
mkTyVar :: forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LHsType (GhcPass 'Parsed))
mkTyVar LocatedN RdrName
nm = do
  GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
tv <- DeltaPos
-> HsType (GhcPass 'Parsed)
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (XTyVar (GhcPass 'Parsed)
-> PromotionFlag
-> LIdP (GhcPass 'Parsed)
-> HsType (GhcPass 'Parsed)
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar XTyVar (GhcPass 'Parsed)
forall a. EpAnn a
noAnn PromotionFlag
NotPromoted LIdP (GhcPass 'Parsed)
LocatedN RdrName
nm)
  -- _ <- setAnnsFor nm [(G AnnVal, DP (0,0))]
  (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
tv', LocatedN RdrName
nm') <- GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> LocatedN RdrName
-> TransformT
     m
     (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)),
      LocatedN RdrName)
forall a b (m :: * -> *) a1 a2.
(Data a, Data b, Monad m, Monoid a1, Monoid a2, Typeable a1,
 Typeable a2) =>
LocatedAn a1 a
-> LocatedAn a2 b -> TransformT m (LocatedAn a1 a, LocatedAn a2 b)
swapEntryDPT GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
tv LocatedN RdrName
nm
  GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
tv'

mkVarPat :: Monad m => LocatedN RdrName -> TransformT m (LPat GhcPs)
mkVarPat :: forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LPat (GhcPass 'Parsed))
mkVarPat LocatedN RdrName
nm = GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall (p :: Pass). LPat (GhcPass p) -> LPat (GhcPass p)
cLPat (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeltaPos
-> Pat (GhcPass 'Parsed)
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (XVarPat (GhcPass 'Parsed)
-> LIdP (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XVarPat p -> LIdP p -> Pat p
VarPat XVarPat (GhcPass 'Parsed)
NoExtField
noExtField LIdP (GhcPass 'Parsed)
LocatedN RdrName
nm)

-- type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))

mkConPatIn
  :: Monad m
  => LocatedN RdrName
  -> HsConPatDetails GhcPs
  -- -> HsConDetails Void (LocatedN RdrName) [RecordPatSynField GhcPs]
  -> TransformT m (LPat GhcPs)
mkConPatIn :: forall (m :: * -> *).
Monad m =>
LocatedN RdrName
-> HsConPatDetails (GhcPass 'Parsed)
-> TransformT m (LPat (GhcPass 'Parsed))
mkConPatIn LocatedN RdrName
patName HsConPatDetails (GhcPass 'Parsed)
params = do
  GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p <- DeltaPos
-> Pat (GhcPass 'Parsed)
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
0) (Pat (GhcPass 'Parsed)
 -> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))))
-> Pat (GhcPass 'Parsed)
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XConPat (GhcPass 'Parsed)
-> XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
-> HsConPatDetails (GhcPass 'Parsed)
-> Pat (GhcPass 'Parsed)
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat XConPat (GhcPass 'Parsed)
forall a. EpAnn a
noAnn XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
LocatedN RdrName
patName HsConPatDetails (GhcPass 'Parsed)
params
  -- setEntryDPT p (DP (0,0))
  GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
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 :: forall (m :: * -> *). Monad m => 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 env pat = runIdentity $ transformA pat $ \ p ->
--   fst <$> runStateT (patToExpr $ cLPat p) (wildSupplyAlphaEnv env, [])

patToExpr :: MonadIO m => LPat GhcPs -> PatQ m (LHsExpr GhcPs)
patToExpr :: forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
orig = case LPat (GhcPass 'Parsed) -> Maybe (LPat (GhcPass 'Parsed))
forall (p :: Pass). LPat (GhcPass p) -> Maybe (LPat (GhcPass p))
dLPat LPat (GhcPass 'Parsed)
orig of
  Maybe (LPat (GhcPass 'Parsed))
Nothing -> String -> PatQ m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr: called on unlocated Pat!"
  Just lp :: LPat (GhcPass 'Parsed)
lp@(L SrcSpanAnnA
_ Pat (GhcPass 'Parsed)
p) -> do
    LocatedA (HsExpr (GhcPass 'Parsed))
e <- Pat (GhcPass 'Parsed)
-> PatQ m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall {m :: * -> *}.
MonadIO m =>
Pat (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
go Pat (GhcPass 'Parsed)
p
    TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> PatQ m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> PatQ m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> PatQ m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) t2 t1 a b.
(Monad m, Monoid t2, Typeable t1, Typeable t2) =>
LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
lp LocatedA (HsExpr (GhcPass 'Parsed))
e
  where
    -- go :: Pat GhcPs -> PatQ m (LHsExpr GhcPs)
    go :: Pat (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
go WildPat{} = do
      RdrName
w <- PatQ m RdrName
forall (m :: * -> *). Monad m => PatQ m RdrName
newWildVar
      LocatedN RdrName
v <- TransformT m (LocatedN RdrName)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LocatedN RdrName)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedN RdrName)
 -> StateT ([RdrName], [RdrName]) (TransformT m) (LocatedN RdrName))
-> TransformT m (LocatedN RdrName)
-> StateT ([RdrName], [RdrName]) (TransformT m) (LocatedN RdrName)
forall a b. (a -> b) -> a -> b
$ DeltaPos -> RdrName -> TransformT m (LocatedN RdrName)
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) RdrName
w
      TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
mkLocatedHsVar LocatedN RdrName
v
#if __GLASGOW_HASKELL__ < 900
    go XPat{} = error "patToExpr XPat"
    go CoPat{} = error "patToExpr CoPat"
    go (ConPatIn con ds) = conPatHelper con ds
    go ConPatOut{} = error "patToExpr ConPatOut" -- only exists post-tc
#else
    go (ConPat XConPat (GhcPass 'Parsed)
_ XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
con HsConPatDetails (GhcPass 'Parsed)
ds) = LocatedN RdrName
-> HsConPatDetails (GhcPass 'Parsed)
-> PatQ m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LocatedN RdrName
-> HsConPatDetails (GhcPass 'Parsed)
-> PatQ m (LHsExpr (GhcPass 'Parsed))
conPatHelper XRec (GhcPass 'Parsed) (ConLikeP (GhcPass 'Parsed))
LocatedN RdrName
con HsConPatDetails (GhcPass 'Parsed)
ds
#endif
    go (LazyPat XLazyPat (GhcPass 'Parsed)
_ LPat (GhcPass 'Parsed)
pat) = LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
pat
    go (BangPat XBangPat (GhcPass 'Parsed)
_ LPat (GhcPass 'Parsed)
pat) = LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
pat
    go (ListPat XListPat (GhcPass 'Parsed)
_ [LPat (GhcPass 'Parsed)]
ps) = do
      [LocatedA (HsExpr (GhcPass 'Parsed))]
ps' <- (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     [LocatedA (HsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps
      TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ do
        EpAnn AnnList
an <- DeltaPos -> AnnList -> TransformT m (EpAnn AnnList)
forall (m :: * -> *) an.
Monad m =>
DeltaPos -> an -> TransformT m (EpAnn an)
mkEpAnn (Int -> DeltaPos
SameLine Int
1)
                      (Maybe Anchor
-> Maybe AddEpAnn
-> Maybe AddEpAnn
-> [AddEpAnn]
-> [TrailingAnn]
-> AnnList
AnnList Maybe Anchor
forall a. Maybe a
Nothing (AddEpAnn -> Maybe AddEpAnn
forall a. a -> Maybe a
Just (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnOpenS EpaLocation
d0)) (AddEpAnn -> Maybe AddEpAnn
forall a. a -> Maybe a
Just (AnnKeywordId -> EpaLocation -> AddEpAnn
AddEpAnn AnnKeywordId
AnnCloseS EpaLocation
d0)) [] [])
        LocatedA (HsExpr (GhcPass 'Parsed))
el <- DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (HsExpr (GhcPass 'Parsed)
 -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XExplicitList (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> HsExpr (GhcPass 'Parsed)
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
ExplicitList EpAnn AnnList
XExplicitList (GhcPass 'Parsed)
an [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
ps'
        -- setAnnsFor el [(G AnnOpenS, DP (0,0)), (G AnnCloseS, DP (0,0))]
        LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (HsExpr (GhcPass 'Parsed))
el
    go (LitPat XLitPat (GhcPass 'Parsed)
_ HsLit (GhcPass 'Parsed)
lit) = TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ do
      -- lit' <- cloneT lit
      DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (HsExpr (GhcPass 'Parsed)
 -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XLitE (GhcPass 'Parsed)
-> HsLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE (GhcPass 'Parsed)
forall a. EpAnn a
noAnn HsLit (GhcPass 'Parsed)
lit
    go (NPat XNPat (GhcPass 'Parsed)
_ XRec (GhcPass 'Parsed) (HsOverLit (GhcPass 'Parsed))
llit Maybe (SyntaxExpr (GhcPass 'Parsed))
mbNeg SyntaxExpr (GhcPass 'Parsed)
_) = TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ do
      -- L _ lit <- cloneT llit
      LocatedA (HsExpr (GhcPass 'Parsed))
e <- DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (HsExpr (GhcPass 'Parsed)
 -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XOverLitE (GhcPass 'Parsed)
-> HsOverLit (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE (GhcPass 'Parsed)
forall a. EpAnn a
noAnn (GenLocated SrcSpan (HsOverLit (GhcPass 'Parsed))
-> HsOverLit (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Parsed) (HsOverLit (GhcPass 'Parsed))
GenLocated SrcSpan (HsOverLit (GhcPass 'Parsed))
llit)
      LocatedA (HsExpr (GhcPass 'Parsed))
negE <- TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> (NoExtField
    -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> Maybe NoExtField
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (HsExpr (GhcPass 'Parsed))
e) (DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
0) (HsExpr (GhcPass 'Parsed)
 -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> (NoExtField -> HsExpr (GhcPass 'Parsed))
-> NoExtField
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNegApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
NegApp XNegApp (GhcPass 'Parsed)
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e) Maybe (SyntaxExpr (GhcPass 'Parsed))
Maybe NoExtField
mbNeg
      -- addAllAnnsT llit negE
      LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (HsExpr (GhcPass 'Parsed))
negE
    go (ParPat XParPat (GhcPass 'Parsed)
an LPat (GhcPass 'Parsed)
p') = do
      LocatedA (HsExpr (GhcPass 'Parsed))
p <- LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
p'
      TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (XPar (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XParPat (GhcPass 'Parsed)
XPar (GhcPass 'Parsed)
an LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
p)
    go SigPat{} = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr SigPat"
    go (TuplePat XTuplePat (GhcPass 'Parsed)
an [LPat (GhcPass 'Parsed)]
ps Boxity
boxity) = do
      [HsTupArg (GhcPass 'Parsed)]
es <- [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
    -> StateT
         ([RdrName], [RdrName]) (TransformT m) (HsTupArg (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) [HsTupArg (GhcPass 'Parsed)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps ((GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
  -> StateT
       ([RdrName], [RdrName]) (TransformT m) (HsTupArg (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName]) (TransformT m) [HsTupArg (GhcPass 'Parsed)])
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
    -> StateT
         ([RdrName], [RdrName]) (TransformT m) (HsTupArg (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) [HsTupArg (GhcPass 'Parsed)]
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
pat -> do
        LocatedA (HsExpr (GhcPass 'Parsed))
e <- LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
pat
        HsTupArg (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (HsTupArg (GhcPass 'Parsed))
forall (m :: * -> *) a. Monad m => a -> m a
return (HsTupArg (GhcPass 'Parsed)
 -> StateT
      ([RdrName], [RdrName]) (TransformT m) (HsTupArg (GhcPass 'Parsed)))
-> HsTupArg (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (HsTupArg (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XPresent (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsTupArg (GhcPass 'Parsed)
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent (GhcPass 'Parsed)
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
      TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (HsExpr (GhcPass 'Parsed)
 -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ XExplicitTuple (GhcPass 'Parsed)
-> [HsTupArg (GhcPass 'Parsed)]
-> Boxity
-> HsExpr (GhcPass 'Parsed)
forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XTuplePat (GhcPass 'Parsed)
XExplicitTuple (GhcPass 'Parsed)
an [HsTupArg (GhcPass 'Parsed)]
es Boxity
boxity
    go (VarPat XVarPat (GhcPass 'Parsed)
_ LIdP (GhcPass 'Parsed)
i) = TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
mkLocatedHsVar LIdP (GhcPass 'Parsed)
LocatedN RdrName
i
    go AsPat{} = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr AsPat"
    go NPlusKPat{} = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr NPlusKPat"
    go SplicePat{} = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr SplicePat"
    go SumPat{} = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr SumPat"
    go ViewPat{} = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"patToExpr ViewPat"

conPatHelper :: MonadIO m
             => LocatedN RdrName
             -> HsConPatDetails GhcPs
             -> PatQ m (LHsExpr GhcPs)
conPatHelper :: forall (m :: * -> *).
MonadIO m =>
LocatedN RdrName
-> HsConPatDetails (GhcPass 'Parsed)
-> PatQ m (LHsExpr (GhcPass 'Parsed))
conPatHelper LocatedN RdrName
con (InfixCon LPat (GhcPass 'Parsed)
x LPat (GhcPass 'Parsed)
y) =
  TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> (HsExpr (GhcPass 'Parsed)
    -> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed))))
-> HsExpr (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaPos
-> HsExpr (GhcPass 'Parsed)
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1)
               (HsExpr (GhcPass 'Parsed)
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (HsExpr (GhcPass 'Parsed))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EpAnn [AddEpAnn]
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
-> HsExpr (GhcPass 'Parsed)
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp (EpAnn [AddEpAnn]
 -> LocatedA (HsExpr (GhcPass 'Parsed))
 -> LocatedA (HsExpr (GhcPass 'Parsed))
 -> LocatedA (HsExpr (GhcPass 'Parsed))
 -> HsExpr (GhcPass 'Parsed))
-> StateT ([RdrName], [RdrName]) (TransformT m) (EpAnn [AddEpAnn])
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed))
      -> LocatedA (HsExpr (GhcPass 'Parsed))
      -> LocatedA (HsExpr (GhcPass 'Parsed))
      -> HsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EpAnn [AddEpAnn]
-> StateT ([RdrName], [RdrName]) (TransformT m) (EpAnn [AddEpAnn])
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn
                         StateT
  ([RdrName], [RdrName])
  (TransformT m)
  (LocatedA (HsExpr (GhcPass 'Parsed))
   -> LocatedA (HsExpr (GhcPass 'Parsed))
   -> LocatedA (HsExpr (GhcPass 'Parsed))
   -> HsExpr (GhcPass 'Parsed))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed))
      -> LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LPat (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
x
                         StateT
  ([RdrName], [RdrName])
  (TransformT m)
  (LocatedA (HsExpr (GhcPass 'Parsed))
   -> LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
mkLocatedHsVar LocatedN RdrName
con)
                         StateT
  ([RdrName], [RdrName])
  (TransformT m)
  (LocatedA (HsExpr (GhcPass 'Parsed)) -> HsExpr (GhcPass 'Parsed))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (HsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LPat (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr LPat (GhcPass 'Parsed)
y
conPatHelper LocatedN RdrName
con (PrefixCon [HsPatSigType (NoGhcTc (GhcPass 'Parsed))]
tyargs [LPat (GhcPass 'Parsed)]
xs) = do
  LocatedA (HsExpr (GhcPass 'Parsed))
f <- TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
Monad m =>
LocatedN RdrName -> TransformT m (LHsExpr (GhcPass 'Parsed))
mkLocatedHsVar LocatedN RdrName
con
  [LocatedA (HsExpr (GhcPass 'Parsed))]
as <- (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     [LocatedA (HsExpr (GhcPass 'Parsed))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *).
MonadIO m =>
LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
patToExpr [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
xs
  -- lift $ lift $ liftIO $ debugPrint Loud "conPatHelper:f="  [showAst f]
  TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
 -> StateT
      ([RdrName], [RdrName])
      (TransformT m)
      (LocatedA (HsExpr (GhcPass 'Parsed))))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)]
-> TransformT m (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
MonadIO m =>
LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)]
-> TransformT m (LHsExpr (GhcPass 'Parsed))
mkApps LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
f [LHsExpr (GhcPass 'Parsed)]
[LocatedA (HsExpr (GhcPass 'Parsed))]
as
conPatHelper LocatedN RdrName
_ HsConPatDetails (GhcPass 'Parsed)
_ = String
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. HasCallStack => String -> a
error String
"conPatHelper RecCon"

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

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

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

precedence :: FixityEnv -> HsExpr GhcPs -> Maybe Fixity
precedence :: FixityEnv -> HsExpr (GhcPass 'Parsed) -> 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 (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
op LHsExpr (GhcPass 'Parsed)
_) = Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just (Fixity -> Maybe Fixity) -> Fixity -> Maybe Fixity
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> FixityEnv -> Fixity
lookupOp LHsExpr (GhcPass 'Parsed)
op FixityEnv
fixities
precedence FixityEnv
_        HsExpr (GhcPass 'Parsed)
_                = Maybe Fixity
forall a. Maybe a
Nothing

parenify
  :: Monad m => Context -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)
parenify :: forall (m :: * -> *).
Monad m =>
Context
-> LHsExpr (GhcPass 'Parsed)
-> TransformT m (LHsExpr (GhcPass 'Parsed))
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 (GhcPass 'Parsed)
le@(L SrcSpanAnnA
_ HsExpr (GhcPass 'Parsed)
e)
  | ParentPrec -> Maybe Fixity -> Bool
needed ParentPrec
ctxtParentPrec (FixityEnv -> HsExpr (GhcPass 'Parsed) -> Maybe Fixity
precedence FixityEnv
ctxtFixityEnv HsExpr (GhcPass 'Parsed)
e) Bool -> Bool -> Bool
&& HsExpr (GhcPass 'Parsed) -> Bool
needsParens HsExpr (GhcPass 'Parsed)
e =
    DeltaPos
-> (EpAnn AnnParen -> HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParen' (LocatedA (HsExpr (GhcPass 'Parsed)) -> DeltaPos
forall t a. LocatedAn t a -> DeltaPos
getEntryDP LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
le) (\EpAnn AnnParen
an -> XPar (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed) -> HsExpr (GhcPass 'Parsed)
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar EpAnn AnnParen
XPar (GhcPass 'Parsed)
an (LocatedA (HsExpr (GhcPass 'Parsed))
-> DeltaPos -> LocatedA (HsExpr (GhcPass 'Parsed))
forall t a. Monoid t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
le (Int -> DeltaPos
SameLine Int
0)))
  | Bool
otherwise = LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
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 :: forall k. Data k => k -> k
getUnparened = (LocatedA (HsExpr (GhcPass 'Parsed))
 -> LocatedA (HsExpr (GhcPass 'Parsed)))
-> k -> k
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
-> LocatedA (HsExpr (GhcPass 'Parsed))
unparen (k -> k)
-> (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
    -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
-> k
-> k
forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
unparenT (k -> k)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
    -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> k
-> k
forall a b.
(Typeable a, Typeable b) =>
(a -> a) -> (b -> b) -> a -> a
`extT` LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
unparenP

-- TODO: what about comments?
unparen :: LHsExpr GhcPs -> LHsExpr GhcPs
unparen :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
unparen (L SrcSpanAnnA
_ (HsPar XPar (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
e)) = LHsExpr (GhcPass 'Parsed)
e
unparen LHsExpr (GhcPass 'Parsed)
e = LHsExpr (GhcPass 'Parsed)
e

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

mkParen :: (Data x, Monad m, Monoid an, Typeable an)
  => (LocatedAn an x -> x) -> LocatedAn an x -> TransformT m (LocatedAn an x)
mkParen :: forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an, Typeable an) =>
(LocatedAn an x -> x)
-> LocatedAn an x -> TransformT m (LocatedAn an x)
mkParen LocatedAn an x -> x
k LocatedAn an x
e = do
  LocatedAn an x
pe <- DeltaPos -> x -> TransformT m (LocatedAn an x)
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA (Int -> DeltaPos
SameLine Int
1) (LocatedAn an x -> x
k LocatedAn an x
e)
  -- _ <- setAnnsFor pe [(G AnnOpenP, DP (0,0)), (G AnnCloseP, DP (0,0))]
  (LocatedAn an x
e0,LocatedAn an x
pe0) <- LocatedAn an x
-> LocatedAn an x -> TransformT m (LocatedAn an x, LocatedAn an x)
forall a b (m :: * -> *) a1 a2.
(Data a, Data b, Monad m, Monoid a1, Monoid a2, Typeable a1,
 Typeable a2) =>
LocatedAn a1 a
-> LocatedAn a2 b -> TransformT m (LocatedAn a1 a, LocatedAn a2 b)
swapEntryDPT LocatedAn an x
e LocatedAn an x
pe
  LocatedAn an x -> TransformT m (LocatedAn an x)
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn an x
pe0

mkParen' :: (Data x, Monad m, Monoid an)
         => DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParen' :: forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParen' DeltaPos
dp EpAnn AnnParen -> x
k = do
  let an :: AnnParen
an = ParenType -> EpaLocation -> EpaLocation -> AnnParen
AnnParen ParenType
AnnParens EpaLocation
d0 EpaLocation
d0
  SrcSpan
l <- TransformT m SrcSpan
forall (m :: * -> *). Monad m => TransformT m SrcSpan
uniqueSrcSpanT
  let anc :: Anchor
anc = RealSrcSpan -> AnchorOperation -> Anchor
Anchor (SrcSpan -> RealSrcSpan
realSrcSpan SrcSpan
l) (DeltaPos -> AnchorOperation
MovedAnchor (Int -> DeltaPos
SameLine Int
0))
  LocatedAn an x
pe <- DeltaPos -> x -> TransformT m (LocatedAn an x)
forall e (m :: * -> *) an.
(Data e, Monad m, Monoid an) =>
DeltaPos -> e -> TransformT m (LocatedAn an e)
mkLocA DeltaPos
dp (EpAnn AnnParen -> x
k (Anchor -> AnnParen -> EpAnnComments -> EpAnn AnnParen
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc AnnParen
an EpAnnComments
emptyComments))
  LocatedAn an x -> TransformT m (LocatedAn an x)
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn an 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
  -> LPat GhcPs
  -> TransformT m (LPat GhcPs)
parenifyP :: forall (m :: * -> *).
Monad m =>
Context
-> LPat (GhcPass 'Parsed) -> TransformT m (LPat (GhcPass 'Parsed))
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 :: LPat (GhcPass 'Parsed)
p@(L SrcSpanAnnA
_ Pat (GhcPass 'Parsed)
pat)
  | ParentPrec
IsLhs <- ParentPrec
ctxtParentPrec
  , Pat (GhcPass 'Parsed) -> Bool
forall {p}. Pat p -> Bool
needed Pat (GhcPass 'Parsed)
pat =
    DeltaPos
-> (EpAnn AnnParen -> Pat (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParen' (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)) -> DeltaPos
forall t a. LocatedAn t a -> DeltaPos
getEntryDP LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p) (\EpAnn AnnParen
an -> XParPat (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed) -> Pat (GhcPass 'Parsed)
forall p. XParPat p -> LPat p -> Pat p
ParPat EpAnn AnnParen
XParPat (GhcPass 'Parsed)
an (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> DeltaPos -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall t a. Monoid t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p (Int -> DeltaPos
SameLine Int
0)))
  | Bool
otherwise = GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
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 _ (PrefixCon []))        = False
    needed ConPatOut{pat_args = PrefixCon []} = False
#else
    needed (ConPat XConPat p
_ XRec p (ConLikeP p)
_ (PrefixCon [HsPatSigType (NoGhcTc p)]
_ []))      = Bool
False
#endif
    needed Pat p
_                                  = Bool
True

parenifyT
  :: Monad m => Context -> LHsType GhcPs -> TransformT m (LHsType GhcPs)
parenifyT :: forall (m :: * -> *).
Monad m =>
Context
-> LHsType (GhcPass 'Parsed)
-> TransformT m (LHsType (GhcPass 'Parsed))
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 (GhcPass 'Parsed)
lty@(L SrcSpanAnnA
_ HsType (GhcPass 'Parsed)
ty)
  | HsType (GhcPass 'Parsed) -> Bool
forall {p :: Pass}. HsType (GhcPass p) -> Bool
needed HsType (GhcPass 'Parsed)
ty = DeltaPos
-> (EpAnn AnnParen -> HsType (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParen' (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)) -> DeltaPos
forall t a. LocatedAn t a -> DeltaPos
getEntryDP LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
lty) (\EpAnn AnnParen
an -> XParTy (GhcPass 'Parsed)
-> LHsType (GhcPass 'Parsed) -> HsType (GhcPass 'Parsed)
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy EpAnn AnnParen
XParTy (GhcPass 'Parsed)
an (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> DeltaPos -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall t a. Monoid t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
lty (Int -> DeltaPos
SameLine Int
0)))
  | Bool
otherwise = GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
lty
  where
    needed :: HsType (GhcPass p) -> Bool
needed HsAppTy{}
      | ParentPrec
IsHsAppsTy <- ParentPrec
ctxtParentPrec = Bool
True
      | Bool
otherwise = Bool
False
    needed HsType (GhcPass p)
t = PprPrec -> HsType (GhcPass p) -> Bool
forall (p :: Pass). PprPrec -> HsType (GhcPass p) -> Bool
hsTypeNeedsParens (Int -> PprPrec
PprPrec Int
10) HsType (GhcPass p)
t

unparenT :: LHsType GhcPs -> LHsType GhcPs
unparenT :: LHsType (GhcPass 'Parsed) -> LHsType (GhcPass 'Parsed)
unparenT (L SrcSpanAnnA
_ (HsParTy XParTy (GhcPass 'Parsed)
_ LHsType (GhcPass 'Parsed)
ty)) = LHsType (GhcPass 'Parsed)
ty
unparenT LHsType (GhcPass 'Parsed)
ty = LHsType (GhcPass 'Parsed)
ty

unparenP :: LPat GhcPs -> LPat GhcPs
unparenP :: LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
unparenP (L SrcSpanAnnA
_ (ParPat XParPat (GhcPass 'Parsed)
_ LPat (GhcPass 'Parsed)
p)) = LPat (GhcPass 'Parsed)
p
unparenP LPat (GhcPass 'Parsed)
p = LPat (GhcPass 'Parsed)
p

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

bitraverseHsConDetails
  :: Applicative m
  => ([tyarg] -> m [tyarg'])
  -> (arg -> m arg')
  -> (rec -> m rec')
  -> HsConDetails tyarg arg rec
  -> m (HsConDetails tyarg' arg' rec')
bitraverseHsConDetails :: forall (m :: * -> *) tyarg tyarg' arg arg' rec rec'.
Applicative m =>
([tyarg] -> m [tyarg'])
-> (arg -> m arg')
-> (rec -> m rec')
-> HsConDetails tyarg arg rec
-> m (HsConDetails tyarg' arg' rec')
bitraverseHsConDetails [tyarg] -> m [tyarg']
argt arg -> m arg'
argf rec -> m rec'
_ (PrefixCon [tyarg]
tyargs [arg]
args) =
  [tyarg'] -> [arg'] -> HsConDetails tyarg' arg' rec'
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon ([tyarg'] -> [arg'] -> HsConDetails tyarg' arg' rec')
-> m [tyarg'] -> m ([arg'] -> HsConDetails tyarg' arg' rec')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([tyarg] -> m [tyarg']
argt [tyarg]
tyargs) m ([arg'] -> HsConDetails tyarg' arg' rec')
-> m [arg'] -> m (HsConDetails tyarg' arg' rec')
forall (f :: * -> *) a b. Applicative f => 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 [tyarg] -> m [tyarg']
_ arg -> m arg'
_ rec -> m rec'
recf (RecCon rec
r) =
  rec' -> HsConDetails tyarg' arg' rec'
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon (rec' -> HsConDetails tyarg' arg' rec')
-> m rec' -> m (HsConDetails tyarg' arg' rec')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> rec -> m rec'
recf rec
r
bitraverseHsConDetails [tyarg] -> m [tyarg']
_ arg -> m arg'
argf rec -> m rec'
_ (InfixCon arg
a1 arg
a2) =
  arg' -> arg' -> HsConDetails tyarg' arg' rec'
forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (arg' -> arg' -> HsConDetails tyarg' arg' rec')
-> m arg' -> m (arg' -> HsConDetails tyarg' arg' rec')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> arg -> m arg'
argf arg
a1 m (arg' -> HsConDetails tyarg' arg' rec')
-> m arg' -> m (HsConDetails tyarg' arg' rec')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> arg -> m arg'
argf arg
a2