{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Trustworthy #-}
module ReWire.HSE.Rename
      ( Renamer, fixFixity, getExports, allExports
      , exclude, extend, finger, rename
      , FQName (mod, name), qnamish
      , QNamish
      , Namespace (..)
      , Exports, expValue, expType, expFixity, expCtorSigs, getCtors
      , Ctors, FQCtors, CtorSigs, FQCtorSigs
      , setCtors, getLocalTypes, getLocalCtorSigs
      , lookupCtors, lookupCtorSig, lookupCtorSigsForType
      , findCtorSigFromField
      , toFilePath
      , fromImps
      ) where

import ReWire.Annotation (Annotation, Annote, noAnn)
import ReWire.Error (failAt, mark, MonadError, AstError)
import ReWire.HSE.Fixity (fixLocalOps, deuniquifyLocalOps)
import ReWire.HSE.SrcLoc () -- the `Annotation SrcSpanInfo` instance (for `mark`/`failAt`).
import ReWire.HSE.Orphans () -- TextShow/Hashable/Generic instances over the haskell-src-exts AST.
import ReWire.Orphans ()
import ReWire.Pretty (TextShow, FromGeneric (..))

import Control.Arrow ((&&&), first)
import Control.Monad (foldM, void)
import Control.Monad.State (MonadState)
import Data.Hashable (Hashable)
import Data.List (find)
import Data.List.Split (splitOn)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Text (Text, pack, unpack)
import GHC.Generics (Generic)
import Language.Haskell.Exts.Fixity (Fixity (..), AppFixity (..))
import Language.Haskell.Exts.Pretty (prettyPrint)
import Language.Haskell.Exts.SrcLoc (SrcSpanInfo, noSrcSpan)
import System.FilePath (joinPath, (<.>))

import qualified Data.Map.Strict                        as Map
import qualified Data.Set                               as Set
import qualified Language.Haskell.Exts.Syntax           as S

import Language.Haskell.Exts.Syntax hiding (Namespace, Annotation, Module)

-- | Map from type name to its set of data constructors.
--   Note: the set of "ctors" also includes fields (things that might appear in
--   an export list).
type Ctors = Map (Name ()) (Set (Name ()))

-- | Qualified (globally-unique) version of the above map.
type FQCtors = Map FQName (Set FQName)

-- | Map from constructor name to its field "signature,"
--   which is a list of field names and types.
type CtorSigs = Map (Name ()) [(Maybe (Name ()), Type ())]

-- | Qualified (globally-unique) version of the above map.
type FQCtorSigs = Map FQName [(Maybe FQName, Type ())]

-- Note that GHC (although we might not catch this) disallows the same symbol
-- appearing twice in an export list (e.g., with different qualifiers, from
-- different modules), but clearly you can import the same symbol (defined in
-- the same or different modules) twice with different qualifiers.
data Exports = Exports
      { Exports -> Set FQName
expValues      :: !(Set FQName)                  -- ^ Values
      , Exports -> Set FQName
expTypes       :: !(Set FQName)                  -- ^ Types
      , Exports -> Set Fixity
expFixities    :: !(Set Fixity)                  -- ^ Fixities
      , Exports -> FQCtors
expCtors       :: !FQCtors
      , Exports -> FQCtorSigs
expCtorSigs    :: !FQCtorSigs
      }
      deriving (Int -> Exports -> ShowS
[Exports] -> ShowS
Exports -> String
(Int -> Exports -> ShowS)
-> (Exports -> String) -> ([Exports] -> ShowS) -> Show Exports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exports -> ShowS
showsPrec :: Int -> Exports -> ShowS
$cshow :: Exports -> String
show :: Exports -> String
$cshowList :: [Exports] -> ShowS
showList :: [Exports] -> ShowS
Show, (forall x. Exports -> Rep Exports x)
-> (forall x. Rep Exports x -> Exports) -> Generic Exports
forall x. Rep Exports x -> Exports
forall x. Exports -> Rep Exports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Exports -> Rep Exports x
from :: forall x. Exports -> Rep Exports x
$cto :: forall x. Rep Exports x -> Exports
to :: forall x. Rep Exports x -> Exports
Generic)
      deriving Int -> Exports -> Text
Int -> Exports -> Text
Int -> Exports -> Builder
[Exports] -> Text
[Exports] -> Text
[Exports] -> Builder
Exports -> Text
Exports -> Text
Exports -> Builder
(Int -> Exports -> Builder)
-> (Exports -> Builder)
-> ([Exports] -> Builder)
-> (Int -> Exports -> Text)
-> (Exports -> Text)
-> ([Exports] -> Text)
-> (Int -> Exports -> Text)
-> (Exports -> Text)
-> ([Exports] -> Text)
-> TextShow Exports
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: Int -> Exports -> Builder
showbPrec :: Int -> Exports -> Builder
$cshowb :: Exports -> Builder
showb :: Exports -> Builder
$cshowbList :: [Exports] -> Builder
showbList :: [Exports] -> Builder
$cshowtPrec :: Int -> Exports -> Text
showtPrec :: Int -> Exports -> Text
$cshowt :: Exports -> Text
showt :: Exports -> Text
$cshowtList :: [Exports] -> Text
showtList :: [Exports] -> Text
$cshowtlPrec :: Int -> Exports -> Text
showtlPrec :: Int -> Exports -> Text
$cshowtl :: Exports -> Text
showtl :: Exports -> Text
$cshowtlList :: [Exports] -> Text
showtlList :: [Exports] -> Text
TextShow via FromGeneric Exports

expValue :: FQName -> Exports -> Exports
expValue :: FQName -> Exports -> Exports
expValue FQName
x e :: Exports
e@Exports { Set FQName
expValues :: Exports -> Set FQName
expValues :: Set FQName
expValues } = Exports
e { expValues = Set.insert x expValues }

expType :: FQName -> Set FQName -> FQCtorSigs -> Exports -> Exports
expType :: FQName -> Set FQName -> FQCtorSigs -> Exports -> Exports
expType FQName
x Set FQName
cs' FQCtorSigs
sigs' e :: Exports
e@Exports { Set FQName
expValues :: Exports -> Set FQName
expValues :: Set FQName
expValues, Set FQName
expTypes :: Exports -> Set FQName
expTypes :: Set FQName
expTypes, FQCtors
expCtors :: Exports -> FQCtors
expCtors :: FQCtors
expCtors, FQCtorSigs
expCtorSigs :: Exports -> FQCtorSigs
expCtorSigs :: FQCtorSigs
expCtorSigs } = Exports
e
      { expValues      = cs' <> expValues
      , expTypes       = Set.insert x expTypes
      , expCtors       = Map.unionWith mappend
                              (Map.fromList [(x, cs'), (qnamish $ name x, cs')]) -- Insert both qualified and unqualified keys for pre-renamer lookup.
                              expCtors
      , expCtorSigs    = sigs' <> expCtorSigs
      }

expFixity :: Assoc () -> Int -> Name () -> Exports -> Exports
expFixity :: Assoc () -> Int -> Name () -> Exports -> Exports
expFixity Assoc ()
asc Int
lvl Name ()
x e :: Exports
e@Exports { Set Fixity
expFixities :: Exports -> Set Fixity
expFixities :: Set Fixity
expFixities } = Exports
e { expFixities = Set.insert (Fixity asc lvl $ UnQual () x) expFixities }

-- | Things in the export list of the named thing (ctors or fields).
getCtors :: QNamish a => a -> Exports -> Set FQName
getCtors :: forall a. QNamish a => a -> Exports -> Set FQName
getCtors a
x Exports { FQCtors
expCtors :: Exports -> FQCtors
expCtors :: FQCtors
expCtors } = Set FQName -> Maybe (Set FQName) -> Set FQName
forall a. a -> Maybe a -> a
fromMaybe Set FQName
forall a. Monoid a => a
mempty (Maybe (Set FQName) -> Set FQName)
-> Maybe (Set FQName) -> Set FQName
forall a b. (a -> b) -> a -> b
$ FQName -> FQCtors -> Maybe (Set FQName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> FQName
forall a b. (QNamish a, QNamish b) => a -> b
qnamish a
x) FQCtors
expCtors

fixities :: Exports -> [Name ()] -> [Fixity]
fixities :: Exports -> [Name ()] -> [Fixity]
fixities Exports { Set Fixity
expFixities :: Exports -> Set Fixity
expFixities :: Set Fixity
expFixities } [Name ()]
ns = Set Fixity -> [Fixity]
forall a. Set a -> [a]
Set.toList (Set Fixity -> [Fixity]) -> Set Fixity -> [Fixity]
forall a b. (a -> b) -> a -> b
$ (Fixity -> Bool) -> Set Fixity -> Set Fixity
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\ (Fixity Assoc ()
_ Int
_ QName ()
n') -> QName ()
n' QName () -> [QName ()] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Name () -> QName ()) -> [Name ()] -> [QName ()]
forall a b. (a -> b) -> [a] -> [b]
map (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual ()) [Name ()]
ns) Set Fixity
expFixities

instance Semigroup Exports where
      (Exports Set FQName
a Set FQName
b Set Fixity
c FQCtors
d FQCtorSigs
e) <> :: Exports -> Exports -> Exports
<> (Exports Set FQName
a' Set FQName
b' Set Fixity
c' FQCtors
d' FQCtorSigs
e') =
            Set FQName
-> Set FQName -> Set Fixity -> FQCtors -> FQCtorSigs -> Exports
Exports (Set FQName
a Set FQName -> Set FQName -> Set FQName
forall a. Semigroup a => a -> a -> a
<> Set FQName
a') (Set FQName
b Set FQName -> Set FQName -> Set FQName
forall a. Semigroup a => a -> a -> a
<> Set FQName
b') (Set Fixity
c Set Fixity -> Set Fixity -> Set Fixity
forall a. Semigroup a => a -> a -> a
<> Set Fixity
c') ((Set FQName -> Set FQName -> Set FQName)
-> FQCtors -> FQCtors -> FQCtors
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set FQName -> Set FQName -> Set FQName
forall a. Monoid a => a -> a -> a
mappend FQCtors
d FQCtors
d') (FQCtorSigs
e FQCtorSigs -> FQCtorSigs -> FQCtorSigs
forall a. Semigroup a => a -> a -> a
<> FQCtorSigs
e')

instance Monoid Exports where
      mempty :: Exports
mempty = Set FQName
-> Set FQName -> Set Fixity -> FQCtors -> FQCtorSigs -> Exports
Exports Set FQName
forall a. Monoid a => a
mempty Set FQName
forall a. Monoid a => a
mempty Set Fixity
forall a. Monoid a => a
mempty FQCtors
forall a. Monoid a => a
mempty FQCtorSigs
forall a. Monoid a => a
mempty

data Namespace = Type | Value
      deriving (Eq Namespace
Eq Namespace =>
(Namespace -> Namespace -> Ordering)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Namespace)
-> (Namespace -> Namespace -> Namespace)
-> Ord Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Namespace -> Namespace -> Ordering
compare :: Namespace -> Namespace -> Ordering
$c< :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
>= :: Namespace -> Namespace -> Bool
$cmax :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
min :: Namespace -> Namespace -> Namespace
Ord, Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq, Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show, (forall x. Namespace -> Rep Namespace x)
-> (forall x. Rep Namespace x -> Namespace) -> Generic Namespace
forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Namespace -> Rep Namespace x
from :: forall x. Namespace -> Rep Namespace x
$cto :: forall x. Rep Namespace x -> Namespace
to :: forall x. Rep Namespace x -> Namespace
Generic)
      deriving Int -> Namespace -> Text
Int -> Namespace -> Text
Int -> Namespace -> Builder
[Namespace] -> Text
[Namespace] -> Text
[Namespace] -> Builder
Namespace -> Text
Namespace -> Text
Namespace -> Builder
(Int -> Namespace -> Builder)
-> (Namespace -> Builder)
-> ([Namespace] -> Builder)
-> (Int -> Namespace -> Text)
-> (Namespace -> Text)
-> ([Namespace] -> Text)
-> (Int -> Namespace -> Text)
-> (Namespace -> Text)
-> ([Namespace] -> Text)
-> TextShow Namespace
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: Int -> Namespace -> Builder
showbPrec :: Int -> Namespace -> Builder
$cshowb :: Namespace -> Builder
showb :: Namespace -> Builder
$cshowbList :: [Namespace] -> Builder
showbList :: [Namespace] -> Builder
$cshowtPrec :: Int -> Namespace -> Text
showtPrec :: Int -> Namespace -> Text
$cshowt :: Namespace -> Text
showt :: Namespace -> Text
$cshowtList :: [Namespace] -> Text
showtList :: [Namespace] -> Text
$cshowtlPrec :: Int -> Namespace -> Text
showtlPrec :: Int -> Namespace -> Text
$cshowtl :: Namespace -> Text
showtl :: Namespace -> Text
$cshowtlList :: [Namespace] -> Text
showtlList :: [Namespace] -> Text
TextShow via FromGeneric Namespace

instance Hashable Namespace

data FQName = FQName { FQName -> ModuleName ()
mod :: !(ModuleName ()), FQName -> Name ()
name :: !(Name ())}
      deriving (Eq FQName
Eq FQName =>
(FQName -> FQName -> Ordering)
-> (FQName -> FQName -> Bool)
-> (FQName -> FQName -> Bool)
-> (FQName -> FQName -> Bool)
-> (FQName -> FQName -> Bool)
-> (FQName -> FQName -> FQName)
-> (FQName -> FQName -> FQName)
-> Ord FQName
FQName -> FQName -> Bool
FQName -> FQName -> Ordering
FQName -> FQName -> FQName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FQName -> FQName -> Ordering
compare :: FQName -> FQName -> Ordering
$c< :: FQName -> FQName -> Bool
< :: FQName -> FQName -> Bool
$c<= :: FQName -> FQName -> Bool
<= :: FQName -> FQName -> Bool
$c> :: FQName -> FQName -> Bool
> :: FQName -> FQName -> Bool
$c>= :: FQName -> FQName -> Bool
>= :: FQName -> FQName -> Bool
$cmax :: FQName -> FQName -> FQName
max :: FQName -> FQName -> FQName
$cmin :: FQName -> FQName -> FQName
min :: FQName -> FQName -> FQName
Ord, FQName -> FQName -> Bool
(FQName -> FQName -> Bool)
-> (FQName -> FQName -> Bool) -> Eq FQName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FQName -> FQName -> Bool
== :: FQName -> FQName -> Bool
$c/= :: FQName -> FQName -> Bool
/= :: FQName -> FQName -> Bool
Eq, Int -> FQName -> ShowS
[FQName] -> ShowS
FQName -> String
(Int -> FQName -> ShowS)
-> (FQName -> String) -> ([FQName] -> ShowS) -> Show FQName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FQName -> ShowS
showsPrec :: Int -> FQName -> ShowS
$cshow :: FQName -> String
show :: FQName -> String
$cshowList :: [FQName] -> ShowS
showList :: [FQName] -> ShowS
Show, (forall x. FQName -> Rep FQName x)
-> (forall x. Rep FQName x -> FQName) -> Generic FQName
forall x. Rep FQName x -> FQName
forall x. FQName -> Rep FQName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FQName -> Rep FQName x
from :: forall x. FQName -> Rep FQName x
$cto :: forall x. Rep FQName x -> FQName
to :: forall x. Rep FQName x -> FQName
Generic)
      deriving Int -> FQName -> Text
Int -> FQName -> Text
Int -> FQName -> Builder
[FQName] -> Text
[FQName] -> Text
[FQName] -> Builder
FQName -> Text
FQName -> Text
FQName -> Builder
(Int -> FQName -> Builder)
-> (FQName -> Builder)
-> ([FQName] -> Builder)
-> (Int -> FQName -> Text)
-> (FQName -> Text)
-> ([FQName] -> Text)
-> (Int -> FQName -> Text)
-> (FQName -> Text)
-> ([FQName] -> Text)
-> TextShow FQName
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: Int -> FQName -> Builder
showbPrec :: Int -> FQName -> Builder
$cshowb :: FQName -> Builder
showb :: FQName -> Builder
$cshowbList :: [FQName] -> Builder
showbList :: [FQName] -> Builder
$cshowtPrec :: Int -> FQName -> Text
showtPrec :: Int -> FQName -> Text
$cshowt :: FQName -> Text
showt :: FQName -> Text
$cshowtList :: [FQName] -> Text
showtList :: [FQName] -> Text
$cshowtlPrec :: Int -> FQName -> Text
showtlPrec :: Int -> FQName -> Text
$cshowtl :: FQName -> Text
showtl :: FQName -> Text
$cshowtlList :: [FQName] -> Text
showtlList :: [FQName] -> Text
TextShow via FromGeneric FQName

instance Hashable FQName

-- | Sometimes-partial conversion between name-like things.
class QNamish a where
      toQNamish :: a -> QName ()
      fromQNamish :: QName l -> a

qnamish :: (QNamish a, QNamish b) => a -> b
qnamish :: forall a b. (QNamish a, QNamish b) => a -> b
qnamish = QName () -> b
forall l. QName l -> b
forall a l. QNamish a => QName l -> a
fromQNamish (QName () -> b) -> (a -> QName ()) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> QName ()
forall a. QNamish a => a -> QName ()
toQNamish

instance QNamish (QName ()) where
      toQNamish :: QName () -> QName ()
toQNamish = QName () -> QName ()
forall a. a -> a
id
      fromQNamish :: forall l. QName l -> QName ()
fromQNamish = QName l -> QName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
instance QNamish (QName Annote) where
      toQNamish :: QName Annote -> QName ()
toQNamish = QName Annote -> QName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      fromQNamish :: forall l. QName l -> QName Annote
fromQNamish = (Annote
noAnn Annote -> QName l -> QName Annote
forall a b. a -> QName b -> QName a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$)
instance QNamish (Name ()) where
      toQNamish :: Name () -> QName ()
toQNamish = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ())
-> (Name () -> Name ()) -> Name () -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name () -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      fromQNamish :: forall l. QName l -> Name ()
fromQNamish (Qual l
_ ModuleName l
_ Name l
n) = Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n
      fromQNamish (UnQual l
_ Name l
n) = Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n
      fromQNamish QName l
n            = Name () -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Name () -> Name ()) -> Name () -> Name ()
forall a b. (a -> b) -> a -> b
$ () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String -> Name ()) -> String -> Name ()
forall a b. (a -> b) -> a -> b
$ QName l -> String
forall a. Pretty a => a -> String
prettyPrint QName l
n
instance QNamish (Name SrcSpanInfo) where
      toQNamish :: Name SrcSpanInfo -> QName ()
toQNamish = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ())
-> (Name SrcSpanInfo -> Name ()) -> Name SrcSpanInfo -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name SrcSpanInfo -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      fromQNamish :: forall l. QName l -> Name SrcSpanInfo
fromQNamish (Qual l
_ ModuleName l
_ Name l
n) = SrcSpanInfo
noSrcSpan SrcSpanInfo -> Name l -> Name SrcSpanInfo
forall a b. a -> Name b -> Name a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name l
n
      fromQNamish (UnQual l
_ Name l
n) = SrcSpanInfo
noSrcSpan SrcSpanInfo -> Name l -> Name SrcSpanInfo
forall a b. a -> Name b -> Name a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name l
n
      fromQNamish QName l
n            = (SrcSpanInfo
noSrcSpan SrcSpanInfo -> Name SrcSpanInfo -> Name SrcSpanInfo
forall a b. a -> Name b -> Name a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Name SrcSpanInfo -> Name SrcSpanInfo)
-> Name SrcSpanInfo -> Name SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> String -> Name SrcSpanInfo
forall l. l -> String -> Name l
Ident SrcSpanInfo
noSrcSpan (String -> Name SrcSpanInfo) -> String -> Name SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ QName l -> String
forall a. Pretty a => a -> String
prettyPrint QName l
n
instance QNamish (Name Annote) where
      toQNamish :: Name Annote -> QName ()
toQNamish = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ())
-> (Name Annote -> Name ()) -> Name Annote -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name Annote -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      fromQNamish :: forall l. QName l -> Name Annote
fromQNamish (Qual l
_ ModuleName l
_ Name l
n) = Annote
noAnn Annote -> Name l -> Name Annote
forall a b. a -> Name b -> Name a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name l
n
      fromQNamish (UnQual l
_ Name l
n) = Annote
noAnn Annote -> Name l -> Name Annote
forall a b. a -> Name b -> Name a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Name l
n
      fromQNamish QName l
n            = (Annote
noAnn Annote -> Name Annote -> Name Annote
forall a b. a -> Name b -> Name a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Name Annote -> Name Annote) -> Name Annote -> Name Annote
forall a b. (a -> b) -> a -> b
$ Annote -> String -> Name Annote
forall l. l -> String -> Name l
Ident Annote
noAnn (String -> Name Annote) -> String -> Name Annote
forall a b. (a -> b) -> a -> b
$ QName l -> String
forall a. Pretty a => a -> String
prettyPrint QName l
n
instance QNamish FQName where
      toQNamish :: FQName -> QName ()
toQNamish (FQName ModuleName ()
m Name ()
n) = () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m Name ()
n
      fromQNamish :: forall l. QName l -> FQName
fromQNamish (Qual l
_ ModuleName l
m Name l
n) = ModuleName () -> Name () -> FQName
FQName (ModuleName l -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ModuleName l
m) (Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n)
      fromQNamish (UnQual l
_ Name l
n) = ModuleName () -> Name () -> FQName
FQName (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"") (Name () -> FQName) -> Name () -> FQName
forall a b. (a -> b) -> a -> b
$ Name l -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name l
n
      -- This definition kinda defeats the purpose of FQName.
      fromQNamish QName l
n            = ModuleName () -> Name () -> FQName
FQName (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"") (Name () -> FQName) -> Name () -> FQName
forall a b. (a -> b) -> a -> b
$ () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String -> Name ()) -> String -> Name ()
forall a b. (a -> b) -> a -> b
$ QName l -> String
forall a. Pretty a => a -> String
prettyPrint QName l
n
instance QNamish Text where
      toQNamish :: Text -> QName ()
toQNamish = () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> (Text -> Name ()) -> Text -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String -> Name ()) -> (Text -> String) -> Text -> Name ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
      fromQNamish :: forall l. QName l -> Text
fromQNamish (Qual l
_ (ModuleName l
_ String
"") (Ident l
_ String
x))  = String -> Text
pack String
x
      fromQNamish (Qual l
_ (ModuleName l
_ String
"") (Symbol l
_ String
x)) = String -> Text
pack String
x
      fromQNamish (Qual l
_ (ModuleName l
_ String
m) (Ident l
_ String
x))   = String -> Text
pack String
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
x
      fromQNamish (Qual l
_ (ModuleName l
_ String
m) (Symbol l
_ String
x))  = String -> Text
pack String
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
x
      fromQNamish (UnQual l
_ (Ident l
_ String
x))                  = String -> Text
pack String
x
      fromQNamish (UnQual l
_ (Symbol l
_ String
x))                 = String -> Text
pack String
x
      fromQNamish QName l
n                                       = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ QName l -> String
forall a. Pretty a => a -> String
prettyPrint QName l
n

data Renamer = Renamer
      { Renamer -> Map (Namespace, QName ()) FQName
rnNames    :: !(Map (Namespace, QName ()) FQName)
      , Renamer -> Map (ModuleName ()) Exports
rnExports  :: !(Map (ModuleName ()) Exports)
      , Renamer -> Set Fixity
rnFixities :: !(Set Fixity)
      , Renamer -> Ctors
rnCtors    :: !Ctors
      , Renamer -> CtorSigs
rnCtorSigs :: !CtorSigs
      } deriving (Int -> Renamer -> ShowS
[Renamer] -> ShowS
Renamer -> String
(Int -> Renamer -> ShowS)
-> (Renamer -> String) -> ([Renamer] -> ShowS) -> Show Renamer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Renamer -> ShowS
showsPrec :: Int -> Renamer -> ShowS
$cshow :: Renamer -> String
show :: Renamer -> String
$cshowList :: [Renamer] -> ShowS
showList :: [Renamer] -> ShowS
Show, (forall x. Renamer -> Rep Renamer x)
-> (forall x. Rep Renamer x -> Renamer) -> Generic Renamer
forall x. Rep Renamer x -> Renamer
forall x. Renamer -> Rep Renamer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Renamer -> Rep Renamer x
from :: forall x. Renamer -> Rep Renamer x
$cto :: forall x. Rep Renamer x -> Renamer
to :: forall x. Rep Renamer x -> Renamer
Generic)
      deriving Int -> Renamer -> Text
Int -> Renamer -> Text
Int -> Renamer -> Builder
[Renamer] -> Text
[Renamer] -> Text
[Renamer] -> Builder
Renamer -> Text
Renamer -> Text
Renamer -> Builder
(Int -> Renamer -> Builder)
-> (Renamer -> Builder)
-> ([Renamer] -> Builder)
-> (Int -> Renamer -> Text)
-> (Renamer -> Text)
-> ([Renamer] -> Text)
-> (Int -> Renamer -> Text)
-> (Renamer -> Text)
-> ([Renamer] -> Text)
-> TextShow Renamer
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
$cshowbPrec :: Int -> Renamer -> Builder
showbPrec :: Int -> Renamer -> Builder
$cshowb :: Renamer -> Builder
showb :: Renamer -> Builder
$cshowbList :: [Renamer] -> Builder
showbList :: [Renamer] -> Builder
$cshowtPrec :: Int -> Renamer -> Text
showtPrec :: Int -> Renamer -> Text
$cshowt :: Renamer -> Text
showt :: Renamer -> Text
$cshowtList :: [Renamer] -> Text
showtList :: [Renamer] -> Text
$cshowtlPrec :: Int -> Renamer -> Text
showtlPrec :: Int -> Renamer -> Text
$cshowtl :: Renamer -> Text
showtl :: Renamer -> Text
$cshowtlList :: [Renamer] -> Text
showtlList :: [Renamer] -> Text
TextShow via FromGeneric Renamer

instance Semigroup Renamer where
      (Renamer Map (Namespace, QName ()) FQName
a Map (ModuleName ()) Exports
b Set Fixity
c Ctors
d CtorSigs
e) <> :: Renamer -> Renamer -> Renamer
<> (Renamer Map (Namespace, QName ()) FQName
a' Map (ModuleName ()) Exports
b' Set Fixity
c' Ctors
d' CtorSigs
e') = Map (Namespace, QName ()) FQName
-> Map (ModuleName ()) Exports
-> Set Fixity
-> Ctors
-> CtorSigs
-> Renamer
Renamer (Map (Namespace, QName ()) FQName
a Map (Namespace, QName ()) FQName
-> Map (Namespace, QName ()) FQName
-> Map (Namespace, QName ()) FQName
forall a. Semigroup a => a -> a -> a
<> Map (Namespace, QName ()) FQName
a') (Map (ModuleName ()) Exports
b Map (ModuleName ()) Exports
-> Map (ModuleName ()) Exports -> Map (ModuleName ()) Exports
forall a. Semigroup a => a -> a -> a
<> Map (ModuleName ()) Exports
b') (Set Fixity
c Set Fixity -> Set Fixity -> Set Fixity
forall a. Semigroup a => a -> a -> a
<> Set Fixity
c') ((Set (Name ()) -> Set (Name ()) -> Set (Name ()))
-> Ctors -> Ctors -> Ctors
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set (Name ()) -> Set (Name ()) -> Set (Name ())
forall a. Semigroup a => a -> a -> a
(<>) Ctors
d Ctors
d') (CtorSigs
e CtorSigs -> CtorSigs -> CtorSigs
forall a. Semigroup a => a -> a -> a
<> CtorSigs
e')

instance Monoid Renamer where
      mempty :: Renamer
mempty = Map (Namespace, QName ()) FQName
-> Map (ModuleName ()) Exports
-> Set Fixity
-> Ctors
-> CtorSigs
-> Renamer
Renamer Map (Namespace, QName ()) FQName
forall a. Monoid a => a
mempty Map (ModuleName ()) Exports
forall a. Monoid a => a
mempty Set Fixity
forall a. Monoid a => a
mempty Ctors
forall a. Monoid a => a
mempty CtorSigs
forall a. Monoid a => a
mempty

rename :: (QNamish a, QNamish b) => Namespace -> Renamer -> a -> b
rename :: forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
ns Renamer { Map (Namespace, QName ()) FQName
rnNames :: Renamer -> Map (Namespace, QName ()) FQName
rnNames :: Map (Namespace, QName ()) FQName
rnNames } a
x = QName () -> b
forall l. QName l -> b
forall a l. QNamish a => QName l -> a
fromQNamish (QName () -> b) -> (Maybe FQName -> QName ()) -> Maybe FQName -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName () -> (FQName -> QName ()) -> Maybe FQName -> QName ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> QName ()
forall a. QNamish a => a -> QName ()
toQNamish a
x) FQName -> QName ()
forall a. QNamish a => a -> QName ()
toQNamish (Maybe FQName -> b) -> Maybe FQName -> b
forall a b. (a -> b) -> a -> b
$ (Namespace, QName ())
-> Map (Namespace, QName ()) FQName -> Maybe FQName
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Namespace
ns, a -> QName ()
forall a. QNamish a => a -> QName ()
toQNamish a
x) Map (Namespace, QName ()) FQName
rnNames

extend :: QNamish a => Namespace -> [(a, FQName)] -> Renamer -> Renamer
extend :: forall a.
QNamish a =>
Namespace -> [(a, FQName)] -> Renamer -> Renamer
extend Namespace
ns [(a, FQName)]
kvs rn :: Renamer
rn@Renamer { Map (Namespace, QName ()) FQName
rnNames :: Renamer -> Map (Namespace, QName ()) FQName
rnNames :: Map (Namespace, QName ()) FQName
rnNames } = Renamer
rn { rnNames = Map.fromList (map (((ns,) . toQNamish . fst) &&& snd) kvs) `Map.union` rnNames }

exclude :: QNamish a => Namespace -> [a] -> Renamer -> Renamer
exclude :: forall a. QNamish a => Namespace -> [a] -> Renamer -> Renamer
exclude Namespace
ns [a]
ks rn :: Renamer
rn@Renamer { Map (Namespace, QName ()) FQName
rnNames :: Renamer -> Map (Namespace, QName ()) FQName
rnNames :: Map (Namespace, QName ()) FQName
rnNames } = Renamer
rn { rnNames = foldr (Map.delete . (ns,) . toQNamish) rnNames ks }

fixFixity :: (MonadFail m, MonadState AstError m) => Renamer -> S.Module SrcSpanInfo -> m (S.Module SrcSpanInfo)
fixFixity :: forall (m :: * -> *).
(MonadFail m, MonadState AstError m) =>
Renamer -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
fixFixity Renamer { Set Fixity
rnFixities :: Renamer -> Set Fixity
rnFixities :: Set Fixity
rnFixities } Module SrcSpanInfo
m = do
      SrcSpanInfo -> m ()
forall (m :: * -> *) an.
(MonadState AstError m, Annotation an) =>
an -> m ()
mark (SrcSpanInfo -> m ()) -> SrcSpanInfo -> m ()
forall a b. (a -> b) -> a -> b
$ Module SrcSpanInfo -> SrcSpanInfo
forall l. Module l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Module SrcSpanInfo
m
      Module SrcSpanInfo -> Module SrcSpanInfo
deuniquifyLocalOps (Module SrcSpanInfo -> Module SrcSpanInfo)
-> m (Module SrcSpanInfo) -> m (Module SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
Module SrcSpanInfo -> m (Module SrcSpanInfo)
fixLocalOps Module SrcSpanInfo
m m (Module SrcSpanInfo)
-> (Module SrcSpanInfo -> m (Module SrcSpanInfo))
-> m (Module SrcSpanInfo)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (m :: * -> *).
MonadFail m =>
[Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (ast :: * -> *) (m :: * -> *).
(AppFixity ast, MonadFail m) =>
[Fixity] -> ast SrcSpanInfo -> m (ast SrcSpanInfo)
applyFixities (Set Fixity -> [Fixity]
forall a. Set a -> [a]
Set.toList Set Fixity
rnFixities))

addFixities :: [Fixity] -> Renamer -> Renamer
addFixities :: [Fixity] -> Renamer -> Renamer
addFixities [Fixity]
fixities' rn :: Renamer
rn@Renamer { Set Fixity
rnFixities :: Renamer -> Set Fixity
rnFixities :: Set Fixity
rnFixities } = Renamer
rn { rnFixities = rnFixities `Set.union` Set.fromList fixities' }

addExports :: ModuleName () -> Exports -> Renamer -> Renamer
addExports :: ModuleName () -> Exports -> Renamer -> Renamer
addExports ModuleName ()
m Exports
exps rn :: Renamer
rn@Renamer { Map (ModuleName ()) Exports
rnExports :: Renamer -> Map (ModuleName ()) Exports
rnExports :: Map (ModuleName ()) Exports
rnExports } = Renamer
rn { rnExports = Map.insert m exps rnExports }

getExports :: ModuleName () -> Renamer -> Exports
getExports :: ModuleName () -> Renamer -> Exports
getExports ModuleName ()
m Renamer { Map (ModuleName ()) Exports
rnExports :: Renamer -> Map (ModuleName ()) Exports
rnExports :: Map (ModuleName ()) Exports
rnExports } = Exports -> Maybe Exports -> Exports
forall a. a -> Maybe a -> a
fromMaybe Exports
forall a. Monoid a => a
mempty (Maybe Exports -> Exports) -> Maybe Exports -> Exports
forall a b. (a -> b) -> a -> b
$ ModuleName () -> Map (ModuleName ()) Exports -> Maybe Exports
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName ()
m Map (ModuleName ()) Exports
rnExports

allExports :: Renamer -> Exports
allExports :: Renamer -> Exports
allExports Renamer { Map (ModuleName ()) Exports
rnExports :: Renamer -> Map (ModuleName ()) Exports
rnExports :: Map (ModuleName ()) Exports
rnExports } = [Exports] -> Exports
forall a. Monoid a => [a] -> a
mconcat ([Exports] -> Exports) -> [Exports] -> Exports
forall a b. (a -> b) -> a -> b
$ Map (ModuleName ()) Exports -> [Exports]
forall k a. Map k a -> [a]
Map.elems Map (ModuleName ()) Exports
rnExports

requalFixity :: ModuleName () -> Fixity -> Fixity
requalFixity :: ModuleName () -> Fixity -> Fixity
requalFixity ModuleName ()
m (Fixity Assoc ()
asc Int
lvl QName ()
n) = Assoc () -> Int -> QName () -> Fixity
Fixity Assoc ()
asc Int
lvl (QName () -> Fixity) -> QName () -> Fixity
forall a b. (a -> b) -> a -> b
$ case QName ()
n of
      Qual ()
_ ModuleName ()
_ Name ()
n' -> () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m Name ()
n'
      UnQual ()
_ Name ()
n' -> () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m Name ()
n'
      QName ()
n'          -> () -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ QName () -> Name ()
forall a b. (QNamish a, QNamish b) => a -> b
qnamish QName ()
n'

filterFixities :: (Name () -> Bool) -> [Fixity] -> [Fixity]
filterFixities :: (Name () -> Bool) -> [Fixity] -> [Fixity]
filterFixities Name () -> Bool
p = (Fixity -> Bool) -> [Fixity] -> [Fixity]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Fixity -> Bool) -> [Fixity] -> [Fixity])
-> (Fixity -> Bool) -> [Fixity] -> [Fixity]
forall a b. (a -> b) -> a -> b
$ \ (Fixity Assoc ()
_ Int
_ QName ()
n) -> Name () -> Bool
p (Name () -> Bool) -> Name () -> Bool
forall a b. (a -> b) -> a -> b
$ QName () -> Name ()
forall a b. (QNamish a, QNamish b) => a -> b
qnamish QName ()
n

-- | True iff an entry for the name exists in the renamer.
finger :: QNamish a => Namespace -> Renamer -> a -> Bool
finger :: forall a. QNamish a => Namespace -> Renamer -> a -> Bool
finger Namespace
ns Renamer { Map (Namespace, QName ()) FQName
rnNames :: Renamer -> Map (Namespace, QName ()) FQName
rnNames :: Map (Namespace, QName ()) FQName
rnNames } = ((Namespace, QName ()) -> Map (Namespace, QName ()) FQName -> Bool)
-> Map (Namespace, QName ()) FQName
-> (Namespace, QName ())
-> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Namespace, QName ()) -> Map (Namespace, QName ()) FQName -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Map (Namespace, QName ()) FQName
rnNames ((Namespace, QName ()) -> Bool)
-> (a -> (Namespace, QName ())) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Namespace
ns,) (QName () -> (Namespace, QName ()))
-> (a -> QName ()) -> a -> (Namespace, QName ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> QName ()
forall a. QNamish a => a -> QName ()
toQNamish

toFilePath :: ModuleName a -> FilePath
toFilePath :: forall a. ModuleName a -> String
toFilePath (ModuleName a
_ String
n) = [String] -> String
joinPath (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
n) String -> ShowS
<.> String
"hs"

lookupExp :: (Annotation a, MonadError AstError m) => Namespace -> Name a -> Exports -> m FQName
lookupExp :: forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Namespace -> Name a -> Exports -> m FQName
lookupExp Namespace
ns Name a
x Exports {Set FQName
expValues :: Exports -> Set FQName
expValues :: Set FQName
expValues, Set FQName
expTypes :: Exports -> Set FQName
expTypes :: Set FQName
expTypes} = case Namespace
ns of
      Namespace
Value -> Set FQName -> m FQName
forall (m :: * -> *).
MonadError AstError m =>
Set FQName -> m FQName
lkup Set FQName
expValues
      Namespace
Type  -> Set FQName -> m FQName
forall (m :: * -> *).
MonadError AstError m =>
Set FQName -> m FQName
lkup Set FQName
expTypes
      where lkup :: MonadError AstError m => Set FQName -> m FQName
            lkup :: forall (m :: * -> *).
MonadError AstError m =>
Set FQName -> m FQName
lkup Set FQName
xs = m FQName -> (FQName -> m FQName) -> Maybe FQName -> m FQName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Text -> m FQName
forall (m :: * -> *) an a.
(MonadError AstError m, Annotation an) =>
an -> Text -> m a
failAt (Name a -> a
forall l. Name l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name a
x) (Text -> m FQName) -> Text -> m FQName
forall a b. (a -> b) -> a -> b
$ Text
"Attempting to import an unexported symbol: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Name a -> String
forall a. Pretty a => a -> String
prettyPrint Name a
x)) FQName -> m FQName
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    (Maybe FQName -> m FQName) -> Maybe FQName -> m FQName
forall a b. (a -> b) -> a -> b
$ (FQName -> Bool) -> [FQName] -> Maybe FQName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find FQName -> Bool
cmp (Set FQName -> [FQName]
forall a. Set a -> [a]
Set.toList Set FQName
xs)

            cmp :: FQName -> Bool
            cmp :: FQName -> Bool
cmp (FQName ModuleName ()
_ Name ()
x') = Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Name ()
x'

getLocalTypes :: Renamer -> Set (Name ())
getLocalTypes :: Renamer -> Set (Name ())
getLocalTypes Renamer
rn = Ctors -> Set (Name ())
forall k a. Map k a -> Set k
Map.keysSet (Ctors -> Set (Name ())) -> Ctors -> Set (Name ())
forall a b. (a -> b) -> a -> b
$ Renamer -> Ctors
rnCtors Renamer
rn

getLocalCtorSigs :: Renamer -> CtorSigs
getLocalCtorSigs :: Renamer -> CtorSigs
getLocalCtorSigs = Renamer -> CtorSigs
rnCtorSigs

lookupCtors :: QNamish a => Renamer -> a -> Set FQName
lookupCtors :: forall a. QNamish a => Renamer -> a -> Set FQName
lookupCtors Renamer
rn a
x = Set FQName -> FQName -> FQCtors -> Set FQName
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set FQName
forall a. Monoid a => a
mempty (Namespace -> Renamer -> a -> FQName
forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
Type Renamer
rn a
x) (FQCtors -> Set FQName) -> FQCtors -> Set FQName
forall a b. (a -> b) -> a -> b
$ Renamer -> FQCtors
allCtors Renamer
rn

lookupCtorSig :: QNamish a => Renamer -> a -> [(Maybe FQName, Type ())]
lookupCtorSig :: forall a. QNamish a => Renamer -> a -> [(Maybe FQName, Type ())]
lookupCtorSig Renamer
rn a
x = [(Maybe FQName, Type ())]
-> FQName -> FQCtorSigs -> [(Maybe FQName, Type ())]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [(Maybe FQName, Type ())]
forall a. Monoid a => a
mempty (Namespace -> Renamer -> a -> FQName
forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
Value Renamer
rn a
x) (FQCtorSigs -> [(Maybe FQName, Type ())])
-> FQCtorSigs -> [(Maybe FQName, Type ())]
forall a b. (a -> b) -> a -> b
$ Renamer -> FQCtorSigs
allCtorSigs Renamer
rn

lookupCtorSigsForType :: QNamish a => Renamer -> a -> FQCtorSigs
lookupCtorSigsForType :: forall a. QNamish a => Renamer -> a -> FQCtorSigs
lookupCtorSigsForType Renamer
rn a
x = (FQName -> [(Maybe FQName, Type ())]) -> Set FQName -> FQCtorSigs
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (Renamer -> FQName -> [(Maybe FQName, Type ())]
forall a. QNamish a => Renamer -> a -> [(Maybe FQName, Type ())]
lookupCtorSig Renamer
rn) (Set FQName -> FQCtorSigs) -> Set FQName -> FQCtorSigs
forall a b. (a -> b) -> a -> b
$ Renamer -> a -> Set FQName
forall a. QNamish a => Renamer -> a -> Set FQName
lookupCtors Renamer
rn a
x

findCtorSigFromField :: QNamish a => Renamer -> a -> Maybe (FQName, [(Maybe FQName, Type ())])
findCtorSigFromField :: forall a.
QNamish a =>
Renamer -> a -> Maybe (FQName, [(Maybe FQName, Type ())])
findCtorSigFromField Renamer
rn a
f = ((FQName, [(Maybe FQName, Type ())]) -> Bool)
-> [(FQName, [(Maybe FQName, Type ())])]
-> Maybe (FQName, [(Maybe FQName, Type ())])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (((Maybe FQName, Type ()) -> Bool)
-> [(Maybe FQName, Type ())] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Maybe FQName -> Maybe FQName -> Bool
forall a. Eq a => a -> a -> Bool
== FQName -> Maybe FQName
forall a. a -> Maybe a
Just (a -> FQName
forall a b. (QNamish a, QNamish b) => a -> b
qnamish a
f)) (Maybe FQName -> Bool)
-> ((Maybe FQName, Type ()) -> Maybe FQName)
-> (Maybe FQName, Type ())
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FQName, Type ()) -> Maybe FQName
forall a b. (a, b) -> a
fst) ([(Maybe FQName, Type ())] -> Bool)
-> ((FQName, [(Maybe FQName, Type ())])
    -> [(Maybe FQName, Type ())])
-> (FQName, [(Maybe FQName, Type ())])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FQName, [(Maybe FQName, Type ())]) -> [(Maybe FQName, Type ())]
forall a b. (a, b) -> b
snd) ([(FQName, [(Maybe FQName, Type ())])]
 -> Maybe (FQName, [(Maybe FQName, Type ())]))
-> [(FQName, [(Maybe FQName, Type ())])]
-> Maybe (FQName, [(Maybe FQName, Type ())])
forall a b. (a -> b) -> a -> b
$ FQCtorSigs -> [(FQName, [(Maybe FQName, Type ())])]
forall k a. Map k a -> [(k, a)]
Map.toList (Renamer -> FQCtorSigs
allCtorSigs Renamer
rn)

noExps :: Maybe (Bool, Imports SrcSpanInfo)
noExps :: Maybe (Bool, Imports SrcSpanInfo)
noExps = Maybe (Bool, Imports SrcSpanInfo)
forall a. Maybe a
Nothing

setCtors :: Ctors -> CtorSigs -> Renamer -> Renamer
setCtors :: Ctors -> CtorSigs -> Renamer -> Renamer
setCtors Ctors
ctors CtorSigs
sigs Renamer
rn = Renamer
rn { rnCtors = ctors, rnCtorSigs = sigs }

qualifyCtors :: Renamer -> Ctors -> FQCtors
qualifyCtors :: Renamer -> Ctors -> FQCtors
qualifyCtors Renamer
rn = (Name () -> FQName) -> Map (Name ()) (Set FQName) -> FQCtors
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Namespace -> Renamer -> Name () -> FQName
forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
Type Renamer
rn) (Map (Name ()) (Set FQName) -> FQCtors)
-> (Ctors -> Map (Name ()) (Set FQName)) -> Ctors -> FQCtors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (Name ()) -> Set FQName)
-> Ctors -> Map (Name ()) (Set FQName)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((Name () -> FQName) -> Set (Name ()) -> Set FQName
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((Name () -> FQName) -> Set (Name ()) -> Set FQName)
-> (Name () -> FQName) -> Set (Name ()) -> Set FQName
forall a b. (a -> b) -> a -> b
$ Namespace -> Renamer -> Name () -> FQName
forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
Value Renamer
rn)

qualifyCtorSigs :: Renamer -> CtorSigs -> FQCtorSigs
qualifyCtorSigs :: Renamer -> CtorSigs -> FQCtorSigs
qualifyCtorSigs Renamer
rn = (Name () -> FQName)
-> Map (Name ()) [(Maybe FQName, Type ())] -> FQCtorSigs
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Namespace -> Renamer -> Name () -> FQName
forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
Value Renamer
rn) (Map (Name ()) [(Maybe FQName, Type ())] -> FQCtorSigs)
-> (CtorSigs -> Map (Name ()) [(Maybe FQName, Type ())])
-> CtorSigs
-> FQCtorSigs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Maybe (Name ()), Type ())] -> [(Maybe FQName, Type ())])
-> CtorSigs -> Map (Name ()) [(Maybe FQName, Type ())]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((Maybe (Name ()), Type ()) -> (Maybe FQName, Type ()))
-> [(Maybe (Name ()), Type ())] -> [(Maybe FQName, Type ())]
forall a b. (a -> b) -> [a] -> [b]
map (((Maybe (Name ()), Type ()) -> (Maybe FQName, Type ()))
 -> [(Maybe (Name ()), Type ())] -> [(Maybe FQName, Type ())])
-> ((Maybe (Name ()), Type ()) -> (Maybe FQName, Type ()))
-> [(Maybe (Name ()), Type ())]
-> [(Maybe FQName, Type ())]
forall a b. (a -> b) -> a -> b
$ (Maybe (Name ()) -> Maybe FQName)
-> (Maybe (Name ()), Type ()) -> (Maybe FQName, Type ())
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Name () -> FQName) -> Maybe (Name ()) -> Maybe FQName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Namespace -> Renamer -> Name () -> FQName
forall a b.
(QNamish a, QNamish b) =>
Namespace -> Renamer -> a -> b
rename Namespace
Value Renamer
rn)))

allCtors :: Renamer -> FQCtors
allCtors :: Renamer -> FQCtors
allCtors Renamer
rn = Renamer -> Ctors -> FQCtors
qualifyCtors Renamer
rn (Renamer -> Ctors
rnCtors Renamer
rn) FQCtors -> FQCtors -> FQCtors
forall a. Semigroup a => a -> a -> a
<> Exports -> FQCtors
expCtors (Renamer -> Exports
allExports Renamer
rn)

allCtorSigs :: Renamer -> FQCtorSigs
allCtorSigs :: Renamer -> FQCtorSigs
allCtorSigs Renamer
rn = Renamer -> CtorSigs -> FQCtorSigs
qualifyCtorSigs Renamer
rn (Renamer -> CtorSigs
rnCtorSigs Renamer
rn) FQCtorSigs -> FQCtorSigs -> FQCtorSigs
forall a. Semigroup a => a -> a -> a
<> Exports -> FQCtorSigs
expCtorSigs (Renamer -> Exports
allExports Renamer
rn)

type Imports a = ([(Namespace, Name a)], [Fixity])

-- | Build renamer from a single import line. Should work on either pre- or
--   post-desugared import lists. Params: module being imported, "qualified",
--   exports (of this import), "... as \<qualifier\>", imports.
fromImps :: (Functor m, MonadError AstError m) => ModuleName () -> Bool -> Exports -> Maybe (ModuleName ()) -> Maybe (ImportSpecList SrcSpanInfo) -> m Renamer
fromImps :: forall (m :: * -> *).
(Functor m, MonadError AstError m) =>
ModuleName ()
-> Bool
-> Exports
-> Maybe (ModuleName ())
-> Maybe (ImportSpecList SrcSpanInfo)
-> m Renamer
fromImps ModuleName ()
m Bool
quald Exports
exps Maybe (ModuleName ())
Nothing   Maybe (ImportSpecList SrcSpanInfo)
Nothing                          = ModuleName () -> Exports -> Renamer -> Renamer
addExports ModuleName ()
m Exports
exps (Renamer -> Renamer) -> m Renamer -> m Renamer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName ()
-> Bool
-> Maybe (Bool, Imports SrcSpanInfo)
-> Exports
-> m Renamer
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
ModuleName ()
-> Bool -> Maybe (Bool, Imports a) -> Exports -> m Renamer
fromImps' ModuleName ()
m Bool
quald Maybe (Bool, Imports SrcSpanInfo)
noExps Exports
exps
fromImps ModuleName ()
m Bool
quald Exports
exps (Just ModuleName ()
m') Maybe (ImportSpecList SrcSpanInfo)
Nothing                          = ModuleName () -> Exports -> Renamer -> Renamer
addExports ModuleName ()
m Exports
exps (Renamer -> Renamer) -> m Renamer -> m Renamer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName ()
-> Bool
-> Maybe (Bool, Imports SrcSpanInfo)
-> Exports
-> m Renamer
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
ModuleName ()
-> Bool -> Maybe (Bool, Imports a) -> Exports -> m Renamer
fromImps' ModuleName ()
m' Bool
quald Maybe (Bool, Imports SrcSpanInfo)
noExps Exports
exps
fromImps ModuleName ()
m Bool
quald Exports
exps (Just ModuleName ()
m') (Just (ImportSpecList SrcSpanInfo
_ Bool
h [ImportSpec SrcSpanInfo]
imps)) = do
      imps' <- (Imports SrcSpanInfo
 -> ImportSpec SrcSpanInfo -> m (Imports SrcSpanInfo))
-> Imports SrcSpanInfo
-> [ImportSpec SrcSpanInfo]
-> m (Imports SrcSpanInfo)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Exports
-> Imports SrcSpanInfo
-> ImportSpec SrcSpanInfo
-> m (Imports SrcSpanInfo)
forall (m :: * -> *).
MonadError AstError m =>
Exports
-> Imports SrcSpanInfo
-> ImportSpec SrcSpanInfo
-> m (Imports SrcSpanInfo)
getImp Exports
exps) Imports SrcSpanInfo
forall a. Monoid a => a
mempty [ImportSpec SrcSpanInfo]
imps
      addExports m exps <$> fromImps' m' quald (Just (h, imps')) exps
fromImps ModuleName ()
m Bool
quald Exports
exps Maybe (ModuleName ())
Nothing (Just (ImportSpecList SrcSpanInfo
_ Bool
h [ImportSpec SrcSpanInfo]
imps))   = do
      imps' <- (Imports SrcSpanInfo
 -> ImportSpec SrcSpanInfo -> m (Imports SrcSpanInfo))
-> Imports SrcSpanInfo
-> [ImportSpec SrcSpanInfo]
-> m (Imports SrcSpanInfo)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Exports
-> Imports SrcSpanInfo
-> ImportSpec SrcSpanInfo
-> m (Imports SrcSpanInfo)
forall (m :: * -> *).
MonadError AstError m =>
Exports
-> Imports SrcSpanInfo
-> ImportSpec SrcSpanInfo
-> m (Imports SrcSpanInfo)
getImp Exports
exps) Imports SrcSpanInfo
forall a. Monoid a => a
mempty [ImportSpec SrcSpanInfo]
imps
      addExports m exps <$> fromImps' m quald (Just (h, imps')) exps

fromImps' :: (Annotation a, MonadError AstError m) => ModuleName () -> Bool -> Maybe (Bool, Imports a) -> Exports -> m Renamer
-- No list of imports -- so import everything.
fromImps' :: forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
ModuleName ()
-> Bool -> Maybe (Bool, Imports a) -> Exports -> m Renamer
fromImps' ModuleName ()
m' Bool
quald Maybe (Bool, Imports a)
Nothing Exports
exps = ModuleName ()
-> Bool
-> Maybe (Bool, Imports SrcSpanInfo)
-> Exports
-> m Renamer
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
ModuleName ()
-> Bool -> Maybe (Bool, Imports a) -> Exports -> m Renamer
fromImps' ModuleName ()
m' Bool
quald ((Bool, Imports SrcSpanInfo) -> Maybe (Bool, Imports SrcSpanInfo)
forall a. a -> Maybe a
Just (Bool
False, Exports -> Imports SrcSpanInfo
toImports Exports
exps)) Exports
exps
      where toImports :: Exports -> Imports SrcSpanInfo
            toImports :: Exports -> Imports SrcSpanInfo
toImports Exports {Set FQName
expValues :: Exports -> Set FQName
expValues :: Set FQName
expValues, Set FQName
expTypes :: Exports -> Set FQName
expTypes :: Set FQName
expTypes, Set Fixity
expFixities :: Exports -> Set Fixity
expFixities :: Set Fixity
expFixities} =
                  ( (FQName -> (Namespace, Name SrcSpanInfo))
-> [FQName] -> [(Namespace, Name SrcSpanInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ((Namespace
Value,) (Name SrcSpanInfo -> (Namespace, Name SrcSpanInfo))
-> (FQName -> Name SrcSpanInfo)
-> FQName
-> (Namespace, Name SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FQName -> Name SrcSpanInfo
forall a b. (QNamish a, QNamish b) => a -> b
qnamish) (Set FQName -> [FQName]
forall a. Set a -> [a]
Set.toList Set FQName
expValues) [(Namespace, Name SrcSpanInfo)]
-> [(Namespace, Name SrcSpanInfo)]
-> [(Namespace, Name SrcSpanInfo)]
forall a. Semigroup a => a -> a -> a
<> (FQName -> (Namespace, Name SrcSpanInfo))
-> [FQName] -> [(Namespace, Name SrcSpanInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ((Namespace
Type,) (Name SrcSpanInfo -> (Namespace, Name SrcSpanInfo))
-> (FQName -> Name SrcSpanInfo)
-> FQName
-> (Namespace, Name SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FQName -> Name SrcSpanInfo
forall a b. (QNamish a, QNamish b) => a -> b
qnamish) (Set FQName -> [FQName]
forall a. Set a -> [a]
Set.toList Set FQName
expTypes)
                  , Set Fixity -> [Fixity]
forall a. Set a -> [a]
Set.toList (Set Fixity -> [Fixity]) -> Set Fixity -> [Fixity]
forall a b. (a -> b) -> a -> b
$ Set Fixity
expFixities Set Fixity -> Set Fixity -> Set Fixity
forall a. Semigroup a => a -> a -> a
<> (Fixity -> Fixity) -> Set Fixity -> Set Fixity
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (ModuleName () -> Fixity -> Fixity
requalFixity ModuleName ()
m') Set Fixity
expFixities
                  )
-- List of imports, no "hiding".
fromImps' ModuleName ()
m' Bool
quald (Just (Bool
False, ([(Namespace, Name a)]
imps, [Fixity]
fs))) Exports
exps = (Renamer -> (Namespace, Name a) -> m Renamer)
-> Renamer -> [(Namespace, Name a)] -> m Renamer
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Renamer -> (Namespace, Name a) -> m Renamer
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Renamer -> (Namespace, Name a) -> m Renamer
ins Renamer
forall a. Monoid a => a
mempty [(Namespace, Name a)]
imps
      where ins :: (Annotation a, MonadError AstError m) => Renamer -> (Namespace, Name a) -> m Renamer
            ins :: forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Renamer -> (Namespace, Name a) -> m Renamer
ins Renamer
tab (Namespace
ns, Name a
x) = do
                  e <- Namespace -> Name a -> Exports -> m FQName
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Namespace -> Name a -> Exports -> m FQName
lookupExp Namespace
ns Name a
x Exports
exps
                  let xs' = (() -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m' (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x, FQName
e)                               (QName (), FQName) -> [(QName (), FQName)] -> [(QName (), FQName)]
forall a. a -> [a] -> [a]
: [ (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x, FQName
e) | Bool -> Bool
not Bool
quald ]
                      fs' = (Fixity -> Fixity) -> [Fixity] -> [Fixity]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName () -> Fixity -> Fixity
requalFixity ModuleName ()
m') ((Name () -> Bool) -> [Fixity] -> [Fixity]
filterFixities (Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x) [Fixity]
fs) [Fixity] -> [Fixity] -> [Fixity]
forall a. Semigroup a => a -> a -> a
<> if Bool
quald then [] else (Name () -> Bool) -> [Fixity] -> [Fixity]
filterFixities (Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x) [Fixity]
fs
                  pure $ extend ns xs' $ addFixities fs' tab
-- List of imports with "hiding" -- import everything, then delete the items
-- from the list.
fromImps' ModuleName ()
m' Bool
quald (Just (Bool
True, ([(Namespace, Name a)]
imps, [Fixity]
fs))) Exports
exps = (Renamer -> [(Namespace, Name a)] -> Renamer)
-> [(Namespace, Name a)] -> Renamer -> Renamer
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Renamer -> (Namespace, Name a) -> Renamer)
-> Renamer -> [(Namespace, Name a)] -> Renamer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Renamer -> (Namespace, Name a) -> Renamer
forall a. Renamer -> (Namespace, Name a) -> Renamer
del) [(Namespace, Name a)]
imps (Renamer -> Renamer) -> m Renamer -> m Renamer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModuleName ()
-> Bool
-> Maybe (Bool, Imports SrcSpanInfo)
-> Exports
-> m Renamer
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
ModuleName ()
-> Bool -> Maybe (Bool, Imports a) -> Exports -> m Renamer
fromImps' ModuleName ()
m' Bool
quald Maybe (Bool, Imports SrcSpanInfo)
noExps Exports
exps
      where del :: Renamer -> (Namespace, Name a) -> Renamer
            del :: forall a. Renamer -> (Namespace, Name a) -> Renamer
del Renamer
tab (Namespace
ns, Name a
x) = Namespace -> [QName ()] -> Renamer -> Renamer
forall a. QNamish a => Namespace -> [a] -> Renamer -> Renamer
exclude Namespace
ns [() -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m' (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x, () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x]
                  (Renamer -> Renamer) -> Renamer -> Renamer
forall a b. (a -> b) -> a -> b
$ [Fixity] -> Renamer -> Renamer
addFixities ((Name () -> Bool) -> [Fixity] -> [Fixity]
filterFixities (Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
/= Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
x) [Fixity]
fs) Renamer
tab

getImp :: (MonadError AstError m) => Exports -> Imports SrcSpanInfo -> ImportSpec SrcSpanInfo -> m (Imports SrcSpanInfo)
getImp :: forall (m :: * -> *).
MonadError AstError m =>
Exports
-> Imports SrcSpanInfo
-> ImportSpec SrcSpanInfo
-> m (Imports SrcSpanInfo)
getImp Exports
exps ([(Namespace, Name SrcSpanInfo)]
imps, [Fixity]
fs) = \ case
      IVar SrcSpanInfo
_ Name SrcSpanInfo
x          -> do
            _ <- Namespace -> Name SrcSpanInfo -> Exports -> m FQName
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Namespace -> Name a -> Exports -> m FQName
lookupExp Namespace
Value Name SrcSpanInfo
x Exports
exps
            pure ((Value, x) : imps, fixities exps [void x] <> fs)
      IAbs SrcSpanInfo
_ Namespace SrcSpanInfo
_ Name SrcSpanInfo
x        -> do
            _ <- Namespace -> Name SrcSpanInfo -> Exports -> m FQName
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Namespace -> Name a -> Exports -> m FQName
lookupExp Namespace
Type Name SrcSpanInfo
x Exports
exps
            pure ((Type, x) : imps, fs)
      IThingAll SrcSpanInfo
_ Name SrcSpanInfo
x     -> do
            _ <- Namespace -> Name SrcSpanInfo -> Exports -> m FQName
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Namespace -> Name a -> Exports -> m FQName
lookupExp Namespace
Type Name SrcSpanInfo
x Exports
exps
            pure ( (Type, x) : (map ((Value,) . qnamish) (Set.toList $ getCtors (void x) exps) <> imps)
                   , fixities exps (map name (Set.toList $ getCtors (void x) exps)) <> fs
                   )
      IThingWith SrcSpanInfo
_ Name SrcSpanInfo
x [CName SrcSpanInfo]
cs -> do
            _ <- Namespace -> Name SrcSpanInfo -> Exports -> m FQName
forall a (m :: * -> *).
(Annotation a, MonadError AstError m) =>
Namespace -> Name a -> Exports -> m FQName
lookupExp Namespace
Type Name SrcSpanInfo
x Exports
exps
            mapM_ (flip (lookupExp Value) exps . toName) cs
            pure ( (Type, x) : (map ((Value,) . toName) cs <> imps)
                   , fixities exps (map (void . toName) cs) <> fs
                   )
      where toName :: CName a -> Name a
            toName :: forall a. CName a -> Name a
toName = \ case
                  VarName a
_ Name a
x -> Name a
x
                  ConName a
_ Name a
x -> Name a
x