{- |
    Module      :  $Header$
    Description :  Checking import specifications
    Copyright   :  (c) 2016       Jan Tikovsky
                       2016       Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  jrt@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module provides the function 'importCheck' to check and expand
    the import specifications of all import declarations.
-}
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]

-- ---------------------------------------------------------------------------
-- Expansion of the import specification
-- ---------------------------------------------------------------------------

-- After the environments have been initialized, the optional import
-- specifications can be checked. There are two kinds of import
-- specifications, a ``normal'' one, which names the entities that shall
-- be imported, and a hiding specification, which lists those entities
-- that shall not be imported.
--
-- There is a subtle difference between both kinds of
-- specifications: While it is not allowed to list a data constructor
-- outside of its type in a ``normal'' specification, it is allowed to
-- hide a data constructor explicitly. E.g., if module \texttt{A} exports
-- the data type \texttt{T} with constructor \texttt{C}, the data
-- constructor can be imported with one of the two specifications
--
-- import A (T(C))
-- import A (T(..))
--
-- but can be hidden in three different ways:
--
-- import A hiding (C)
-- import A hiding (T (C))
-- import A hiding (T (..))
--
-- The functions \texttt{expandImport} and \texttt{expandHiding} check
-- that all entities in an import specification are actually exported
-- from the module. In addition, all imports of type constructors are
-- changed into a \texttt{T()} specification and explicit imports for the
-- data constructors are added.

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

-- try to expand as type constructor
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

-- try to expand as function / data constructor
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

-- try to hide as type constructor
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

-- try to hide as function / data constructor
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
  -- check if given identifier is constructor or label of type tc
  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 []

-- error messages

errUndefinedElement :: Ident -> Ident -> Message
errUndefinedElement :: Ident -> Ident -> Message
errUndefinedElement tc :: Ident
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
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 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
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 p. HasPosition p => p -> Doc -> Message
posMessage 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 p. HasPosition p => p -> Doc -> Message
posMessage 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 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
  [ "Explicit import for data constructor", Ident -> String
idName Ident
c ]