{-# LANGUAGE RankNTypes #-}

module HsDev.Symbols.Resolve (
	RefineTable, refineTable, refineSymbol, refineSymbols,
	symbolUniqId
	) where

import Control.Lens
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)

import HsDev.Symbols

type RefineTable = M.Map (Text, Text, SymbolInfo) Symbol

refineTable :: [Symbol] -> RefineTable
refineTable :: [Symbol] -> RefineTable
refineTable [Symbol]
syms = [((Text, Text, SymbolInfo), Symbol)] -> RefineTable
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Symbol -> (Text, Text, SymbolInfo)
symbolUniqId Symbol
s, Symbol
s) | Symbol
s <- [Symbol]
syms]

refineSymbol :: RefineTable -> Symbol -> Symbol
refineSymbol :: RefineTable -> Symbol -> Symbol
refineSymbol RefineTable
tbl Symbol
s = Symbol -> Maybe Symbol -> Symbol
forall a. a -> Maybe a -> a
fromMaybe Symbol
s (Maybe Symbol -> Symbol) -> Maybe Symbol -> Symbol
forall a b. (a -> b) -> a -> b
$ (Text, Text, SymbolInfo) -> RefineTable -> Maybe Symbol
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Symbol -> (Text, Text, SymbolInfo)
symbolUniqId Symbol
s) RefineTable
tbl

refineSymbols :: RefineTable -> Module -> Module
refineSymbols :: RefineTable -> Module -> Module
refineSymbols RefineTable
tbl = ASetter Module Module Symbol Symbol
-> (Symbol -> Symbol) -> Module -> Module
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Module Module Symbol Symbol
Traversal' Module Symbol
moduleSymbols (RefineTable -> Symbol -> Symbol
refineSymbol RefineTable
tbl)

symbolUniqId :: Symbol -> (Text, Text, SymbolInfo)
symbolUniqId :: Symbol -> (Text, Text, SymbolInfo)
symbolUniqId Symbol
s = (Getting Text Symbol Text -> Symbol -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol)
-> ((Text -> Const Text Text) -> SymbolId -> Const Text SymbolId)
-> Getting Text Symbol Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> SymbolId -> Const Text SymbolId
Lens' SymbolId Text
symbolName) Symbol
s, Getting Text Symbol Text -> Symbol -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> Const Text SymbolId) -> Symbol -> Const Text Symbol)
-> ((Text -> Const Text Text) -> SymbolId -> Const Text SymbolId)
-> Getting Text Symbol Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> Const Text ModuleId)
-> SymbolId -> Const Text SymbolId
Lens' SymbolId ModuleId
symbolModule ((ModuleId -> Const Text ModuleId)
 -> SymbolId -> Const Text SymbolId)
-> ((Text -> Const Text Text) -> ModuleId -> Const Text ModuleId)
-> (Text -> Const Text Text)
-> SymbolId
-> Const Text SymbolId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> ModuleId -> Const Text ModuleId
Lens' ModuleId Text
moduleName) Symbol
s, SymbolInfo -> SymbolInfo
nullifyInfo (SymbolInfo -> SymbolInfo) -> SymbolInfo -> SymbolInfo
forall a b. (a -> b) -> a -> b
$ Getting SymbolInfo Symbol SymbolInfo -> Symbol -> SymbolInfo
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SymbolInfo Symbol SymbolInfo
Lens' Symbol SymbolInfo
symbolInfo Symbol
s)