module Language.PureScript.Docs.Convert.ReExports
  ( updateReExports
  ) where

import Prelude

import Control.Arrow ((&&&), first, second)
import Control.Monad
import Control.Monad.Reader.Class (MonadReader, ask)
import Control.Monad.State.Class (MonadState, gets, modify)
import Control.Monad.Trans.Reader (runReaderT)
import Control.Monad.Trans.State.Strict (execState)

import Data.Either
import Data.Foldable (fold, traverse_)
import Data.Map (Map)
import Data.Maybe (mapMaybe)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T

import Language.PureScript.Docs.Types

import qualified Language.PureScript.AST as P
import qualified Language.PureScript.Crash as P
import qualified Language.PureScript.Errors as P
import qualified Language.PureScript.Externs as P
import qualified Language.PureScript.ModuleDependencies as P
import qualified Language.PureScript.Names as P
import qualified Language.PureScript.Types as P


-- |
-- Given:
--
--      * A list of externs files
--      * A function for tagging a module with the package it comes from
--      * A map of modules, indexed by their names, which are assumed to not
--      have their re-exports listed yet
--
-- This function adds all the missing re-exports.
--
updateReExports ::
  [P.ExternsFile] ->
  (P.ModuleName -> InPackage P.ModuleName) ->
  Map P.ModuleName Module ->
  Map P.ModuleName Module
updateReExports :: [ExternsFile]
-> (ModuleName -> InPackage ModuleName)
-> Map ModuleName Module
-> Map ModuleName Module
updateReExports [ExternsFile]
externs ModuleName -> InPackage ModuleName
withPackage = forall s a. State s a -> s -> s
execState StateT (Map ModuleName Module) Identity ()
action
  where
  action :: StateT (Map ModuleName Module) Identity ()
action =
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ModuleName -> StateT (Map ModuleName Module) Identity ()
go [ModuleName]
traversalOrder

  go :: ModuleName -> StateT (Map ModuleName Module) Identity ()
go ModuleName
mn = do
    Module
mdl <- forall {m :: * -> *} {b}.
MonadState (Map ModuleName b) m =>
ModuleName -> m b
lookup' ModuleName
mn
    [(ModuleName, [Declaration])]
reExports <- forall (m :: * -> *).
MonadState (Map ModuleName Module) m =>
Map ModuleName ExternsFile
-> ModuleName -> m [(ModuleName, [Declaration])]
getReExports Map ModuleName ExternsFile
externsEnv ModuleName
mn
    let mdl' :: Module
mdl' = Module
mdl { modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ModuleName -> InPackage ModuleName
withPackage) [(ModuleName, [Declaration])]
reExports }
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleName
mn Module
mdl')

  lookup' :: ModuleName -> m b
lookup' ModuleName
mn = do
    Maybe b
v <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn)
    case Maybe b
v of
      Just b
v' ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v'
      Maybe b
Nothing ->
        forall a. [Char] -> a
internalError ([Char]
"Module missing: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (ModuleName -> Text
P.runModuleName ModuleName
mn))

  externsEnv :: Map P.ModuleName P.ExternsFile
  externsEnv :: Map ModuleName ExternsFile
externsEnv = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ExternsFile -> ModuleName
P.efModuleName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [ExternsFile]
externs

  traversalOrder :: [P.ModuleName]
  traversalOrder :: [ModuleName]
traversalOrder =
    case forall (m :: * -> *) a.
MonadError MultipleErrors m =>
DependencyDepth
-> (a -> ModuleSignature) -> [a] -> m ([a], ModuleGraph)
P.sortModules DependencyDepth
P.Transitive ExternsFile -> ModuleSignature
externsSignature [ExternsFile]
externs of
      Right ([ExternsFile]
es, ModuleGraph
_) -> forall a b. (a -> b) -> [a] -> [b]
map ExternsFile -> ModuleName
P.efModuleName [ExternsFile]
es
      Left MultipleErrors
errs -> forall a. [Char] -> a
internalError forall a b. (a -> b) -> a -> b
$
        [Char]
"failed to sortModules: " forall a. [a] -> [a] -> [a]
++
        PPEOptions -> MultipleErrors -> [Char]
P.prettyPrintMultipleErrors PPEOptions
P.defaultPPEOptions MultipleErrors
errs

  externsSignature :: P.ExternsFile -> P.ModuleSignature
  externsSignature :: ExternsFile -> ModuleSignature
externsSignature ExternsFile
ef =
    P.ModuleSignature
      { sigSourceSpan :: SourceSpan
P.sigSourceSpan = ExternsFile -> SourceSpan
P.efSourceSpan ExternsFile
ef
      , sigModuleName :: ModuleName
P.sigModuleName = ExternsFile -> ModuleName
P.efModuleName ExternsFile
ef
      , sigImports :: [(ModuleName, SourceSpan)]
P.sigImports = forall a b. (a -> b) -> [a] -> [b]
map (\ExternsImport
ei -> (ExternsImport -> ModuleName
P.eiModule ExternsImport
ei, SourceSpan
P.nullSourceSpan)) (ExternsFile -> [ExternsImport]
P.efImports ExternsFile
ef)
      }

-- |
-- Collect all of the re-exported declarations for a single module.
--
-- We require that modules have already been sorted (P.sortModules) in order to
-- ensure that by the time we convert a particular module, all its dependencies
-- have already been converted.
--
getReExports ::
  (MonadState (Map P.ModuleName Module) m) =>
  Map P.ModuleName P.ExternsFile ->
  P.ModuleName ->
  m [(P.ModuleName, [Declaration])]
getReExports :: forall (m :: * -> *).
MonadState (Map ModuleName Module) m =>
Map ModuleName ExternsFile
-> ModuleName -> m [(ModuleName, [Declaration])]
getReExports Map ModuleName ExternsFile
externsEnv ModuleName
mn =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn Map ModuleName ExternsFile
externsEnv of
    Maybe ExternsFile
Nothing ->
      forall a. [Char] -> a
internalError ([Char]
"Module missing: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (ModuleName -> Text
P.runModuleName ModuleName
mn))
    Just P.ExternsFile { efExports :: ExternsFile -> [DeclarationRef]
P.efExports = [DeclarationRef]
refs } -> do
      let reExpRefs :: [(ExportSource, DeclarationRef)]
reExpRefs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe (ExportSource, DeclarationRef)
toReExportRef [DeclarationRef]
refs
      forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[(ExportSource, DeclarationRef)] -> m [(ModuleName, [Declaration])]
collectDeclarations [(ExportSource, DeclarationRef)]
reExpRefs) ModuleName
mn

toReExportRef :: P.DeclarationRef -> Maybe (P.ExportSource, P.DeclarationRef)
toReExportRef :: DeclarationRef -> Maybe (ExportSource, DeclarationRef)
toReExportRef (P.ReExportRef SourceSpan
_ ExportSource
source DeclarationRef
ref) = forall a. a -> Maybe a
Just (ExportSource
source, DeclarationRef
ref)
toReExportRef DeclarationRef
_ = forall a. Maybe a
Nothing

-- |
-- Assemble a list of declarations re-exported from a particular module, based
-- on the Imports and Exports value for that module, and by extracting the
-- declarations from the current state.
--
-- This function works by searching through the lists of exported declarations
-- in the Exports, and looking them up in the associated Imports value to find
-- the module they were imported from.
--
-- Additionally:
--
--      * Attempts to move re-exported type class members under their parent
--      type classes, if possible, or otherwise, "promote" them from
--      ChildDeclarations to proper Declarations.
--      * Filters data declarations to ensure that only re-exported data
--      constructors are listed.
--      * Filters type class declarations to ensure that only re-exported type
--      class members are listed.
--
collectDeclarations :: forall m.
  (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m) =>
  [(P.ExportSource, P.DeclarationRef)] ->
  m [(P.ModuleName, [Declaration])]
collectDeclarations :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[(ExportSource, DeclarationRef)] -> m [(ModuleName, [Declaration])]
collectDeclarations [(ExportSource, DeclarationRef)]
reExports = do
  Map
  ModuleName
  [Either (Text, Constraint', ChildDeclaration) Declaration]
valsAndMembers <- forall a b.
(ModuleName -> a -> m (ModuleName, [b]))
-> Map a ExportSource -> m (Map ModuleName [b])
collect forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName
-> Ident
-> m (ModuleName,
      [Either (Text, Constraint', ChildDeclaration) Declaration])
lookupValueDeclaration Map Ident ExportSource
expVals
  Map ModuleName [Declaration]
valOps <- forall a b.
(ModuleName -> a -> m (ModuleName, [b]))
-> Map a ExportSource -> m (Map ModuleName [b])
collect forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName -> OpName 'ValueOpName -> m (ModuleName, [Declaration])
lookupValueOpDeclaration Map (OpName 'ValueOpName) ExportSource
expValOps
  Map ModuleName [Declaration]
typeClasses <- forall a b.
(ModuleName -> a -> m (ModuleName, [b]))
-> Map a ExportSource -> m (Map ModuleName [b])
collect forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName
-> ProperName 'ClassName -> m (ModuleName, [Declaration])
lookupTypeClassDeclaration Map (ProperName 'ClassName) ExportSource
expTCs
  Map ModuleName [Declaration]
types <- forall a b.
(ModuleName -> a -> m (ModuleName, [b]))
-> Map a ExportSource -> m (Map ModuleName [b])
collect forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName -> ProperName 'TypeName -> m (ModuleName, [Declaration])
lookupTypeDeclaration Map (ProperName 'TypeName) ExportSource
expTypes
  Map ModuleName [Declaration]
typeOps <- forall a b.
(ModuleName -> a -> m (ModuleName, [b]))
-> Map a ExportSource -> m (Map ModuleName [b])
collect forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName -> OpName 'TypeOpName -> m (ModuleName, [Declaration])
lookupTypeOpDeclaration Map (OpName 'TypeOpName) ExportSource
expTypeOps

  (Map ModuleName [Declaration]
vals, Map ModuleName [Declaration]
classes) <- forall (m :: * -> *).
MonadReader ModuleName m =>
Map
  ModuleName
  [Either (Text, Constraint', ChildDeclaration) Declaration]
-> Map ModuleName [Declaration]
-> m (Map ModuleName [Declaration], Map ModuleName [Declaration])
handleTypeClassMembers Map
  ModuleName
  [Either (Text, Constraint', ChildDeclaration) Declaration]
valsAndMembers Map ModuleName [Declaration]
typeClasses

  let filteredTypes :: Map ModuleName [Declaration]
filteredTypes = [ProperName 'ConstructorName]
-> Map ModuleName [Declaration] -> Map ModuleName [Declaration]
filterDataConstructors [ProperName 'ConstructorName]
expCtors Map ModuleName [Declaration]
types
  let filteredClasses :: Map ModuleName [Declaration]
filteredClasses = [Ident]
-> Map ModuleName [Declaration] -> Map ModuleName [Declaration]
filterTypeClassMembers (forall k a. Map k a -> [k]
Map.keys Map Ident ExportSource
expVals) Map ModuleName [Declaration]
classes

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Map k a -> [(k, a)]
Map.toList (forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith forall a. Semigroup a => a -> a -> a
(<>) [Map ModuleName [Declaration]
filteredTypes, Map ModuleName [Declaration]
filteredClasses, Map ModuleName [Declaration]
vals, Map ModuleName [Declaration]
valOps, Map ModuleName [Declaration]
typeOps]))

  where

  collect
    :: (P.ModuleName -> a -> m (P.ModuleName, [b]))
    -> Map a P.ExportSource
    -> m (Map P.ModuleName [b])
  collect :: forall a b.
(ModuleName -> a -> m (ModuleName, [b]))
-> Map a ExportSource -> m (Map ModuleName [b])
collect ModuleName -> a -> m (ModuleName, [b])
lookup' Map a ExportSource
exps = do
    let reExps :: [(a, ModuleName)]
reExps = forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe ExportSource -> Maybe ModuleName
P.exportSourceImportedFrom Map a ExportSource
exps
    [(ModuleName, [b])]
decls <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip ModuleName -> a -> m (ModuleName, [b])
lookup')) [(a, ModuleName)]
reExps
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Semigroup a => a -> a -> a
(<>) [(ModuleName, [b])]
decls

  expVals :: Map P.Ident P.ExportSource
  expVals :: Map Ident ExportSource
expVals = forall name.
Ord name =>
(DeclarationRef -> Maybe name) -> Map name ExportSource
mkExportMap DeclarationRef -> Maybe Ident
P.getValueRef

  expValOps :: Map (P.OpName 'P.ValueOpName) P.ExportSource
  expValOps :: Map (OpName 'ValueOpName) ExportSource
expValOps = forall name.
Ord name =>
(DeclarationRef -> Maybe name) -> Map name ExportSource
mkExportMap DeclarationRef -> Maybe (OpName 'ValueOpName)
P.getValueOpRef

  expTCs :: Map (P.ProperName 'P.ClassName) P.ExportSource
  expTCs :: Map (ProperName 'ClassName) ExportSource
expTCs = forall name.
Ord name =>
(DeclarationRef -> Maybe name) -> Map name ExportSource
mkExportMap DeclarationRef -> Maybe (ProperName 'ClassName)
P.getTypeClassRef

  expTypes :: Map (P.ProperName 'P.TypeName) P.ExportSource
  expTypes :: Map (ProperName 'TypeName) ExportSource
expTypes = forall name.
Ord name =>
(DeclarationRef -> Maybe name) -> Map name ExportSource
mkExportMap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclarationRef
-> Maybe
     (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
P.getTypeRef)

  expTypeOps :: Map (P.OpName 'P.TypeOpName) P.ExportSource
  expTypeOps :: Map (OpName 'TypeOpName) ExportSource
expTypeOps = forall name.
Ord name =>
(DeclarationRef -> Maybe name) -> Map name ExportSource
mkExportMap DeclarationRef -> Maybe (OpName 'TypeOpName)
P.getTypeOpRef

  mkExportMap :: Ord name => (P.DeclarationRef -> Maybe name) -> Map name P.ExportSource
  mkExportMap :: forall name.
Ord name =>
(DeclarationRef -> Maybe name) -> Map name ExportSource
mkExportMap DeclarationRef -> Maybe name
f =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(ExportSource
exportSrc, DeclarationRef
ref) -> (,ExportSource
exportSrc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DeclarationRef -> Maybe name
f DeclarationRef
ref) [(ExportSource, DeclarationRef)]
reExports

  expCtors :: [P.ProperName 'P.ConstructorName]
  expCtors :: [ProperName 'ConstructorName]
expCtors = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a, b) -> b
snd forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DeclarationRef
-> Maybe
     (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
P.getTypeRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)) [(ExportSource, DeclarationRef)]
reExports

lookupValueDeclaration ::
  forall m.
  (MonadState (Map P.ModuleName Module) m,
   MonadReader P.ModuleName m) =>
  P.ModuleName ->
  P.Ident ->
  m (P.ModuleName, [Either (Text, Constraint', ChildDeclaration) Declaration])
lookupValueDeclaration :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName
-> Ident
-> m (ModuleName,
      [Either (Text, Constraint', ChildDeclaration) Declaration])
lookupValueDeclaration ModuleName
importedFrom Ident
ident = do
  [Declaration]
decls <- forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[Char] -> ModuleName -> m [Declaration]
lookupModuleDeclarations [Char]
"lookupValueDeclaration" ModuleName
importedFrom
  let
    rs :: [Declaration]
rs =
      forall a. (a -> Bool) -> [a] -> [a]
filter (\Declaration
d -> Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== Ident -> Text
P.showIdent Ident
ident
                    Bool -> Bool -> Bool
&& (Declaration -> Bool
isValue Declaration
d Bool -> Bool -> Bool
|| Declaration -> Bool
isValueAlias Declaration
d)) [Declaration]
decls
    errOther :: Show a => a -> m b
    errOther :: forall a b. Show a => a -> m b
errOther a
other =
      forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
        ([Char]
"lookupValueDeclaration: unexpected result:\n" forall a. [a] -> [a] -> [a]
++
          [Char]
"other: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
other forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
          [Char]
"ident: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Ident
ident forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
          [Char]
"decls: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Declaration]
decls)

  case [Declaration]
rs of
    [Declaration
r] ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [forall a b. b -> Either a b
Right Declaration
r])
    [] ->
      -- It's a type class member.
      -- Note that we need to filter based on the child declaration info using
      -- `isTypeClassMember` anyway, because child declarations of type classes
      -- are not necessarily members; they could also be instances.
      let
        allTypeClassChildDecls :: [(Text, Constraint', ChildDeclaration)]
allTypeClassChildDecls =
          [Declaration]
decls
           forall a b. a -> (a -> b) -> b
|> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Declaration
d -> (Declaration
d,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declaration -> Maybe Constraint'
typeClassConstraintFor Declaration
d)
           forall a b. a -> (a -> b) -> b
|> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Declaration
d, Constraint'
constr) ->
                forall a b. (a -> b) -> [a] -> [b]
map (Declaration -> Text
declTitle Declaration
d, Constraint'
constr,)
                    (Declaration -> [ChildDeclaration]
declChildren Declaration
d))

        matchesIdent :: ChildDeclaration -> Bool
matchesIdent ChildDeclaration
cdecl =
          ChildDeclaration -> Text
cdeclTitle ChildDeclaration
cdecl forall a. Eq a => a -> a -> Bool
== Ident -> Text
P.showIdent Ident
ident

        matchesAndIsTypeClassMember :: ChildDeclaration -> Bool
matchesAndIsTypeClassMember =
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(&&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChildDeclaration -> Bool
matchesIdent forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ChildDeclaration -> Bool
isTypeClassMember)

      in
        case forall a. (a -> Bool) -> [a] -> [a]
filter (ChildDeclaration -> Bool
matchesAndIsTypeClassMember forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a, b, c) -> c
thd) [(Text, Constraint', ChildDeclaration)]
allTypeClassChildDecls of
          [(Text, Constraint', ChildDeclaration)
r'] ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [forall a b. a -> Either a b
Left (Text, Constraint', ChildDeclaration)
r'])
          [(Text, Constraint', ChildDeclaration)]
other ->
            forall a b. Show a => a -> m b
errOther [(Text, Constraint', ChildDeclaration)]
other
    [Declaration]
other -> forall a b. Show a => a -> m b
errOther [Declaration]
other

  where
  thd :: (a, b, c) -> c
  thd :: forall a b c. (a, b, c) -> c
thd (a
_, b
_, c
x) = c
x

lookupValueOpDeclaration
  :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)
  => P.ModuleName
  -> P.OpName 'P.ValueOpName
  -> m (P.ModuleName, [Declaration])
lookupValueOpDeclaration :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName -> OpName 'ValueOpName -> m (ModuleName, [Declaration])
lookupValueOpDeclaration ModuleName
importedFrom OpName 'ValueOpName
op = do
  [Declaration]
decls <- forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[Char] -> ModuleName -> m [Declaration]
lookupModuleDeclarations [Char]
"lookupValueOpDeclaration" ModuleName
importedFrom
  case forall a. (a -> Bool) -> [a] -> [a]
filter (\Declaration
d -> Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== forall (a :: OpNameType). OpName a -> Text
P.showOp OpName 'ValueOpName
op Bool -> Bool -> Bool
&& Declaration -> Bool
isValueAlias Declaration
d) [Declaration]
decls of
    [Declaration
d] ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [Declaration
d])
    [Declaration]
other ->
      forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
        ([Char]
"lookupValueOpDeclaration: unexpected result for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Declaration]
other)

-- |
-- Extract a particular type declaration. For data declarations, constructors
-- are only included in the output if they are listed in the arguments.
--
lookupTypeDeclaration ::
  (MonadState (Map P.ModuleName Module) m,
   MonadReader P.ModuleName m) =>
  P.ModuleName ->
  P.ProperName 'P.TypeName ->
  m (P.ModuleName, [Declaration])
lookupTypeDeclaration :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName -> ProperName 'TypeName -> m (ModuleName, [Declaration])
lookupTypeDeclaration ModuleName
importedFrom ProperName 'TypeName
ty = do
  [Declaration]
decls <- forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[Char] -> ModuleName -> m [Declaration]
lookupModuleDeclarations [Char]
"lookupTypeDeclaration" ModuleName
importedFrom
  let
    ds :: [Declaration]
ds = forall a. (a -> Bool) -> [a] -> [a]
filter (\Declaration
d -> Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
ty Bool -> Bool -> Bool
&& Declaration -> Bool
isType Declaration
d) [Declaration]
decls
  case [Declaration]
ds of
    [Declaration
d] ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [Declaration
d])
    [] | ModuleName -> Bool
P.isBuiltinModuleName ModuleName
importedFrom ->
      -- Type classes in builtin modules (i.e. submodules of Prim) also have
      -- corresponding pseudo-types in the primEnv, but since these are an
      -- implementation detail they do not exist in the Modules, and hence in
      -- this case, `ds` will be empty.
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [])
    [Declaration]
other ->
      forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
        ([Char]
"lookupTypeDeclaration: unexpected result for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ProperName 'TypeName
ty forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Declaration]
other)

lookupTypeOpDeclaration
  :: (MonadState (Map P.ModuleName Module) m,MonadReader P.ModuleName m)
  => P.ModuleName
  -> P.OpName 'P.TypeOpName
  -> m (P.ModuleName, [Declaration])
lookupTypeOpDeclaration :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName -> OpName 'TypeOpName -> m (ModuleName, [Declaration])
lookupTypeOpDeclaration ModuleName
importedFrom OpName 'TypeOpName
tyOp = do
  [Declaration]
decls <- forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[Char] -> ModuleName -> m [Declaration]
lookupModuleDeclarations [Char]
"lookupTypeOpDeclaration" ModuleName
importedFrom
  let
    ds :: [Declaration]
ds = forall a. (a -> Bool) -> [a] -> [a]
filter (\Declaration
d -> Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== (Text
"type " forall a. Semigroup a => a -> a -> a
<> forall (a :: OpNameType). OpName a -> Text
P.showOp OpName 'TypeOpName
tyOp) Bool -> Bool -> Bool
&& Declaration -> Bool
isTypeAlias Declaration
d) [Declaration]
decls
  case [Declaration]
ds of
    [Declaration
d] ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [Declaration
d])
    [Declaration]
other ->
      forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
        ([Char]
"lookupTypeOpDeclaration: unexpected result: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Declaration]
other)

lookupTypeClassDeclaration
  :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)
  => P.ModuleName
  -> P.ProperName 'P.ClassName
  -> m (P.ModuleName, [Declaration])
lookupTypeClassDeclaration :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
ModuleName
-> ProperName 'ClassName -> m (ModuleName, [Declaration])
lookupTypeClassDeclaration ModuleName
importedFrom ProperName 'ClassName
tyClass = do
  [Declaration]
decls <- forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[Char] -> ModuleName -> m [Declaration]
lookupModuleDeclarations [Char]
"lookupTypeClassDeclaration" ModuleName
importedFrom
  let
    ds :: [Declaration]
ds = forall a. (a -> Bool) -> [a] -> [a]
filter (\Declaration
d -> Declaration -> Text
declTitle Declaration
d forall a. Eq a => a -> a -> Bool
== forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'ClassName
tyClass
                       Bool -> Bool -> Bool
&& Declaration -> Bool
isTypeClass Declaration
d)
                [Declaration]
decls
  case [Declaration]
ds of
    [Declaration
d] ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
importedFrom, [Declaration
d])
    [Declaration]
other ->
      forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
        ([Char]
"lookupTypeClassDeclaration: unexpected result for "
         forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ProperName 'ClassName
tyClass forall a. [a] -> [a] -> [a]
++ [Char]
": "
         forall a. [a] -> [a] -> [a]
++ ([[Char]] -> [Char]
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show) [Declaration]
other)

-- |
-- Get the full list of declarations for a particular module out of the
-- state, or raise an internal error if it is not there.
--
lookupModuleDeclarations ::
  (MonadState (Map P.ModuleName Module) m,
   MonadReader P.ModuleName m) =>
  String ->
  P.ModuleName ->
  m [Declaration]
lookupModuleDeclarations :: forall (m :: * -> *).
(MonadState (Map ModuleName Module) m, MonadReader ModuleName m) =>
[Char] -> ModuleName -> m [Declaration]
lookupModuleDeclarations [Char]
definedIn ModuleName
moduleName = do
  Maybe Module
mmdl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
moduleName)
  case Maybe Module
mmdl of
    Maybe Module
Nothing ->
      forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
        ([Char]
definedIn forall a. [a] -> [a] -> [a]
++ [Char]
": module missing: "
         forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (ModuleName -> Text
P.runModuleName ModuleName
moduleName))
    Just Module
mdl ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Module -> [Declaration]
allDeclarations Module
mdl)

handleTypeClassMembers ::
  (MonadReader P.ModuleName m) =>
  Map P.ModuleName [Either (Text, Constraint', ChildDeclaration) Declaration] ->
  Map P.ModuleName [Declaration] ->
  m (Map P.ModuleName [Declaration], Map P.ModuleName [Declaration])
handleTypeClassMembers :: forall (m :: * -> *).
MonadReader ModuleName m =>
Map
  ModuleName
  [Either (Text, Constraint', ChildDeclaration) Declaration]
-> Map ModuleName [Declaration]
-> m (Map ModuleName [Declaration], Map ModuleName [Declaration])
handleTypeClassMembers Map
  ModuleName
  [Either (Text, Constraint', ChildDeclaration) Declaration]
valsAndMembers Map ModuleName [Declaration]
typeClasses =
  let
    moduleEnvs :: Map ModuleName TypeClassEnv
moduleEnvs =
      forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>)
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Text, Constraint', ChildDeclaration) Declaration]
-> TypeClassEnv
valsAndMembersToEnv Map
  ModuleName
  [Either (Text, Constraint', ChildDeclaration) Declaration]
valsAndMembers)
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Declaration] -> TypeClassEnv
typeClassesToEnv Map ModuleName [Declaration]
typeClasses)
  in
    Map ModuleName TypeClassEnv
moduleEnvs
      forall a b. a -> (a -> b) -> b
|> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *).
MonadReader ModuleName m =>
TypeClassEnv -> m ([Declaration], [Declaration])
handleEnv
      forall a b. a -> (a -> b) -> b
|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v1 v2. Map k (v1, v2) -> (Map k v1, Map k v2)
splitMap

valsAndMembersToEnv ::
  [Either (Text, Constraint', ChildDeclaration) Declaration] -> TypeClassEnv
valsAndMembersToEnv :: [Either (Text, Constraint', ChildDeclaration) Declaration]
-> TypeClassEnv
valsAndMembersToEnv [Either (Text, Constraint', ChildDeclaration) Declaration]
xs =
  let ([(Text, Constraint', ChildDeclaration)]
envUnhandledMembers, [Declaration]
envValues) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (Text, Constraint', ChildDeclaration) Declaration]
xs
      envTypeClasses :: [a]
envTypeClasses = []
  in TypeClassEnv{[(Text, Constraint', ChildDeclaration)]
[Declaration]
forall a. [a]
envTypeClasses :: [Declaration]
envValues :: [Declaration]
envUnhandledMembers :: [(Text, Constraint', ChildDeclaration)]
envTypeClasses :: forall a. [a]
envValues :: [Declaration]
envUnhandledMembers :: [(Text, Constraint', ChildDeclaration)]
..}

typeClassesToEnv :: [Declaration] -> TypeClassEnv
typeClassesToEnv :: [Declaration] -> TypeClassEnv
typeClassesToEnv [Declaration]
classes =
  TypeClassEnv
    { envUnhandledMembers :: [(Text, Constraint', ChildDeclaration)]
envUnhandledMembers = []
    , envValues :: [Declaration]
envValues = []
    , envTypeClasses :: [Declaration]
envTypeClasses = [Declaration]
classes
    }

-- |
-- An intermediate data type, used for either moving type class members under
-- their parent type classes, or promoting them to normal Declaration values
-- if their parent type class has not been re-exported.
--
data TypeClassEnv = TypeClassEnv
  { -- |
    -- Type class members which have not yet been dealt with. The Text is the
    -- name of the type class they belong to, and the constraint is used to
    -- make sure that they have the correct type if they get promoted.
    --
    TypeClassEnv -> [(Text, Constraint', ChildDeclaration)]
envUnhandledMembers :: [(Text, Constraint', ChildDeclaration)]
    -- |
    -- A list of normal value declarations. Type class members will be added to
    -- this list if their parent type class is not available.
    --
  , TypeClassEnv -> [Declaration]
envValues :: [Declaration]
    -- |
    -- A list of type class declarations. Type class members will be added to
    -- their parents in this list, if they exist.
    --
  , TypeClassEnv -> [Declaration]
envTypeClasses :: [Declaration]
  }
  deriving (Int -> TypeClassEnv -> ShowS
[TypeClassEnv] -> ShowS
TypeClassEnv -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TypeClassEnv] -> ShowS
$cshowList :: [TypeClassEnv] -> ShowS
show :: TypeClassEnv -> [Char]
$cshow :: TypeClassEnv -> [Char]
showsPrec :: Int -> TypeClassEnv -> ShowS
$cshowsPrec :: Int -> TypeClassEnv -> ShowS
Show)

instance Semigroup TypeClassEnv where
  (TypeClassEnv [(Text, Constraint', ChildDeclaration)]
a1 [Declaration]
b1 [Declaration]
c1) <> :: TypeClassEnv -> TypeClassEnv -> TypeClassEnv
<> (TypeClassEnv [(Text, Constraint', ChildDeclaration)]
a2 [Declaration]
b2 [Declaration]
c2) =
    [(Text, Constraint', ChildDeclaration)]
-> [Declaration] -> [Declaration] -> TypeClassEnv
TypeClassEnv ([(Text, Constraint', ChildDeclaration)]
a1 forall a. Semigroup a => a -> a -> a
<> [(Text, Constraint', ChildDeclaration)]
a2) ([Declaration]
b1 forall a. Semigroup a => a -> a -> a
<> [Declaration]
b2) ([Declaration]
c1 forall a. Semigroup a => a -> a -> a
<> [Declaration]
c2)

instance Monoid TypeClassEnv where
  mempty :: TypeClassEnv
mempty =
    [(Text, Constraint', ChildDeclaration)]
-> [Declaration] -> [Declaration] -> TypeClassEnv
TypeClassEnv forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- |
-- Take a TypeClassEnv and handle all of the type class members in it, either
-- adding them to their parent classes, or promoting them to normal Declaration
-- values.
--
-- Returns a tuple of (values, type classes).
--
handleEnv
  :: (MonadReader P.ModuleName m)
  => TypeClassEnv
  -> m ([Declaration], [Declaration])
handleEnv :: forall (m :: * -> *).
MonadReader ModuleName m =>
TypeClassEnv -> m ([Declaration], [Declaration])
handleEnv TypeClassEnv{[(Text, Constraint', ChildDeclaration)]
[Declaration]
envTypeClasses :: [Declaration]
envValues :: [Declaration]
envUnhandledMembers :: [(Text, Constraint', ChildDeclaration)]
envTypeClasses :: TypeClassEnv -> [Declaration]
envValues :: TypeClassEnv -> [Declaration]
envUnhandledMembers :: TypeClassEnv -> [(Text, Constraint', ChildDeclaration)]
..} =
  [(Text, Constraint', ChildDeclaration)]
envUnhandledMembers
    forall a b. a -> (a -> b) -> b
|> forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {k} {f :: * -> *} {a}.
(Ord k, MonadReader ModuleName f) =>
([Declaration], Map k a)
-> (k, Constraint', ChildDeclaration) -> f ([Declaration], Map k a)
go ([Declaration]
envValues, [Declaration] -> Map Text Declaration
mkMap [Declaration]
envTypeClasses)
    forall a b. a -> (a -> b) -> b
|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall k a. Map k a -> [a]
Map.elems)

  where
  mkMap :: [Declaration] -> Map Text Declaration
mkMap =
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Declaration -> Text
declTitle forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)

  go :: ([Declaration], Map k a)
-> (k, Constraint', ChildDeclaration) -> f ([Declaration], Map k a)
go ([Declaration]
values, Map k a
tcs) (k
title, Constraint'
constraint, ChildDeclaration
childDecl) =
    case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
title Map k a
tcs of
      Just a
_ ->
        -- Leave the state unchanged; if the type class is there, the child
        -- will be too.
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Declaration]
values, Map k a
tcs)
      Maybe a
Nothing -> do
        Declaration
c <- forall {f :: * -> *}.
MonadReader ModuleName f =>
Constraint' -> ChildDeclaration -> f Declaration
promoteChild Constraint'
constraint ChildDeclaration
childDecl
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Declaration
c forall a. a -> [a] -> [a]
: [Declaration]
values, Map k a
tcs)

  promoteChild :: Constraint' -> ChildDeclaration -> f Declaration
promoteChild Constraint'
constraint ChildDeclaration{Maybe Text
Maybe SourceSpan
Text
ChildDeclarationInfo
cdeclInfo :: ChildDeclaration -> ChildDeclarationInfo
cdeclSourceSpan :: ChildDeclaration -> Maybe SourceSpan
cdeclComments :: ChildDeclaration -> Maybe Text
cdeclInfo :: ChildDeclarationInfo
cdeclSourceSpan :: Maybe SourceSpan
cdeclComments :: Maybe Text
cdeclTitle :: Text
cdeclTitle :: ChildDeclaration -> Text
..} =
    case ChildDeclarationInfo
cdeclInfo of
      ChildTypeClassMember Type'
typ ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Declaration
          { declTitle :: Text
declTitle      = Text
cdeclTitle
          , declComments :: Maybe Text
declComments   = Maybe Text
cdeclComments
          , declSourceSpan :: Maybe SourceSpan
declSourceSpan = Maybe SourceSpan
cdeclSourceSpan
          , declChildren :: [ChildDeclaration]
declChildren   = []
          , declInfo :: DeclarationInfo
declInfo       = Type' -> DeclarationInfo
ValueDeclaration (Constraint' -> Type' -> Type'
addConstraint Constraint'
constraint Type'
typ)
          , declKind :: Maybe KindInfo
declKind       = forall a. Maybe a
Nothing
          }
      ChildDeclarationInfo
_ ->
        forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule
          ([Char]
"handleEnv: Bad child declaration passed to promoteChild: "
          forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
cdeclTitle)

  addConstraint :: Constraint' -> Type' -> Type'
addConstraint Constraint'
constraint =
    forall a. Type a -> Type a
P.quantify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Type a -> Type a
P.moveQuantifiersToFront forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Constraint a -> Type a -> Type a
P.ConstrainedType () Constraint'
constraint

splitMap :: Map k (v1, v2) -> (Map k v1, Map k v2)
splitMap :: forall k v1 v2. Map k (v1, v2) -> (Map k v1, Map k v2)
splitMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd

-- |
-- Given a list of exported constructor names, remove any data constructor
-- names in the provided Map of declarations which are not in the list.
--
filterDataConstructors
  :: [P.ProperName 'P.ConstructorName]
  -> Map P.ModuleName [Declaration]
  -> Map P.ModuleName [Declaration]
filterDataConstructors :: [ProperName 'ConstructorName]
-> Map ModuleName [Declaration] -> Map ModuleName [Declaration]
filterDataConstructors =
  forall (f :: * -> *) name.
Functor f =>
(ChildDeclaration -> Bool)
-> (name -> Text) -> [name] -> f [Declaration] -> f [Declaration]
filterExportedChildren ChildDeclaration -> Bool
isDataConstructor forall (a :: ProperNameType). ProperName a -> Text
P.runProperName

-- |
-- Given a list of exported type class member names, remove any data
-- type class member names in the provided Map of declarations which are not in
-- the list.
--
filterTypeClassMembers
  :: [P.Ident]
  -> Map P.ModuleName [Declaration]
  -> Map P.ModuleName [Declaration]
filterTypeClassMembers :: [Ident]
-> Map ModuleName [Declaration] -> Map ModuleName [Declaration]
filterTypeClassMembers =
  forall (f :: * -> *) name.
Functor f =>
(ChildDeclaration -> Bool)
-> (name -> Text) -> [name] -> f [Declaration] -> f [Declaration]
filterExportedChildren ChildDeclaration -> Bool
isTypeClassMember Ident -> Text
P.showIdent

filterExportedChildren
  :: (Functor f)
  => (ChildDeclaration -> Bool)
  -> (name -> Text)
  -> [name]
  -> f [Declaration]
  -> f [Declaration]
filterExportedChildren :: forall (f :: * -> *) name.
Functor f =>
(ChildDeclaration -> Bool)
-> (name -> Text) -> [name] -> f [Declaration] -> f [Declaration]
filterExportedChildren ChildDeclaration -> Bool
isTargetedKind name -> Text
runName [name]
expNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Declaration] -> [Declaration]
filterDecls
  where
  filterDecls :: [Declaration] -> [Declaration]
filterDecls =
    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ (ChildDeclaration -> Bool) -> Declaration -> Declaration
filterChildren forall a b. (a -> b) -> a -> b
$ \ChildDeclaration
c ->
      Bool -> Bool
not (ChildDeclaration -> Bool
isTargetedKind ChildDeclaration
c) Bool -> Bool -> Bool
|| ChildDeclaration -> Text
cdeclTitle ChildDeclaration
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
expNames'
  expNames' :: [Text]
expNames' = forall a b. (a -> b) -> [a] -> [b]
map name -> Text
runName [name]
expNames

allDeclarations :: Module -> [Declaration]
allDeclarations :: Module -> [Declaration]
allDeclarations Module{[(InPackage ModuleName, [Declaration])]
[Declaration]
Maybe Text
ModuleName
modDeclarations :: Module -> [Declaration]
modComments :: Module -> Maybe Text
modName :: Module -> ModuleName
modReExports :: [(InPackage ModuleName, [Declaration])]
modDeclarations :: [Declaration]
modComments :: Maybe Text
modName :: ModuleName
modReExports :: Module -> [(InPackage ModuleName, [Declaration])]
..} =
  [Declaration]
modDeclarations forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(InPackage ModuleName, [Declaration])]
modReExports

(|>) :: a -> (a -> b) -> b
a
x |> :: forall a b. a -> (a -> b) -> b
|> a -> b
f = a -> b
f a
x

internalError :: String -> a
internalError :: forall a. [Char] -> a
internalError = forall a. HasCallStack => [Char] -> a
P.internalError forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"Docs.Convert.ReExports: " forall a. [a] -> [a] -> [a]
++)

internalErrorInModule
  :: (MonadReader P.ModuleName m)
  => String
  -> m a
internalErrorInModule :: forall (m :: * -> *) a. MonadReader ModuleName m => [Char] -> m a
internalErrorInModule [Char]
msg = do
  ModuleName
mn <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall a. [Char] -> a
internalError
    ([Char]
"while collecting re-exports for module: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (ModuleName -> Text
P.runModuleName ModuleName
mn) forall a. [a] -> [a] -> [a]
++
     [Char]
", " forall a. [a] -> [a] -> [a]
++ [Char]
msg)

-- |
-- If the provided Declaration is a TypeClassDeclaration, construct an
-- appropriate Constraint for use with the types of its members.
--
typeClassConstraintFor :: Declaration -> Maybe Constraint'
typeClassConstraintFor :: Declaration -> Maybe Constraint'
typeClassConstraintFor Declaration{[ChildDeclaration]
Maybe Text
Maybe SourceSpan
Maybe KindInfo
Text
DeclarationInfo
declKind :: Maybe KindInfo
declInfo :: DeclarationInfo
declChildren :: [ChildDeclaration]
declSourceSpan :: Maybe SourceSpan
declComments :: Maybe Text
declTitle :: Text
declKind :: Declaration -> Maybe KindInfo
declInfo :: Declaration -> DeclarationInfo
declSourceSpan :: Declaration -> Maybe SourceSpan
declComments :: Declaration -> Maybe Text
declChildren :: Declaration -> [ChildDeclaration]
declTitle :: Declaration -> Text
..} =
  case DeclarationInfo
declInfo of
    TypeClassDeclaration [(Text, Maybe Type')]
tyArgs [Constraint']
_ [([Text], [Text])]
_ ->
      forall a. a -> Maybe a
Just (forall a.
a
-> Qualified (ProperName 'ClassName)
-> [Type a]
-> [Type a]
-> Maybe ConstraintData
-> Constraint a
P.Constraint () (forall a. QualifiedBy -> a -> Qualified a
P.Qualified QualifiedBy
P.ByNullSourcePos (forall (a :: ProperNameType). Text -> ProperName a
P.ProperName Text
declTitle)) [] (forall {b}. [(Text, b)] -> [Type']
mkConstraint [(Text, Maybe Type')]
tyArgs) forall a. Maybe a
Nothing)
    DeclarationInfo
_ ->
      forall a. Maybe a
Nothing
  where
  mkConstraint :: [(Text, b)] -> [Type']
mkConstraint = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Text -> Type a
P.TypeVar () forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)