Refactor ExtensibleState

This removes the persistence since we don’t need it.
Also it replaces the existential by Dynamic from Data.Dynamic.
In addition to that it replaces some undefined hacks
using ScopedTypeVariables.

Author: cocreature

hie-plugin-api/Haskell/Ide/Engine/ExtensibleState.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- Based on the one in xmonad-contrib, original header below
 -----------------------------------------------------------------------------
 -- |
@@ -24,24 +24,21 @@ module Haskell.Ide.Engine.ExtensibleState (
                               , gets
                               ) where
 
-import Control.Applicative
-import Data.Typeable (typeOf,Typeable,cast)
-import qualified Data.Map as M
-import Haskell.Ide.Engine.PluginDescriptor
 import qualified Control.Monad.State.Strict as State
-import Data.Maybe (fromMaybe)
-import Control.Monad
-import Control.Monad.Trans.Class
+import           Control.Monad.Trans.Class
+import           Data.Dynamic
+import qualified Data.Map as M
+import           Haskell.Ide.Engine.PluginDescriptor
 
 -- ---------------------------------------------------------------------
 -- $usage
 --
--- To utilize this feature in a contrib module, create a data type
+-- To utilize this feature in a plugin, create a data type
 -- and make it an instance of ExtensionClass. You can then use
 -- the functions from this module for storing and retrieving your data:
 --
 -- > {-# LANGUAGE DeriveDataTypeable #-}
--- > import qualified XMonad.Util.ExtensibleState as XS
+-- > import qualified Haskell.Ide.Engine.ExtensibleState as XS
 -- >
 -- > data ListStorage = ListStorage [Integer] deriving Typeable
 -- > instance ExtensionClass ListStorage where
@@ -58,28 +55,19 @@ import Control.Monad.Trans.Class
 --
 -- > .. XS.get :: X ListStorage
 --
--- To make your data persistent between restarts, the data type needs to be
--- an instance of Read and Show and the instance declaration has to be changed:
---
 -- > data ListStorage = ListStorage [Integer] deriving (Typeable,Read,Show)
 -- >
 -- > instance ExtensionClass ListStorage where
 -- >   initialValue = ListStorage []
--- >   extensionType = PersistentExtension
 --
--- One should take care that the string representation of the chosen type
--- is unique among the stored values, otherwise it will be overwritten.
--- Normally these string representations contain fully qualified module names
--- when automatically deriving Typeable, so
--- name collisions should not be a problem in most cases.
 -- A module should not try to store common datatypes(e.g. a list of Integers)
 -- without a custom data type as a wrapper to avoid collisions with other modules
 -- trying to store the same data type without a wrapper.
 --
 
 -- | Modify the map of state extensions by applying the given function.
-modifyStateExts :: (M.Map String (Either String StateExtension)
-                   -> M.Map String (Either String StateExtension))
+modifyStateExts :: (M.Map TypeRep Dynamic
+                   -> M.Map TypeRep Dynamic)
                 -> IdeM ()
 modifyStateExts f = lift $ lift $ State.modify $ \st -> st { extensibleState = f (extensibleState st) }
 
@@ -92,30 +80,22 @@ modify f = put . f =<< get
 -- type will be overwritten. (More precisely: A value whose string representation of its type
 -- is equal to the new one's)
 put :: ExtensionClass a => a -> IdeM ()
-put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v
+put v = modifyStateExts . M.insert (typeOf $ v) . toDyn $ v
 
 -- | Try to retrieve a value of the requested type, return an initial value if there is no such value.
-get :: ExtensionClass a => IdeM a
-get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
-  where toValue val = maybe initialValue id $ cast val
-        getState' :: ExtensionClass a => a -> IdeM a
-        getState' k = do
-          v <- lift $ lift $ State.gets $ M.lookup (show . typeOf $ k) . extensibleState
-          case v of
-            Just (Right (StateExtension val)) -> return $ toValue val
-            Just (Right (PersistentExtension val)) -> return $ toValue val
-            Just (Left str) | PersistentExtension x <- extensionType k -> do
-                let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x
-                put (val `asTypeOf` k)
-                return val
-            _ -> return $ initialValue
-        safeRead str = case reads str of
-                         [(x,"")] -> Just x
-                         _ -> Nothing
+get :: forall a. ExtensionClass a => IdeM a
+get =
+  do v <-
+       lift $
+       lift $
+       State.gets $ M.lookup (typeRep $ (Proxy :: Proxy a)) . extensibleState
+     case v of
+       Just dyn -> return $ fromDyn dyn initialValue
+       _ -> return initialValue
 
 gets :: ExtensionClass a => (a -> b) -> IdeM b
 gets = flip fmap get
 
 -- | Remove the value from the extensible state field that has the same type as the supplied argument
-remove :: ExtensionClass a => a -> IdeM ()
-remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
+remove :: ExtensionClass a => proxy a -> IdeM ()
+remove wit = modifyStateExts $ M.delete (typeRep $ wit)

hie-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs

@@ -44,7 +44,6 @@ module Haskell.Ide.Engine.PluginDescriptor
   -- * The IDE monad
   , IdeM
   , IdeState(..)
-  , StateExtension(..)
   , ExtensionClass(..)
   , getPlugins
   , untagPluginDescriptor
@@ -59,19 +58,18 @@ module Haskell.Ide.Engine.PluginDescriptor
   , module Haskell.Ide.Engine.PluginTypes
   ) where
 
-import           GHC.TypeLits
-import           Haskell.Ide.Engine.PluginTypes
-
-import           Data.Singletons
 import           Control.Applicative
 import           Control.Monad.State.Strict
 import           Data.Aeson
+import           Data.Dynamic
 import qualified Data.Map as Map
+import           Data.Singletons
 import qualified Data.Text as T
-import           Data.Typeable
 import           Data.Vinyl
 import qualified Data.Vinyl.Functor as Vinyl
 import           GHC.Generics
+import           GHC.TypeLits
+import           Haskell.Ide.Engine.PluginTypes
 import qualified Language.Haskell.GhcMod.Monad as GM
 
 -- ---------------------------------------------------------------------
@@ -211,7 +209,7 @@ type IdeT m = GM.GhcModT (StateT IdeState m)
 data IdeState = IdeState
   {
     idePlugins :: Plugins
-  , extensibleState :: !(Map.Map String (Either String StateExtension))
+  , extensibleState :: !(Map.Map TypeRep Dynamic)
               -- ^ stores custom state information.
   } deriving (Show)
 
@@ -230,23 +228,3 @@ getPlugins = lift $ lift $ idePlugins <$> get
 class Typeable a => ExtensionClass a where
     -- | Defines an initial value for the state extension
     initialValue :: a
-    -- | Specifies whether the state extension should be
-    -- persistent. Setting this method to 'PersistentExtension'
-    -- will make the stored data survive restarts, but
-    -- requires a to be an instance of Read and Show.
-    --
-    -- It defaults to 'StateExtension', i.e. no persistence.
-    extensionType :: a -> StateExtension
-    extensionType = StateExtension
-
--- | Existential type to store a state extension.
-data StateExtension =
-    forall a. ExtensionClass a => StateExtension a
-    -- ^ Non-persistent state extension
-  | forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
-    -- ^ Persistent extension
-
-instance Show StateExtension where
-  show _ = "StateExtension"
-
--- EOF