module Checks.ImportSyntaxCheck(importCheck) where
import Control.Monad (liftM, unless)
import qualified Control.Monad.State as S (State, gets, modify, runState)
import Data.List (nub, union)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Curry.Base.Ident
import Curry.Base.Pretty
import Curry.Base.SpanInfo
import Curry.Syntax hiding (Var (..))
import Base.Messages
import Base.TopEnv
importCheck :: Interface -> Maybe ImportSpec -> (Maybe ImportSpec, [Message])
importCheck :: Interface -> Maybe ImportSpec -> (Maybe ImportSpec, [Message])
importCheck (Interface m :: ModuleIdent
m _ ds :: [IDecl]
ds) is :: Maybe ImportSpec
is = ExpandM (Maybe ImportSpec)
-> ModuleIdent
-> ExpTCEnv
-> ExpValueEnv
-> (Maybe ImportSpec, [Message])
forall a.
ExpandM a
-> ModuleIdent -> ExpTCEnv -> ExpValueEnv -> (a, [Message])
runExpand (Maybe ImportSpec -> ExpandM (Maybe ImportSpec)
expandSpecs Maybe ImportSpec
is) ModuleIdent
m ExpTCEnv
mTCEnv ExpValueEnv
mTyEnv
where
mTCEnv :: ExpTCEnv
mTCEnv = (IDecl -> [ITypeInfo]) -> [IDecl] -> ExpTCEnv
forall a. Entity a => (IDecl -> [a]) -> [IDecl] -> IdentMap a
intfEnv IDecl -> [ITypeInfo]
types [IDecl]
ds
mTyEnv :: ExpValueEnv
mTyEnv = (IDecl -> [IValueInfo]) -> [IDecl] -> ExpValueEnv
forall a. Entity a => (IDecl -> [a]) -> [IDecl] -> IdentMap a
intfEnv IDecl -> [IValueInfo]
values [IDecl]
ds
data ITypeInfo = Data QualIdent [Ident]
| Alias QualIdent
| Class QualIdent [Ident]
deriving Int -> ITypeInfo -> ShowS
[ITypeInfo] -> ShowS
ITypeInfo -> String
(Int -> ITypeInfo -> ShowS)
-> (ITypeInfo -> String)
-> ([ITypeInfo] -> ShowS)
-> Show ITypeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ITypeInfo] -> ShowS
$cshowList :: [ITypeInfo] -> ShowS
show :: ITypeInfo -> String
$cshow :: ITypeInfo -> String
showsPrec :: Int -> ITypeInfo -> ShowS
$cshowsPrec :: Int -> ITypeInfo -> ShowS
Show
instance Entity ITypeInfo where
origName :: ITypeInfo -> QualIdent
origName (Data tc :: QualIdent
tc _) = QualIdent
tc
origName (Alias tc :: QualIdent
tc ) = QualIdent
tc
origName (Class cls :: QualIdent
cls _) = QualIdent
cls
merge :: ITypeInfo -> ITypeInfo -> Maybe ITypeInfo
merge (Data tc1 :: QualIdent
tc1 cs1 :: [Ident]
cs1) (Data tc2 :: QualIdent
tc2 cs2 :: [Ident]
cs2)
| QualIdent
tc1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
tc2 Bool -> Bool -> Bool
&& ([Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
cs1 Bool -> Bool -> Bool
|| [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
cs2 Bool -> Bool -> Bool
|| [Ident]
cs1 [Ident] -> [Ident] -> Bool
forall a. Eq a => a -> a -> Bool
== [Ident]
cs2) =
ITypeInfo -> Maybe ITypeInfo
forall a. a -> Maybe a
Just (ITypeInfo -> Maybe ITypeInfo) -> ITypeInfo -> Maybe ITypeInfo
forall a b. (a -> b) -> a -> b
$ QualIdent -> [Ident] -> ITypeInfo
Data QualIdent
tc1 (if [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
cs1 then [Ident]
cs2 else [Ident]
cs1)
merge l :: ITypeInfo
l@(Alias tc1 :: QualIdent
tc1) (Alias tc2 :: QualIdent
tc2)
| QualIdent
tc1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
tc2 = ITypeInfo -> Maybe ITypeInfo
forall a. a -> Maybe a
Just ITypeInfo
l
merge (Class cls1 :: QualIdent
cls1 ms1 :: [Ident]
ms1) (Class cls2 :: QualIdent
cls2 ms2 :: [Ident]
ms2)
| QualIdent
cls1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
cls2 Bool -> Bool -> Bool
&& ([Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
ms1 Bool -> Bool -> Bool
|| [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
ms2 Bool -> Bool -> Bool
|| [Ident]
ms1 [Ident] -> [Ident] -> Bool
forall a. Eq a => a -> a -> Bool
== [Ident]
ms2) =
ITypeInfo -> Maybe ITypeInfo
forall a. a -> Maybe a
Just (ITypeInfo -> Maybe ITypeInfo) -> ITypeInfo -> Maybe ITypeInfo
forall a b. (a -> b) -> a -> b
$ QualIdent -> [Ident] -> ITypeInfo
Class QualIdent
cls1 (if [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
ms1 then [Ident]
ms2 else [Ident]
ms1)
merge _ _ = Maybe ITypeInfo
forall a. Maybe a
Nothing
data IValueInfo = Constr QualIdent
| Var QualIdent [QualIdent]
deriving Int -> IValueInfo -> ShowS
[IValueInfo] -> ShowS
IValueInfo -> String
(Int -> IValueInfo -> ShowS)
-> (IValueInfo -> String)
-> ([IValueInfo] -> ShowS)
-> Show IValueInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IValueInfo] -> ShowS
$cshowList :: [IValueInfo] -> ShowS
show :: IValueInfo -> String
$cshow :: IValueInfo -> String
showsPrec :: Int -> IValueInfo -> ShowS
$cshowsPrec :: Int -> IValueInfo -> ShowS
Show
instance Entity IValueInfo where
origName :: IValueInfo -> QualIdent
origName (Constr c :: QualIdent
c) = QualIdent
c
origName (Var x :: QualIdent
x _) = QualIdent
x
merge :: IValueInfo -> IValueInfo -> Maybe IValueInfo
merge (Constr c1 :: QualIdent
c1) (Constr c2 :: QualIdent
c2)
| QualIdent
c1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
c2 = IValueInfo -> Maybe IValueInfo
forall a. a -> Maybe a
Just (QualIdent -> IValueInfo
Constr QualIdent
c1)
merge (Var x1 :: QualIdent
x1 cs1 :: [QualIdent]
cs1) (Var x2 :: QualIdent
x2 cs2 :: [QualIdent]
cs2)
| QualIdent
x1 QualIdent -> QualIdent -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent
x2 = IValueInfo -> Maybe IValueInfo
forall a. a -> Maybe a
Just (QualIdent -> [QualIdent] -> IValueInfo
Var QualIdent
x1 ([QualIdent]
cs1 [QualIdent] -> [QualIdent] -> [QualIdent]
forall a. Eq a => [a] -> [a] -> [a]
`union` [QualIdent]
cs2))
merge _ _ = Maybe IValueInfo
forall a. Maybe a
Nothing
intfEnv :: Entity a => (IDecl -> [a]) -> [IDecl] -> IdentMap a
intfEnv :: (IDecl -> [a]) -> [IDecl] -> IdentMap a
intfEnv idents :: IDecl -> [a]
idents ds :: [IDecl]
ds = (a -> IdentMap a -> IdentMap a) -> IdentMap a -> [a] -> IdentMap a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> IdentMap a -> IdentMap a
forall a. Entity a => a -> Map Ident a -> Map Ident a
bindId IdentMap a
forall k a. Map k a
Map.empty ((IDecl -> [a]) -> [IDecl] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IDecl -> [a]
idents [IDecl]
ds)
where bindId :: a -> Map Ident a -> Map Ident a
bindId x :: a
x = Ident -> a -> Map Ident a -> Map Ident a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (QualIdent -> Ident
unqualify (a -> QualIdent
forall a. Entity a => a -> QualIdent
origName a
x)) a
x
types :: IDecl -> [ITypeInfo]
types :: IDecl -> [ITypeInfo]
types (IDataDecl _ tc :: QualIdent
tc _ _ cs :: [ConstrDecl]
cs hs :: [Ident]
hs) = [QualIdent -> [Ident] -> ITypeInfo
Data QualIdent
tc ((Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs) [Ident]
xs)]
where xs :: [Ident]
xs = (ConstrDecl -> Ident) -> [ConstrDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Ident
constrId [ConstrDecl]
cs [Ident] -> [Ident] -> [Ident]
forall a. [a] -> [a] -> [a]
++ [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub ((ConstrDecl -> [Ident]) -> [ConstrDecl] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConstrDecl -> [Ident]
recordLabels [ConstrDecl]
cs)
types (INewtypeDecl _ tc :: QualIdent
tc _ _ nc :: NewConstrDecl
nc hs :: [Ident]
hs) = [QualIdent -> [Ident] -> ITypeInfo
Data QualIdent
tc ((Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs) [Ident]
xs)]
where xs :: [Ident]
xs = NewConstrDecl -> Ident
nconstrId NewConstrDecl
nc Ident -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
: NewConstrDecl -> [Ident]
nrecordLabels NewConstrDecl
nc
types (ITypeDecl _ tc :: QualIdent
tc _ _ _) = [QualIdent -> ITypeInfo
Alias QualIdent
tc]
types (IClassDecl _ _ cls :: QualIdent
cls _ _ ms :: [IMethodDecl]
ms hs :: [Ident]
hs) = [QualIdent -> [Ident] -> ITypeInfo
Class QualIdent
cls ((Ident -> Bool) -> [Ident] -> [Ident]
forall a. (a -> Bool) -> [a] -> [a]
filter (Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs) [Ident]
xs)]
where xs :: [Ident]
xs = (IMethodDecl -> Ident) -> [IMethodDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map IMethodDecl -> Ident
imethod [IMethodDecl]
ms
types _ = []
values :: IDecl -> [IValueInfo]
values :: IDecl -> [IValueInfo]
values (IDataDecl _ tc :: QualIdent
tc _ _ cs :: [ConstrDecl]
cs hs :: [Ident]
hs) =
QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
cidents QualIdent
tc ((ConstrDecl -> Ident) -> [ConstrDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map ConstrDecl -> Ident
constrId [ConstrDecl]
cs) [Ident]
hs [IValueInfo] -> [IValueInfo] -> [IValueInfo]
forall a. [a] -> [a] -> [a]
++
QualIdent -> [(Ident, [Ident])] -> [Ident] -> [IValueInfo]
lidents QualIdent
tc [(Ident
l, [ConstrDecl] -> Ident -> [Ident]
lconstrs [ConstrDecl]
cs Ident
l) | Ident
l <- [Ident] -> [Ident]
forall a. Eq a => [a] -> [a]
nub ((ConstrDecl -> [Ident]) -> [ConstrDecl] -> [Ident]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ConstrDecl -> [Ident]
recordLabels [ConstrDecl]
cs)] [Ident]
hs
where lconstrs :: [ConstrDecl] -> Ident -> [Ident]
lconstrs cons :: [ConstrDecl]
cons l :: Ident
l = [ConstrDecl -> Ident
constrId ConstrDecl
c | ConstrDecl
c <- [ConstrDecl]
cons, Ident
l Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ConstrDecl -> [Ident]
recordLabels ConstrDecl
c]
values (INewtypeDecl _ tc :: QualIdent
tc _ _ nc :: NewConstrDecl
nc hs :: [Ident]
hs) =
QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
cidents QualIdent
tc [NewConstrDecl -> Ident
nconstrId NewConstrDecl
nc] [Ident]
hs [IValueInfo] -> [IValueInfo] -> [IValueInfo]
forall a. [a] -> [a] -> [a]
++
QualIdent -> [(Ident, [Ident])] -> [Ident] -> [IValueInfo]
lidents QualIdent
tc [(Ident
l, [Ident
c]) | NewRecordDecl _ c :: Ident
c (l :: Ident
l, _) <- [NewConstrDecl
nc]] [Ident]
hs
values (IFunctionDecl _ f :: QualIdent
f _ _ _) = [QualIdent -> [QualIdent] -> IValueInfo
Var QualIdent
f []]
values (IClassDecl _ _ cls :: QualIdent
cls _ _ ms :: [IMethodDecl]
ms hs :: [Ident]
hs) = QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
midents QualIdent
cls ((IMethodDecl -> Ident) -> [IMethodDecl] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map IMethodDecl -> Ident
imethod [IMethodDecl]
ms) [Ident]
hs
values _ = []
cidents :: QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
cidents :: QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
cidents tc :: QualIdent
tc cs :: [Ident]
cs hs :: [Ident]
hs = [QualIdent -> IValueInfo
Constr (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
c) | Ident
c <- [Ident]
cs, Ident
c Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs]
lidents :: QualIdent -> [(Ident, [Ident])] -> [Ident] -> [IValueInfo]
lidents :: QualIdent -> [(Ident, [Ident])] -> [Ident] -> [IValueInfo]
lidents tc :: QualIdent
tc ls :: [(Ident, [Ident])]
ls hs :: [Ident]
hs = [ QualIdent -> [QualIdent] -> IValueInfo
Var (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc Ident
l) ((Ident -> QualIdent) -> [Ident] -> [QualIdent]
forall a b. (a -> b) -> [a] -> [b]
map (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
tc) [Ident]
cs)
| (l :: Ident
l, cs :: [Ident]
cs) <- [(Ident, [Ident])]
ls, Ident
l Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs
]
midents :: QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
midents :: QualIdent -> [Ident] -> [Ident] -> [IValueInfo]
midents cls :: QualIdent
cls fs :: [Ident]
fs hs :: [Ident]
hs = [QualIdent -> [QualIdent] -> IValueInfo
Var (QualIdent -> Ident -> QualIdent
qualifyLike QualIdent
cls Ident
f) [] | Ident
f <- [Ident]
fs, Ident
f Ident -> [Ident] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Ident]
hs]
type IdentMap = Map.Map Ident
type ExpTCEnv = IdentMap ITypeInfo
type ExpValueEnv = IdentMap IValueInfo
data ExpandState = ExpandState
{ ExpandState -> ModuleIdent
expModIdent :: ModuleIdent
, ExpandState -> ExpTCEnv
expTCEnv :: ExpTCEnv
, ExpandState -> ExpValueEnv
expValueEnv :: ExpValueEnv
, ExpandState -> [Message]
errors :: [Message]
}
type ExpandM a = S.State ExpandState a
getModuleIdent :: ExpandM ModuleIdent
getModuleIdent :: ExpandM ModuleIdent
getModuleIdent = (ExpandState -> ModuleIdent) -> ExpandM ModuleIdent
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ExpandState -> ModuleIdent
expModIdent
getTyConsEnv :: ExpandM ExpTCEnv
getTyConsEnv :: ExpandM ExpTCEnv
getTyConsEnv = (ExpandState -> ExpTCEnv) -> ExpandM ExpTCEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ExpandState -> ExpTCEnv
expTCEnv
getValueEnv :: ExpandM ExpValueEnv
getValueEnv :: ExpandM ExpValueEnv
getValueEnv = (ExpandState -> ExpValueEnv) -> ExpandM ExpValueEnv
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets ExpandState -> ExpValueEnv
expValueEnv
report :: Message -> ExpandM ()
report :: Message -> ExpandM ()
report msg :: Message
msg = (ExpandState -> ExpandState) -> ExpandM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify ((ExpandState -> ExpandState) -> ExpandM ())
-> (ExpandState -> ExpandState) -> ExpandM ()
forall a b. (a -> b) -> a -> b
$ \ s :: ExpandState
s -> ExpandState
s { errors :: [Message]
errors = Message
msg Message -> [Message] -> [Message]
forall a. a -> [a] -> [a]
: ExpandState -> [Message]
errors ExpandState
s }
runExpand :: ExpandM a -> ModuleIdent -> ExpTCEnv -> ExpValueEnv -> (a, [Message])
runExpand :: ExpandM a
-> ModuleIdent -> ExpTCEnv -> ExpValueEnv -> (a, [Message])
runExpand expand :: ExpandM a
expand m :: ModuleIdent
m tcEnv :: ExpTCEnv
tcEnv tyEnv :: ExpValueEnv
tyEnv =
let (r :: a
r, s :: ExpandState
s) = ExpandM a -> ExpandState -> (a, ExpandState)
forall s a. State s a -> s -> (a, s)
S.runState ExpandM a
expand (ModuleIdent -> ExpTCEnv -> ExpValueEnv -> [Message] -> ExpandState
ExpandState ModuleIdent
m ExpTCEnv
tcEnv ExpValueEnv
tyEnv [])
in (a
r, [Message] -> [Message]
forall a. [a] -> [a]
reverse ([Message] -> [Message]) -> [Message] -> [Message]
forall a b. (a -> b) -> a -> b
$ ExpandState -> [Message]
errors ExpandState
s)
expandSpecs :: Maybe ImportSpec -> ExpandM (Maybe ImportSpec)
expandSpecs :: Maybe ImportSpec -> ExpandM (Maybe ImportSpec)
expandSpecs Nothing = Maybe ImportSpec -> ExpandM (Maybe ImportSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ImportSpec
forall a. Maybe a
Nothing
expandSpecs (Just (Importing p :: SpanInfo
p is :: [Import]
is)) = (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just (ImportSpec -> Maybe ImportSpec)
-> ([[Import]] -> ImportSpec) -> [[Import]] -> Maybe ImportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanInfo -> [Import] -> ImportSpec
Importing SpanInfo
p ([Import] -> ImportSpec)
-> ([[Import]] -> [Import]) -> [[Import]] -> ImportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Import]] -> [Import]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[Import]] -> Maybe ImportSpec)
-> StateT ExpandState Identity [[Import]]
-> ExpandM (Maybe ImportSpec)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Import -> StateT ExpandState Identity [Import])
-> [Import] -> StateT ExpandState Identity [[Import]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Import -> StateT ExpandState Identity [Import]
expandImport [Import]
is
expandSpecs (Just (Hiding p :: SpanInfo
p is :: [Import]
is)) = (ImportSpec -> Maybe ImportSpec
forall a. a -> Maybe a
Just (ImportSpec -> Maybe ImportSpec)
-> ([[Import]] -> ImportSpec) -> [[Import]] -> Maybe ImportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanInfo -> [Import] -> ImportSpec
Hiding SpanInfo
p ([Import] -> ImportSpec)
-> ([[Import]] -> [Import]) -> [[Import]] -> ImportSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Import]] -> [Import]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[Import]] -> Maybe ImportSpec)
-> StateT ExpandState Identity [[Import]]
-> ExpandM (Maybe ImportSpec)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Import -> StateT ExpandState Identity [Import])
-> [Import] -> StateT ExpandState Identity [[Import]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Import -> StateT ExpandState Identity [Import]
expandHiding [Import]
is
expandImport :: Import -> ExpandM [Import]
expandImport :: Import -> StateT ExpandState Identity [Import]
expandImport (Import spi :: SpanInfo
spi x :: Ident
x ) = SpanInfo -> Ident -> StateT ExpandState Identity [Import]
expandThing SpanInfo
spi Ident
x
expandImport (ImportTypeWith spi :: SpanInfo
spi tc :: Ident
tc cs :: [Ident]
cs) = (Import -> [Import] -> [Import]
forall a. a -> [a] -> [a]
:[]) (Import -> [Import])
-> StateT ExpandState Identity Import
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` SpanInfo -> Ident -> [Ident] -> StateT ExpandState Identity Import
expandTypeWith SpanInfo
spi Ident
tc [Ident]
cs
expandImport (ImportTypeAll spi :: SpanInfo
spi tc :: Ident
tc ) = (Import -> [Import] -> [Import]
forall a. a -> [a] -> [a]
:[]) (Import -> [Import])
-> StateT ExpandState Identity Import
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` SpanInfo -> Ident -> StateT ExpandState Identity Import
expandTypeAll SpanInfo
spi Ident
tc
expandHiding :: Import -> ExpandM [Import]
expandHiding :: Import -> StateT ExpandState Identity [Import]
expandHiding (Import spi :: SpanInfo
spi x :: Ident
x ) = SpanInfo -> Ident -> StateT ExpandState Identity [Import]
expandHide SpanInfo
spi Ident
x
expandHiding (ImportTypeWith spi :: SpanInfo
spi tc :: Ident
tc cs :: [Ident]
cs) = (Import -> [Import] -> [Import]
forall a. a -> [a] -> [a]
:[]) (Import -> [Import])
-> StateT ExpandState Identity Import
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` SpanInfo -> Ident -> [Ident] -> StateT ExpandState Identity Import
expandTypeWith SpanInfo
spi Ident
tc [Ident]
cs
expandHiding (ImportTypeAll spi :: SpanInfo
spi tc :: Ident
tc ) = (Import -> [Import] -> [Import]
forall a. a -> [a] -> [a]
:[]) (Import -> [Import])
-> StateT ExpandState Identity Import
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` SpanInfo -> Ident -> StateT ExpandState Identity Import
expandTypeAll SpanInfo
spi Ident
tc
expandThing :: SpanInfo -> Ident -> ExpandM [Import]
expandThing :: SpanInfo -> Ident -> StateT ExpandState Identity [Import]
expandThing spi :: SpanInfo
spi tc :: Ident
tc = do
ExpTCEnv
tcEnv <- ExpandM ExpTCEnv
getTyConsEnv
case Ident -> ExpTCEnv -> Maybe ITypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
tc ExpTCEnv
tcEnv of
Just _ -> SpanInfo
-> Ident -> Maybe [Import] -> StateT ExpandState Identity [Import]
expandThing' SpanInfo
spi Ident
tc (Maybe [Import] -> StateT ExpandState Identity [Import])
-> Maybe [Import] -> StateT ExpandState Identity [Import]
forall a b. (a -> b) -> a -> b
$ [Import] -> Maybe [Import]
forall a. a -> Maybe a
Just [SpanInfo -> Ident -> [Ident] -> Import
ImportTypeWith SpanInfo
spi Ident
tc []]
Nothing -> SpanInfo
-> Ident -> Maybe [Import] -> StateT ExpandState Identity [Import]
expandThing' SpanInfo
spi Ident
tc Maybe [Import]
forall a. Maybe a
Nothing
expandThing' :: SpanInfo -> Ident -> Maybe [Import] -> ExpandM [Import]
expandThing' :: SpanInfo
-> Ident -> Maybe [Import] -> StateT ExpandState Identity [Import]
expandThing' spi :: SpanInfo
spi f :: Ident
f tcImport :: Maybe [Import]
tcImport = do
ModuleIdent
m <- ExpandM ModuleIdent
getModuleIdent
ExpValueEnv
tyEnv <- ExpandM ExpValueEnv
getValueEnv
ModuleIdent
-> Ident
-> Maybe IValueInfo
-> Maybe [Import]
-> StateT ExpandState Identity [Import]
expand ModuleIdent
m Ident
f (Ident -> ExpValueEnv -> Maybe IValueInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
f ExpValueEnv
tyEnv) Maybe [Import]
tcImport
where
expand :: ModuleIdent -> Ident
-> Maybe IValueInfo -> Maybe [Import] -> ExpandM [Import]
expand :: ModuleIdent
-> Ident
-> Maybe IValueInfo
-> Maybe [Import]
-> StateT ExpandState Identity [Import]
expand m :: ModuleIdent
m e :: Ident
e Nothing Nothing = Message -> ExpandM ()
report (ModuleIdent -> Ident -> Message
errUndefinedEntity ModuleIdent
m Ident
e) ExpandM ()
-> StateT ExpandState Identity [Import]
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return []
expand _ _ Nothing (Just tc :: [Import]
tc) = [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return [Import]
tc
expand m :: ModuleIdent
m e :: Ident
e (Just v :: IValueInfo
v) maybeTc :: Maybe [Import]
maybeTc
| IValueInfo -> Bool
isConstr IValueInfo
v = case Maybe [Import]
maybeTc of
Nothing -> Message -> ExpandM ()
report (ModuleIdent -> Ident -> Message
errImportDataConstr ModuleIdent
m Ident
e) ExpandM ()
-> StateT ExpandState Identity [Import]
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just tc :: [Import]
tc -> [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return [Import]
tc
| Bool
otherwise = [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return [SpanInfo -> Ident -> Import
Import SpanInfo
spi Ident
e]
isConstr :: IValueInfo -> Bool
isConstr (Constr _) = Bool
True
isConstr (Var _ _) = Bool
False
expandHide :: SpanInfo -> Ident -> ExpandM [Import]
expandHide :: SpanInfo -> Ident -> StateT ExpandState Identity [Import]
expandHide spi :: SpanInfo
spi tc :: Ident
tc = do
ExpTCEnv
tcEnv <- ExpandM ExpTCEnv
getTyConsEnv
case Ident -> ExpTCEnv -> Maybe ITypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
tc ExpTCEnv
tcEnv of
Just _ -> SpanInfo
-> Ident -> Maybe [Import] -> StateT ExpandState Identity [Import]
expandHide' SpanInfo
spi Ident
tc (Maybe [Import] -> StateT ExpandState Identity [Import])
-> Maybe [Import] -> StateT ExpandState Identity [Import]
forall a b. (a -> b) -> a -> b
$ [Import] -> Maybe [Import]
forall a. a -> Maybe a
Just [SpanInfo -> Ident -> [Ident] -> Import
ImportTypeWith SpanInfo
spi Ident
tc []]
Nothing -> SpanInfo
-> Ident -> Maybe [Import] -> StateT ExpandState Identity [Import]
expandHide' SpanInfo
spi Ident
tc Maybe [Import]
forall a. Maybe a
Nothing
expandHide' :: SpanInfo -> Ident -> Maybe [Import] -> ExpandM [Import]
expandHide' :: SpanInfo
-> Ident -> Maybe [Import] -> StateT ExpandState Identity [Import]
expandHide' spi :: SpanInfo
spi f :: Ident
f tcImport :: Maybe [Import]
tcImport = do
ModuleIdent
m <- ExpandM ModuleIdent
getModuleIdent
ExpValueEnv
tyEnv <- ExpandM ExpValueEnv
getValueEnv
case Ident -> ExpValueEnv -> Maybe IValueInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
f ExpValueEnv
tyEnv of
Just _ -> [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Import] -> StateT ExpandState Identity [Import])
-> [Import] -> StateT ExpandState Identity [Import]
forall a b. (a -> b) -> a -> b
$ SpanInfo -> Ident -> Import
Import SpanInfo
spi Ident
f Import -> [Import] -> [Import]
forall a. a -> [a] -> [a]
: [Import] -> Maybe [Import] -> [Import]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Import]
tcImport
Nothing -> case Maybe [Import]
tcImport of
Nothing -> Message -> ExpandM ()
report (ModuleIdent -> Ident -> Message
errUndefinedEntity ModuleIdent
m Ident
f) ExpandM ()
-> StateT ExpandState Identity [Import]
-> StateT ExpandState Identity [Import]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just tc :: [Import]
tc -> [Import] -> StateT ExpandState Identity [Import]
forall (m :: * -> *) a. Monad m => a -> m a
return [Import]
tc
expandTypeWith :: SpanInfo -> Ident -> [Ident] -> ExpandM Import
expandTypeWith :: SpanInfo -> Ident -> [Ident] -> StateT ExpandState Identity Import
expandTypeWith spi :: SpanInfo
spi tc :: Ident
tc cs :: [Ident]
cs = do
ModuleIdent
m <- ExpandM ModuleIdent
getModuleIdent
ExpTCEnv
tcEnv <- ExpandM ExpTCEnv
getTyConsEnv
SpanInfo -> Ident -> [Ident] -> Import
ImportTypeWith SpanInfo
spi Ident
tc ([Ident] -> Import)
-> StateT ExpandState Identity [Ident]
-> StateT ExpandState Identity Import
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` case Ident -> ExpTCEnv -> Maybe ITypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
tc ExpTCEnv
tcEnv of
Just (Data _ xs :: [Ident]
xs) -> (Ident -> StateT ExpandState Identity Ident)
-> [Ident] -> StateT ExpandState Identity [Ident]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Ident -> Ident -> Message)
-> [Ident] -> Ident -> StateT ExpandState Identity Ident
forall (t :: * -> *) b.
(Foldable t, Eq b) =>
(Ident -> b -> Message)
-> t b -> b -> StateT ExpandState Identity b
checkElement Ident -> Ident -> Message
errUndefinedElement [Ident]
xs) [Ident]
cs
Just (Class _ xs :: [Ident]
xs) -> (Ident -> StateT ExpandState Identity Ident)
-> [Ident] -> StateT ExpandState Identity [Ident]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Ident -> Ident -> Message)
-> [Ident] -> Ident -> StateT ExpandState Identity Ident
forall (t :: * -> *) b.
(Foldable t, Eq b) =>
(Ident -> b -> Message)
-> t b -> b -> StateT ExpandState Identity b
checkElement Ident -> Ident -> Message
errUndefinedMethod [Ident]
xs) [Ident]
cs
Just (Alias _) -> Message -> ExpandM ()
report (Ident -> Message
errNonDataTypeOrTypeClass Ident
tc) ExpandM ()
-> StateT ExpandState Identity [Ident]
-> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Ident] -> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Nothing -> Message -> ExpandM ()
report (ModuleIdent -> Ident -> Message
errUndefinedEntity ModuleIdent
m Ident
tc) ExpandM ()
-> StateT ExpandState Identity [Ident]
-> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Ident] -> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
checkElement :: (Ident -> b -> Message)
-> t b -> b -> StateT ExpandState Identity b
checkElement err :: Ident -> b -> Message
err cs' :: t b
cs' c :: b
c = do
Bool -> ExpandM () -> ExpandM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (b
c b -> t b -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t b
cs') (ExpandM () -> ExpandM ()) -> ExpandM () -> ExpandM ()
forall a b. (a -> b) -> a -> b
$ Message -> ExpandM ()
report (Message -> ExpandM ()) -> Message -> ExpandM ()
forall a b. (a -> b) -> a -> b
$ Ident -> b -> Message
err Ident
tc b
c
b -> StateT ExpandState Identity b
forall (m :: * -> *) a. Monad m => a -> m a
return b
c
expandTypeAll :: SpanInfo -> Ident -> ExpandM Import
expandTypeAll :: SpanInfo -> Ident -> StateT ExpandState Identity Import
expandTypeAll spi :: SpanInfo
spi tc :: Ident
tc = do
ModuleIdent
m <- ExpandM ModuleIdent
getModuleIdent
ExpTCEnv
tcEnv <- ExpandM ExpTCEnv
getTyConsEnv
SpanInfo -> Ident -> [Ident] -> Import
ImportTypeWith SpanInfo
spi Ident
tc ([Ident] -> Import)
-> StateT ExpandState Identity [Ident]
-> StateT ExpandState Identity Import
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` case Ident -> ExpTCEnv -> Maybe ITypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
tc ExpTCEnv
tcEnv of
Just (Data _ xs :: [Ident]
xs) -> [Ident] -> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ident]
xs
Just (Class _ xs :: [Ident]
xs) -> [Ident] -> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a. Monad m => a -> m a
return [Ident]
xs
Just (Alias _) -> Message -> ExpandM ()
report (Ident -> Message
errNonDataTypeOrTypeClass Ident
tc) ExpandM ()
-> StateT ExpandState Identity [Ident]
-> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Ident] -> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Nothing -> Message -> ExpandM ()
report (ModuleIdent -> Ident -> Message
errUndefinedEntity ModuleIdent
m Ident
tc) ExpandM ()
-> StateT ExpandState Identity [Ident]
-> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Ident] -> StateT ExpandState Identity [Ident]
forall (m :: * -> *) a. Monad m => a -> m a
return []
errUndefinedElement :: Ident -> Ident -> Message
errUndefinedElement :: Ident -> Ident -> Message
errUndefinedElement tc :: Ident
tc c :: Ident
c = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage 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
idName Ident
c, "is not a constructor or label of type ", Ident -> String
idName Ident
tc ]
errUndefinedMethod :: Ident -> Ident -> Message
errUndefinedMethod :: Ident -> Ident -> Message
errUndefinedMethod cls :: Ident
cls f :: Ident
f = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage 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
idName Ident
f, "is not a method of class", Ident -> String
idName Ident
cls ]
errUndefinedEntity :: ModuleIdent -> Ident -> Message
errUndefinedEntity :: ModuleIdent -> Ident -> Message
errUndefinedEntity m :: ModuleIdent
m x :: Ident
x = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
x (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
moduleName ModuleIdent
m, "does not export", Ident -> String
idName Ident
x ]
errNonDataTypeOrTypeClass :: Ident -> Message
errNonDataTypeOrTypeClass :: Ident -> Message
errNonDataTypeOrTypeClass tc :: Ident
tc = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage Ident
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
[ Ident -> String
idName Ident
tc, "is not a data type or type class" ]
errImportDataConstr :: ModuleIdent -> Ident -> Message
errImportDataConstr :: ModuleIdent -> Ident -> Message
errImportDataConstr _ c :: Ident
c = Ident -> Doc -> Message
forall s. HasSpanInfo s => s -> Doc -> Message
spanInfoMessage 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
[ "Explicit import for data constructor", Ident -> String
idName Ident
c ]