{-# LANGUAGE DeriveDataTypeable #-}
-- | This module is designed to be imported qualified.
module Language.Haskell.Names.GlobalSymbolTable where

import Language.Haskell.Exts hiding (NewType, PatSyn)

import Data.Map (
    Map)
import qualified Data.Map as Map (
    empty,unionWith,fromListWith,lookup)

import Control.Arrow
import Data.List as List (union)
import Data.Maybe (fromMaybe)

import Language.Haskell.Names.Types
import Language.Haskell.Names.SyntaxUtils (dropAnn)

-- | Global symbol table — contains names declared somewhere at the top level.
type Table = Map (QName ()) [Symbol]

-- | Empty global symbol table.
empty :: Table
empty :: Table
empty = Table
forall k a. Map k a
Map.empty

-- | For each name take the union of the lists of symbols they refer to.
mergeTables :: Table -> Table -> Table
mergeTables :: Table -> Table -> Table
mergeTables = ([Symbol] -> [Symbol] -> [Symbol]) -> Table -> Table -> Table
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
List.union

lookupValue :: QName l -> Table -> [Symbol]
lookupValue :: forall l. QName l -> Table -> [Symbol]
lookupValue QName l
qn = (Symbol -> Bool) -> [Symbol] -> [Symbol]
forall a. (a -> Bool) -> [a] -> [a]
filter Symbol -> Bool
isValue ([Symbol] -> [Symbol]) -> (Table -> [Symbol]) -> Table -> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName l -> Table -> [Symbol]
forall l. QName l -> Table -> [Symbol]
lookupName QName l
qn

lookupType :: QName l -> Table -> [Symbol]
lookupType :: forall l. QName l -> Table -> [Symbol]
lookupType QName l
qn = (Symbol -> Bool) -> [Symbol] -> [Symbol]
forall a. (a -> Bool) -> [a] -> [a]
filter Symbol -> Bool
isType ([Symbol] -> [Symbol]) -> (Table -> [Symbol]) -> Table -> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName l -> Table -> [Symbol]
forall l. QName l -> Table -> [Symbol]
lookupName QName l
qn

lookupMethodOrAssociate :: QName l -> Table -> [Symbol]
lookupMethodOrAssociate :: forall l. QName l -> Table -> [Symbol]
lookupMethodOrAssociate QName l
qn = (Symbol -> Bool) -> [Symbol] -> [Symbol]
forall a. (a -> Bool) -> [a] -> [a]
filter Symbol -> Bool
isMethodOrAssociated ([Symbol] -> [Symbol]) -> (Table -> [Symbol]) -> Table -> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName l -> Table -> [Symbol]
forall l. QName l -> Table -> [Symbol]
lookupName QName l
qn

lookupSelector :: QName l -> Table -> [Symbol]
lookupSelector :: forall l. QName l -> Table -> [Symbol]
lookupSelector QName l
qn = (Symbol -> Bool) -> [Symbol] -> [Symbol]
forall a. (a -> Bool) -> [a] -> [a]
filter Symbol -> Bool
isSelector ([Symbol] -> [Symbol]) -> (Table -> [Symbol]) -> Table -> [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName l -> Table -> [Symbol]
forall l. QName l -> Table -> [Symbol]
lookupName QName l
qn

lookupName ::  QName l -> Table -> [Symbol]
lookupName :: forall l. QName l -> Table -> [Symbol]
lookupName QName l
qn Table
table = [Symbol] -> Maybe [Symbol] -> [Symbol]
forall a. a -> Maybe a -> a
fromMaybe [] (QName () -> Table -> Maybe [Symbol]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (QName l -> QName ()
forall (a :: * -> *) l. Functor a => a l -> a ()
dropAnn QName l
qn) Table
table)

isValue :: Symbol -> Bool
isValue :: Symbol -> Bool
isValue Symbol
symbol = case Symbol
symbol of
    Value {} -> Bool
True
    Method {} -> Bool
True
    Selector {} -> Bool
True
    Constructor {} -> Bool
True
    PatternConstructor {} -> Bool
True
    PatternSelector {} -> Bool
True
    Symbol
_ -> Bool
False

isType :: Symbol -> Bool
isType :: Symbol -> Bool
isType Symbol
symbol = case Symbol
symbol of
    Type {} -> Bool
True
    Data {} -> Bool
True
    NewType {} -> Bool
True
    TypeFam {} -> Bool
True
    DataFam {} -> Bool
True
    Class   {} -> Bool
True
    Symbol
_ -> Bool
False

isMethodOrAssociated :: Symbol -> Bool
isMethodOrAssociated :: Symbol -> Bool
isMethodOrAssociated Symbol
symbol = case Symbol
symbol of
    Method {} -> Bool
True
    TypeFam {} -> Bool
True
    DataFam {} -> Bool
True
    Symbol
_ -> Bool
False

isSelector :: Symbol -> Bool
isSelector :: Symbol -> Bool
isSelector Symbol
symbol = case Symbol
symbol of
    Selector {} -> Bool
True
    PatternSelector {} -> Bool
True
    Symbol
_ -> Bool
False

fromList :: [(QName (),Symbol)] -> Table
fromList :: [(QName (), Symbol)] -> Table
fromList = ([Symbol] -> [Symbol] -> [Symbol])
-> [(QName (), [Symbol])] -> Table
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Symbol] -> [Symbol] -> [Symbol]
forall a. Eq a => [a] -> [a] -> [a]
List.union ([(QName (), [Symbol])] -> Table)
-> ([(QName (), Symbol)] -> [(QName (), [Symbol])])
-> [(QName (), Symbol)]
-> Table
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((QName (), Symbol) -> (QName (), [Symbol]))
-> [(QName (), Symbol)] -> [(QName (), [Symbol])]
forall a b. (a -> b) -> [a] -> [b]
map ((Symbol -> [Symbol]) -> (QName (), Symbol) -> (QName (), [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] -> [Symbol]
forall a. a -> [a] -> [a]
:[]))