module Language.Haskell.Names.ScopeUtils where

import Control.Arrow
import Data.Monoid
import Language.Haskell.Names.Types
import Language.Haskell.Names.SyntaxUtils
import Language.Haskell.Exts
import qualified Language.Haskell.Names.GlobalSymbolTable as Global
import Control.Monad (guard)
import Data.List (nub)

scopeError :: Functor f => Error l -> f l -> f (Scoped l)
scopeError :: forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError Error l
e f l
f = NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped (Error l -> NameInfo l
forall l. Error l -> NameInfo l
ScopeError Error l
e) (l -> Scoped l) -> f l -> f (Scoped l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f l
f

none :: l -> Scoped l
none :: forall l. l -> Scoped l
none = NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped NameInfo l
forall l. NameInfo l
None

noScope :: (Annotated a) => a l -> a (Scoped l)
noScope :: forall (a :: * -> *) l. Annotated a => a l -> a (Scoped l)
noScope = (l -> Scoped l) -> a l -> a (Scoped l)
forall a b. (a -> b) -> a a -> a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l -> Scoped l
forall l. l -> Scoped l
none

symbolParent :: Symbol -> Maybe (Name ())
symbolParent :: Symbol -> Maybe (Name ())
symbolParent (Selector { typeName :: Symbol -> Name ()
typeName = Name ()
n }) = Name () -> Maybe (Name ())
forall a. a -> Maybe a
Just Name ()
n
symbolParent (Constructor { typeName :: Symbol -> Name ()
typeName = Name ()
n }) = Name () -> Maybe (Name ())
forall a. a -> Maybe a
Just Name ()
n
symbolParent (Method { className :: Symbol -> Name ()
className = Name ()
n }) = Name () -> Maybe (Name ())
forall a. a -> Maybe a
Just Name ()
n
symbolParent (TypeFam { associate :: Symbol -> Maybe (Name ())
associate = Maybe (Name ())
as }) = Maybe (Name ())
as
symbolParent (DataFam { associate :: Symbol -> Maybe (Name ())
associate = Maybe (Name ())
as }) = Maybe (Name ())
as
symbolParent (PatternConstructor { patternTypeName :: Symbol -> Maybe (Name ())
patternTypeName = Maybe (Name ())
mn}) = Maybe (Name ())
mn
symbolParent (PatternSelector { patternTypeName :: Symbol -> Maybe (Name ())
patternTypeName = Maybe (Name ())
mn}) = Maybe (Name ())
mn
symbolParent Symbol
_ = Maybe (Name ())
forall a. Maybe a
Nothing

computeSymbolTable
  :: Bool
    -- ^ If 'True' (\"qualified\"), then only the qualified names are
    -- inserted.
    --
    -- If 'False', then both qualified and unqualified names are insterted.
  -> ModuleName ()
  -> [Symbol]
  -> Global.Table
computeSymbolTable :: Bool -> ModuleName () -> [Symbol] -> Table
computeSymbolTable Bool
qual ModuleName ()
modulename [Symbol]
symbols =
  [(QName (), Symbol)] -> Table
Global.fromList ([(QName (), Symbol)]
qualified [(QName (), Symbol)]
-> [(QName (), Symbol)] -> [(QName (), Symbol)]
forall a. Semigroup a => a -> a -> a
<> if Bool
qual then [] else [(QName (), Symbol)]
unqualified) where
    qualified :: [(QName (), Symbol)]
qualified = do
        Symbol
symbol <- [Symbol]
symbols
        (QName (), Symbol) -> [(QName (), Symbol)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual  ()ModuleName ()
modulename (Symbol -> Name ()
symbolName Symbol
symbol),Symbol
symbol)
    unqualified :: [(QName (), Symbol)]
unqualified = do
        Symbol
symbol <- [Symbol]
symbols
        (QName (), Symbol) -> [(QName (), Symbol)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Symbol -> Name ()
symbolName Symbol
symbol),Symbol
symbol)

-- | Find a single constructor or method name in a list of symbols
resolveCName
  :: [Symbol]
  -> Name ()
  -> (CName l -> Error l) -- ^ error for "not found" condition
  -> CName l
  -> (CName (Scoped l), [Symbol])
resolveCName :: forall l.
[Symbol]
-> Name ()
-> (CName l -> Error l)
-> CName l
-> (CName (Scoped l), [Symbol])
resolveCName [Symbol]
symbols Name ()
parent CName l -> Error l
notFound CName l
cn =
  let
    vs :: [Symbol]
vs = [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a]
nub (do
        Symbol
symbol <- [Symbol]
symbols
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Symbol -> Bool
Global.isValue Symbol
symbol)
        let name :: Name ()
name = Symbol -> Name ()
symbolName Symbol
symbol
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (CName l -> Name l
forall l. CName l -> Name l
unCName CName l
cn) Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Name ()
name)
        Just Name ()
p <- Maybe (Name ()) -> [Maybe (Name ())]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Name ()) -> [Maybe (Name ())])
-> Maybe (Name ()) -> [Maybe (Name ())]
forall a b. (a -> b) -> a -> b
$ Symbol -> Maybe (Name ())
symbolParent Symbol
symbol
        Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Name ()
p Name () -> Name () -> Bool
forall a. Eq a => a -> a -> Bool
== Name ()
parent)
        Symbol -> [Symbol]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
symbol)
  in
    case [Symbol]
vs of
      [] -> (Error l -> CName l -> CName (Scoped l)
forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError (CName l -> Error l
notFound CName l
cn) CName l
cn, [])
      [Symbol
symbol] -> (NameInfo l -> l -> Scoped l
forall l. NameInfo l -> l -> Scoped l
Scoped (Symbol -> QName () -> NameInfo l
forall l. Symbol -> QName () -> NameInfo l
GlobalSymbol Symbol
symbol (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name l -> Name ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn (CName l -> Name l
forall l. CName l -> Name l
unCName CName l
cn)))) (l -> Scoped l) -> CName l -> CName (Scoped l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CName l
cn, [Symbol
symbol])
      [Symbol]
_ -> (Error l -> CName l -> CName (Scoped l)
forall (f :: * -> *) l. Functor f => Error l -> f l -> f (Scoped l)
scopeError (String -> Error l
forall l. String -> Error l
EInternal String
"resolveCName") CName l
cn, [])

-- | Find a list of constructor or method names in a list of symbols.
resolveCNames
  :: [Symbol]
  -> Name ()
  -> (CName l -> Error l) -- ^ error for "not found" condition
  -> [CName l]
  -> ([CName (Scoped l)], [Symbol])
resolveCNames :: forall l.
[Symbol]
-> Name ()
-> (CName l -> Error l)
-> [CName l]
-> ([CName (Scoped l)], [Symbol])
resolveCNames [Symbol]
syms Name ()
orig CName l -> Error l
notFound =
  ([[Symbol]] -> [Symbol])
-> ([CName (Scoped l)], [[Symbol]])
-> ([CName (Scoped l)], [Symbol])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [[Symbol]] -> [Symbol]
forall a. Monoid a => [a] -> a
mconcat (([CName (Scoped l)], [[Symbol]])
 -> ([CName (Scoped l)], [Symbol]))
-> ([CName l] -> ([CName (Scoped l)], [[Symbol]]))
-> [CName l]
-> ([CName (Scoped l)], [Symbol])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CName (Scoped l), [Symbol])] -> ([CName (Scoped l)], [[Symbol]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(CName (Scoped l), [Symbol])]
 -> ([CName (Scoped l)], [[Symbol]]))
-> ([CName l] -> [(CName (Scoped l), [Symbol])])
-> [CName l]
-> ([CName (Scoped l)], [[Symbol]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CName l -> (CName (Scoped l), [Symbol]))
-> [CName l] -> [(CName (Scoped l), [Symbol])]
forall a b. (a -> b) -> [a] -> [b]
map ([Symbol]
-> Name ()
-> (CName l -> Error l)
-> CName l
-> (CName (Scoped l), [Symbol])
forall l.
[Symbol]
-> Name ()
-> (CName l -> Error l)
-> CName l
-> (CName (Scoped l), [Symbol])
resolveCName [Symbol]
syms Name ()
orig CName l -> Error l
notFound)