Safe Haskell | None |
---|---|
Language | Haskell2010 |
Translation from the private to the public types
- type family XShared a
- class (MShared (XShared a) ~ a, Binary (XShared a)) => ExplicitSharing a where
- removeExplicitSharing :: Proxy a -> ExplicitSharingCache -> XShared a -> a
- class IntroduceSharing a where
- introduceExplicitSharing :: ExplicitSharingCache -> a -> Maybe (XShared a)
- showNormalized :: forall a. (Show a, ExplicitSharing a, MShared (XShared a) ~ a) => Proxy a -> ExplicitSharingCache -> XShared a -> String
- dereferenceFilePathPtr :: ExplicitSharingCache -> FilePathPtr -> FilePath
Documentation
class (MShared (XShared a) ~ a, Binary (XShared a)) => ExplicitSharing a where Source
Many of the public data types that we export in IdeSession have a
corresponding private XShared
version. For instance, we have IdProp
and
XShared IdProp
, SourceError
and XShared SourceError
, etc. These
XShared
types are abstract; what's important is only that they can be
serialized (support FromJSON
and ToJSON
). The main difference between
the public and the private data types is that the private data types use
explicit sharing. This is important for serialization, because there is
quite a bit of sharing in the type information that we collect and losing
this would be a significant performance hit. (The other difference is that
the private data types use specialized types that guarantee strictness.)
The MShared (XShared a) ~ a
condition on the ExplicitSharing
type class
is there for technical reasons only (it convinces GHC that the XShared
type family is a bijection).
removeExplicitSharing :: Proxy a -> ExplicitSharingCache -> XShared a -> a Source
class IntroduceSharing a where Source
Introduce explicit sharing
This provides the opposite translation to removeExplicitSharing. Note however
that this is a partial function -- we never extend the cache, so if a
required value is missing from the cache we return Nothing
.
introduceExplicitSharing :: ExplicitSharingCache -> a -> Maybe (XShared a) Source
showNormalized :: forall a. (Show a, ExplicitSharing a, MShared (XShared a) ~ a) => Proxy a -> ExplicitSharingCache -> XShared a -> String Source