{-| Module : MetaHS.DataModel.Utils.NameResolution Description : The MetaHS extractor for uses relations Copyright : Copyright (C) 2017-2019 H.H.R.F. Vos, S. Kamps License : -- This file is distributed under the terms of the Apache License 2.0. For more information, see the file "LICENSE", which is included in the distribution. Stability : experimental NameResolution functions -} module MetaHS.DataModel.Utils.NameResolution ( NameResolutionMap , NameResolutionMaps , createNameResolutionMaps , resolveType , resolveValue ) where import Data.Maybe (fromMaybe) import Data.Set (filter) import qualified Data.Map as Map import qualified MetaHS.DataModel.MetaModel as MetaModel import MetaHS.DataModel.Utils.Name -- | A NameResolutionMap is a Data.Map that map from plain identifiers to resolved MetaModel.Element (e.g. "sum" -> Function "M.N.sum"). type NameResolutionMap = Map.Map String MetaModel.Element -- | The NameResolutionMaps. The first Data.Map is applicable to types; the second Data.Map is applicable to values. type NameResolutionMaps = (NameResolutionMap, NameResolutionMap) -- | Creates the NameResolution Data.Map instances. createNameResolutionMaps :: String -- ^ Module name. -> MetaModel.Relation -- ^ The "Module mn `Contains` Element" Relations. -> NameResolutionMaps -- ^ The resulting NameResolutionMaps. createNameResolutionMaps mn r = foldr f empty fcrs where fcrs = Data.Set.filter (isModuleNameContains mn) r -- fcrs = filtered contains relations. List of "Module mn `Contains` Element" Relations that are applicable to the current Module. empty = (Map.empty, Map.empty) :: NameResolutionMaps unqualifiedName = snd . split f (_,mmdt@(MetaModel.DataType mmdtn)) nrms = -- mmdt = MetaModel DataType, mmdtn = MetaModel DataType name, nrms = NameResolutionMaps (Map.insert key value $ fst nrms, snd nrms) where key = unqualifiedName mmdtn value = mmdt f (_,mmts@(MetaModel.TypeSynonym mmtsn)) nrms = -- mmts = MetaModel TypeSynonym, mmtsn = MetaModel TypeSynonym name, nrms = NameResolutionMaps (Map.insert key value $ fst nrms, snd nrms) where key = unqualifiedName mmtsn value = mmts f (_,mmf@(MetaModel.Function mmfn)) nrms = -- mmf = MetaModel Function, mmfn = MetaModel Function name, nrms = NameResolutionMaps (fst nrms, Map.insert key value $ snd nrms) where key = unqualifiedName mmfn value = mmf f _ nrms = nrms -- | Resolves a simple type name to the corresponding qualified Element. -- The simple type name will be qualified with "?" and wrapped in an -- MetaModel.UnknownType Element if the mapping is not known by the -- provided NameResolutionMaps. resolveType :: String -- ^ The simple value name. -> NameResolutionMaps -- ^ The NameResolutionMaps. -> MetaModel.Element -- ^ The corresponding Element. resolveType s nrms = fromMaybe unknown lookupResult where lookupResult = Map.lookup s $ fst nrms -- lookupResult = result from the lookup in the types NameResolutionMap unknown = MetaModel.UnknownType $ makeQualifiedId "?" s -- unknown = UnknownType object in case lookupResult == Nothing -- | Resolves a simple value name to the corresponding qualified Element. -- The simple value name will be qualified with "?" if the mapping is not -- known by the provided NameResolutionMaps. resolveValue :: String -- ^ The simple value name. -> NameResolutionMaps -- ^ The NameResolutionMaps. -> MetaModel.Element -- ^ The corresponding Element. resolveValue s nrms = fromMaybe unknown lookupResult where lookupResult = Map.lookup s $ snd nrms -- lookupResult = result from the lookup in the value NameResolutionMap unknown = MetaModel.Function $ makeQualifiedId "?" s -- unknown = Function object in case lookupResult == Nothing -- | Returns True if the Relation is of the form (Module "mn",Element) -- where mn is the provided Module name. isModuleNameContains :: String -- ^ Module name. -> (MetaModel.Element,MetaModel.Element) -- ^ The (Element,Element) pair to check. -> Bool -- ^ Check result isModuleNameContains mn (MetaModel.Module n,_) = n == mn isModuleNameContains _ _ = False