{-# language ExistentialQuantification, ScopedTypeVariables #-} module Rasa.Internal.Extensions ( Ext(..) , ExtMap , HasBufExts(..) , HasExts(..) , bufExt , ext ) where import Control.Lens import Data.Default import Data.Map import Data.Dynamic import Data.Maybe import Unsafe.Coerce -- | A wrapper around an extension of any type so it can be stored in an 'ExtMap' data Ext = forall a. Show a => Ext a instance Show Ext where show (Ext a) = show a -- | A map of extension types to their current value. type ExtMap = Map TypeRep Ext -- | Members of this class have access to editor extensions. class HasExts s where -- | This lens focuses the Extensions States exts :: Lens' s (Map TypeRep Ext) -- | This is a lens which will focus the extension state that matches the type -- inferred as the focal point. It's a little bit of magic, if you treat the -- focus as a member of your extension state it should just work out. -- -- This lens falls back on the extension's 'Data.Default.Default' instance (when getting) if -- nothing has yet been stored. ext :: forall a e. (Show a, Typeable a, Default a, HasExts e) => Lens' e a ext = lens getter setter where getter s = fromMaybe def $ s ^.exts . at (typeRep (Proxy :: Proxy a)) . mapping coerce setter s new = set (exts . at (typeRep (Proxy :: Proxy a)) . mapping coerce) (Just new) s coerce = iso (\(Ext x) -> unsafeCoerce x) Ext -- | Members of this class have access to buffer extensions. (Each 'Rasa.Internal.Buffer.Buffer' is a member of this class) class HasBufExts s where -- | This lens focuses the Extensions States map of the in-scope buffer. bufExts :: Lens' s (Map TypeRep Ext) -- | 'bufExt' is a lens which will focus a given extension's state within a -- buffer (within a 'Data.Action.BufAction'). The lens will automagically focus -- the required extension by using type inference. It's a little bit of magic, -- if you treat the focus as a member of your extension state it should just -- work out. -- -- This lens falls back on the extension's 'Data.Default.Default' instance (when getting) if -- nothing has yet been stored. bufExt :: forall a s. (Show a, Typeable a, Default a, HasBufExts s) => Lens' s a bufExt = lens getter setter where getter buf = fromMaybe def $ buf ^. bufExts . at (typeRep (Proxy :: Proxy a)) . mapping coerce setter buf new = set (bufExts . at (typeRep (Proxy :: Proxy a)) . mapping coerce) (Just new) buf coerce :: (Show a1) => Iso Ext Ext a a1 coerce = iso (\(Ext x) -> unsafeCoerce x) Ext