{-# LANGUAGE ViewPatterns, GeneralizedNewtypeDeriving #-}

module HSE.Scope(
    Scope, scopeCreate, scopeImports,
    scopeMatch, scopeMove
    ) where

import Data.Semigroup
import HSE.Type
import HSE.Util
import Data.List
import Data.Maybe
import Prelude

{-
the hint file can do:

import Prelude (filter)
import Data.List (filter)
import List (filter)

then filter on it's own will get expanded to all of them

import Data.List
import List as Data.List


if Data.List.head x ==> x, then that might match List too
-}


-- | Data type representing the modules in scope within a module.
--   Created with 'scopeCreate' and queried with 'scopeMatch' and 'scopeMove'.
--   Note that the 'mempty' 'Scope' is not equivalent to 'scopeCreate' on an empty module,
--   due to the implicit import of 'Prelude'.
newtype Scope = Scope [ImportDecl S]
             deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show, Semigroup Scope
Scope
Semigroup Scope =>
Scope
-> (Scope -> Scope -> Scope) -> ([Scope] -> Scope) -> Monoid Scope
[Scope] -> Scope
Scope -> Scope -> Scope
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Scope] -> Scope
$cmconcat :: [Scope] -> Scope
mappend :: Scope -> Scope -> Scope
$cmappend :: Scope -> Scope -> Scope
mempty :: Scope
$cmempty :: Scope
$cp1Monoid :: Semigroup Scope
Monoid, b -> Scope -> Scope
NonEmpty Scope -> Scope
Scope -> Scope -> Scope
(Scope -> Scope -> Scope)
-> (NonEmpty Scope -> Scope)
-> (forall b. Integral b => b -> Scope -> Scope)
-> Semigroup Scope
forall b. Integral b => b -> Scope -> Scope
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Scope -> Scope
$cstimes :: forall b. Integral b => b -> Scope -> Scope
sconcat :: NonEmpty Scope -> Scope
$csconcat :: NonEmpty Scope -> Scope
<> :: Scope -> Scope -> Scope
$c<> :: Scope -> Scope -> Scope
Semigroup)

-- | Create a 'Scope' value from a module, based on the modules imports.
scopeCreate :: Module SrcSpanInfo -> Scope
scopeCreate :: Module SrcSpanInfo -> Scope
scopeCreate xs :: Module SrcSpanInfo
xs = [ImportDecl SrcSpanInfo] -> Scope
Scope ([ImportDecl SrcSpanInfo] -> Scope)
-> [ImportDecl SrcSpanInfo] -> Scope
forall a b. (a -> b) -> a -> b
$ [ImportDecl SrcSpanInfo
prelude | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ImportDecl SrcSpanInfo -> Bool)
-> [ImportDecl SrcSpanInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ImportDecl SrcSpanInfo -> Bool
isPrelude [ImportDecl SrcSpanInfo]
res] [ImportDecl SrcSpanInfo]
-> [ImportDecl SrcSpanInfo] -> [ImportDecl SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [ImportDecl SrcSpanInfo]
res
    where
        res :: [ImportDecl SrcSpanInfo]
res = [ImportDecl SrcSpanInfo
x | ImportDecl SrcSpanInfo
x <- Module SrcSpanInfo -> [ImportDecl SrcSpanInfo]
moduleImports Module SrcSpanInfo
xs, ImportDecl SrcSpanInfo -> Maybe String
forall l. ImportDecl l -> Maybe String
importPkg ImportDecl SrcSpanInfo
x Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just "hint"]
        prelude :: ImportDecl SrcSpanInfo
prelude = SrcSpanInfo
-> ModuleName SrcSpanInfo
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName SrcSpanInfo)
-> Maybe (ImportSpecList SrcSpanInfo)
-> ImportDecl SrcSpanInfo
forall l.
l
-> ModuleName l
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Maybe (ModuleName l)
-> Maybe (ImportSpecList l)
-> ImportDecl l
ImportDecl SrcSpanInfo
an (SrcSpanInfo -> String -> ModuleName SrcSpanInfo
forall l. l -> String -> ModuleName l
ModuleName SrcSpanInfo
an "Prelude") Bool
False Bool
False Bool
False Maybe String
forall a. Maybe a
Nothing Maybe (ModuleName SrcSpanInfo)
forall a. Maybe a
Nothing Maybe (ImportSpecList SrcSpanInfo)
forall a. Maybe a
Nothing
        isPrelude :: ImportDecl SrcSpanInfo -> Bool
isPrelude x :: ImportDecl SrcSpanInfo
x = ModuleName SrcSpanInfo -> String
fromModuleName (ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo
forall l. ImportDecl l -> ModuleName l
importModule ImportDecl SrcSpanInfo
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Prelude"


scopeImports :: Scope -> [ImportDecl S]
scopeImports :: Scope -> [ImportDecl SrcSpanInfo]
scopeImports (Scope x :: [ImportDecl SrcSpanInfo]
x) = [ImportDecl SrcSpanInfo]
x



-- | Given a two names in scopes, could they possibly refer to the same thing.
--   This property is reflexive.
scopeMatch :: (Scope, QName S) -> (Scope, QName S) -> Bool
scopeMatch :: (Scope, QName SrcSpanInfo) -> (Scope, QName SrcSpanInfo) -> Bool
scopeMatch (a :: Scope
a, x :: QName SrcSpanInfo
x@Special{}) (b :: Scope
b, y :: QName SrcSpanInfo
y@Special{}) = QName SrcSpanInfo
x QName SrcSpanInfo -> QName SrcSpanInfo -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= QName SrcSpanInfo
y
scopeMatch (a :: Scope
a, x :: QName SrcSpanInfo
x) (b :: Scope
b, y :: QName SrcSpanInfo
y) | QName SrcSpanInfo -> Bool
isSpecial QName SrcSpanInfo
x Bool -> Bool -> Bool
|| QName SrcSpanInfo -> Bool
isSpecial QName SrcSpanInfo
y = Bool
False
scopeMatch (a :: Scope
a, x :: QName SrcSpanInfo
x) (b :: Scope
b, y :: QName SrcSpanInfo
y) = QName SrcSpanInfo -> QName SrcSpanInfo
unqual QName SrcSpanInfo
x QName SrcSpanInfo -> QName SrcSpanInfo -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= QName SrcSpanInfo -> QName SrcSpanInfo
unqual QName SrcSpanInfo
y Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Scope -> QName SrcSpanInfo -> [String]
possModules Scope
a QName SrcSpanInfo
x [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Scope -> QName SrcSpanInfo -> [String]
possModules Scope
b QName SrcSpanInfo
y)


-- | Given a name in a scope, and a new scope, create a name for the new scope that will refer
--   to the same thing. If the resulting name is ambiguous, it picks a plausible candidate.
scopeMove :: (Scope, QName S) -> Scope -> QName S
scopeMove :: (Scope, QName SrcSpanInfo) -> Scope -> QName SrcSpanInfo
scopeMove (a :: Scope
a, x :: QName SrcSpanInfo
x@(QName SrcSpanInfo -> Maybe (Name SrcSpanInfo)
forall a. QName a -> Maybe (Name a)
fromQual -> Just name :: Name SrcSpanInfo
name)) (Scope b :: [ImportDecl SrcSpanInfo]
b)
    | [ImportDecl SrcSpanInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ImportDecl SrcSpanInfo]
imps = [QName SrcSpanInfo] -> QName SrcSpanInfo
forall a. [a] -> a
head ([QName SrcSpanInfo] -> QName SrcSpanInfo)
-> [QName SrcSpanInfo] -> QName SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ [QName SrcSpanInfo]
real [QName SrcSpanInfo] -> [QName SrcSpanInfo] -> [QName SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ [QName SrcSpanInfo
x]
    | (ImportDecl SrcSpanInfo -> Bool)
-> [ImportDecl SrcSpanInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool)
-> (ImportDecl SrcSpanInfo -> Bool)
-> ImportDecl SrcSpanInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl SrcSpanInfo -> Bool
forall l. ImportDecl l -> Bool
importQualified) [ImportDecl SrcSpanInfo]
imps = QName SrcSpanInfo -> QName SrcSpanInfo
unqual QName SrcSpanInfo
x
    | Bool
otherwise = SrcSpanInfo
-> ModuleName SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> ModuleName l -> Name l -> QName l
Qual SrcSpanInfo
an ([ModuleName SrcSpanInfo] -> ModuleName SrcSpanInfo
forall a. [a] -> a
head ([ModuleName SrcSpanInfo] -> ModuleName SrcSpanInfo)
-> [ModuleName SrcSpanInfo] -> ModuleName SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ (ImportDecl SrcSpanInfo -> Maybe (ModuleName SrcSpanInfo))
-> [ImportDecl SrcSpanInfo] -> [ModuleName SrcSpanInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ImportDecl SrcSpanInfo -> Maybe (ModuleName SrcSpanInfo)
forall l. ImportDecl l -> Maybe (ModuleName l)
importAs [ImportDecl SrcSpanInfo]
imps [ModuleName SrcSpanInfo]
-> [ModuleName SrcSpanInfo] -> [ModuleName SrcSpanInfo]
forall a. [a] -> [a] -> [a]
++ (ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo)
-> [ImportDecl SrcSpanInfo] -> [ModuleName SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo
forall l. ImportDecl l -> ModuleName l
importModule [ImportDecl SrcSpanInfo]
imps) Name SrcSpanInfo
name
    where
        real :: [QName SrcSpanInfo]
real = [SrcSpanInfo
-> ModuleName SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> ModuleName l -> Name l -> QName l
Qual SrcSpanInfo
an (SrcSpanInfo -> String -> ModuleName SrcSpanInfo
forall l. l -> String -> ModuleName l
ModuleName SrcSpanInfo
an String
m) Name SrcSpanInfo
name | String
m <- Scope -> QName SrcSpanInfo -> [String]
possModules Scope
a QName SrcSpanInfo
x]
        imps :: [ImportDecl SrcSpanInfo]
imps = [ImportDecl SrcSpanInfo
i | QName SrcSpanInfo
r <- [QName SrcSpanInfo]
real, ImportDecl SrcSpanInfo
i <- [ImportDecl SrcSpanInfo]
b, ImportDecl SrcSpanInfo -> QName SrcSpanInfo -> Bool
possImport ImportDecl SrcSpanInfo
i QName SrcSpanInfo
r]
scopeMove (_, x :: QName SrcSpanInfo
x) _ = QName SrcSpanInfo
x


-- which modules could a name possibly lie in
-- if it's qualified but not matching any import, assume the user
-- just lacks an import
possModules :: Scope -> QName S -> [String]
possModules :: Scope -> QName SrcSpanInfo -> [String]
possModules (Scope is :: [ImportDecl SrcSpanInfo]
is) x :: QName SrcSpanInfo
x = QName SrcSpanInfo -> [String]
f QName SrcSpanInfo
x
    where
        res :: [String]
res = [ModuleName SrcSpanInfo -> String
fromModuleName (ModuleName SrcSpanInfo -> String)
-> ModuleName SrcSpanInfo -> String
forall a b. (a -> b) -> a -> b
$ ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo
forall l. ImportDecl l -> ModuleName l
importModule ImportDecl SrcSpanInfo
i | ImportDecl SrcSpanInfo
i <- [ImportDecl SrcSpanInfo]
is, ImportDecl SrcSpanInfo -> QName SrcSpanInfo -> Bool
possImport ImportDecl SrcSpanInfo
i QName SrcSpanInfo
x]

        f :: QName SrcSpanInfo -> [String]
f Special{} = [""]
        f x :: QName SrcSpanInfo
x@(Qual _ mod :: ModuleName SrcSpanInfo
mod _) = [ModuleName SrcSpanInfo -> String
fromModuleName ModuleName SrcSpanInfo
mod | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
res] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
res
        f _ = [String]
res


possImport :: ImportDecl S -> QName S -> Bool
possImport :: ImportDecl SrcSpanInfo -> QName SrcSpanInfo -> Bool
possImport i :: ImportDecl SrcSpanInfo
i Special{} = Bool
False
possImport i :: ImportDecl SrcSpanInfo
i (Qual _ mod :: ModuleName SrcSpanInfo
mod x :: Name SrcSpanInfo
x) = ModuleName SrcSpanInfo -> String
fromModuleName ModuleName SrcSpanInfo
mod String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ModuleName SrcSpanInfo -> String)
-> [ModuleName SrcSpanInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName SrcSpanInfo -> String
fromModuleName [ModuleName SrcSpanInfo]
ms Bool -> Bool -> Bool
&& ImportDecl SrcSpanInfo -> QName SrcSpanInfo -> Bool
possImport ImportDecl SrcSpanInfo
i{importQualified :: Bool
importQualified=Bool
False} (SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> Name l -> QName l
UnQual SrcSpanInfo
an Name SrcSpanInfo
x)
    where ms :: [ModuleName SrcSpanInfo]
ms = ImportDecl SrcSpanInfo -> ModuleName SrcSpanInfo
forall l. ImportDecl l -> ModuleName l
importModule ImportDecl SrcSpanInfo
i ModuleName SrcSpanInfo
-> [ModuleName SrcSpanInfo] -> [ModuleName SrcSpanInfo]
forall a. a -> [a] -> [a]
: Maybe (ModuleName SrcSpanInfo) -> [ModuleName SrcSpanInfo]
forall a. Maybe a -> [a]
maybeToList (ImportDecl SrcSpanInfo -> Maybe (ModuleName SrcSpanInfo)
forall l. ImportDecl l -> Maybe (ModuleName l)
importAs ImportDecl SrcSpanInfo
i)
possImport i :: ImportDecl SrcSpanInfo
i (UnQual _ x :: Name SrcSpanInfo
x) = Bool -> Bool
not (ImportDecl SrcSpanInfo -> Bool
forall l. ImportDecl l -> Bool
importQualified ImportDecl SrcSpanInfo
i) Bool -> Bool -> Bool
&& Bool
-> (ImportSpecList SrcSpanInfo -> Bool)
-> Maybe (ImportSpecList SrcSpanInfo)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ImportSpecList SrcSpanInfo -> Bool
f (ImportDecl SrcSpanInfo -> Maybe (ImportSpecList SrcSpanInfo)
forall l. ImportDecl l -> Maybe (ImportSpecList l)
importSpecs ImportDecl SrcSpanInfo
i)
    where
        f :: ImportSpecList SrcSpanInfo -> Bool
f (ImportSpecList _ hide :: Bool
hide xs :: [ImportSpec SrcSpanInfo]
xs) = if Bool
hide then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> [Maybe Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Maybe Bool]
ms else Maybe Bool
forall a. Maybe a
Nothing Maybe Bool -> [Maybe Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms Bool -> Bool -> Bool
|| Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> [Maybe Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Bool]
ms
            where ms :: [Maybe Bool]
ms = (ImportSpec SrcSpanInfo -> Maybe Bool)
-> [ImportSpec SrcSpanInfo] -> [Maybe Bool]
forall a b. (a -> b) -> [a] -> [b]
map ImportSpec SrcSpanInfo -> Maybe Bool
g [ImportSpec SrcSpanInfo]
xs

        g :: ImportSpec S -> Maybe Bool -- does this import cover the name x
        g :: ImportSpec SrcSpanInfo -> Maybe Bool
g (IVar _ y :: Name SrcSpanInfo
y) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo
x Name SrcSpanInfo -> Name SrcSpanInfo -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Name SrcSpanInfo
y
        g (IAbs _ _ y :: Name SrcSpanInfo
y) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo
x Name SrcSpanInfo -> Name SrcSpanInfo -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Name SrcSpanInfo
y
        g (IThingAll _ y :: Name SrcSpanInfo
y) = if Name SrcSpanInfo
x Name SrcSpanInfo -> Name SrcSpanInfo -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Name SrcSpanInfo
y then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True else Maybe Bool
forall a. Maybe a
Nothing
        g (IThingWith _ y :: Name SrcSpanInfo
y ys :: [CName SrcSpanInfo]
ys) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo
x Name SrcSpanInfo -> [Name SrcSpanInfo] -> Bool
forall (f :: * -> *).
(Annotated f, Eq (f ())) =>
f SrcSpanInfo -> [f SrcSpanInfo] -> Bool
`elem_` (Name SrcSpanInfo
y Name SrcSpanInfo -> [Name SrcSpanInfo] -> [Name SrcSpanInfo]
forall a. a -> [a] -> [a]
: (CName SrcSpanInfo -> Name SrcSpanInfo)
-> [CName SrcSpanInfo] -> [Name SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map CName SrcSpanInfo -> Name SrcSpanInfo
fromCName [CName SrcSpanInfo]
ys)

        fromCName :: CName S -> Name S
        fromCName :: CName SrcSpanInfo -> Name SrcSpanInfo
fromCName (VarName _ x :: Name SrcSpanInfo
x) = Name SrcSpanInfo
x
        fromCName (ConName _ x :: Name SrcSpanInfo
x) = Name SrcSpanInfo
x