{-# LANGUAGE CPP #-}
module Checks.ExportCheck (exportCheck, expandExports) where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad (unless)
import qualified Control.Monad.State as S (State, runState, gets, modify)
import Data.List (nub, union)
import qualified Data.Map as Map ( Map, elems, empty, insert
, insertWith, lookup, toList )
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set ( Set, empty, fromList, insert
, member, toList )
import Curry.Base.Ident
import Curry.Base.Position
import Curry.Base.SpanInfo
import Curry.Base.Pretty
import Curry.Syntax
import Base.Messages (Message, internalError, posMessage)
import Base.TopEnv (allEntities, origName, localBindings, moduleImports)
import Base.Types ( Type (..), unapplyType, arrowBase, PredType (..)
, DataConstr (..), constrIdent, recLabels
, ClassMethod, methodName
, TypeScheme (..) )
import Base.Utils (findMultiples)
import Env.ModuleAlias (AliasEnv)
import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTypeInfoUnique)
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValueUnique)
currentModuleName :: String
currentModuleName :: String
currentModuleName = "Checks.ExportCheck"
expandExports :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv
-> Maybe ExportSpec -> ExportSpec
expandExports :: ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> ExportSpec
expandExports m :: ModuleIdent
m aEnv :: AliasEnv
aEnv tcEnv :: TCEnv
tcEnv tyEnv :: ValueEnv
tyEnv spec :: Maybe ExportSpec
spec = SpanInfo -> [Export] -> ExportSpec
Exporting (Maybe ExportSpec -> SpanInfo
exportSpan Maybe ExportSpec
spec) [Export]
es
where
exportSpan :: Maybe ExportSpec -> SpanInfo
exportSpan (Just (Exporting spi :: SpanInfo
spi _)) = SpanInfo
spi
exportSpan Nothing = SpanInfo
NoSpanInfo
es :: [Export]
es = ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Export]
expand ModuleIdent
m AliasEnv
aEnv TCEnv
tcEnv ValueEnv
tyEnv Maybe ExportSpec
spec
exportCheck :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv
-> Maybe ExportSpec -> [Message]
exportCheck :: ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Message]
exportCheck m :: ModuleIdent
m aEnv :: AliasEnv
aEnv tcEnv :: TCEnv
tcEnv tyEnv :: ValueEnv
tyEnv spec :: Maybe ExportSpec
spec = case ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Message]
check ModuleIdent
m AliasEnv
aEnv TCEnv
tcEnv ValueEnv
tyEnv Maybe ExportSpec
spec of
[] -> [Export] -> [Message]
checkNonUniqueness ([Export] -> [Message]) -> [Export] -> [Message]
forall a b. (a -> b) -> a -> b
$ ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Export]
expand ModuleIdent
m AliasEnv
aEnv TCEnv
tcEnv ValueEnv
tyEnv Maybe ExportSpec
spec
ms :: [Message]
ms -> [Message]
ms
data ECState = ECState
{ ECState -> ModuleIdent
moduleIdent :: ModuleIdent
, ECState -> Set ModuleIdent
importedMods :: Set.Set ModuleIdent
, ECState -> TCEnv
tyConsEnv :: TCEnv
, ECState -> ValueEnv
valueEnv :: ValueEnv
, ECState -> [Message]
errors :: [Message]
}
type ECM a = S.State ECState a
runECM :: ECM a -> ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> (a, [Message])
runECM :: ECM a
-> ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> (a, [Message])
runECM ecm :: ECM a
ecm m :: ModuleIdent
m aEnv :: AliasEnv
aEnv tcEnv :: TCEnv
tcEnv tyEnv :: ValueEnv
tyEnv
= let (a :: a
a, s' :: ECState
s') = ECM a -> ECState -> (a, ECState)
forall s a. State s a -> s -> (a, s)
S.runState ECM a
ecm ECState
initState in (a
a, [Message] -> [Message]
forall a. [a] -> [a]
reverse ([Message] -> [Message]) -> [Message] -> [Message]
forall a b. (a -> b) -> a -> b
$ ECState -> [Message]
errors ECState
s')
where
initState :: ECState
initState = ModuleIdent
-> Set ModuleIdent -> TCEnv -> ValueEnv -> [Message] -> ECState
ECState ModuleIdent
m Set ModuleIdent
imported TCEnv
tcEnv ValueEnv
tyEnv []
imported :: Set ModuleIdent
imported = [ModuleIdent] -> Set ModuleIdent
forall a. Ord a => [a] -> Set a
Set.fromList (AliasEnv -> [ModuleIdent]
forall k a. Map k a -> [a]
Map.elems AliasEnv
aEnv)
getModuleIdent :: ECM ModuleIdent
getModuleIdent :: ECM ModuleIdent
getModuleIdent = (ECState -> ModuleIdent) -> ECM ModuleIdent
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ECState -> ModuleIdent
moduleIdent
getImportedModules :: ECM (Set.Set ModuleIdent)
getImportedModules :: ECM (Set ModuleIdent)
getImportedModules = (ECState -> Set ModuleIdent) -> ECM (Set ModuleIdent)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ECState -> Set ModuleIdent
importedMods
getTyConsEnv :: ECM TCEnv
getTyConsEnv :: ECM TCEnv
getTyConsEnv = (ECState -> TCEnv) -> ECM TCEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ECState -> TCEnv
tyConsEnv
getValueEnv :: ECM ValueEnv
getValueEnv :: ECM ValueEnv
getValueEnv = (ECState -> ValueEnv) -> ECM ValueEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ECState -> ValueEnv
valueEnv
report :: Message -> ECM ()
report :: Message -> ECM ()
report err :: Message
err = (ECState -> ECState) -> ECM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (\ s :: ECState
s -> ECState
s { errors :: [Message]
errors = Message
err Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: ECState -> [Message]
errors ECState
s })
ok :: ECM ()
ok :: ECM ()
ok = () -> ECM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
check :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec
-> [Message]
check :: ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Message]
check m :: ModuleIdent
m aEnv :: AliasEnv
aEnv tcEnv :: TCEnv
tcEnv tyEnv :: ValueEnv
tyEnv spec :: Maybe ExportSpec
spec = ((), [Message]) -> [Message]
forall a b. (a, b) -> b
snd (((), [Message]) -> [Message]) -> ((), [Message]) -> [Message]
forall a b. (a -> b) -> a -> b
$ ECM ()
-> ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> ((), [Message])
forall a.
ECM a
-> ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> (a, [Message])
runECM (Maybe ExportSpec -> ECM ()
checkSpec Maybe ExportSpec
spec) ModuleIdent
m AliasEnv
aEnv TCEnv
tcEnv ValueEnv
tyEnv
checkSpec :: Maybe ExportSpec -> ECM ()
checkSpec :: Maybe ExportSpec -> ECM ()
checkSpec (Just (Exporting _ es :: [Export]
es)) = (Export -> ECM ()) -> [Export] -> ECM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Export -> ECM ()
checkExport [Export]
es
checkSpec Nothing = ECM ()
ok
checkExport :: Export -> ECM ()
checkExport :: Export -> ECM ()
checkExport (Export _ x :: QualIdent
x ) = QualIdent -> ECM ()
checkThing QualIdent
x
checkExport (ExportTypeWith _ tc :: QualIdent
tc cs :: [Ident]
cs) = QualIdent -> [Ident] -> ECM ()
checkTypeWith QualIdent
tc [Ident]
cs
checkExport (ExportTypeAll _ tc :: QualIdent
tc ) = QualIdent -> ECM ()
checkTypeAll QualIdent
tc
checkExport (ExportModule _ em :: ModuleIdent
em ) = ModuleIdent -> ECM ()
checkModule ModuleIdent
em
checkThing :: QualIdent -> ECM ()
checkThing :: QualIdent -> ECM ()
checkThing tc :: QualIdent
tc = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
case ModuleIdent -> QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfoUnique ModuleIdent
m QualIdent
tc TCEnv
tcEnv of
[] -> QualIdent -> Maybe [Export] -> ECM ()
checkThing' QualIdent
tc Maybe [Export]
forall a. Maybe a
Nothing
[t :: TypeInfo
t] -> QualIdent -> Maybe [Export] -> ECM ()
checkThing' QualIdent
tc ([Export] -> Maybe [Export]
forall a. a -> Maybe a
Just [SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
NoSpanInfo (TypeInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName TypeInfo
t) []])
ts :: [TypeInfo]
ts -> Message -> ECM ()
report (QualIdent -> [TypeInfo] -> Message
errAmbiguousType QualIdent
tc [TypeInfo]
ts)
checkThing' :: QualIdent -> Maybe [Export] -> ECM ()
checkThing' :: QualIdent -> Maybe [Export] -> ECM ()
checkThing' f :: QualIdent
f tcExport :: Maybe [Export]
tcExport = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
ValueEnv
tyEnv <- ECM ValueEnv
getValueEnv
case ModuleIdent -> QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValueUnique ModuleIdent
m QualIdent
f ValueEnv
tyEnv of
[] -> (QualIdent -> Message) -> ECM ()
justTcOr QualIdent -> Message
errUndefinedName
[v :: ValueInfo
v] -> case ValueInfo
v of
Value _ _ _ _ -> ECM ()
ok
Label _ _ _ -> Message -> ECM ()
report (Message -> ECM ()) -> Message -> ECM ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> QualIdent -> Message
errOutsideTypeLabel QualIdent
f (ValueInfo -> QualIdent
getTc ValueInfo
v)
_ -> (QualIdent -> Message) -> ECM ()
justTcOr ((QualIdent -> Message) -> ECM ())
-> (QualIdent -> Message) -> ECM ()
forall a b. (a -> b) -> a -> b
$ (QualIdent -> QualIdent -> Message)
-> QualIdent -> QualIdent -> Message
forall a b c. (a -> b -> c) -> b -> a -> c
flip QualIdent -> QualIdent -> Message
errOutsideTypeConstructor (ValueInfo -> QualIdent
getTc ValueInfo
v)
fs :: [ValueInfo]
fs -> Message -> ECM ()
report (QualIdent -> [ValueInfo] -> Message
errAmbiguousName QualIdent
f [ValueInfo]
fs)
where
justTcOr :: (QualIdent -> Message) -> ECM ()
justTcOr errFun :: QualIdent -> Message
errFun = ECM () -> ([Export] -> ECM ()) -> Maybe [Export] -> ECM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Message -> ECM ()
report (Message -> ECM ()) -> Message -> ECM ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> Message
errFun QualIdent
f) (ECM () -> [Export] -> ECM ()
forall a b. a -> b -> a
const ECM ()
ok) Maybe [Export]
tcExport
getTc :: ValueInfo -> QualIdent
getTc (DataConstructor _ _ _ (ForAll _ (PredType _ ty :: Type
ty))) = Type -> QualIdent
getTc' Type
ty
getTc (NewtypeConstructor _ _ (ForAll _ (PredType _ ty :: Type
ty))) = Type -> QualIdent
getTc' Type
ty
getTc (Label _ _ (ForAll _ (PredType _ (TypeArrow tc' :: Type
tc' _)))) =
let (TypeConstructor tc :: QualIdent
tc, _) = Bool -> Type -> (Type, [Type])
unapplyType Bool
False Type
tc' in QualIdent
tc
getTc err :: ValueInfo
err = String -> QualIdent
forall a. String -> a
internalError (String -> QualIdent) -> String -> QualIdent
forall a b. (a -> b) -> a -> b
$ String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".checkThing'.getTc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ValueInfo -> String
forall a. Show a => a -> String
show ValueInfo
err
getTc' :: Type -> QualIdent
getTc' ty :: Type
ty = let (TypeConstructor tc :: QualIdent
tc) = Type -> Type
arrowBase Type
ty in QualIdent
tc
checkTypeWith :: QualIdent -> [Ident] -> ECM ()
checkTypeWith :: QualIdent -> [Ident] -> ECM ()
checkTypeWith tc :: QualIdent
tc xs :: [Ident]
xs = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
case ModuleIdent -> QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfoUnique ModuleIdent
m QualIdent
tc TCEnv
tcEnv of
[] -> Message -> ECM ()
report (QualIdent -> Message
errUndefinedTypeOrClass QualIdent
tc)
[DataType _ _ cs :: [DataConstr]
cs] ->
(Ident -> ECM ()) -> [Ident] -> ECM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((QualIdent -> Ident -> Message) -> [Ident] -> Ident -> ECM ()
forall (t :: * -> *) t.
(Foldable t, Eq t) =>
(QualIdent -> t -> Message) -> t t -> t -> ECM ()
checkElement QualIdent -> Ident -> Message
errUndefinedElement ([DataConstr] -> [Ident]
visibleElems [DataConstr]
cs )) [Ident]
xs'
[RenamingType _ _ c :: DataConstr
c] ->
(Ident -> ECM ()) -> [Ident] -> ECM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((QualIdent -> Ident -> Message) -> [Ident] -> Ident -> ECM ()
forall (t :: * -> *) t.
(Foldable t, Eq t) =>
(QualIdent -> t -> Message) -> t t -> t -> ECM ()
checkElement QualIdent -> Ident -> Message
errUndefinedElement ([DataConstr] -> [Ident]
visibleElems [DataConstr
c])) [Ident]
xs'
[TypeClass _ _ ms :: [ClassMethod]
ms] ->
(Ident -> ECM ()) -> [Ident] -> ECM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((QualIdent -> Ident -> Message) -> [Ident] -> Ident -> ECM ()
forall (t :: * -> *) t.
(Foldable t, Eq t) =>
(QualIdent -> t -> Message) -> t t -> t -> ECM ()
checkElement QualIdent -> Ident -> Message
errUndefinedMethod ([ClassMethod] -> [Ident]
visibleMethods [ClassMethod]
ms)) [Ident]
xs'
[_] -> Message -> ECM ()
report (QualIdent -> Message
errNonDataTypeOrTypeClass QualIdent
tc)
ts :: [TypeInfo]
ts -> Message -> ECM ()
report (QualIdent -> [TypeInfo] -> Message
errAmbiguousType QualIdent
tc [TypeInfo]
ts)
where
xs' :: [Ident]
xs' = [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub [Ident]
xs
checkElement :: (QualIdent -> t -> Message) -> t t -> t -> ECM ()
checkElement err :: QualIdent -> t -> Message
err cs' :: t t
cs' c :: t
c = Bool -> ECM () -> ECM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (t
c t -> t t -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t t
cs') (ECM () -> ECM ()) -> ECM () -> ECM ()
forall a b. (a -> b) -> a -> b
$ Message -> ECM ()
report (Message -> ECM ()) -> Message -> ECM ()
forall a b. (a -> b) -> a -> b
$ QualIdent -> t -> Message
err QualIdent
tc t
c
checkTypeAll :: QualIdent -> ECM ()
checkTypeAll :: QualIdent -> ECM ()
checkTypeAll tc :: QualIdent
tc = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
case ModuleIdent -> QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfoUnique ModuleIdent
m QualIdent
tc TCEnv
tcEnv of
[] -> Message -> ECM ()
report (QualIdent -> Message
errUndefinedTypeOrClass QualIdent
tc)
[DataType _ _ _] -> ECM ()
ok
[RenamingType _ _ _] -> ECM ()
ok
[TypeClass _ _ _] -> ECM ()
ok
[_] -> Message -> ECM ()
report (QualIdent -> Message
errNonDataTypeOrTypeClass QualIdent
tc)
ts :: [TypeInfo]
ts -> Message -> ECM ()
report (QualIdent -> [TypeInfo] -> Message
errAmbiguousType QualIdent
tc [TypeInfo]
ts)
checkModule :: ModuleIdent -> ECM ()
checkModule :: ModuleIdent -> ECM ()
checkModule em :: ModuleIdent
em = do
Bool
isLocal <- (ModuleIdent
em ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
==) (ModuleIdent -> Bool)
-> ECM ModuleIdent -> StateT ECState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ECM ModuleIdent
getModuleIdent
Bool
isForeign <- (ModuleIdent -> Set ModuleIdent -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ModuleIdent
em) (Set ModuleIdent -> Bool)
-> ECM (Set ModuleIdent) -> StateT ECState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ECM (Set ModuleIdent)
getImportedModules
Bool -> ECM () -> ECM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
isLocal Bool -> Bool -> Bool
|| Bool
isForeign) (ECM () -> ECM ()) -> ECM () -> ECM ()
forall a b. (a -> b) -> a -> b
$ Message -> ECM ()
report (Message -> ECM ()) -> Message -> ECM ()
forall a b. (a -> b) -> a -> b
$ ModuleIdent -> Message
errModuleNotImported ModuleIdent
em
checkNonUniqueness :: [Export] -> [Message]
checkNonUniqueness :: [Export] -> [Message]
checkNonUniqueness es :: [Export]
es = ([Ident] -> Message) -> [[Ident]] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map [Ident] -> Message
errMultipleType ([Ident] -> [[Ident]]
forall a. Eq a => [a] -> [[a]]
findMultiples [Ident]
types )
[Message] -> [Message] -> [Message]
forall a. [a] -> [a] -> [a]
++ ([Ident] -> Message) -> [[Ident]] -> [Message]
forall a b. (a -> b) -> [a] -> [b]
map [Ident] -> Message
errMultipleName ([Ident] -> [[Ident]]
forall a. Eq a => [a] -> [[a]]
findMultiples [Ident]
values)
where
types :: [Ident]
types = [ QualIdent -> Ident
unqualify QualIdent
tc | ExportTypeWith _ tc :: QualIdent
tc _ <- [Export]
es ]
values :: [Ident]
values = [ Ident
c | ExportTypeWith _ _ cs :: [Ident]
cs <- [Export]
es, Ident
c <- [Ident]
cs ]
[Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [ QualIdent -> Ident
unqualify QualIdent
f | Export _ f :: QualIdent
f <- [Export]
es ]
expand :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec
-> [Export]
expand :: ModuleIdent
-> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec -> [Export]
expand m :: ModuleIdent
m aEnv :: AliasEnv
aEnv tcEnv :: TCEnv
tcEnv tyEnv :: ValueEnv
tyEnv spec :: Maybe ExportSpec
spec
= ([Export], [Message]) -> [Export]
forall a b. (a, b) -> a
fst (([Export], [Message]) -> [Export])
-> ([Export], [Message]) -> [Export]
forall a b. (a -> b) -> a -> b
$ ECM [Export]
-> ModuleIdent
-> AliasEnv
-> TCEnv
-> ValueEnv
-> ([Export], [Message])
forall a.
ECM a
-> ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> (a, [Message])
runECM (([Export] -> [Export]
joinExports ([Export] -> [Export])
-> ([Export] -> [Export]) -> [Export] -> [Export]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TCEnv -> [Export] -> [Export]
canonExports TCEnv
tcEnv) ([Export] -> [Export]) -> ECM [Export] -> ECM [Export]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ExportSpec -> ECM [Export]
expandSpec Maybe ExportSpec
spec)
ModuleIdent
m AliasEnv
aEnv TCEnv
tcEnv ValueEnv
tyEnv
expandSpec :: Maybe ExportSpec -> ECM [Export]
expandSpec :: Maybe ExportSpec -> ECM [Export]
expandSpec (Just (Exporting _ es :: [Export]
es)) = [[Export]] -> [Export]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Export]] -> [Export])
-> StateT ECState Identity [[Export]] -> ECM [Export]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Export -> ECM [Export])
-> [Export] -> StateT ECState Identity [[Export]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Export -> ECM [Export]
expandExport [Export]
es
expandSpec Nothing = ECM [Export]
expandLocalModule
expandExport :: Export -> ECM [Export]
expandExport :: Export -> ECM [Export]
expandExport (Export _ x :: QualIdent
x) = QualIdent -> ECM [Export]
expandThing QualIdent
x
expandExport (ExportTypeWith _ tc :: QualIdent
tc cs :: [Ident]
cs) = QualIdent -> [Ident] -> ECM [Export]
expandTypeWith QualIdent
tc [Ident]
cs
expandExport (ExportTypeAll _ tc :: QualIdent
tc) = QualIdent -> ECM [Export]
expandTypeAll QualIdent
tc
expandExport (ExportModule _ em :: ModuleIdent
em) = ModuleIdent -> ECM [Export]
expandModule ModuleIdent
em
expandThing :: QualIdent -> ECM [Export]
expandThing :: QualIdent -> ECM [Export]
expandThing tc :: QualIdent
tc = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
case ModuleIdent -> QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfoUnique ModuleIdent
m QualIdent
tc TCEnv
tcEnv of
[] -> QualIdent -> Maybe [Export] -> ECM [Export]
expandThing' QualIdent
tc Maybe [Export]
forall a. Maybe a
Nothing
[t :: TypeInfo
t] -> QualIdent -> Maybe [Export] -> ECM [Export]
expandThing' QualIdent
tc
([Export] -> Maybe [Export]
forall a. a -> Maybe a
Just [SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
NoSpanInfo (TypeInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName TypeInfo
t QualIdent -> QualIdent -> QualIdent
forall a b. (HasPosition a, HasPosition b) => a -> b -> a
@> QualIdent
tc) []])
err :: [TypeInfo]
err -> String -> ECM [Export]
forall a. String -> a
internalError (String -> ECM [Export]) -> String -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".expandThing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TypeInfo] -> String
forall a. Show a => a -> String
show [TypeInfo]
err
expandThing' :: QualIdent -> Maybe [Export] -> ECM [Export]
expandThing' :: QualIdent -> Maybe [Export] -> ECM [Export]
expandThing' f :: QualIdent
f tcExport :: Maybe [Export]
tcExport = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
ValueEnv
tyEnv <- ECM ValueEnv
getValueEnv
case ModuleIdent -> QualIdent -> ValueEnv -> [ValueInfo]
qualLookupValueUnique ModuleIdent
m QualIdent
f ValueEnv
tyEnv of
[Value f' :: QualIdent
f' _ _ _]
-> [Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Export] -> ECM [Export]) -> [Export] -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ SpanInfo -> QualIdent -> Export
Export SpanInfo
NoSpanInfo (QualIdent
f' QualIdent -> QualIdent -> QualIdent
forall a b. (HasPosition a, HasPosition b) => a -> b -> a
@> QualIdent
f) Export -> [Export] -> [Export]
forall a. a -> [a] -> [a]
: [Export] -> Maybe [Export] -> [Export]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Export]
tcExport
_
-> [Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Export] -> ECM [Export]) -> [Export] -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ [Export] -> Maybe [Export] -> [Export]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Export]
tcExport
expandTypeWith :: QualIdent -> [Ident] -> ECM [Export]
expandTypeWith :: QualIdent -> [Ident] -> ECM [Export]
expandTypeWith tc :: QualIdent
tc xs :: [Ident]
xs = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
case ModuleIdent -> QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfoUnique ModuleIdent
m QualIdent
tc TCEnv
tcEnv of
[t :: TypeInfo
t] -> [Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return [SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
NoSpanInfo (TypeInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName TypeInfo
t QualIdent -> QualIdent -> QualIdent
forall a b. (HasPosition a, HasPosition b) => a -> b -> a
@> QualIdent
tc) ([Ident] -> Export) -> [Ident] -> Export
forall a b. (a -> b) -> a -> b
$ [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub [Ident]
xs]
err :: [TypeInfo]
err -> String -> ECM [Export]
forall a. String -> a
internalError (String -> ECM [Export]) -> String -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".expandTypeWith: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TypeInfo] -> String
forall a. Show a => a -> String
show [TypeInfo]
err
expandTypeAll :: QualIdent -> ECM [Export]
expandTypeAll :: QualIdent -> ECM [Export]
expandTypeAll tc :: QualIdent
tc = do
ModuleIdent
m <- ECM ModuleIdent
getModuleIdent
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
case ModuleIdent -> QualIdent -> TCEnv -> [TypeInfo]
qualLookupTypeInfoUnique ModuleIdent
m QualIdent
tc TCEnv
tcEnv of
[t :: TypeInfo
t] -> [Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeInfo -> Export
exportType TypeInfo
t]
err :: [TypeInfo]
err -> String -> ECM [Export]
forall a. String -> a
internalError (String -> ECM [Export]) -> String -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".expandTypeAll: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TypeInfo] -> String
forall a. Show a => a -> String
show [TypeInfo]
err
expandModule :: ModuleIdent -> ECM [Export]
expandModule :: ModuleIdent -> ECM [Export]
expandModule em :: ModuleIdent
em = do
Bool
isLocal <- (ModuleIdent
em ModuleIdent -> ModuleIdent -> Bool
forall a. Eq a => a -> a -> Bool
==) (ModuleIdent -> Bool)
-> ECM ModuleIdent -> StateT ECState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ECM ModuleIdent
getModuleIdent
Bool
isForeign <- (ModuleIdent -> Set ModuleIdent -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ModuleIdent
em) (Set ModuleIdent -> Bool)
-> ECM (Set ModuleIdent) -> StateT ECState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ECM (Set ModuleIdent)
getImportedModules
[Export]
locals <- if Bool
isLocal then ECM [Export]
expandLocalModule else [Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Export]
foreigns <- if Bool
isForeign then ModuleIdent -> ECM [Export]
expandImportedModule ModuleIdent
em else [Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Export] -> ECM [Export]) -> [Export] -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ [Export]
locals [Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [Export]
foreigns
expandLocalModule :: ECM [Export]
expandLocalModule :: ECM [Export]
expandLocalModule = do
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
ValueEnv
tyEnv <- ECM ValueEnv
getValueEnv
[Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Export] -> ECM [Export]) -> [Export] -> ECM [Export]
forall a b. (a -> b) -> a -> b
$
[ TypeInfo -> Export
exportType TypeInfo
t | (_, t :: TypeInfo
t) <- TCEnv -> [(Ident, TypeInfo)]
forall a. TopEnv a -> [(Ident, a)]
localBindings TCEnv
tcEnv ]
[Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [ SpanInfo -> QualIdent -> Export
Export SpanInfo
NoSpanInfo QualIdent
f'
| (f :: Ident
f, Value f' :: QualIdent
f' _ _ _) <- ValueEnv -> [(Ident, ValueInfo)]
forall a. TopEnv a -> [(Ident, a)]
localBindings ValueEnv
tyEnv, Ident -> Bool
hasGlobalScope Ident
f ]
[Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [ SpanInfo -> QualIdent -> Export
Export SpanInfo
NoSpanInfo QualIdent
l'
| (l :: Ident
l, Label l' :: QualIdent
l' _ _) <- ValueEnv -> [(Ident, ValueInfo)]
forall a. TopEnv a -> [(Ident, a)]
localBindings ValueEnv
tyEnv, Ident -> Bool
hasGlobalScope Ident
l ]
expandImportedModule :: ModuleIdent -> ECM [Export]
expandImportedModule :: ModuleIdent -> ECM [Export]
expandImportedModule m :: ModuleIdent
m = do
TCEnv
tcEnv <- ECM TCEnv
getTyConsEnv
ValueEnv
tyEnv <- ECM ValueEnv
getValueEnv
[Export] -> ECM [Export]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Export] -> ECM [Export]) -> [Export] -> ECM [Export]
forall a b. (a -> b) -> a -> b
$ [TypeInfo -> Export
exportType TypeInfo
t | (_, t :: TypeInfo
t) <- ModuleIdent -> TCEnv -> [(Ident, TypeInfo)]
forall a. ModuleIdent -> TopEnv a -> [(Ident, a)]
moduleImports ModuleIdent
m TCEnv
tcEnv]
[Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [SpanInfo -> QualIdent -> Export
Export SpanInfo
NoSpanInfo QualIdent
f | (_, Value f :: QualIdent
f _ _ _) <- ModuleIdent -> ValueEnv -> [(Ident, ValueInfo)]
forall a. ModuleIdent -> TopEnv a -> [(Ident, a)]
moduleImports ModuleIdent
m ValueEnv
tyEnv]
[Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [SpanInfo -> QualIdent -> Export
Export SpanInfo
NoSpanInfo QualIdent
l | (_, Label l :: QualIdent
l _ _) <- ModuleIdent -> ValueEnv -> [(Ident, ValueInfo)]
forall a. ModuleIdent -> TopEnv a -> [(Ident, a)]
moduleImports ModuleIdent
m ValueEnv
tyEnv]
exportType :: TypeInfo -> Export
exportType :: TypeInfo -> Export
exportType t :: TypeInfo
t = SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
NoSpanInfo QualIdent
tc [Ident]
xs
where tc :: QualIdent
tc = TypeInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName TypeInfo
t
xs :: [Ident]
xs = TypeInfo -> [Ident]
elements TypeInfo
t
canonExports :: TCEnv -> [Export] -> [Export]
canonExports :: TCEnv -> [Export] -> [Export]
canonExports tcEnv :: TCEnv
tcEnv es :: [Export]
es = (Export -> Export) -> [Export] -> [Export]
forall a b. (a -> b) -> [a] -> [b]
map (Map QualIdent Export -> Export -> Export
canonExport (TCEnv -> [Export] -> Map QualIdent Export
canonLabels TCEnv
tcEnv [Export]
es)) [Export]
es
canonExport :: Map.Map QualIdent Export -> Export -> Export
canonExport :: Map QualIdent Export -> Export -> Export
canonExport ls :: Map QualIdent Export
ls (Export spi :: SpanInfo
spi x :: QualIdent
x) =
Export -> Maybe Export -> Export
forall a. a -> Maybe a -> a
fromMaybe (SpanInfo -> QualIdent -> Export
Export SpanInfo
spi QualIdent
x) (QualIdent -> Map QualIdent Export -> Maybe Export
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent
x Map QualIdent Export
ls)
canonExport _ (ExportTypeWith spi :: SpanInfo
spi tc :: QualIdent
tc xs :: [Ident]
xs) = SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
spi QualIdent
tc [Ident]
xs
canonExport _ e :: Export
e = String -> Export
forall a. String -> a
internalError (String -> Export) -> String -> Export
forall a b. (a -> b) -> a -> b
$
String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".canonExport: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Export -> String
forall a. Show a => a -> String
show Export
e
canonLabels :: TCEnv -> [Export] -> Map.Map QualIdent Export
canonLabels :: TCEnv -> [Export] -> Map QualIdent Export
canonLabels tcEnv :: TCEnv
tcEnv es :: [Export]
es = (TypeInfo -> Map QualIdent Export -> Map QualIdent Export)
-> Map QualIdent Export -> [TypeInfo] -> Map QualIdent Export
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TypeInfo -> Map QualIdent Export -> Map QualIdent Export
bindLabels Map QualIdent Export
forall k a. Map k a
Map.empty (TCEnv -> [TypeInfo]
forall a. TopEnv a -> [a]
allEntities TCEnv
tcEnv)
where
tcs :: [QualIdent]
tcs = [QualIdent
tc | ExportTypeWith _ tc :: QualIdent
tc _ <- [Export]
es]
bindLabels :: TypeInfo -> Map QualIdent Export -> Map QualIdent Export
bindLabels t :: TypeInfo
t ls :: Map QualIdent Export
ls
| QualIdent
tc' QualIdent -> [QualIdent] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [QualIdent]
tcs = (Ident -> Map QualIdent Export -> Map QualIdent Export)
-> Map QualIdent Export -> [Ident] -> Map QualIdent Export
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (QualIdent -> Ident -> Map QualIdent Export -> Map QualIdent Export
bindLabel QualIdent
tc') Map QualIdent Export
ls (TypeInfo -> [Ident]
elements TypeInfo
t)
| Bool
otherwise = Map QualIdent Export
ls
where
tc' :: QualIdent
tc' = TypeInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName TypeInfo
t
bindLabel :: QualIdent -> Ident -> Map QualIdent Export -> Map QualIdent Export
bindLabel tc :: QualIdent
tc x :: Ident
x =
QualIdent -> Export -> Map QualIdent Export -> Map QualIdent Export
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
x) (SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
NoSpanInfo QualIdent
tc [Ident
x])
joinExports :: [Export] -> [Export]
joinExports :: [Export] -> [Export]
joinExports es :: [Export]
es = [SpanInfo -> QualIdent -> [Ident] -> Export
ExportTypeWith SpanInfo
NoSpanInfo QualIdent
tc [Ident]
cs | (tc :: QualIdent
tc, cs :: [Ident]
cs) <- [(QualIdent, [Ident])]
joinedTypes]
[Export] -> [Export] -> [Export]
forall a. [a] -> [a] -> [a]
++ [SpanInfo -> QualIdent -> Export
Export SpanInfo
NoSpanInfo QualIdent
f | QualIdent
f <- [QualIdent]
joinedFuncs]
where joinedTypes :: [(QualIdent, [Ident])]
joinedTypes = Map QualIdent [Ident] -> [(QualIdent, [Ident])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map QualIdent [Ident] -> [(QualIdent, [Ident])])
-> Map QualIdent [Ident] -> [(QualIdent, [Ident])]
forall a b. (a -> b) -> a -> b
$ (Export -> Map QualIdent [Ident] -> Map QualIdent [Ident])
-> Map QualIdent [Ident] -> [Export] -> Map QualIdent [Ident]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Export -> Map QualIdent [Ident] -> Map QualIdent [Ident]
joinType Map QualIdent [Ident]
forall k a. Map k a
Map.empty [Export]
es
joinedFuncs :: [QualIdent]
joinedFuncs = Set QualIdent -> [QualIdent]
forall a. Set a -> [a]
Set.toList (Set QualIdent -> [QualIdent]) -> Set QualIdent -> [QualIdent]
forall a b. (a -> b) -> a -> b
$ (Export -> Set QualIdent -> Set QualIdent)
-> Set QualIdent -> [Export] -> Set QualIdent
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Export -> Set QualIdent -> Set QualIdent
joinFun Set QualIdent
forall a. Set a
Set.empty [Export]
es
joinType :: Export -> Map.Map QualIdent [Ident] -> Map.Map QualIdent [Ident]
joinType :: Export -> Map QualIdent [Ident] -> Map QualIdent [Ident]
joinType (Export _ _) tcs :: Map QualIdent [Ident]
tcs = Map QualIdent [Ident]
tcs
joinType (ExportTypeWith _ tc :: QualIdent
tc cs :: [Ident]
cs) tcs :: Map QualIdent [Ident]
tcs = ([Ident] -> [Ident] -> [Ident])
-> QualIdent
-> [Ident]
-> Map QualIdent [Ident]
-> Map QualIdent [Ident]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [Ident] -> [Ident] -> [Ident]
forall a. Eq a => [a] -> [a] -> [a]
union QualIdent
tc [Ident]
cs Map QualIdent [Ident]
tcs
joinType export :: Export
export _ = String -> Map QualIdent [Ident]
forall a. String -> a
internalError (String -> Map QualIdent [Ident])
-> String -> Map QualIdent [Ident]
forall a b. (a -> b) -> a -> b
$
String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".joinType: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Export -> String
forall a. Show a => a -> String
show Export
export
joinFun :: Export -> Set.Set QualIdent -> Set.Set QualIdent
joinFun :: Export -> Set QualIdent -> Set QualIdent
joinFun (Export _ f :: QualIdent
f) fs :: Set QualIdent
fs = QualIdent
f QualIdent -> Set QualIdent -> Set QualIdent
forall a. Ord a => a -> Set a -> Set a
`Set.insert` Set QualIdent
fs
joinFun (ExportTypeWith _ _ _) fs :: Set QualIdent
fs = Set QualIdent
fs
joinFun export :: Export
export _ = String -> Set QualIdent
forall a. String -> a
internalError (String -> Set QualIdent) -> String -> Set QualIdent
forall a b. (a -> b) -> a -> b
$
String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".joinFun: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Export -> String
forall a. Show a => a -> String
show Export
export
elements :: TypeInfo -> [Ident]
elements :: TypeInfo -> [Ident]
elements (DataType _ _ cs :: [DataConstr]
cs) = [DataConstr] -> [Ident]
visibleElems [DataConstr]
cs
elements (RenamingType _ _ c :: DataConstr
c) = [DataConstr] -> [Ident]
visibleElems [DataConstr
c]
elements (AliasType _ _ _ _) = []
elements (TypeClass _ _ ms :: [ClassMethod]
ms) = [ClassMethod] -> [Ident]
visibleMethods [ClassMethod]
ms
elements (TypeVar _) =
String -> [Ident]
forall a. HasCallStack => String -> a
error "Checks.ExportCheck.elements: type variable"
visibleElems :: [DataConstr] -> [Ident]
visibleElems :: [DataConstr] -> [Ident]
visibleElems cs :: [DataConstr]
cs = (DataConstr -> Ident) -> [DataConstr] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map DataConstr -> Ident
constrIdent [DataConstr]
cs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ ([Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub ((DataConstr -> [Ident]) -> [DataConstr] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DataConstr -> [Ident]
recLabels [DataConstr]
cs))
visibleMethods :: [ClassMethod] -> [Ident]
visibleMethods :: [ClassMethod] -> [Ident]
visibleMethods = (ClassMethod -> Ident) -> [ClassMethod] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ClassMethod -> Ident
methodName
errAmbiguousName :: QualIdent -> [ValueInfo] -> Message
errAmbiguousName :: QualIdent -> [ValueInfo] -> Message
errAmbiguousName x :: QualIdent
x vs :: [ValueInfo]
vs = String -> QualIdent -> [QualIdent] -> Message
errAmbiguous "name" QualIdent
x ((ValueInfo -> QualIdent) -> [ValueInfo] -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map ValueInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName [ValueInfo]
vs)
errAmbiguousType :: QualIdent -> [TypeInfo] -> Message
errAmbiguousType :: QualIdent -> [TypeInfo] -> Message
errAmbiguousType tc :: QualIdent
tc tcs :: [TypeInfo]
tcs = String -> QualIdent -> [QualIdent] -> Message
errAmbiguous "type" QualIdent
tc ((TypeInfo -> QualIdent) -> [TypeInfo] -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map TypeInfo -> QualIdent
forall a. Entity a => a -> QualIdent
origName [TypeInfo]
tcs)
errAmbiguous :: String -> QualIdent -> [QualIdent] -> Message
errAmbiguous :: String -> QualIdent -> [QualIdent] -> Message
errAmbiguous what :: String
what qn :: QualIdent
qn qns :: [QualIdent]
qns = QualIdent -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage QualIdent
qn
(Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Ambiguous" Doc -> Doc -> Doc
<+> String -> Doc
text String
what Doc -> Doc -> Doc
<+> String -> Doc
text (QualIdent -> String
escQualName QualIdent
qn)
Doc -> Doc -> Doc
$+$ String -> Doc
text "It could refer to:"
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ((QualIdent -> Doc) -> [QualIdent] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc
text (String -> Doc) -> (QualIdent -> String) -> QualIdent -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent -> String
escQualName) [QualIdent]
qns))
errModuleNotImported :: ModuleIdent -> Message
errModuleNotImported :: ModuleIdent -> Message
errModuleNotImported m :: ModuleIdent
m = ModuleIdent -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage ModuleIdent
m (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
["Module", ModuleIdent -> String
escModuleName ModuleIdent
m, "not imported"]
errMultipleName :: [Ident] -> Message
errMultipleName :: [Ident] -> Message
errMultipleName = String -> [Ident] -> Message
errMultiple "name"
errMultipleType :: [Ident] -> Message
errMultipleType :: [Ident] -> Message
errMultipleType = String -> [Ident] -> Message
errMultiple "type"
errMultiple :: String -> [Ident] -> Message
errMultiple :: String -> [Ident] -> Message
errMultiple _ [] = String -> Message
forall a. String -> a
internalError (String -> Message) -> String -> Message
forall a b. (a -> b) -> a -> b
$
String
currentModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".errMultiple: empty list"
errMultiple what :: String
what (i :: Ident
i:is :: [Ident]
is) = Ident -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Ident
i (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "Multiple exports of" Doc -> Doc -> Doc
<+> String -> Doc
text String
what Doc -> Doc -> Doc
<+> String -> Doc
text (Ident -> String
escName Ident
i) Doc -> Doc -> Doc
<+> String -> Doc
text "at:"
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ((Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
showPos (Ident
iIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
is)))
where showPos :: Ident -> Doc
showPos = String -> Doc
text (String -> Doc) -> (Ident -> String) -> Ident -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> String
showLine (Position -> String) -> (Ident -> Position) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Position
forall a. HasPosition a => a -> Position
getPosition
errNonDataTypeOrTypeClass :: QualIdent -> Message
errNonDataTypeOrTypeClass :: QualIdent -> Message
errNonDataTypeOrTypeClass tc :: QualIdent
tc = QualIdent -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage QualIdent
tc (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
[QualIdent -> String
escQualName QualIdent
tc, "is not a data type or type class"]
errOutsideTypeConstructor :: QualIdent -> QualIdent -> Message
errOutsideTypeConstructor :: QualIdent -> QualIdent -> Message
errOutsideTypeConstructor c :: QualIdent
c tc :: QualIdent
tc = String -> QualIdent -> QualIdent -> Message
errOutsideTypeExport "Data constructor" QualIdent
c QualIdent
tc
errOutsideTypeLabel :: QualIdent -> QualIdent -> Message
errOutsideTypeLabel :: QualIdent -> QualIdent -> Message
errOutsideTypeLabel l :: QualIdent
l tc :: QualIdent
tc = String -> QualIdent -> QualIdent -> Message
errOutsideTypeExport "Label" QualIdent
l QualIdent
tc
errOutsideTypeExport :: String -> QualIdent -> QualIdent -> Message
errOutsideTypeExport :: String -> QualIdent -> QualIdent -> Message
errOutsideTypeExport what :: String
what q :: QualIdent
q tc :: QualIdent
tc = QualIdent -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage QualIdent
q
(Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
what Doc -> Doc -> Doc
<+> String -> Doc
text (QualIdent -> String
escQualName QualIdent
q)
Doc -> Doc -> Doc
<+> String -> Doc
text "outside type export in export list"
Doc -> Doc -> Doc
$+$ String -> Doc
text "Use `" Doc -> Doc -> Doc
<> String -> Doc
text (QualIdent -> String
qualName QualIdent
tc) Doc -> Doc -> Doc
<+> Doc -> Doc
parens (String -> Doc
text (QualIdent -> String
qualName QualIdent
q))
Doc -> Doc -> Doc
<> String -> Doc
text "' instead"
errUndefinedElement :: QualIdent -> Ident -> Message
errUndefinedElement :: QualIdent -> Ident -> Message
errUndefinedElement tc :: QualIdent
tc c :: Ident
c = Ident -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Ident
c (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
[ Ident -> String
escName Ident
c, "is not a constructor or label of type", QualIdent -> String
escQualName QualIdent
tc ]
errUndefinedMethod :: QualIdent -> Ident -> Message
errUndefinedMethod :: QualIdent -> Ident -> Message
errUndefinedMethod cls :: QualIdent
cls f :: Ident
f = Ident -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage Ident
f (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
[ Ident -> String
escName Ident
f, "is not a method of class", QualIdent -> String
escQualName QualIdent
cls ]
errUndefinedName :: QualIdent -> Message
errUndefinedName :: QualIdent -> Message
errUndefinedName = String -> QualIdent -> Message
errUndefined "name"
errUndefinedTypeOrClass :: QualIdent -> Message
errUndefinedTypeOrClass :: QualIdent -> Message
errUndefinedTypeOrClass = String -> QualIdent -> Message
errUndefined "type or class"
errUndefined :: String -> QualIdent -> Message
errUndefined :: String -> QualIdent -> Message
errUndefined what :: String
what tc :: QualIdent
tc = QualIdent -> Doc -> Message
forall p. HasPosition p => p -> Doc -> Message
posMessage QualIdent
tc (Doc -> Message) -> Doc -> Message
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
["Undefined", String
what, QualIdent -> String
escQualName QualIdent
tc, "in export list"]