-- 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
  , mkEpAnn
  , mkHsAppsTy
  , mkLams
  , mkLet
  , mkLoc
  , mkLocA
  , mkLocatedHsVar
  , mkVarPat
  , mkTyVar
  , parenify
  , parenifyT
  , parenifyP
  , patToExpr
  -- , patToExprA
  -- , setAnnsFor
  , unparen
  , unparenP
  , unparenT
  , wildSupply
  ) where

import Control.Monad
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 a b.
TransformT m (a -> b) -> TransformT m a -> TransformT m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> e -> TransformT m e
forall a. a -> TransformT m a
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 a. a -> TransformT m a
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 a. a -> TransformT m a
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 a. a -> TransformT m a
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 a. a -> TransformT IO a
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 (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 (GhcPass 'Parsed)
-> [LPat (GhcPass 'Parsed)]
-> LHsExpr (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall (p :: Pass).
IsPass p =>
HsMatchContext (GhcPass p)
-> [LPat (GhcPass p)]
-> LHsExpr (GhcPass p)
-> HsLocalBinds (GhcPass p)
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch HsMatchContext (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
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
grhs' = case [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
grhs of
      [L SrcAnn NoEpAnns
lg (GRHS XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
an [GuardLStmt (GhcPass 'Parsed)]
guards LocatedA (HsExpr (GhcPass 'Parsed))
rhs)] -> [SrcAnn NoEpAnns
-> GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))
forall l e. l -> e -> GenLocated l e
L SrcAnn NoEpAnns
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 XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn GrhsAnn
ang [GuardLStmt (GhcPass 'Parsed)]
guards LocatedA (HsExpr (GhcPass 'Parsed))
rhs)]
      [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
_ -> String
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
forall a. String -> [a]
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 (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 p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnn [AddEpAnn]
anm HsMatchContext (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 XCGRHSs (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
EpAnnComments
cs [LGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed))))]
grhs' HsLocalBinds (GhcPass 'Parsed)
binds))]
  let
    mg :: MatchGroup (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
mg =
#if __GLASGOW_HASKELL__ < 908
      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
#else
      mkMatchGroup (Generated SkipPmc) matches
#endif
  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 a. a -> TransformT m a
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
#if __GLASGOW_HASKELL__ < 904
  an <- mkEpAnn (DifferentLine 1 5)
                (AnnsLet {
                   alLet = EpaDelta (SameLine 0) [],
                   alIn = EpaDelta (DifferentLine 1 1) []
                 })
  le <- mkLocA (SameLine 1) $ HsLet an lbs e
  return le
#else
  EpAnn NoEpAnns
an <- DeltaPos -> NoEpAnns -> TransformT m (EpAnn NoEpAnns)
forall (m :: * -> *) an.
Monad m =>
DeltaPos -> an -> TransformT m (EpAnn an)
mkEpAnn (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
5) NoEpAnns
NoEpAnns
  let tokLet :: GenLocated TokenLocation (HsToken tok)
tokLet = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
      tokIn :: GenLocated TokenLocation (HsToken tok)
tokIn = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> Int -> DeltaPos
DifferentLine Int
1 Int
1) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
  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)
-> LHsToken "let" (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
-> LHsToken "in" (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XLet p
-> LHsToken "let" p
-> HsLocalBinds p
-> LHsToken "in" p
-> LHsExpr p
-> HsExpr p
HsLet XLet (GhcPass 'Parsed)
EpAnn NoEpAnns
an LHsToken "let" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "let")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokLet HsLocalBinds (GhcPass 'Parsed)
lbs LHsToken "in" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "in")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokIn LHsExpr (GhcPass 'Parsed)
e
  LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (HsExpr (GhcPass 'Parsed))
le
#endif

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 a. a -> TransformT m a
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)
EpAnn NoEpAnns
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)
EpAnn [AddEpAnn]
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 a. a -> TransformT m a
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 = LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
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)
EpAnn [AddEpAnn]
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 a. a -> TransformT m a
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 a. a -> StateT ([RdrName], [RdrName]) (TransformT m) a
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
-> StateT
     ([RdrName], [RdrName])
     (TransformT 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)
-> StateT
     ([RdrName], [RdrName])
     (TransformT 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)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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
$ 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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LPat (GhcPass 'Parsed) -> PatQ m (LHsExpr (GhcPass 'Parsed))
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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 XExplicitList (GhcPass 'Parsed)
EpAnn AnnList
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 a. a -> TransformT m a
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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)
EpAnn NoEpAnns
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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)
EpAnn NoEpAnns
forall a. EpAnn a
noAnn (GenLocated (SrcAnn NoEpAnns) (HsOverLit (GhcPass 'Parsed))
-> HsOverLit (GhcPass 'Parsed)
forall l e. GenLocated l e -> e
unLoc XRec (GhcPass 'Parsed) (HsOverLit (GhcPass 'Parsed))
GenLocated (SrcAnn NoEpAnns) (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 a. a -> TransformT m a
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)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e) Maybe NoExtField
Maybe (SyntaxExpr (GhcPass 'Parsed))
mbNeg
      -- addAllAnnsT llit negE
      LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedA (HsExpr (GhcPass 'Parsed))
negE
#if __GLASGOW_HASKELL__ < 904
    go (ParPat an p') = do
      p <- patToExpr p'
      lift $ mkLocA (SameLine 1) (HsPar an p)
#else
    go (ParPat XParPat (GhcPass 'Parsed)
an LHsToken "(" (GhcPass 'Parsed)
_ LPat (GhcPass 'Parsed)
p' LHsToken ")" (GhcPass 'Parsed)
_) = 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'
      let tokLP :: GenLocated TokenLocation (HsToken tok)
tokLP = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
          tokRP :: GenLocated TokenLocation (HsToken tok)
tokRP = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
      TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
-> StateT
     ([RdrName], [RdrName])
     (TransformT m)
     (LocatedA (HsExpr (GhcPass 'Parsed)))
forall (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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)
-> LHsToken "(" (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsToken ")" (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XParPat (GhcPass 'Parsed)
XPar (GhcPass 'Parsed)
an LHsToken "(" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "(")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokLP LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
p LHsToken ")" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken ")")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokRP)
#endif
    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 a. a -> StateT ([RdrName], [RdrName]) (TransformT m) a
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)
EpAnn [AddEpAnn]
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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
=<< XOpApp (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
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 a. a -> StateT ([RdrName], [RdrName]) (TransformT m) a
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 a b.
StateT ([RdrName], [RdrName]) (TransformT m) (a -> b)
-> StateT ([RdrName], [RdrName]) (TransformT m) a
-> StateT ([RdrName], [RdrName]) (TransformT m) b
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 a b.
StateT ([RdrName], [RdrName]) (TransformT m) (a -> b)
-> StateT ([RdrName], [RdrName]) (TransformT m) a
-> StateT ([RdrName], [RdrName]) (TransformT m) b
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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 a b.
StateT ([RdrName], [RdrName]) (TransformT m) (a -> b)
-> StateT ([RdrName], [RdrName]) (TransformT m) a
-> StateT ([RdrName], [RdrName]) (TransformT m) b
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 [HsConPatTyArg (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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LPat (GhcPass 'Parsed)
-> StateT
     ([RdrName], [RdrName]) (TransformT m) (LHsExpr (GhcPass 'Parsed))
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 (m :: * -> *) a.
Monad m =>
m a -> StateT ([RdrName], [RdrName]) m a
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 SrcAnn NoEpAnns
_ (GRHS XCGRHS (GhcPass 'Parsed) (LocatedA (HsExpr (GhcPass 'Parsed)))
_ [] LocatedA (HsExpr (GhcPass 'Parsed))
e)) = LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
e
grhsToExpr (L SrcAnn NoEpAnns
_ (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
#if __GLASGOW_HASKELL__ < 908
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
#else
precedence _        (HsApp {})       = Just $ Fixity (SourceText (fsLit "HsApp")) 10 InfixL
#endif
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
ctxtBinders :: [RdrName]
ctxtDependents :: Rewriter
ctxtFixityEnv :: FixityEnv
ctxtInScope :: AlphaEnv
ctxtParentPrec :: ParentPrec
ctxtRewriter :: Rewriter
ctxtSubst :: Maybe Substitution
ctxtBinders :: Context -> [RdrName]
ctxtDependents :: Context -> Rewriter
ctxtFixityEnv :: Context -> FixityEnv
ctxtInScope :: Context -> AlphaEnv
ctxtParentPrec :: Context -> ParentPrec
ctxtRewriter :: Context -> Rewriter
ctxtSubst :: Context -> Maybe Substitution
..} le :: LHsExpr (GhcPass 'Parsed)
le@(L SrcSpanAnnA
_ HsExpr (GhcPass 'Parsed)
e)
#if __GLASGOW_HASKELL__ < 904
  | needed ctxtParentPrec (precedence ctxtFixityEnv e) && needsParens e =
    mkParen' (getEntryDP le) (\an -> HsPar an (setEntryDP le (SameLine 0)))
#else
  | 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 = do
    let tokLP :: GenLocated TokenLocation (HsToken tok)
tokLP = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
        tokRP :: GenLocated TokenLocation (HsToken tok)
tokRP = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
     in DeltaPos
-> (EpAnn NoEpAnns -> HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn NoEpAnns -> 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 NoEpAnns
an -> XPar (GhcPass 'Parsed)
-> LHsToken "(" (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> LHsToken ")" (GhcPass 'Parsed)
-> HsExpr (GhcPass 'Parsed)
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar (GhcPass 'Parsed)
EpAnn NoEpAnns
an LHsToken "(" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "(")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokLP (LocatedA (HsExpr (GhcPass 'Parsed))
-> DeltaPos -> LocatedA (HsExpr (GhcPass 'Parsed))
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LHsExpr (GhcPass 'Parsed)
LocatedA (HsExpr (GhcPass 'Parsed))
le (Int -> DeltaPos
SameLine Int
0)) LHsToken ")" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken ")")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokRP)
#endif
  | Bool
otherwise = LocatedA (HsExpr (GhcPass 'Parsed))
-> TransformT m (LocatedA (HsExpr (GhcPass 'Parsed)))
forall a. a -> TransformT m a
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
#if __GLASGOW_HASKELL__ < 904
unparen (L _ (HsPar _ e)) = e
#else
unparen :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
unparen (L SrcSpanAnnA
_ (HsPar XPar (GhcPass 'Parsed)
_ LHsToken "(" (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
e LHsToken ")" (GhcPass 'Parsed)
_)) = LHsExpr (GhcPass 'Parsed)
e
#endif
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 a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn an x
pe0

#if __GLASGOW_HASKELL__ < 904
mkParen' :: (Data x, Monad m, Monoid an)
         => DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParen' dp k = do
  let an = AnnParen AnnParens d0 d0
  l <- uniqueSrcSpanT
  let anc = Anchor (realSrcSpan l) (MovedAnchor (SameLine 0))
  pe <- mkLocA dp (k (EpAnn anc an emptyComments))
  return pe
#else
mkParen' :: (Data x, Monad m, Monoid an)
         => DeltaPos -> (EpAnn NoEpAnns -> x) -> TransformT m (LocatedAn an x)
mkParen' :: forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn NoEpAnns -> x) -> TransformT m (LocatedAn an x)
mkParen' DeltaPos
dp EpAnn NoEpAnns -> x
k = do
  let an :: NoEpAnns
an = NoEpAnns
NoEpAnns
  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 NoEpAnns -> x
k (Anchor -> NoEpAnns -> EpAnnComments -> EpAnn NoEpAnns
forall ann. Anchor -> ann -> EpAnnComments -> EpAnn ann
EpAnn Anchor
anc NoEpAnns
an EpAnnComments
emptyComments))
  LocatedAn an x -> TransformT m (LocatedAn an x)
forall a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn an x
pe

mkParenTy :: (Data x, Monad m, Monoid an)
         => DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParenTy :: forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn AnnParen -> x) -> TransformT m (LocatedAn an x)
mkParenTy 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 a. a -> TransformT m a
forall (m :: * -> *) a. Monad m => a -> m a
return LocatedAn an x
pe
#endif

-- 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
ctxtBinders :: Context -> [RdrName]
ctxtDependents :: Context -> Rewriter
ctxtFixityEnv :: Context -> FixityEnv
ctxtInScope :: Context -> AlphaEnv
ctxtParentPrec :: Context -> ParentPrec
ctxtRewriter :: Context -> Rewriter
ctxtSubst :: Context -> Maybe Substitution
ctxtBinders :: [RdrName]
ctxtDependents :: Rewriter
ctxtFixityEnv :: FixityEnv
ctxtInScope :: AlphaEnv
ctxtParentPrec :: ParentPrec
ctxtRewriter :: Rewriter
ctxtSubst :: Maybe Substitution
..} 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 =
#if __GLASGOW_HASKELL__ < 904
    mkParen' (getEntryDP p) (\an -> ParPat an (setEntryDP p (SameLine 0)))
#else
    let tokLP :: GenLocated TokenLocation (HsToken tok)
tokLP = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
        tokRP :: GenLocated TokenLocation (HsToken tok)
tokRP = TokenLocation
-> HsToken tok -> GenLocated TokenLocation (HsToken tok)
forall l e. l -> e -> GenLocated l e
L (EpaLocation -> TokenLocation
TokenLoc (DeltaPos -> [LEpaComment] -> EpaLocation
EpaDelta (Int -> DeltaPos
SameLine Int
0) [])) HsToken tok
forall (tok :: Symbol). HsToken tok
HsTok
     in DeltaPos
-> (EpAnn NoEpAnns -> Pat (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall x (m :: * -> *) an.
(Data x, Monad m, Monoid an) =>
DeltaPos -> (EpAnn NoEpAnns -> 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 NoEpAnns
an -> XParPat (GhcPass 'Parsed)
-> LHsToken "(" (GhcPass 'Parsed)
-> LPat (GhcPass 'Parsed)
-> LHsToken ")" (GhcPass 'Parsed)
-> Pat (GhcPass 'Parsed)
forall p.
XParPat p -> LHsToken "(" p -> LPat p -> LHsToken ")" p -> Pat p
ParPat XParPat (GhcPass 'Parsed)
EpAnn NoEpAnns
an LHsToken "(" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken "(")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokLP (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> DeltaPos -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LPat (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
p (Int -> DeltaPos
SameLine Int
0)) LHsToken ")" (GhcPass 'Parsed)
GenLocated TokenLocation (HsToken ")")
forall {tok :: Symbol}. GenLocated TokenLocation (HsToken tok)
tokRP)
#endif
  | Bool
otherwise = GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
forall a. a -> TransformT m a
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 [HsConPatTyArg (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
ctxtBinders :: Context -> [RdrName]
ctxtDependents :: Context -> Rewriter
ctxtFixityEnv :: Context -> FixityEnv
ctxtInScope :: Context -> AlphaEnv
ctxtParentPrec :: Context -> ParentPrec
ctxtRewriter :: Context -> Rewriter
ctxtSubst :: Context -> Maybe Substitution
ctxtBinders :: [RdrName]
ctxtDependents :: Rewriter
ctxtFixityEnv :: FixityEnv
ctxtInScope :: AlphaEnv
ctxtParentPrec :: ParentPrec
ctxtRewriter :: Rewriter
ctxtSubst :: Maybe Substitution
..} 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 =
#if __GLASGOW_HASKELL__ < 904
      mkParen' (getEntryDP lty) (\an -> HsParTy an (setEntryDP lty (SameLine 0)))
#else
      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)
mkParenTy (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 XParTy (GhcPass 'Parsed)
EpAnn AnnParen
an (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> DeltaPos -> GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
forall t a. Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP LHsType (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
lty (Int -> DeltaPos
SameLine Int
0)))
#endif
  | Bool
otherwise = GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed))
-> TransformT m (GenLocated SrcSpanAnnA (HsType (GhcPass 'Parsed)))
forall a. a -> TransformT m a
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
#if __GLASGOW_HASKELL__ < 904
unparenP (L _ (ParPat _ p)) = p
#else
unparenP :: LPat (GhcPass 'Parsed) -> LPat (GhcPass 'Parsed)
unparenP (L SrcSpanAnnA
_ (ParPat XParPat (GhcPass 'Parsed)
_ LHsToken "(" (GhcPass 'Parsed)
_ LPat (GhcPass 'Parsed)
p LHsToken ")" (GhcPass 'Parsed)
_)) = LPat (GhcPass 'Parsed)
p
#endif
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 a b. m (a -> b) -> m a -> m b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [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 a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> arg -> m arg'
argf arg
a2