{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, TemplateHaskell,
             MultiParamTypeClasses, UndecidableInstances, RankNTypes,
             ImplicitParams #-}

-- MonoLocalBinds extension prevents premature generalization, which
-- results in the "default" instance being picked.
{-# LANGUAGE MonoLocalBinds #-}

module Language.Haskell.Names.Open.Instances where

import Language.Haskell.Names.Types
import Language.Haskell.Names.Open.Base
import Language.Haskell.Names.Open.Derived ()
import Language.Haskell.Names.GetBound
import Language.Haskell.Names.RecordWildcards
import Language.Haskell.Exts
import Language.Haskell.Names.SyntaxUtils
import qualified Data.Data as D
import Data.Typeable
import Data.Lens.Light
import Data.List
import qualified Data.Traversable as T


c :: Applicative w => c -> w c
c :: forall (w :: * -> *) c. Applicative w => c -> w c
c = c -> w c
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

(<|)
  :: (Applicative w, Resolvable b, ?alg :: Alg w)
  => w (b -> c) -> (b, Scope) -> w c
<| :: forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
(<|) w (b -> c)
k (b
b, Scope
sc) = w (b -> c)
k w (b -> c) -> w b -> w c
forall a b. w (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> Scope -> w b
forall (w :: * -> *) d.
(?alg::Alg w, Resolvable d) =>
d -> Scope -> w d
alg b
b Scope
sc
infixl 4 <|

(-:) :: Scope -> a -> (a, Scope)
Scope
sc -: :: forall a. Scope -> a -> (a, Scope)
-: a
b = (a
b, Scope
sc)
infix 5 -:

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Decl l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Decl l -> Scope -> f (Decl l)
rtraverse Decl l
e Scope
sc =
    case Decl l
e of
      -- N.B. We do not add pat to the local scope.
      --
      -- If this is a top-level binding, then we shouldn't do so, lest
      -- global values are marked as local.
      -- (see https://github.com/haskell-suite/haskell-names/issues/35)
      --
      -- If this is a local binding, then we have already introduced these
      -- variables when processing the enclosing Binds.
      PatBind l
l Pat l
pat Rhs l
rhs Maybe (Binds l)
mbWhere ->
        let
          scWithWhere :: Scope
scWithWhere = Maybe (Binds l) -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Maybe (Binds l)
mbWhere Scope
sc
        in
        (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
-> f (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind
          f (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
-> (l, Scope) -> f (Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
-> (Pat l, Scope) -> f (Rhs l -> Maybe (Binds l) -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
          f (Rhs l -> Maybe (Binds l) -> Decl l)
-> (Rhs l, Scope) -> f (Maybe (Binds l) -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
scWithWhere Scope -> Rhs l -> (Rhs l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Rhs l
rhs
          f (Maybe (Binds l) -> Decl l)
-> (Maybe (Binds l), Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                Scope -> Maybe (Binds l) -> (Maybe (Binds l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Binds l)
mbWhere
      p :: Decl l
p@(PatSyn l
l Pat l
pat Pat l
rpat PatternSynDirection l
dir) ->
        let
          scWithPatSyn :: Scope
scWithPatSyn = Decl l -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Decl l
p Scope
sc
          scWithPat :: Scope
scWithPat = Pat l -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Pat l
pat Scope
scWithPatSyn
        in
        (l -> Pat l -> Pat l -> PatternSynDirection l -> Decl l)
-> f (l -> Pat l -> Pat l -> PatternSynDirection l -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Pat l -> Pat l -> PatternSynDirection l -> Decl l
forall l. l -> Pat l -> Pat l -> PatternSynDirection l -> Decl l
PatSyn
          f (l -> Pat l -> Pat l -> PatternSynDirection l -> Decl l)
-> (l, Scope)
-> f (Pat l -> Pat l -> PatternSynDirection l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                                            Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Pat l -> Pat l -> PatternSynDirection l -> Decl l)
-> (Pat l, Scope) -> f (Pat l -> PatternSynDirection l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| (PatSynMode -> Scope -> Scope
setPatSynMode PatSynMode
PatSynLeftHandSide Scope
sc)         Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
          f (Pat l -> PatternSynDirection l -> Decl l)
-> (Pat l, Scope) -> f (PatternSynDirection l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| (PatSynMode -> Scope -> Scope
setPatSynMode PatSynMode
PatSynRightHandSide Scope
scWithPat) Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
rpat
          f (PatternSynDirection l -> Decl l)
-> (PatternSynDirection l, Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                                            Scope -> PatternSynDirection l -> (PatternSynDirection l, Scope)
forall a. Scope -> a -> (a, Scope)
-: PatternSynDirection l
dir
      TypeSig l
l [Name l]
names Type l
ty ->
        (l -> [Name l] -> Type l -> Decl l)
-> f (l -> [Name l] -> Type l -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Name l] -> Type l -> Decl l
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig
          f (l -> [Name l] -> Type l -> Decl l)
-> (l, Scope) -> f ([Name l] -> Type l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc            Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f ([Name l] -> Type l -> Decl l)
-> ([Name l], Scope) -> f (Type l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
signatureV Scope
sc Scope -> [Name l] -> ([Name l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Name l]
names
          f (Type l -> Decl l) -> (Type l, Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc            Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
ty
      InfixDecl l
l Assoc l
assoc Maybe Int
mp [Op l]
ops ->
        (l -> Assoc l -> Maybe Int -> [Op l] -> Decl l)
-> f (l -> Assoc l -> Maybe Int -> [Op l] -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
forall l. l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
InfixDecl
          f (l -> Assoc l -> Maybe Int -> [Op l] -> Decl l)
-> (l, Scope) -> f (Assoc l -> Maybe Int -> [Op l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Assoc l -> Maybe Int -> [Op l] -> Decl l)
-> (Assoc l, Scope) -> f (Maybe Int -> [Op l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Assoc l -> (Assoc l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Assoc l
assoc
          f (Maybe Int -> [Op l] -> Decl l)
-> (Maybe Int, Scope) -> f ([Op l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Maybe Int -> (Maybe Int, Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe Int
mp
          f ([Op l] -> Decl l) -> ([Op l], Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
sc Scope -> [Op l] -> ([Op l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Op l]
ops
      InstDecl l
l Maybe (Overlap l)
mOverlap InstRule l
rule Maybe [InstDecl l]
mInstDecls ->
        let sc' :: Scope
sc' = Maybe (QName ()) -> Scope -> Scope
setInstClassName (QName () -> Maybe (QName ())
forall a. a -> Maybe a
Just (QName l -> QName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (InstRule l -> QName l
forall l. InstRule l -> QName l
instanceRuleClass InstRule l
rule))) Scope
sc
        in (l
 -> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l)
-> f (l
      -> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
forall l.
l
-> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l
InstDecl
          f (l
   -> Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l)
-> (l, Scope)
-> f (Maybe (Overlap l)
      -> InstRule l -> Maybe [InstDecl l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc'       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Maybe (Overlap l) -> InstRule l -> Maybe [InstDecl l] -> Decl l)
-> (Maybe (Overlap l), Scope)
-> f (InstRule l -> Maybe [InstDecl l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc'       Scope -> Maybe (Overlap l) -> (Maybe (Overlap l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Overlap l)
mOverlap
          f (InstRule l -> Maybe [InstDecl l] -> Decl l)
-> (InstRule l, Scope) -> f (Maybe [InstDecl l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc'       Scope -> InstRule l -> (InstRule l, Scope)
forall a. Scope -> a -> (a, Scope)
-: InstRule l
rule
          f (Maybe [InstDecl l] -> Decl l)
-> (Maybe [InstDecl l], Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc'       Scope -> Maybe [InstDecl l] -> (Maybe [InstDecl l], Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe [InstDecl l]
mInstDecls
      Decl l
_ -> Decl l -> Scope -> f (Decl l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse Decl l
e Scope
sc


instanceRuleClass :: InstRule l -> QName l
instanceRuleClass :: forall l. InstRule l -> QName l
instanceRuleClass (IParen l
_ InstRule l
instRule) = InstRule l -> QName l
forall l. InstRule l -> QName l
instanceRuleClass InstRule l
instRule
instanceRuleClass (IRule l
_ Maybe [TyVarBind l]
_ Maybe (Context l)
_ InstHead l
instHead) = InstHead l -> QName l
forall l. InstHead l -> QName l
instanceHeadClass InstHead l
instHead

instanceHeadClass :: InstHead l -> QName l
instanceHeadClass :: forall l. InstHead l -> QName l
instanceHeadClass (IHCon l
_ QName l
qn) = QName l
qn
instanceHeadClass (IHInfix l
_ Type l
_ QName l
qn) = QName l
qn
instanceHeadClass (IHParen l
_ InstHead l
instHead) = InstHead l -> QName l
forall l. InstHead l -> QName l
instanceHeadClass InstHead l
instHead
instanceHeadClass (IHApp l
_ InstHead l
instHead Type l
_) = InstHead l -> QName l
forall l. InstHead l -> QName l
instanceHeadClass InstHead l
instHead

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Type l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Type l -> Scope -> f (Type l)
rtraverse Type l
e Scope
sc = Type l -> Scope -> f (Type l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse Type l
e (Scope -> Scope
exprT Scope
sc)

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (DeclHead l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
DeclHead l -> Scope -> f (DeclHead l)
rtraverse DeclHead l
e Scope
sc =
    case DeclHead l
e of
      DHead l
l Name l
name ->
        (l -> Name l -> DeclHead l) -> f (l -> Name l -> DeclHead l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> DeclHead l
forall l. l -> Name l -> DeclHead l
DHead
          f (l -> Name l -> DeclHead l)
-> (l, Scope) -> f (Name l -> DeclHead l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> DeclHead l) -> (Name l, Scope) -> f (DeclHead l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderT Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
      DHInfix l
l TyVarBind l
v1 Name l
name ->
        (l -> TyVarBind l -> Name l -> DeclHead l)
-> f (l -> TyVarBind l -> Name l -> DeclHead l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> TyVarBind l -> Name l -> DeclHead l
forall l. l -> TyVarBind l -> Name l -> DeclHead l
DHInfix
          f (l -> TyVarBind l -> Name l -> DeclHead l)
-> (l, Scope) -> f (TyVarBind l -> Name l -> DeclHead l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (TyVarBind l -> Name l -> DeclHead l)
-> (TyVarBind l, Scope) -> f (Name l -> DeclHead l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> TyVarBind l -> (TyVarBind l, Scope)
forall a. Scope -> a -> (a, Scope)
-: TyVarBind l
v1
          f (Name l -> DeclHead l) -> (Name l, Scope) -> f (DeclHead l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderT Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
      DeclHead l
_ -> DeclHead l -> Scope -> f (DeclHead l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse DeclHead l
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (ConDecl l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
ConDecl l -> Scope -> f (ConDecl l)
rtraverse ConDecl l
e Scope
sc =
    case ConDecl l
e of
      ConDecl l
l Name l
name [Type l]
tys ->
        (l -> Name l -> [Type l] -> ConDecl l)
-> f (l -> Name l -> [Type l] -> ConDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> [Type l] -> ConDecl l
forall l. l -> Name l -> [Type l] -> ConDecl l
ConDecl
          f (l -> Name l -> [Type l] -> ConDecl l)
-> (l, Scope) -> f (Name l -> [Type l] -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> [Type l] -> ConDecl l)
-> (Name l, Scope) -> f ([Type l] -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
          f ([Type l] -> ConDecl l) -> ([Type l], Scope) -> f (ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> [Type l] -> ([Type l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Type l]
tys
      InfixConDecl l
l Type l
t1 Name l
name Type l
t2 ->
        (l -> Type l -> Name l -> Type l -> ConDecl l)
-> f (l -> Type l -> Name l -> Type l -> ConDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Type l -> Name l -> Type l -> ConDecl l
forall l. l -> Type l -> Name l -> Type l -> ConDecl l
InfixConDecl
          f (l -> Type l -> Name l -> Type l -> ConDecl l)
-> (l, Scope) -> f (Type l -> Name l -> Type l -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Type l -> Name l -> Type l -> ConDecl l)
-> (Type l, Scope) -> f (Name l -> Type l -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
t1
          f (Name l -> Type l -> ConDecl l)
-> (Name l, Scope) -> f (Type l -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
          f (Type l -> ConDecl l) -> (Type l, Scope) -> f (ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
t2
      RecDecl l
l Name l
name [FieldDecl l]
fields ->
        (l -> Name l -> [FieldDecl l] -> ConDecl l)
-> f (l -> Name l -> [FieldDecl l] -> ConDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> [FieldDecl l] -> ConDecl l
forall l. l -> Name l -> [FieldDecl l] -> ConDecl l
RecDecl
          f (l -> Name l -> [FieldDecl l] -> ConDecl l)
-> (l, Scope) -> f (Name l -> [FieldDecl l] -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> [FieldDecl l] -> ConDecl l)
-> (Name l, Scope) -> f ([FieldDecl l] -> ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
          f ([FieldDecl l] -> ConDecl l)
-> ([FieldDecl l], Scope) -> f (ConDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> [FieldDecl l] -> ([FieldDecl l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [FieldDecl l]
fields


instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (FieldDecl l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
FieldDecl l -> Scope -> f (FieldDecl l)
rtraverse FieldDecl l
e Scope
sc =
    case FieldDecl l
e of
      FieldDecl l
l [Name l]
name Type l
tys ->
        (l -> [Name l] -> Type l -> FieldDecl l)
-> f (l -> [Name l] -> Type l -> FieldDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Name l] -> Type l -> FieldDecl l
forall l. l -> [Name l] -> Type l -> FieldDecl l
FieldDecl
          f (l -> [Name l] -> Type l -> FieldDecl l)
-> (l, Scope) -> f ([Name l] -> Type l -> FieldDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f ([Name l] -> Type l -> FieldDecl l)
-> ([Name l], Scope) -> f (Type l -> FieldDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> [Name l] -> ([Name l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Name l]
name
          f (Type l -> FieldDecl l) -> (Type l, Scope) -> f (FieldDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
tys


instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Pat l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Pat l -> Scope -> f (Pat l)
rtraverse Pat l
e Scope
sc =
    case Pat l
e of
      PVar l
l Name l
name ->
        (l -> Name l -> Pat l) -> f (l -> Name l -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> Pat l
forall l. l -> Name l -> Pat l
PVar
          f (l -> Name l -> Pat l) -> (l, Scope) -> f (Name l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> Pat l) -> (Name l, Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
      PNPlusK l
l Name l
name Integer
i ->
        (l -> Name l -> Integer -> Pat l)
-> f (l -> Name l -> Integer -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> Integer -> Pat l
forall l. l -> Name l -> Integer -> Pat l
PNPlusK
          f (l -> Name l -> Integer -> Pat l)
-> (l, Scope) -> f (Name l -> Integer -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> Integer -> Pat l)
-> (Name l, Scope) -> f (Integer -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
          f (Integer -> Pat l) -> (Integer, Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> Integer -> (Integer, Scope)
forall a. Scope -> a -> (a, Scope)
-: Integer
i
      PInfixApp l
l Pat l
pat1 QName l
name Pat l
pat2 ->
        (l -> Pat l -> QName l -> Pat l -> Pat l)
-> f (l -> Pat l -> QName l -> Pat l -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Pat l -> QName l -> Pat l -> Pat l
forall l. l -> Pat l -> QName l -> Pat l -> Pat l
PInfixApp
          f (l -> Pat l -> QName l -> Pat l -> Pat l)
-> (l, Scope) -> f (Pat l -> QName l -> Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Pat l -> QName l -> Pat l -> Pat l)
-> (Pat l, Scope) -> f (QName l -> Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat1
          f (QName l -> Pat l -> Pat l)
-> (QName l, Scope) -> f (Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
name
          f (Pat l -> Pat l) -> (Pat l, Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat2
      PApp l
l QName l
qn [Pat l]
pat ->
        (l -> QName l -> [Pat l] -> Pat l)
-> f (l -> QName l -> [Pat l] -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> [Pat l] -> Pat l
forall l. l -> QName l -> [Pat l] -> Pat l
PApp
          f (l -> QName l -> [Pat l] -> Pat l)
-> (l, Scope) -> f (QName l -> [Pat l] -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> [Pat l] -> Pat l)
-> (QName l, Scope) -> f ([Pat l] -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
          f ([Pat l] -> Pat l) -> ([Pat l], Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> [Pat l] -> ([Pat l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Pat l]
pat
      PRec l
l QName l
qn [PatField l]
pfs ->
        let
          scWc :: Scope
scWc =
            WcNames -> Scope -> Scope
setWcNames (Table -> QName l -> [PatField l] -> WcNames
forall l. Table -> QName l -> [PatField l] -> WcNames
patWcNames (Scope
sc Scope -> Lens Scope Table -> Table
forall b c. b -> Lens b c -> c
^. Lens Scope Table
gTable) QName l
qn [PatField l]
pfs) Scope
sc
        in
        (l -> QName l -> [PatField l] -> Pat l)
-> f (l -> QName l -> [PatField l] -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> [PatField l] -> Pat l
forall l. l -> QName l -> [PatField l] -> Pat l
PRec
          f (l -> QName l -> [PatField l] -> Pat l)
-> (l, Scope) -> f (QName l -> [PatField l] -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> [PatField l] -> Pat l)
-> (QName l, Scope) -> f ([PatField l] -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
          f ([PatField l] -> Pat l) -> ([PatField l], Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWc     Scope -> [PatField l] -> ([PatField l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [PatField l]
pfs
      PAsPat l
l Name l
n Pat l
pat ->
        (l -> Name l -> Pat l -> Pat l)
-> f (l -> Name l -> Pat l -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> Pat l -> Pat l
forall l. l -> Name l -> Pat l -> Pat l
PAsPat
          f (l -> Name l -> Pat l -> Pat l)
-> (l, Scope) -> f (Name l -> Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> Pat l -> Pat l)
-> (Name l, Scope) -> f (Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
n
          f (Pat l -> Pat l) -> (Pat l, Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
      PViewPat l
l Exp l
exp Pat l
pat ->
        (l -> Exp l -> Pat l -> Pat l) -> f (l -> Exp l -> Pat l -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Exp l -> Pat l -> Pat l
forall l. l -> Exp l -> Pat l -> Pat l
PViewPat
          f (l -> Exp l -> Pat l -> Pat l)
-> (l, Scope) -> f (Exp l -> Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Exp l -> Pat l -> Pat l) -> (Exp l, Scope) -> f (Pat l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
sc Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
exp
          f (Pat l -> Pat l) -> (Pat l, Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
      Pat l
_ -> Pat l -> Scope -> f (Pat l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse Pat l
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (PatField l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
PatField l -> Scope -> f (PatField l)
rtraverse PatField l
e Scope
sc =
    case PatField l
e of
      PFieldPat l
l QName l
qn Pat l
pat ->
        (l -> QName l -> Pat l -> PatField l)
-> f (l -> QName l -> Pat l -> PatField l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> Pat l -> PatField l
forall l. l -> QName l -> Pat l -> PatField l
PFieldPat
          f (l -> QName l -> Pat l -> PatField l)
-> (l, Scope) -> f (QName l -> Pat l -> PatField l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> Pat l -> PatField l)
-> (QName l, Scope) -> f (Pat l -> PatField l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprRS Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
          f (Pat l -> PatField l) -> (Pat l, Scope) -> f (PatField l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
      PFieldPun l
l QName l
qn ->
        (l -> QName l -> PatField l) -> f (l -> QName l -> PatField l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> PatField l
forall l. l -> QName l -> PatField l
PFieldPun
          f (l -> QName l -> PatField l)
-> (l, Scope) -> f (QName l -> PatField l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> PatField l) -> (QName l, Scope) -> f (PatField l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprRS Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
      PFieldWildcard {} -> PatField l -> Scope -> f (PatField l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse PatField l
e Scope
sc

-- | Chain a sequence of nodes where every node may introduce some
-- variables into scope for the subsequent nodes. Examples: patterns (see
-- note [Nested pattern scopes]), statements.
chain
  :: ( Resolvable (a l)
     , GetBound (a l) l
     , Applicative w
     , SrcInfo l
     , D.Data l
     , ?alg :: Alg w)
  => [a l] -> Scope -> (w [a l], Scope)
chain :: forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [a l]
pats Scope
sc =
  case [a l]
pats of
    [] -> ([a l] -> w [a l]
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], Scope
sc)
    a l
p:[a l]
ps ->
      let
        sc' :: Scope
sc' = a l -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro a l
p Scope
sc
        p' :: w (a l)
p' = a l -> Scope -> w (a l)
forall (w :: * -> *) d.
(?alg::Alg w, Resolvable d) =>
d -> Scope -> w d
alg a l
p Scope
sc
        (w [a l]
ps', Scope
sc'') = [a l] -> Scope -> (w [a l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [a l]
ps Scope
sc'
      in ((:) (a l -> [a l] -> [a l]) -> w (a l) -> w ([a l] -> [a l])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> w (a l)
p' w ([a l] -> [a l]) -> w [a l] -> w [a l]
forall a b. w (a -> b) -> w a -> w b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> w [a l]
ps', Scope
sc'')

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Match l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Match l -> Scope -> f (Match l)
rtraverse Match l
e Scope
sc =
    case Match l
e of
      Match l
l Name l
name [Pat l]
pats Rhs l
rhs Maybe (Binds l)
mbWhere ->
        -- f x y z = ...
        --   where ...
        let
          (f [Pat l]
pats', Scope
scWithPats) = [Pat l] -> Scope -> (f [Pat l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [Pat l]
pats Scope
sc
          scWithWhere :: Scope
scWithWhere = Maybe (Binds l) -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Maybe (Binds l)
mbWhere Scope
scWithPats
        in
        (l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> f (l
      -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match
          f (l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> (l, Scope)
-> f (Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> (Name l, Scope)
-> f ([Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc        Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
          f ([Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> f [Pat l] -> f (Rhs l -> Maybe (Binds l) -> Match l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Pat l]
pats' -- has been already traversed
          f (Rhs l -> Maybe (Binds l) -> Match l)
-> (Rhs l, Scope) -> f (Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
scWithWhere Scope -> Rhs l -> (Rhs l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Rhs l
rhs
          f (Maybe (Binds l) -> Match l)
-> (Maybe (Binds l), Scope) -> f (Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithPats        Scope -> Maybe (Binds l) -> (Maybe (Binds l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Binds l)
mbWhere
      InfixMatch l
l Pat l
pat1 Name l
name [Pat l]
patsRest Rhs l
rhs Maybe (Binds l)
mbWhere ->
        let
          equivalentMatch :: Match l
equivalentMatch = l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match l
l Name l
name (Pat l
pat1Pat l -> [Pat l] -> [Pat l]
forall a. a -> [a] -> [a]
:[Pat l]
patsRest) Rhs l
rhs Maybe (Binds l)
mbWhere
          back :: Match l -> Match l
back (Match l
l Name l
name (Pat l
pat1:[Pat l]
patsRest) Rhs l
rhs Maybe (Binds l)
mbWhere) =
            l
-> Pat l
-> Name l
-> [Pat l]
-> Rhs l
-> Maybe (Binds l)
-> Match l
forall l.
l
-> Pat l
-> Name l
-> [Pat l]
-> Rhs l
-> Maybe (Binds l)
-> Match l
InfixMatch l
l Pat l
pat1 Name l
name [Pat l]
patsRest Rhs l
rhs Maybe (Binds l)
mbWhere
          back Match l
_ = String -> Match l
forall a. HasCallStack => String -> a
error String
"InfixMatch"
        in Match l -> Match l
forall {l}. Match l -> Match l
back (Match l -> Match l) -> f (Match l) -> f (Match l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Match l -> Scope -> f (Match l)
forall a (f :: * -> *).
(Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Match l -> Scope -> f (Match l)
rtraverse Match l
equivalentMatch Scope
sc

-- NB: there is an inefficiency here (and in similar places), because we
-- call intro on the same subtree several times. Maybe tackle it later.
instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Binds l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Binds l -> Scope -> f (Binds l)
rtraverse Binds l
e Scope
sc =
    case Binds l
e of
      BDecls l
l [Decl l]
decls ->
        let scWithBinds :: Scope
scWithBinds = [Decl l] -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro [Decl l]
decls Scope
sc
        in
        (l -> [Decl l] -> Binds l) -> f (l -> [Decl l] -> Binds l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Decl l] -> Binds l
forall l. l -> [Decl l] -> Binds l
BDecls
          f (l -> [Decl l] -> Binds l)
-> (l, Scope) -> f ([Decl l] -> Binds l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc          Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f ([Decl l] -> Binds l) -> ([Decl l], Scope) -> f (Binds l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithBinds Scope -> [Decl l] -> ([Decl l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Decl l]
decls
      Binds l
_ -> Binds l -> Scope -> f (Binds l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse Binds l
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Exp l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Exp l -> Scope -> f (Exp l)
rtraverse Exp l
e Scope
sc =
    case Exp l
e of
      Let l
l Binds l
bnds Exp l
body ->
        let scWithBinds :: Scope
scWithBinds = Binds l -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Binds l
bnds Scope
sc
        in
        (l -> Binds l -> Exp l -> Exp l)
-> f (l -> Binds l -> Exp l -> Exp l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Binds l -> Exp l -> Exp l
forall l. l -> Binds l -> Exp l -> Exp l
Let
          f (l -> Binds l -> Exp l -> Exp l)
-> (l, Scope) -> f (Binds l -> Exp l -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc          Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Binds l -> Exp l -> Exp l)
-> (Binds l, Scope) -> f (Exp l -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithBinds Scope -> Binds l -> (Binds l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Binds l
bnds
          f (Exp l -> Exp l) -> (Exp l, Scope) -> f (Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithBinds Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
body

      Lambda l
l [Pat l]
pats Exp l
body ->
        let (f [Pat l]
pats', Scope
scWithPats) = [Pat l] -> Scope -> (f [Pat l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [Pat l]
pats Scope
sc
        in
        (l -> [Pat l] -> Exp l -> Exp l)
-> f (l -> [Pat l] -> Exp l -> Exp l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Pat l] -> Exp l -> Exp l
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda
          f (l -> [Pat l] -> Exp l -> Exp l)
-> (l, Scope) -> f ([Pat l] -> Exp l -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc         Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f ([Pat l] -> Exp l -> Exp l) -> f [Pat l] -> f (Exp l -> Exp l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Pat l]
pats'
          f (Exp l -> Exp l) -> (Exp l, Scope) -> f (Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
scWithPats Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
body

      ListComp l
l Exp l
e [QualStmt l]
stmts ->
        let (f [QualStmt l]
stmts', Scope
scWithStmts) = [QualStmt l] -> Scope -> (f [QualStmt l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [QualStmt l]
stmts Scope
sc
        in
        (l -> Exp l -> [QualStmt l] -> Exp l)
-> f (l -> Exp l -> [QualStmt l] -> Exp l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Exp l -> [QualStmt l] -> Exp l
forall l. l -> Exp l -> [QualStmt l] -> Exp l
ListComp
          f (l -> Exp l -> [QualStmt l] -> Exp l)
-> (l, Scope) -> f (Exp l -> [QualStmt l] -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Exp l -> [QualStmt l] -> Exp l)
-> (Exp l, Scope) -> f ([QualStmt l] -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
scWithStmts Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
e
          f ([QualStmt l] -> Exp l) -> f [QualStmt l] -> f (Exp l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [QualStmt l]
stmts'

      ParComp l
l Exp l
e [[QualStmt l]]
stmtss ->
        let
          ([f [QualStmt l]]
stmtss', [Scope]
scsWithStmts) =
            [(f [QualStmt l], Scope)] -> ([f [QualStmt l]], [Scope])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(f [QualStmt l], Scope)] -> ([f [QualStmt l]], [Scope]))
-> [(f [QualStmt l], Scope)] -> ([f [QualStmt l]], [Scope])
forall a b. (a -> b) -> a -> b
$ ([QualStmt l] -> (f [QualStmt l], Scope))
-> [[QualStmt l]] -> [(f [QualStmt l], Scope)]
forall a b. (a -> b) -> [a] -> [b]
map (\[QualStmt l]
stmts -> [QualStmt l] -> Scope -> (f [QualStmt l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [QualStmt l]
stmts Scope
sc) [[QualStmt l]]
stmtss
          scWithAllStmtss :: Scope
scWithAllStmtss = (Scope -> Scope -> Scope) -> [Scope] -> Scope
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Scope -> Scope -> Scope
mergeLocalScopes [Scope]
scsWithStmts
        in
        (l -> Exp l -> [[QualStmt l]] -> Exp l)
-> f (l -> Exp l -> [[QualStmt l]] -> Exp l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Exp l -> [[QualStmt l]] -> Exp l
forall l. l -> Exp l -> [[QualStmt l]] -> Exp l
ParComp
          f (l -> Exp l -> [[QualStmt l]] -> Exp l)
-> (l, Scope) -> f (Exp l -> [[QualStmt l]] -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Exp l -> [[QualStmt l]] -> Exp l)
-> (Exp l, Scope) -> f ([[QualStmt l]] -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
scWithAllStmtss Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
e
          f ([[QualStmt l]] -> Exp l) -> f [[QualStmt l]] -> f (Exp l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [f [QualStmt l]] -> f [[QualStmt l]]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
T.sequenceA [f [QualStmt l]]
stmtss'

      Proc l
l Pat l
pat Exp l
e ->
        let scWithPat :: Scope
scWithPat = Pat l -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Pat l
pat Scope
sc
        in
        (l -> Pat l -> Exp l -> Exp l) -> f (l -> Pat l -> Exp l -> Exp l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Pat l -> Exp l -> Exp l
forall l. l -> Pat l -> Exp l -> Exp l
Proc
          f (l -> Pat l -> Exp l -> Exp l)
-> (l, Scope) -> f (Pat l -> Exp l -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Pat l -> Exp l -> Exp l) -> (Pat l, Scope) -> f (Exp l -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
          f (Exp l -> Exp l) -> (Exp l, Scope) -> f (Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithPat Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
e

      RecConstr l
l QName l
qn [FieldUpdate l]
fields ->
        let
          scWc :: Scope
scWc =
            WcNames -> Scope -> Scope
setWcNames
              (Table -> Table -> QName l -> [FieldUpdate l] -> WcNames
forall l. Table -> Table -> QName l -> [FieldUpdate l] -> WcNames
expWcNames
                (Scope
sc Scope -> Lens Scope Table -> Table
forall b c. b -> Lens b c -> c
^. Lens Scope Table
gTable)
                (Scope
sc Scope -> Lens Scope Table -> Table
forall b c. b -> Lens b c -> c
^. Lens Scope Table
lTable)
                QName l
qn
                [FieldUpdate l]
fields)
              Scope
sc
        in
        (l -> QName l -> [FieldUpdate l] -> Exp l)
-> f (l -> QName l -> [FieldUpdate l] -> Exp l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> [FieldUpdate l] -> Exp l
forall l. l -> QName l -> [FieldUpdate l] -> Exp l
RecConstr
          f (l -> QName l -> [FieldUpdate l] -> Exp l)
-> (l, Scope) -> f (QName l -> [FieldUpdate l] -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc          Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> [FieldUpdate l] -> Exp l)
-> (QName l, Scope) -> f ([FieldUpdate l] -> Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc          Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
          f ([FieldUpdate l] -> Exp l)
-> ([FieldUpdate l], Scope) -> f (Exp l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWc Scope -> [FieldUpdate l] -> ([FieldUpdate l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [FieldUpdate l]
fields

      Exp l
_ -> Exp l -> Scope -> f (Exp l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse Exp l
e Scope
sc


instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (FieldUpdate l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
FieldUpdate l -> Scope -> f (FieldUpdate l)
rtraverse FieldUpdate l
e Scope
sc =
    case FieldUpdate l
e of
      FieldUpdate l
l QName l
qn Exp l
exp ->
        (l -> QName l -> Exp l -> FieldUpdate l)
-> f (l -> QName l -> Exp l -> FieldUpdate l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> Exp l -> FieldUpdate l
forall l. l -> QName l -> Exp l -> FieldUpdate l
FieldUpdate
          f (l -> QName l -> Exp l -> FieldUpdate l)
-> (l, Scope) -> f (QName l -> Exp l -> FieldUpdate l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> Exp l -> FieldUpdate l)
-> (QName l, Scope) -> f (Exp l -> FieldUpdate l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprRS Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
          f (Exp l -> FieldUpdate l) -> (Exp l, Scope) -> f (FieldUpdate l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
exp
      FieldPun l
l QName l
qn ->
        (l -> QName l -> FieldUpdate l)
-> f (l -> QName l -> FieldUpdate l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> FieldUpdate l
forall l. l -> QName l -> FieldUpdate l
FieldPun
          f (l -> QName l -> FieldUpdate l)
-> (l, Scope) -> f (QName l -> FieldUpdate l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (QName l -> FieldUpdate l)
-> (QName l, Scope) -> f (FieldUpdate l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprRS Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn
      FieldWildcard {} -> FieldUpdate l -> Scope -> f (FieldUpdate l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse FieldUpdate l
e Scope
sc


instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Alt l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Alt l -> Scope -> f (Alt l)
rtraverse Alt l
e Scope
sc =
    case Alt l
e of
      Alt l
l Pat l
pat Rhs l
guardedAlts Maybe (Binds l)
mbWhere ->
        let
          scWithPat :: Scope
scWithPat = Pat l -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Pat l
pat Scope
sc
          scWithBinds :: Scope
scWithBinds = Maybe (Binds l) -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Maybe (Binds l)
mbWhere Scope
scWithPat
        in
        (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l)
-> f (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt
          f (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l)
-> (l, Scope) -> f (Pat l -> Rhs l -> Maybe (Binds l) -> Alt l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Pat l -> Rhs l -> Maybe (Binds l) -> Alt l)
-> (Pat l, Scope) -> f (Rhs l -> Maybe (Binds l) -> Alt l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Pat l -> (Pat l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Pat l
pat
          f (Rhs l -> Maybe (Binds l) -> Alt l)
-> (Rhs l, Scope) -> f (Maybe (Binds l) -> Alt l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithBinds Scope -> Rhs l -> (Rhs l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Rhs l
guardedAlts
          f (Maybe (Binds l) -> Alt l)
-> (Maybe (Binds l), Scope) -> f (Alt l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithBinds Scope -> Maybe (Binds l) -> (Maybe (Binds l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Binds l)
mbWhere

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (GuardedRhs l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
GuardedRhs l -> Scope -> f (GuardedRhs l)
rtraverse GuardedRhs l
e Scope
sc =
    case GuardedRhs l
e of
      GuardedRhs l
l [Stmt l]
stmts Exp l
exp ->
        let (f [Stmt l]
stmts', Scope
scWithStmts) = [Stmt l] -> Scope -> (f [Stmt l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [Stmt l]
stmts Scope
sc
        in
        (l -> [Stmt l] -> Exp l -> GuardedRhs l)
-> f (l -> [Stmt l] -> Exp l -> GuardedRhs l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Stmt l] -> Exp l -> GuardedRhs l
forall l. l -> [Stmt l] -> Exp l -> GuardedRhs l
GuardedRhs
          f (l -> [Stmt l] -> Exp l -> GuardedRhs l)
-> (l, Scope) -> f ([Stmt l] -> Exp l -> GuardedRhs l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f ([Stmt l] -> Exp l -> GuardedRhs l)
-> f [Stmt l] -> f (Exp l -> GuardedRhs l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Stmt l]
stmts'
          f (Exp l -> GuardedRhs l) -> (Exp l, Scope) -> f (GuardedRhs l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
scWithStmts Scope -> Exp l -> (Exp l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Exp l
exp

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable [Stmt l] where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
[Stmt l] -> Scope -> f [Stmt l]
rtraverse [Stmt l]
e Scope
sc =
    (f [Stmt l], Scope) -> f [Stmt l]
forall a b. (a, b) -> a
fst ((f [Stmt l], Scope) -> f [Stmt l])
-> (f [Stmt l], Scope) -> f [Stmt l]
forall a b. (a -> b) -> a -> b
$ [Stmt l] -> Scope -> (f [Stmt l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [Stmt l]
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (QualStmt l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
QualStmt l -> Scope -> f (QualStmt l)
rtraverse QualStmt l
e Scope
sc =
    case QualStmt l
e of
      QualStmt {} -> QualStmt l -> Scope -> f (QualStmt l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse QualStmt l
e Scope
sc
      QualStmt l
_ -> String -> f (QualStmt l)
forall a. HasCallStack => String -> a
error String
"haskell-names: TransformListComp is not supported yet"

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (InstRule l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
InstRule l -> Scope -> f (InstRule l)
rtraverse InstRule l
e Scope
sc =
    case InstRule l
e of
      IRule l
l Maybe [TyVarBind l]
mtv Maybe (Context l)
mc InstHead l
ih ->
        (l
 -> Maybe [TyVarBind l]
 -> Maybe (Context l)
 -> InstHead l
 -> InstRule l)
-> f (l
      -> Maybe [TyVarBind l]
      -> Maybe (Context l)
      -> InstHead l
      -> InstRule l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> InstHead l
-> InstRule l
forall l.
l
-> Maybe [TyVarBind l]
-> Maybe (Context l)
-> InstHead l
-> InstRule l
IRule
          f (l
   -> Maybe [TyVarBind l]
   -> Maybe (Context l)
   -> InstHead l
   -> InstRule l)
-> (l, Scope)
-> f (Maybe [TyVarBind l]
      -> Maybe (Context l) -> InstHead l -> InstRule l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Maybe [TyVarBind l]
   -> Maybe (Context l) -> InstHead l -> InstRule l)
-> (Maybe [TyVarBind l], Scope)
-> f (Maybe (Context l) -> InstHead l -> InstRule l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Maybe [TyVarBind l] -> (Maybe [TyVarBind l], Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe [TyVarBind l]
mtv
          f (Maybe (Context l) -> InstHead l -> InstRule l)
-> (Maybe (Context l), Scope) -> f (InstHead l -> InstRule l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc       Scope -> Maybe (Context l) -> (Maybe (Context l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Context l)
mc
          f (InstHead l -> InstRule l)
-> (InstHead l, Scope) -> f (InstRule l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprT Scope
sc Scope -> InstHead l -> (InstHead l, Scope)
forall a. Scope -> a -> (a, Scope)
-: InstHead l
ih
      InstRule l
_ -> InstRule l -> Scope -> f (InstRule l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse InstRule l
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Context l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Context l -> Scope -> f (Context l)
rtraverse Context l
e Scope
sc = Context l -> Scope -> f (Context l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse Context l
e (Scope -> Scope
exprT Scope
sc)

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (InstDecl l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
InstDecl l -> Scope -> f (InstDecl l)
rtraverse InstDecl l
e Scope
sc =
    case InstDecl l
e of
      InsDecl l
dl (PatBind l
l (PVar l
pl Name l
name) Rhs l
rhs Maybe (Binds l)
mbWhere) ->
        let
          scWithWhere :: Scope
scWithWhere = Maybe (Binds l) -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Maybe (Binds l)
mbWhere Scope
sc
        in
        (l -> Decl l -> InstDecl l) -> f (l -> Decl l -> InstDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Decl l -> InstDecl l
forall l. l -> Decl l -> InstDecl l
InsDecl
          f (l -> Decl l -> InstDecl l)
-> (l, Scope) -> f (Decl l -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
dl
          f (Decl l -> InstDecl l) -> f (Decl l) -> f (InstDecl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
-> f (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind
            f (l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
-> (l, Scope) -> f (Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc                Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
            f (Pat l -> Rhs l -> Maybe (Binds l) -> Decl l)
-> f (Pat l) -> f (Rhs l -> Maybe (Binds l) -> Decl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> Name l -> Pat l) -> f (l -> Name l -> Pat l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> Pat l
forall l. l -> Name l -> Pat l
PVar
                  f (l -> Name l -> Pat l) -> (l, Scope) -> f (Name l -> Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
pl
                  f (Name l -> Pat l) -> (Name l, Scope) -> f (Pat l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprUV Scope
sc Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name)
            f (Rhs l -> Maybe (Binds l) -> Decl l)
-> (Rhs l, Scope) -> f (Maybe (Binds l) -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope -> Scope
exprV Scope
scWithWhere Scope -> Rhs l -> (Rhs l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Rhs l
rhs
            f (Maybe (Binds l) -> Decl l)
-> (Maybe (Binds l), Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc                Scope -> Maybe (Binds l) -> (Maybe (Binds l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Binds l)
mbWhere)
      InsDecl l
dl (FunBind l
bl [Match l]
ms) ->
        (l -> Decl l -> InstDecl l) -> f (l -> Decl l -> InstDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Decl l -> InstDecl l
forall l. l -> Decl l -> InstDecl l
InsDecl
          f (l -> Decl l -> InstDecl l)
-> (l, Scope) -> f (Decl l -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
dl
          f (Decl l -> InstDecl l) -> f (Decl l) -> f (InstDecl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> [Match l] -> Decl l) -> f (l -> [Match l] -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Match l] -> Decl l
forall l. l -> [Match l] -> Decl l
FunBind
            f (l -> [Match l] -> Decl l)
-> (l, Scope) -> f ([Match l] -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<|  Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
bl
            f ([Match l] -> Decl l) -> f [Match l] -> f (Decl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Match l] -> (Match l -> f (Match l)) -> f [Match l]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
T.for [Match l]
ms (\Match l
m -> case Match l
m of
                Match l
l Name l
name [Pat l]
pats Rhs l
rhs Maybe (Binds l)
mbWhere ->
                    -- f x y z = ...
                    --   where ...
                  let
                    (f [Pat l]
pats', Scope
scWithPats) = [Pat l] -> Scope -> (f [Pat l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain [Pat l]
pats Scope
sc
                    scWithWhere :: Scope
scWithWhere = Maybe (Binds l) -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Maybe (Binds l)
mbWhere Scope
scWithPats
                  in
                    (l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> f (l
      -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match
                      f (l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> (l, Scope)
-> f (Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
                      f (Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> (Name l, Scope)
-> f ([Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprUV Scope
sc         Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
                      f ([Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> f [Pat l] -> f (Rhs l -> Maybe (Binds l) -> Match l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Pat l]
pats' -- has been already traversed
                      f (Rhs l -> Maybe (Binds l) -> Match l)
-> (Rhs l, Scope) -> f (Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
scWithWhere Scope -> Rhs l -> (Rhs l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Rhs l
rhs
                      f (Maybe (Binds l) -> Match l)
-> (Maybe (Binds l), Scope) -> f (Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithPats        Scope -> Maybe (Binds l) -> (Maybe (Binds l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Binds l)
mbWhere
                InfixMatch l
l Pat l
pat1 Name l
name [Pat l]
patsRest Rhs l
rhs Maybe (Binds l)
mbWhere ->
                    -- x <*> y = ...
                    --   where ...
                  let
                    (f [Pat l]
pats', Scope
scWithPats) = [Pat l] -> Scope -> (f [Pat l], Scope)
forall (a :: * -> *) l (w :: * -> *).
(Resolvable (a l), GetBound (a l) l, Applicative w, SrcInfo l,
 Data l, ?alg::Alg w) =>
[a l] -> Scope -> (w [a l], Scope)
chain (Pat l
pat1Pat l -> [Pat l] -> [Pat l]
forall a. a -> [a] -> [a]
:[Pat l]
patsRest) Scope
sc
                    pat1' :: f (Pat l)
pat1' = ([Pat l] -> Pat l) -> f [Pat l] -> f (Pat l)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pat l] -> Pat l
forall a. HasCallStack => [a] -> a
head f [Pat l]
pats'
                    patsRest' :: f [Pat l]
patsRest' = ([Pat l] -> [Pat l]) -> f [Pat l] -> f [Pat l]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pat l] -> [Pat l]
forall a. HasCallStack => [a] -> [a]
tail f [Pat l]
pats'
                    scWithWhere :: Scope
scWithWhere = Maybe (Binds l) -> Scope -> Scope
forall l a. (SrcInfo l, GetBound a l) => a -> Scope -> Scope
intro Maybe (Binds l)
mbWhere Scope
scWithPats
                  in
                    (l
 -> Pat l
 -> Name l
 -> [Pat l]
 -> Rhs l
 -> Maybe (Binds l)
 -> Match l)
-> f (l
      -> Pat l
      -> Name l
      -> [Pat l]
      -> Rhs l
      -> Maybe (Binds l)
      -> Match l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l
-> Pat l
-> Name l
-> [Pat l]
-> Rhs l
-> Maybe (Binds l)
-> Match l
forall l.
l
-> Pat l
-> Name l
-> [Pat l]
-> Rhs l
-> Maybe (Binds l)
-> Match l
InfixMatch
                      f (l
   -> Pat l
   -> Name l
   -> [Pat l]
   -> Rhs l
   -> Maybe (Binds l)
   -> Match l)
-> (l, Scope)
-> f (Pat l
      -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc                Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
                      f (Pat l
   -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> f (Pat l)
-> f (Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Pat l)
pat1'     -- has been already traversed
                      f (Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> (Name l, Scope)
-> f ([Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprUV Scope
sc         Scope -> Name l -> (Name l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Name l
name
                      f ([Pat l] -> Rhs l -> Maybe (Binds l) -> Match l)
-> f [Pat l] -> f (Rhs l -> Maybe (Binds l) -> Match l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [Pat l]
patsRest' -- has been already traversed
                      f (Rhs l -> Maybe (Binds l) -> Match l)
-> (Rhs l, Scope) -> f (Maybe (Binds l) -> Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprV Scope
scWithWhere Scope -> Rhs l -> (Rhs l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Rhs l
rhs
                      f (Maybe (Binds l) -> Match l)
-> (Maybe (Binds l), Scope) -> f (Match l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
scWithPats        Scope -> Maybe (Binds l) -> (Maybe (Binds l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Binds l)
mbWhere))
      InsType l
dl (TyApp l
al (TyCon l
cl QName l
qn) Type l
aa) Type l
rhs ->
        (l -> Type l -> Type l -> InstDecl l)
-> f (l -> Type l -> Type l -> InstDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Type l -> Type l -> InstDecl l
forall l. l -> Type l -> Type l -> InstDecl l
InsType
          f (l -> Type l -> Type l -> InstDecl l)
-> (l, Scope) -> f (Type l -> Type l -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
dl
          f (Type l -> Type l -> InstDecl l)
-> f (Type l) -> f (Type l -> InstDecl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> Type l -> Type l -> Type l)
-> f (l -> Type l -> Type l -> Type l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Type l -> Type l -> Type l
forall l. l -> Type l -> Type l -> Type l
TyApp
            f (l -> Type l -> Type l -> Type l)
-> (l, Scope) -> f (Type l -> Type l -> Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
al
            f (Type l -> Type l -> Type l)
-> f (Type l) -> f (Type l -> Type l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> QName l -> Type l) -> f (l -> QName l -> Type l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> Type l
forall l. l -> QName l -> Type l
TyCon
              f (l -> QName l -> Type l) -> (l, Scope) -> f (QName l -> Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
cl
              f (QName l -> Type l) -> (QName l, Scope) -> f (Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprUT Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn)
            f (Type l -> Type l) -> (Type l, Scope) -> f (Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
aa)
          f (Type l -> InstDecl l) -> (Type l, Scope) -> f (InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
rhs
      InsData l
dl DataOrNew l
don (TyApp l
al (TyCon l
cl QName l
qn) Type l
aa) [QualConDecl l]
cs [Deriving l]
md ->
        (l
 -> DataOrNew l
 -> Type l
 -> [QualConDecl l]
 -> [Deriving l]
 -> InstDecl l)
-> f (l
      -> DataOrNew l
      -> Type l
      -> [QualConDecl l]
      -> [Deriving l]
      -> InstDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l
-> DataOrNew l
-> Type l
-> [QualConDecl l]
-> [Deriving l]
-> InstDecl l
forall l.
l
-> DataOrNew l
-> Type l
-> [QualConDecl l]
-> [Deriving l]
-> InstDecl l
InsData
          f (l
   -> DataOrNew l
   -> Type l
   -> [QualConDecl l]
   -> [Deriving l]
   -> InstDecl l)
-> (l, Scope)
-> f (DataOrNew l
      -> Type l -> [QualConDecl l] -> [Deriving l] -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
dl
          f (DataOrNew l
   -> Type l -> [QualConDecl l] -> [Deriving l] -> InstDecl l)
-> (DataOrNew l, Scope)
-> f (Type l -> [QualConDecl l] -> [Deriving l] -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> DataOrNew l -> (DataOrNew l, Scope)
forall a. Scope -> a -> (a, Scope)
-: DataOrNew l
don
          f (Type l -> [QualConDecl l] -> [Deriving l] -> InstDecl l)
-> f (Type l) -> f ([QualConDecl l] -> [Deriving l] -> InstDecl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> Type l -> Type l -> Type l)
-> f (l -> Type l -> Type l -> Type l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Type l -> Type l -> Type l
forall l. l -> Type l -> Type l -> Type l
TyApp
            f (l -> Type l -> Type l -> Type l)
-> (l, Scope) -> f (Type l -> Type l -> Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
al
            f (Type l -> Type l -> Type l)
-> f (Type l) -> f (Type l -> Type l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> QName l -> Type l) -> f (l -> QName l -> Type l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> Type l
forall l. l -> QName l -> Type l
TyCon
              f (l -> QName l -> Type l) -> (l, Scope) -> f (QName l -> Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
cl
              f (QName l -> Type l) -> (QName l, Scope) -> f (Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprUT Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn)
            f (Type l -> Type l) -> (Type l, Scope) -> f (Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
aa)
          f ([QualConDecl l] -> [Deriving l] -> InstDecl l)
-> ([QualConDecl l], Scope) -> f ([Deriving l] -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> [QualConDecl l] -> ([QualConDecl l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [QualConDecl l]
cs
          f ([Deriving l] -> InstDecl l)
-> ([Deriving l], Scope) -> f (InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> [Deriving l] -> ([Deriving l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Deriving l]
md
      InsGData l
dl DataOrNew l
don (TyApp l
al (TyCon l
cl QName l
qn) Type l
aa) Maybe (Type l)
mk [GadtDecl l]
cs [Deriving l]
md ->
        (l
 -> DataOrNew l
 -> Type l
 -> Maybe (Type l)
 -> [GadtDecl l]
 -> [Deriving l]
 -> InstDecl l)
-> f (l
      -> DataOrNew l
      -> Type l
      -> Maybe (Type l)
      -> [GadtDecl l]
      -> [Deriving l]
      -> InstDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l
-> DataOrNew l
-> Type l
-> Maybe (Type l)
-> [GadtDecl l]
-> [Deriving l]
-> InstDecl l
forall l.
l
-> DataOrNew l
-> Type l
-> Maybe (Type l)
-> [GadtDecl l]
-> [Deriving l]
-> InstDecl l
InsGData
          f (l
   -> DataOrNew l
   -> Type l
   -> Maybe (Type l)
   -> [GadtDecl l]
   -> [Deriving l]
   -> InstDecl l)
-> (l, Scope)
-> f (DataOrNew l
      -> Type l
      -> Maybe (Type l)
      -> [GadtDecl l]
      -> [Deriving l]
      -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
dl
          f (DataOrNew l
   -> Type l
   -> Maybe (Type l)
   -> [GadtDecl l]
   -> [Deriving l]
   -> InstDecl l)
-> (DataOrNew l, Scope)
-> f (Type l
      -> Maybe (Type l) -> [GadtDecl l] -> [Deriving l] -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> DataOrNew l -> (DataOrNew l, Scope)
forall a. Scope -> a -> (a, Scope)
-: DataOrNew l
don
          f (Type l
   -> Maybe (Type l) -> [GadtDecl l] -> [Deriving l] -> InstDecl l)
-> f (Type l)
-> f (Maybe (Type l) -> [GadtDecl l] -> [Deriving l] -> InstDecl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> Type l -> Type l -> Type l)
-> f (l -> Type l -> Type l -> Type l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Type l -> Type l -> Type l
forall l. l -> Type l -> Type l -> Type l
TyApp
            f (l -> Type l -> Type l -> Type l)
-> (l, Scope) -> f (Type l -> Type l -> Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
al
            f (Type l -> Type l -> Type l)
-> f (Type l) -> f (Type l -> Type l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> QName l -> Type l) -> f (l -> QName l -> Type l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> QName l -> Type l
forall l. l -> QName l -> Type l
TyCon
              f (l -> QName l -> Type l) -> (l, Scope) -> f (QName l -> Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc        Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
cl
              f (QName l -> Type l) -> (QName l, Scope) -> f (Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
exprUT Scope
sc Scope -> QName l -> (QName l, Scope)
forall a. Scope -> a -> (a, Scope)
-: QName l
qn)
            f (Type l -> Type l) -> (Type l, Scope) -> f (Type l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
aa)
          f (Maybe (Type l) -> [GadtDecl l] -> [Deriving l] -> InstDecl l)
-> (Maybe (Type l), Scope)
-> f ([GadtDecl l] -> [Deriving l] -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> Maybe (Type l) -> (Maybe (Type l), Scope)
forall a. Scope -> a -> (a, Scope)
-: Maybe (Type l)
mk
          f ([GadtDecl l] -> [Deriving l] -> InstDecl l)
-> ([GadtDecl l], Scope) -> f ([Deriving l] -> InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> [GadtDecl l] -> ([GadtDecl l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [GadtDecl l]
cs
          f ([Deriving l] -> InstDecl l)
-> ([Deriving l], Scope) -> f (InstDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> [Deriving l] -> ([Deriving l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Deriving l]
md
      InstDecl l
_ -> InstDecl l -> Scope -> f (InstDecl l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse InstDecl l
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (ClassDecl l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
ClassDecl l -> Scope -> f (ClassDecl l)
rtraverse ClassDecl l
e Scope
sc =
    case ClassDecl l
e of
      ClsDecl l
l (TypeSig l
sl [Name l
n] Type l
t) ->
        (l -> Decl l -> ClassDecl l) -> f (l -> Decl l -> ClassDecl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Decl l -> ClassDecl l
forall l. l -> Decl l -> ClassDecl l
ClsDecl
          f (l -> Decl l -> ClassDecl l)
-> (l, Scope) -> f (Decl l -> ClassDecl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Decl l -> ClassDecl l) -> f (Decl l) -> f (ClassDecl l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((l -> [Name l] -> Type l -> Decl l)
-> f (l -> [Name l] -> Type l -> Decl l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> [Name l] -> Type l -> Decl l
forall l. l -> [Name l] -> Type l -> Decl l
TypeSig
            f (l -> [Name l] -> Type l -> Decl l)
-> (l, Scope) -> f ([Name l] -> Type l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
sl
            f ([Name l] -> Type l -> Decl l)
-> ([Name l], Scope) -> f (Type l -> Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope -> Scope
binderV Scope
sc Scope -> [Name l] -> ([Name l], Scope)
forall a. Scope -> a -> (a, Scope)
-: [Name l
n]
            f (Type l -> Decl l) -> (Type l, Scope) -> f (Decl l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc         Scope -> Type l -> (Type l, Scope)
forall a. Scope -> a -> (a, Scope)
-: Type l
t)
      ClassDecl l
_ -> ClassDecl l -> Scope -> f (ClassDecl l)
forall a (f :: * -> *).
(GTraversable Resolvable a, Applicative f, ?alg::Alg f) =>
a -> Scope -> f a
defaultRtraverse ClassDecl l
e Scope
sc

instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Op l) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Op l -> Scope -> f (Op l)
rtraverse Op l
e Scope
sc =
    case Op l
e of
      VarOp l
l Name l
name ->
        (l -> Name l -> Op l) -> f (l -> Name l -> Op l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> Op l
forall l. l -> Name l -> Op l
VarOp
          f (l -> Name l -> Op l) -> (l, Scope) -> f (Name l -> Op l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> Op l) -> f (Name l) -> f (Op l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName l -> Name l) -> f (QName l) -> f (Name l)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName l -> Name l
forall l. QName l -> Name l
qNameToName (QName l -> Scope -> f (QName l)
forall (w :: * -> *) d.
(?alg::Alg w, Resolvable d) =>
d -> Scope -> w d
alg (Name l -> QName l
forall l. Name l -> QName l
nameToQName Name l
name) (Scope -> Scope
exprV Scope
sc))
      ConOp l
l Name l
name ->
        (l -> Name l -> Op l) -> f (l -> Name l -> Op l)
forall (w :: * -> *) c. Applicative w => c -> w c
c l -> Name l -> Op l
forall l. l -> Name l -> Op l
ConOp
          f (l -> Name l -> Op l) -> (l, Scope) -> f (Name l -> Op l)
forall (w :: * -> *) b c.
(Applicative w, Resolvable b, ?alg::Alg w) =>
w (b -> c) -> (b, Scope) -> w c
<| Scope
sc Scope -> l -> (l, Scope)
forall a. Scope -> a -> (a, Scope)
-: l
l
          f (Name l -> Op l) -> f (Name l) -> f (Op l)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName l -> Name l) -> f (QName l) -> f (Name l)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QName l -> Name l
forall l. QName l -> Name l
qNameToName (QName l -> Scope -> f (QName l)
forall (w :: * -> *) d.
(?alg::Alg w, Resolvable d) =>
d -> Scope -> w d
alg (Name l -> QName l
forall l. Name l -> QName l
nameToQName Name l
name) (Scope -> Scope
exprV Scope
sc))


{-
Note [Nested pattern scopes]
~~~~~~~~~~~~~~~~~~~~~~

When we resolve a group of patterns, their scopes nest.

Most of the time, this is not important, but there are two exceptions:
1. ScopedTypeVariables

Example: f (x :: a) (y :: a) = ...

The first 'a' is a binder, the second — a reference.

2. View patterns

An expression inside a view pattern may reference the variables bound
earlier.

Example: f x (find (< x) -> Just y) = ...
-}

-- Some road-block Resolvable instances
instance Typeable a => Resolvable (Scoped a) where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
Scoped a -> Scope -> f (Scoped a)
rtraverse = (Scope -> Scoped a -> f (Scoped a))
-> Scoped a -> Scope -> f (Scoped a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Scope -> Scoped a -> f (Scoped a))
 -> Scoped a -> Scope -> f (Scoped a))
-> (Scope -> Scoped a -> f (Scoped a))
-> Scoped a
-> Scope
-> f (Scoped a)
forall a b. (a -> b) -> a -> b
$ (Scoped a -> f (Scoped a)) -> Scope -> Scoped a -> f (Scoped a)
forall a b. a -> b -> a
const Scoped a -> f (Scoped a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Resolvable SrcSpan where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
SrcSpan -> Scope -> f SrcSpan
rtraverse = (Scope -> SrcSpan -> f SrcSpan) -> SrcSpan -> Scope -> f SrcSpan
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Scope -> SrcSpan -> f SrcSpan) -> SrcSpan -> Scope -> f SrcSpan)
-> (Scope -> SrcSpan -> f SrcSpan) -> SrcSpan -> Scope -> f SrcSpan
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> f SrcSpan) -> Scope -> SrcSpan -> f SrcSpan
forall a b. a -> b -> a
const SrcSpan -> f SrcSpan
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance Resolvable SrcSpanInfo where
  rtraverse :: forall (f :: * -> *).
(Applicative f, ?alg::Alg f) =>
SrcSpanInfo -> Scope -> f SrcSpanInfo
rtraverse = (Scope -> SrcSpanInfo -> f SrcSpanInfo)
-> SrcSpanInfo -> Scope -> f SrcSpanInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Scope -> SrcSpanInfo -> f SrcSpanInfo)
 -> SrcSpanInfo -> Scope -> f SrcSpanInfo)
-> (Scope -> SrcSpanInfo -> f SrcSpanInfo)
-> SrcSpanInfo
-> Scope
-> f SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ (SrcSpanInfo -> f SrcSpanInfo)
-> Scope -> SrcSpanInfo -> f SrcSpanInfo
forall a b. a -> b -> a
const SrcSpanInfo -> f SrcSpanInfo
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure