packages feed

web-plugins 0.1.2 → 0.2.0

raw patch · 2 files changed

+46/−15 lines, 2 files

Files

Web/Plugins/Core.hs view
@@ -10,6 +10,8 @@      , withPlugins      , getPluginsSt      , putPluginsSt+     , addPluginState+     , getPluginState      , modifyPluginsSt      , addHandler      , addCleanup@@ -62,13 +64,14 @@ type PluginName = Text  data PluginsState theme n hook config st = PluginsState-    { pluginsHandler    :: Map PluginName (Plugins theme n hook config st -> [Text] -> n)-    , pluginsOnShutdown :: [Cleanup]-    , pluginsRouteFn    :: Map PluginName Dynamic-    , pluginsTheme      :: Maybe theme-    , pluginsPostHooks  :: [hook]-    , pluginsConfig     :: config-    , pluginsState      :: st+    { pluginsHandler     :: Map PluginName (Plugins theme n hook config st -> [Text] -> n)+    , pluginsOnShutdown  :: [Cleanup]+    , pluginsRouteFn     :: Map PluginName Dynamic+    , pluginsPluginState :: Map PluginName (TVar Dynamic)  -- ^ per-plugin state+    , pluginsTheme       :: Maybe theme+    , pluginsPostHooks   :: [hook]+    , pluginsConfig      :: config+    , pluginsState       :: st     }  -- | we don't really want to give the Plugin unrestricted access to modify the PluginsState TVar. So we will use a newtype?@@ -80,13 +83,14 @@             -> IO (Plugins theme n hook config st) initPlugins config st =     do ptv <- atomically $ newTVar-              (PluginsState { pluginsHandler    = Map.empty-                            , pluginsOnShutdown = []-                            , pluginsRouteFn    = Map.empty-                            , pluginsTheme      = Nothing-                            , pluginsPostHooks  = []-                            , pluginsConfig     = config-                            , pluginsState      = st+              (PluginsState { pluginsHandler     = Map.empty+                            , pluginsOnShutdown  = []+                            , pluginsRouteFn     = Map.empty+                            , pluginsPluginState = Map.empty+                            , pluginsTheme       = Nothing+                            , pluginsPostHooks   = []+                            , pluginsConfig      = config+                            , pluginsState       = st                             }               )        return (Plugins ptv)@@ -145,6 +149,33 @@ addHandler (Plugins tps) pname ph =     liftIO $ atomically $ modifyTVar' tps $ \ps@PluginsState{..} ->               ps { pluginsHandler = Map.insert pname ph pluginsHandler }++-- | add a new plugin-local state+addPluginState :: (MonadIO m, Typeable state) => Plugins theme n hook config st+               -> Text -- plugin name+               -> state+               -> m ()+addPluginState (Plugins tps) pname state =+    liftIO $ atomically $+           do stateTV <- newTVar (toDyn state)+              modifyTVar' tps $ \ps@PluginsState{..} ->+                    ps { pluginsPluginState = Map.insert pname stateTV pluginsPluginState }++-- | Get the state for a particular plugin+--+-- per-plugin state is optional. This will return 'Nothing' if the+-- plugin did not register any local state.+getPluginState :: (MonadIO m, Typeable state) =>+                  Plugins theme n hook config st+               -> Text -- plugin name+               -> m (Maybe state)+getPluginState (Plugins ptv) pluginName =+    do states <- liftIO $ atomically $ pluginsPluginState <$> readTVar ptv+       case Map.lookup pluginName states of+         Nothing -> return Nothing+         (Just tvar) ->+             do dyn <- liftIO $ atomically $ readTVar tvar+                return $ fromDynamic dyn  -- | add a new cleanup action to the top of the stack addCleanup :: (MonadIO m) => Plugins theme n hook config st -> When -> IO () -> m ()
web-plugins.cabal view
@@ -1,5 +1,5 @@ name:                web-plugins-version:             0.1.2+version:             0.2.0 synopsis:            dynamic plugin system for web applications homepage:            http://www.happstack.com/ license:             BSD3