|
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
module Rename.Types where
|
|
|
|
import Ahc.Data.Lens (lens, Lens, Lens')
|
|
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Data.HashMap.Strict (HashMap)
|
|
import Data.ByteString (ByteString)
|
|
import Data.Text (Text)
|
|
|
|
import Development.Shake.Classes
|
|
|
|
import Frontend.Parser.Posn
|
|
import Frontend.Syntax
|
|
|
|
import GHC.Generics
|
|
|
|
data ModuleId
|
|
= ModuleId { moduleName :: Text
|
|
, moduleFp :: String
|
|
, moduleHash :: ByteString
|
|
}
|
|
deriving (Eq, Show, Generic, NFData, Binary, Hashable)
|
|
|
|
data Namespace
|
|
= DataCon
|
|
| TypeCon
|
|
| Variable
|
|
| Module
|
|
deriving (Eq, Show, Generic, NFData, Binary, Hashable)
|
|
|
|
data FqVar
|
|
= FqVar { fqVarName :: Text
|
|
, fqVarModule :: ModuleId
|
|
, fqVarNamespace :: Namespace
|
|
, fqBegin :: Posn
|
|
, fqEnd :: Posn
|
|
}
|
|
deriving (Eq, Show, Generic, NFData, Binary, Hashable)
|
|
|
|
instance HasPosn FqVar where
|
|
startPosn = fqBegin
|
|
endPosn = fqEnd
|
|
span s e var = var { fqBegin = startPosn s, fqEnd = endPosn e }
|
|
|
|
data RenamedMod
|
|
= RnmMod { rnmModModule :: FeModule FqVar
|
|
, rnmModSignature :: Scope }
|
|
deriving (Eq, Show, Generic, NFData, Binary, Hashable)
|
|
|
|
data Scope
|
|
= Scope
|
|
{ _scopeNames :: HashMap Text [FqVar]
|
|
, _scopeTypes :: HashMap Text [FqVar]
|
|
, _scopeNamespaces :: HashMap Text (FqVar, Scope) }
|
|
deriving (Eq, Show, Generic, NFData, Binary, Hashable)
|
|
|
|
scopeNames :: Lens' Scope (HashMap Text [FqVar])
|
|
scopeNames = lens _scopeNames (\s x -> s { _scopeNames = x})
|
|
|
|
scopeTypes :: Lens' Scope (HashMap Text [FqVar])
|
|
scopeTypes = lens _scopeTypes (\s x -> s { _scopeTypes = x})
|
|
|
|
scopeNamespaces :: Lens' Scope (HashMap Text (FqVar, Scope))
|
|
scopeNamespaces = lens _scopeNamespaces (\s x -> s { _scopeNamespaces = x})
|
|
|
|
instance Semigroup Scope where
|
|
Scope nam typ ns <> Scope nam' typ' ns'
|
|
= Scope (nam `merge` nam') (typ `merge` typ') (ns `merge'` ns')
|
|
where
|
|
merge = HashMap.unionWith (<>)
|
|
merge' = HashMap.unionWith (\(x, y) (_, z) -> (x, y <> z))
|
|
|
|
instance Monoid Scope where
|
|
mempty = Scope mempty mempty mempty
|
|
|
|
instance (Eq k, Hashable k, Binary k, Binary v) => Binary (HashMap k v) where
|
|
get = HashMap.fromList <$> get
|
|
put = put . HashMap.toList
|