{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- ModName (ModuleName l)
module Language.Haskell.Names.Imports
  ( importTable
  , annotateImportDecls
  )
  where

import Data.Monoid
import Data.Maybe
import Data.Either

import Control.Monad (guard)
import Control.Monad.Writer
import Data.Map as Map (lookup)
import Language.Haskell.Exts (
  Module(Module), ModuleName(ModuleName), ImportDecl(..),
  ann,ImportSpecList(..),ImportSpec(..),Name(..),
  Annotated)
import Language.Haskell.Exts.Extension (
  Extension(DisableExtension), KnownExtension(ImplicitPrelude))
import Language.Haskell.Names.Types
import Language.Haskell.Names.ScopeUtils
import qualified Language.Haskell.Names.GlobalSymbolTable as Global
import Language.Haskell.Names.SyntaxUtils
import Data.List ((\\))


-- | Compute a table of symbols imported by the given module from the given
-- environment.
importTable :: Environment -> Module l -> Global.Table
importTable :: forall l. Environment -> Module l -> Table
importTable Environment
environment Module l
modul =
  (Table -> Table -> Table) -> Table -> [Table] -> Table
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Table -> Table -> Table
Global.mergeTables Table
perhapsPrelude [Table]
tables where

    tables :: [Table]
tables = (ImportDecl l -> Table) -> [ImportDecl l] -> [Table]
forall a b. (a -> b) -> [a] -> [b]
map (Environment -> ImportDecl l -> Table
forall l. Environment -> ImportDecl l -> Table
importDeclTable Environment
environment) [ImportDecl l]
importDecls
    Module l
_ Maybe (ModuleHead l)
_ [ModulePragma l]
_ [ImportDecl l]
importDecls [Decl l]
_ = Module l
modul

    perhapsPrelude :: Table
perhapsPrelude = if Bool
noImplicitPrelude
      then Table
Global.empty
      else Bool -> ModuleName () -> [Symbol] -> Table
computeSymbolTable Bool
False ModuleName ()
preludeModuleName [Symbol]
preludeSymbols
    noImplicitPrelude :: Bool
noImplicitPrelude =
      KnownExtension -> Extension
DisableExtension KnownExtension
ImplicitPrelude Extension -> [Extension] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Extension]
extensions Bool -> Bool -> Bool
|| Bool
isPreludeImported
    isPreludeImported :: Bool
isPreludeImported = Bool -> Bool
not ([()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (do
      ImportDecl l
importDecl <- [ImportDecl l]
importDecls
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (ImportDecl l -> ModuleName l
forall l. ImportDecl l -> ModuleName l
importModule ImportDecl l
importDecl) ModuleName () -> ModuleName () -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName ()
preludeModuleName)))
    preludeSymbols :: [Symbol]
preludeSymbols = [Symbol] -> Maybe [Symbol] -> [Symbol]
forall a. a -> Maybe a -> a
fromMaybe [] (ModuleName () -> Environment -> Maybe [Symbol]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName ()
preludeModuleName Environment
environment)
    (Maybe Language
_, [Extension]
extensions) = Module l -> (Maybe Language, [Extension])
forall l. Module l -> (Maybe Language, [Extension])
getModuleExtensions Module l
modul

preludeModuleName :: ModuleName ()
preludeModuleName :: ModuleName ()
preludeModuleName = () -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Prelude"

importDeclTable :: Environment -> ImportDecl l -> Global.Table
importDeclTable :: forall l. Environment -> ImportDecl l -> Table
importDeclTable Environment
environment ImportDecl l
importDecl =
  Bool -> ModuleName () -> [Symbol] -> Table
computeSymbolTable Bool
isQualified ModuleName ()
moduleName [Symbol]
importSymbols where
    ImportDecl l
_ ModuleName l
importModuleName Bool
isQualified Bool
_ Bool
_ Maybe String
_ Maybe (ModuleName l)
maybeAs Maybe (ImportSpecList l)
maybeImportSpecList =
      ImportDecl l
importDecl
    moduleName :: ModuleName ()
moduleName = ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (ModuleName l -> Maybe (ModuleName l) -> ModuleName l
forall a. a -> Maybe a -> a
fromMaybe ModuleName l
importModuleName Maybe (ModuleName l)
maybeAs)
    importSymbols :: [Symbol]
importSymbols = case Maybe (ImportSpecList l)
maybeImportSpecList of
      Maybe (ImportSpecList l)
Nothing ->
        [Symbol]
importModuleSymbols
      Just ImportSpecList l
importSpecList ->
        ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
forall l. ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
importSpecListSymbols ModuleName l
importModuleName [Symbol]
importModuleSymbols ImportSpecList l
importSpecList
    importModuleSymbols :: [Symbol]
importModuleSymbols = [Symbol] -> Maybe [Symbol] -> [Symbol]
forall a. a -> Maybe a -> a
fromMaybe [] (
      ModuleName () -> Environment -> Maybe [Symbol]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
importModuleName) Environment
environment)


importSpecListSymbols :: ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
importSpecListSymbols :: forall l. ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
importSpecListSymbols ModuleName l
importModuleName [Symbol]
allSymbols ImportSpecList l
importSpecList =
  if Bool
isHiding
    then [Symbol]
allSymbols [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Symbol]
mentionedSymbols
    else [Symbol]
mentionedSymbols where
      ImportSpecList l
_ Bool
isHiding [ImportSpec l]
importSpecs = ImportSpecList l
importSpecList
      annotatedImportSpecs :: [ImportSpec (Scoped l)]
annotatedImportSpecs =
        (ImportSpec l -> ImportSpec (Scoped l))
-> [ImportSpec l] -> [ImportSpec (Scoped l)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName l
-> Bool -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
forall l.
ModuleName l
-> Bool -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
resolveImportSpec ModuleName l
importModuleName Bool
isHiding [Symbol]
allSymbols) [ImportSpec l]
importSpecs
      mentionedSymbols :: [Symbol]
mentionedSymbols =
        [[Symbol]] -> [Symbol]
forall a. Monoid a => [a] -> a
mconcat ([Either (Error l) [Symbol]] -> [[Symbol]]
forall a b. [Either a b] -> [b]
rights ((ImportSpec (Scoped l) -> Either (Error l) [Symbol])
-> [ImportSpec (Scoped l)] -> [Either (Error l) [Symbol]]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec (Scoped l) -> Either (Error l) [Symbol]
forall (a :: * -> *) l.
Annotated a =>
a (Scoped l) -> Either (Error l) [Symbol]
ann2syms [ImportSpec (Scoped l)]
annotatedImportSpecs))

-- | Annotate the given list of import declarations with scoping information
-- against the given environment. We need the name of the module that contains
-- the import declarations for error annotations.
annotateImportDecls ::
  ModuleName l -> Environment -> [ImportDecl l] -> [ImportDecl (Scoped l)]
annotateImportDecls :: forall l.
ModuleName l
-> Environment -> [ImportDecl l] -> [ImportDecl (Scoped l)]
annotateImportDecls ModuleName l
moduleName Environment
environment [ImportDecl l]
importDecls =
  (ImportDecl l -> ImportDecl (Scoped l))
-> [ImportDecl l] -> [ImportDecl (Scoped l)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName l
-> Environment -> ImportDecl l -> ImportDecl (Scoped l)
forall l.
ModuleName l
-> Environment -> ImportDecl l -> ImportDecl (Scoped l)
annotateImportDecl ModuleName l
moduleName Environment
environment) [ImportDecl l]
importDecls


annotateImportDecl ::
  ModuleName l -> Environment -> ImportDecl l -> ImportDecl (Scoped l)
annotateImportDecl :: forall l.
ModuleName l
-> Environment -> ImportDecl l -> ImportDecl (Scoped l)
annotateImportDecl ModuleName l
moduleName Environment
environment ImportDecl l
importDecl = ImportDecl (Scoped l)
importDecl' where
  ImportDecl
    l
l
    ModuleName l
importModuleName
    Bool
isQualified
    Bool
isSource
    Bool
isSafe
    Maybe String
importPackage
    Maybe (ModuleName l)
maybeAs
    Maybe (ImportSpecList l)
maybeImportSpecList = ImportDecl l
importDecl

  importDecl' :: ImportDecl (Scoped l)
importDecl' = case ModuleName () -> Environment -> Maybe [Symbol]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn ModuleName l
importModuleName) Environment
environment of
    Maybe [Symbol]
Nothing -> Error l -> ImportDecl l -> ImportDecl (Scoped l)
forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError (ModuleName l -> Error l
forall l. ModuleName l -> Error l
EModNotFound ModuleName l
importModuleName) ImportDecl l
importDecl
    Just [Symbol]
symbols ->
      Scoped l
-> ModuleName (Scoped l)
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName (Scoped l))
-> Maybe (ImportSpecList (Scoped l))
-> ImportDecl (Scoped l)
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl
        Scoped l
l'
        ModuleName (Scoped l)
importModuleName'
        Bool
isQualified
        Bool
isSource
        Bool
isSafe
        Maybe String
importPackage
        Maybe (ModuleName (Scoped l))
maybeAs'
        Maybe (ImportSpecList (Scoped l))
maybeImportSpecList' where
          l' :: Scoped l
l' = NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped NameInfo l
info l
l
          importModuleName' :: ModuleName (Scoped l)
importModuleName' = (l -> Scoped l) -> ModuleName l -> ModuleName (Scoped l)
forall a b. (a -> b) -> ModuleName a -> ModuleName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped ([Symbol] -> NameInfo l
forall l. [Symbol] -> NameInfo l
ImportPart [Symbol]
symbols)) ModuleName l
importModuleName
          maybeAs' :: Maybe (ModuleName (Scoped l))
maybeAs' = (ModuleName l -> ModuleName (Scoped l))
-> Maybe (ModuleName l) -> Maybe (ModuleName (Scoped l))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModuleName l -> ModuleName (Scoped l)
forall (a :: * -> *) l. Annotated a => a l -> a (Scoped l)
noScope Maybe (ModuleName l)
maybeAs
          maybeImportSpecList' :: Maybe (ImportSpecList (Scoped l))
maybeImportSpecList' =
            (ImportSpecList l -> ImportSpecList (Scoped l))
-> Maybe (ImportSpecList l) -> Maybe (ImportSpecList (Scoped l))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ModuleName l
-> [Symbol] -> ImportSpecList l -> ImportSpecList (Scoped l)
forall l.
ModuleName l
-> [Symbol] -> ImportSpecList l -> ImportSpecList (Scoped l)
annotateImportSpecList ModuleName l
moduleName [Symbol]
symbols) Maybe (ImportSpecList l)
maybeImportSpecList
          info :: NameInfo l
info = case Maybe (ImportSpecList (Scoped l))
maybeImportSpecList' of
            Just ImportSpecList (Scoped l)
sl | Scoped (ScopeError Error l
e) l
_ <- ImportSpecList (Scoped l) -> Scoped l
forall l. ImportSpecList l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann ImportSpecList (Scoped l)
sl ->
              Error l -> NameInfo l
forall l. Error l -> NameInfo l
ScopeError Error l
e
            Maybe (ImportSpecList (Scoped l))
_ -> Table -> NameInfo l
forall l. Table -> NameInfo l
Import Table
table
          table :: Table
table = Bool -> ModuleName () -> [Symbol] -> Table
computeSymbolTable Bool
isQualified ModuleName ()
qualificationName [Symbol]
importSymbols
          qualificationName :: ModuleName ()
qualificationName = ModuleName l -> ModuleName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (ModuleName l -> Maybe (ModuleName l) -> ModuleName l
forall a. a -> Maybe a -> a
fromMaybe ModuleName l
importModuleName Maybe (ModuleName l)
maybeAs)
          importSymbols :: [Symbol]
importSymbols =
            [Symbol]
-> (ImportSpecList l -> [Symbol])
-> Maybe (ImportSpecList l)
-> [Symbol]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              [Symbol]
symbols
              (ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
forall l. ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
importSpecListSymbols ModuleName l
moduleName [Symbol]
symbols)
              Maybe (ImportSpecList l)
maybeImportSpecList


annotateImportSpecList ::
  ModuleName l -> [Symbol] -> ImportSpecList l -> ImportSpecList (Scoped l)
annotateImportSpecList :: forall l.
ModuleName l
-> [Symbol] -> ImportSpecList l -> ImportSpecList (Scoped l)
annotateImportSpecList ModuleName l
moduleName [Symbol]
allSymbols ImportSpecList l
importSpecList =
  (Scoped l
-> Bool -> [ImportSpec (Scoped l)] -> ImportSpecList (Scoped l)
forall l. l -> Bool -> [ImportSpec l] -> ImportSpecList l
ImportSpecList Scoped l
l' Bool
isHiding [ImportSpec (Scoped l)]
importSpecs') where
    ImportSpecList l
l Bool
isHiding [ImportSpec l]
importSpecs = ImportSpecList l
importSpecList
    l' :: Scoped l
l' = NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped ([Symbol] -> NameInfo l
forall l. [Symbol] -> NameInfo l
ImportPart [Symbol]
importSymbols) l
l
    importSpecs' :: [ImportSpec (Scoped l)]
importSpecs' = (ImportSpec l -> ImportSpec (Scoped l))
-> [ImportSpec l] -> [ImportSpec (Scoped l)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName l
-> Bool -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
forall l.
ModuleName l
-> Bool -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
resolveImportSpec ModuleName l
moduleName Bool
isHiding [Symbol]
allSymbols) [ImportSpec l]
importSpecs
    importSymbols :: [Symbol]
importSymbols = ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
forall l. ModuleName l -> [Symbol] -> ImportSpecList l -> [Symbol]
importSpecListSymbols ModuleName l
moduleName [Symbol]
allSymbols ImportSpecList l
importSpecList


resolveImportSpec
  :: ModuleName l
  -> Bool
  -> [Symbol]
  -> ImportSpec l
  -> ImportSpec (Scoped l)
-- NB: this can be made more efficient
resolveImportSpec :: forall l.
ModuleName l
-> Bool -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
resolveImportSpec ModuleName l
mod Bool
isHiding [Symbol]
symbols ImportSpec l
spec =
  case ImportSpec l
spec of
    IVar l
_ Name l
n ->
      let
        matches :: [Symbol]
matches =
          -- Strictly speaking, the isConstructor check is unnecessary
          -- because constructors are lexically different from anything
          -- else.
          [ Symbol
symbol
          | Symbol
symbol <- [Symbol]
symbols
          , Bool -> Bool
not (Symbol -> Bool
isConstructor Symbol
symbol)
          , Symbol
symbol Symbol -> Name l -> Bool
forall l. Symbol -> Name l -> Bool
~~ Name l
n]
      in
        Error l -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
forall (f :: * -> *) l.
Functor f =>
Error l -> [Symbol] -> f l -> f (Scoped l)
checkUnique
          (Maybe (Name l) -> Name l -> ModuleName l -> Error l
forall l. Maybe (Name l) -> Name l -> ModuleName l -> Error l
ENotExported Maybe (Name l)
forall a. Maybe a
Nothing Name l
n ModuleName l
mod)
          [Symbol]
matches
          ImportSpec l
spec
    -- FIXME think about data families etc.
    IAbs l
_ Namespace l
_ Name l
n
      | Bool
isHiding ->
          -- This is a bit special. 'C' may match both types/classes and
          -- data constructors.
          -- FIXME Still check for uniqueness?
          let
            matches :: [Symbol]
matches = [ Symbol
symbol | Symbol
symbol <- [Symbol]
symbols, Symbol
symbol Symbol -> Name l -> Bool
forall l. Symbol -> Name l -> Bool
~~ Name l
n]
          in
            if [Symbol] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Symbol]
matches
              then
                Error l -> ImportSpec l -> ImportSpec (Scoped l)
forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError (Maybe (Name l) -> Name l -> ModuleName l -> Error l
forall l. Maybe (Name l) -> Name l -> ModuleName l -> Error l
ENotExported Maybe (Name l)
forall a. Maybe a
Nothing Name l
n ModuleName l
mod) ImportSpec l
spec
              else
                NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped ([Symbol] -> NameInfo l
forall l. [Symbol] -> NameInfo l
ImportPart [Symbol]
matches) (l -> Scoped l) -> ImportSpec l -> ImportSpec (Scoped l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportSpec l
spec
      | Bool
otherwise ->
          let
            matches :: [Symbol]
matches = [Symbol
symbol | Symbol
symbol <- [Symbol]
symbols, Symbol
symbol Symbol -> Name l -> Bool
forall l. Symbol -> Name l -> Bool
~~ Name l
n, Bool -> Bool
not (Symbol -> Bool
isConstructor Symbol
symbol)]
          in
            Error l -> [Symbol] -> ImportSpec l -> ImportSpec (Scoped l)
forall (f :: * -> *) l.
Functor f =>
Error l -> [Symbol] -> f l -> f (Scoped l)
checkUnique
              (Maybe (Name l) -> Name l -> ModuleName l -> Error l
forall l. Maybe (Name l) -> Name l -> ModuleName l -> Error l
ENotExported Maybe (Name l)
forall a. Maybe a
Nothing Name l
n ModuleName l
mod)
              [Symbol]
matches
              ImportSpec l
spec

    IThingAll l
l Name l
n ->
      let
        matches :: [Symbol]
matches = [ Symbol
symbol | Symbol
symbol <- [Symbol]
symbols, Symbol
symbol Symbol -> Name l -> Bool
forall l. Symbol -> Name l -> Bool
~~ Name l
n, Symbol -> Bool
hasSubImports Symbol
symbol]
        subs :: [Symbol]
subs = [ Symbol
symbol
          | Symbol
n <- [Symbol]
matches
          , Symbol
symbol <- [Symbol]
symbols
          , Just Name ()
n' <- Maybe (Name ()) -> [Maybe (Name ())]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name ()) -> [Maybe (Name ())])
-> Maybe (Name ()) -> [Maybe (Name ())]
forall a b. (a -> b) -> a -> b
$ Symbol -> Maybe (Name ())
symbolParent Symbol
symbol
          , Name ()
n' Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol -> Name ()
symbolName Symbol
n ]
        n' :: Name (Scoped l)
n' =
          Error l -> [Symbol] -> Name l -> Name (Scoped l)
forall (f :: * -> *) l.
Functor f =>
Error l -> [Symbol] -> f l -> f (Scoped l)
checkUnique
            (Maybe (Name l) -> Name l -> ModuleName l -> Error l
forall l. Maybe (Name l) -> Name l -> ModuleName l -> Error l
ENotExported Maybe (Name l)
forall a. Maybe a
Nothing Name l
n ModuleName l
mod)
            [Symbol]
matches
            Name l
n
        in
          case Name (Scoped l) -> Scoped l
forall l. Name l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Name (Scoped l)
n' of
            e :: Scoped l
e@(Scoped ScopeError{} l
_) -> Scoped l -> Name (Scoped l) -> ImportSpec (Scoped l)
forall l. l -> Name l -> ImportSpec l
IThingAll Scoped l
e Name (Scoped l)
n'
            Scoped l
_ ->
              Scoped l -> Name (Scoped l) -> ImportSpec (Scoped l)
forall l. l -> Name l -> ImportSpec l
IThingAll
                (NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped
                  ([Symbol] -> NameInfo l
forall l. [Symbol] -> NameInfo l
ImportPart ([Symbol]
subs [Symbol] -> [Symbol] -> [Symbol]
forall a. Semigroup a => a -> a -> a
<> [Symbol]
matches))
                  l
l
                )
                Name (Scoped l)
n'

    IThingWith l
l Name l
n [CName l]
cns ->
      let
        matches :: [Symbol]
matches = [Symbol
symbol | Symbol
symbol <- [Symbol]
symbols, Symbol
symbol Symbol -> Name l -> Bool
forall l. Symbol -> Name l -> Bool
~~ Name l
n, Symbol -> Bool
hasSubImports Symbol
symbol]
        n' :: Name (Scoped l)
n' =
          Error l -> [Symbol] -> Name l -> Name (Scoped l)
forall (f :: * -> *) l.
Functor f =>
Error l -> [Symbol] -> f l -> f (Scoped l)
checkUnique
            (Maybe (Name l) -> Name l -> ModuleName l -> Error l
forall l. Maybe (Name l) -> Name l -> ModuleName l -> Error l
ENotExported Maybe (Name l)
forall a. Maybe a
Nothing Name l
n ModuleName l
mod)
            [Symbol]
matches
            Name l
n
        typeName :: Name ()
typeName = Symbol -> Name ()
symbolName (Symbol -> Name ()) -> Symbol -> Name ()
forall a b. (a -> b) -> a -> b
$ [Symbol] -> Symbol
forall a. HasCallStack => [a] -> a
head [Symbol]
matches -- should be safe
        ([CName (Scoped l)]
cns', [Symbol]
cnSyms) =
          [Symbol]
-> Name ()
-> (CName l -> Error l)
-> [CName l]
-> ([CName (Scoped l)], [Symbol])
forall l.
[Symbol]
-> Name ()
-> (CName l -> Error l)
-> [CName l]
-> ([CName (Scoped l)], [Symbol])
resolveCNames
            [Symbol]
symbols
            Name ()
typeName
            (\CName l
cn -> Maybe (Name l) -> Name l -> ModuleName l -> Error l
forall l. Maybe (Name l) -> Name l -> ModuleName l -> Error l
ENotExported (Name l -> Maybe (Name l)
forall a. a -> Maybe a
Just Name l
n) (CName l -> Name l
forall l. CName l -> Name l
unCName CName l
cn) ModuleName l
mod)
            [CName l]
cns
      in
        Scoped l
-> Name (Scoped l) -> [CName (Scoped l)] -> ImportSpec (Scoped l)
forall l. l -> Name l -> [CName l] -> ImportSpec l
IThingWith
          (NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped
            ([Symbol] -> NameInfo l
forall l. [Symbol] -> NameInfo l
ImportPart ([Symbol]
cnSyms [Symbol] -> [Symbol] -> [Symbol]
forall a. Semigroup a => a -> a -> a
<> [Symbol]
matches))
            l
l
          )
          Name (Scoped l)
n'
          [CName (Scoped l)]
cns'
  where
    (~~) :: Symbol -> Name l -> Bool
    Symbol
symbol ~~ :: forall l. Symbol -> Name l -> Bool
~~ Name l
name = Symbol -> Name ()
symbolName Symbol
symbol Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn Name l
name

    isConstructor :: Symbol -> Bool
    isConstructor :: Symbol -> Bool
isConstructor Constructor {} = Bool
True
    isConstructor Symbol
_ = Bool
False

    hasSubImports :: Symbol -> Bool
    hasSubImports :: Symbol -> Bool
hasSubImports Symbol
symbol = case Symbol
symbol of
        Data {} -> Bool
True
        NewType {} -> Bool
True
        DataFam {} -> Bool
True
        Class   {} -> Bool
True
        Symbol
_ -> Bool
False

ann2syms :: Annotated a => a (Scoped l) -> Either (Error l) ([Symbol])
ann2syms :: forall (a :: * -> *) l.
Annotated a =>
a (Scoped l) -> Either (Error l) [Symbol]
ann2syms a (Scoped l)
a =
  case a (Scoped l) -> Scoped l
forall l. a l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann a (Scoped l)
a of
    Scoped (ScopeError Error l
e) l
_ -> Error l -> Either (Error l) [Symbol]
forall a b. a -> Either a b
Left Error l
e
    Scoped (ImportPart [Symbol]
syms) l
_ -> [Symbol] -> Either (Error l) [Symbol]
forall a b. b -> Either a b
Right [Symbol]
syms
    Scoped l
_ -> Error l -> Either (Error l) [Symbol]
forall a b. a -> Either a b
Left (Error l -> Either (Error l) [Symbol])
-> Error l -> Either (Error l) [Symbol]
forall a b. (a -> b) -> a -> b
$ String -> Error l
forall l. String -> Error l
EInternal String
"ann2syms"

checkUnique
  :: Functor f =>
  Error l ->
  [Symbol] ->
  f l ->
  f (Scoped l)
checkUnique :: forall (f :: * -> *) l.
Functor f =>
Error l -> [Symbol] -> f l -> f (Scoped l)
checkUnique Error l
notFound [Symbol]
symbols f l
f =
  case [Symbol] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Symbol]
symbols of
    Int
0 -> Error l -> f l -> f (Scoped l)
forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError Error l
notFound f l
f
    Int
1 -> NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped ([Symbol] -> NameInfo l
forall l. [Symbol] -> NameInfo l
ImportPart [Symbol]
symbols) (l -> Scoped l) -> f l -> f (Scoped l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f l
f
    -- there should be no clashes, and it should be checked elsewhere
    Int
_ -> Error l -> f l -> f (Scoped l)
forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError (String -> Error l
forall l. String -> Error l
EInternal (String
"ambiguous import: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Symbol] -> String
forall a. Show a => a -> String
show [Symbol]
symbols)) f l
f