web-plugins 0.2.0 → 0.2.1
raw patch · 2 files changed
+42/−13 lines, 2 filesdep ~containers
Dependency ranges changed: containers
Files
- Web/Plugins/Core.hs +40/−11
- web-plugins.cabal +2/−2
Web/Plugins/Core.hs view
@@ -59,10 +59,20 @@ isWhen Always _ = True isWhen x y = x == y +-- | A 'Cleanup' is an 'IO' action to run when the server shuts+-- down. The server can either shutdown normally or due to a+-- failure. The 'When' parameter indicates when an action should run. data Cleanup = Cleanup When (IO ()) +-- | The 'PluginName' should uniquely identify a plugin -- though we+-- currently have no way to enforce that. type PluginName = Text +-- | The 'PluginsState' record holds all the record keeping+-- information needed for loading, unloading, and invoking plugins. In+-- theory you should not be modifying or inspecting this structure+-- directly -- only calling the helper functions that modify or read+-- it. data PluginsState theme n hook config st = PluginsState { pluginsHandler :: Map PluginName (Plugins theme n hook config st -> [Text] -> n) , pluginsOnShutdown :: [Cleanup]@@ -74,10 +84,15 @@ , pluginsState :: st } --- | we don't really want to give the Plugin unrestricted access to modify the PluginsState TVar. So we will use a newtype?+-- | The 'Plugins' type is the handle to the plugins system. Generally+-- you will have exactly one 'Plugins' value in your app.+--+-- see also 'withPlugins' newtype Plugins theme m hook config st = Plugins { ptv :: TVar (PluginsState theme m hook config st) } -- | initialize the plugins system+--+-- see also 'withPlugins' initPlugins :: config -- ^ initial value for the 'config' field of 'PluginsState' -> st -- ^ initial value for the 'state' field of the 'PluginsState' -> IO (Plugins theme n hook config st)@@ -96,7 +111,9 @@ return (Plugins ptv) -- | shutdown the plugins system-destroyPlugins :: When -- ^ should be 'OnFailure' or 'OnNormal'+--+-- see also 'withPlugins'+destroyPlugins :: When -- ^ should be 'OnFailure' or 'OnNormal' -> Plugins theme m hook config st -- ^ handle to the plugins -> IO () destroyPlugins whn (Plugins ptv) =@@ -121,7 +138,7 @@ -- PluginsSt ------------------------------------------------------------------------------ --- | get the current st value from 'Plugins'+-- | get the current @st@ value from 'Plugins' getPluginsSt :: (MonadIO m) => Plugins theme n hook config st -> m st getPluginsSt (Plugins tps) =@@ -183,6 +200,7 @@ liftIO $ atomically $ modifyTVar' tps $ \ps@PluginsState{..} -> ps { pluginsOnShutdown = (Cleanup when action) : pluginsOnShutdown } +-- | add a new post initialization hook addPostHook :: (MonadIO m) => Plugins theme n hook config st -> hook@@ -191,15 +209,19 @@ liftIO $ atomically $ modifyTVar' tps $ \ps@PluginsState{..} -> ps { pluginsPostHooks = postHook : pluginsPostHooks } +-- | get all the post initialization hooks getPostHooks :: (MonadIO m) => Plugins theme n hook config st -> m [hook] getPostHooks (Plugins tps) = liftIO $ atomically $ pluginsPostHooks <$> readTVar tps +-- | add the routing function for a plugin+--+-- see also: 'getPluginRouteFn' addPluginRouteFn :: (MonadIO m, Typeable url) => Plugins theme n hook config st- -> Text+ -> PluginName -> (url -> [(Text, Maybe Text)] -> Text) -> m () addPluginRouteFn (Plugins tpv) pluginName routeFn =@@ -208,9 +230,12 @@ ps { pluginsRouteFn = Map.insert pluginName (toDyn routeFn) pluginsRouteFn } +-- | get the plugin routing function for the named plugin+--+-- see also: 'addPluginRouteFn' getPluginRouteFn :: (MonadIO m, Typeable url) => Plugins theme n hook config st- -> Text+ -> PluginName -- ^ name of plugin -> m (Maybe (url -> [(Text, Maybe Text)] -> Text)) getPluginRouteFn (Plugins ptv) pluginName = do -- liftIO $ putStrLn $ "looking up route function for " ++ Text.unpack pluginName@@ -220,6 +245,7 @@ return Nothing (Just dyn) -> return $ fromDynamic dyn +-- | set the current @theme@ setTheme :: (MonadIO m) => Plugins theme n hook config st -> Maybe theme@@ -228,12 +254,14 @@ liftIO $ atomically $ modifyTVar' tps $ \ps@PluginsState{..} -> ps { pluginsTheme = theme } +-- | get the current @theme@ getTheme :: (MonadIO m) => Plugins theme n hook config st -> m (Maybe theme) getTheme (Plugins tvp) = liftIO $ atomically $ pluginsTheme <$> readTVar tvp +-- | get the @config@ value from the 'Plugins' type getConfig :: (MonadIO m) => Plugins theme n hook config st -> m config@@ -244,14 +272,15 @@ data Plugin url theme n hook config st = Plugin { pluginName :: PluginName , pluginInit :: Plugins theme n hook config st -> IO (Maybe Text)- , pluginDepends :: [Text] -- ^ plugins which much be initialized before this one can be+ , pluginDepends :: [PluginName] -- ^ plugins which much be initialized before this one can be , pluginToPathInfo :: url -> Text , pluginPostHook :: hook } +-- | initialize a plugin initPlugin :: (Typeable url) => Plugins theme n hook config st- -> Text+ -> PluginName -> Plugin url theme n hook config st -> IO (Maybe Text) initPlugin plugins baseURI (Plugin{..}) =@@ -260,7 +289,6 @@ addPostHook plugins pluginPostHook pluginInit plugins - paramsToQueryString :: [(Text, Text)] -> Text paramsToQueryString [] = mempty paramsToQueryString ps = toStrictText $ "?" <> mconcat (intersperse "&" (map paramToQueryString ps) )@@ -303,9 +331,10 @@ -- serve ------------------------------------------------------------------------------ -serve :: Plugins theme n hook config st- -> Text- -> [Text]+-- | serve requests using the 'Plugins' handle+serve :: Plugins theme n hook config st -- ^ 'Plugins' handle+ -> PluginName -- ^ name of the plugin to handle this request+ -> [Text] -- ^ unconsume path segments to pass to handler -> IO (Either String n) serve plugins@(Plugins tvp) prefix path = do phs <- atomically $ pluginsHandler <$> readTVar tvp
web-plugins.cabal view
@@ -1,5 +1,5 @@ name: web-plugins-version: 0.2.0+version: 0.2.1 synopsis: dynamic plugin system for web applications homepage: http://www.happstack.com/ license: BSD3@@ -21,4 +21,4 @@ stm == 2.4.*, mtl == 2.1.*, text == 0.11.*,- containers == 0.4.*+ containers >= 0.4 && < 0.6