packages feed

happstack-plugins 6.1.1 → 6.2.1

raw patch · 8 files changed

+45/−525 lines, 8 filesdep +plugins-autodep −containersdep −filepathdep −hinotifydep ~happstack-server

Dependencies added: plugins-auto

Dependencies removed: containers, filepath, hinotify, plugins

Dependency ranges changed: happstack-server

Files

− Happstack/Plugins/Dynamic.hs
@@ -1,8 +0,0 @@-module Happstack.Plugins.Dynamic -    ( PluginHandle-    , initPlugins-    ) where--import Happstack.Plugins.Plugins (PluginHandle,initPlugins)--
− Happstack/Plugins/FileSystemWatcher.hs
@@ -1,95 +0,0 @@--- | Api for watching and notifying file changes.--- Currently, this is based on inotify, but people may want to--- provide implementations of this module for non-inotify-supported --- platforms.-module Happstack.Plugins.FileSystemWatcher-          ( FSWatcher-          , FSWatchDescriptor-          , initFSWatcher-          , addWatch-          , removeWatch-          ) where--import Control.Concurrent.MVar    (MVar,readMVar,modifyMVar,modifyMVar_,newMVar)-import System.INotify              (INotify, WatchDescriptor, Event(..), EventVariety(..),initINotify)-import qualified System.INotify as I(addWatch, removeWatch)-import System.FilePath             (splitFileName)-import qualified Data.Map       as Map-import           Data.Map          (Map)---- Keeps watching a file even after it has been deleted and created again.------ It does so by observing the folder which contains the file. When no files--- are observed in a given folder, the folder stops being observed.-data FSWatcher = FSWatcher -         INotify                       -- INotify handle-         (MVar -           (Map FilePath                 -- Folder containing the file-                ( WatchDescriptor        -- Watch descriptor of the folder-                , Map String             -- File being observed-                      (Event -> IO ())   -- Handler to run on file events-                )-           )-         )--data FSWatchDescriptor = FSWatchDescriptor FSWatcher FilePath---- | Initializes a watcher.-initFSWatcher :: IO FSWatcher-initFSWatcher = do-  iN <- initINotify-  fmvar <- newMVar Map.empty-  return$ FSWatcher iN fmvar---- Replacement for splitFileName which returns "." instead of an empty folder.-splitFileName' :: FilePath -> (FilePath,String)-splitFileName' fp =-   let (d,f) = splitFileName fp-    in (if null d then "." else d,f)---- | Runs the callback IO action on modifications to the file at the given path.------ Each file can have only one callback IO action. Registering a new IO action--- discards any previously registered callback.------ The returned FSWatchDescriptor value can be used to stop watching the file.-addWatch :: FSWatcher -> FilePath -> IO () -> IO FSWatchDescriptor-addWatch piN@(FSWatcher iN fmvar) fp hdl = -   let (d,f) = splitFileName' fp-    in modifyMVar fmvar$ \fm ->-   case Map.lookup d fm of-     Nothing -> do-         wd <- I.addWatch iN [Modify, Move, Delete] d $ \e -> do -                  case e of-                     Ignored -> return ()-                     Deleted { filePath = f' } -> callHandler e d f'-                     MovedIn { filePath = f' } -> callHandler e d f'-                     Modified { maybeFilePath = Just f' } -> callHandler e d f'-                     _ -> return ()-         return ( Map.insert d (wd,Map.singleton f (const hdl)) fm -                , FSWatchDescriptor piN fp -                )-     Just (wd,ffm) -> return ( Map.insert d (wd,Map.insert f (const hdl) ffm) fm-                             , FSWatchDescriptor piN fp-                             )-  where-     callHandler e d f = do -       fm <- readMVar fmvar -       case Map.lookup d fm of -         Nothing -> return ()-         Just (_,ffm) -> case Map.lookup f ffm of-                           Nothing -> return ()-                           Just mhdl -> mhdl e- --- | Stops watching the file associated to the given file descriptor.-removeWatch :: FSWatchDescriptor -> IO ()-removeWatch (FSWatchDescriptor (FSWatcher _iN fmvar) fp) =-   let (d,f) = splitFileName' fp-    in modifyMVar_ fmvar$ \fm ->-   case Map.lookup d fm of-     Nothing -> error$ "removeWatchP: invalid handle for file "++fp-     Just (wd,ffm) -> let ffm' = Map.delete f ffm-                       in if Map.null ffm' then I.removeWatch wd >> return (Map.delete d fm)-                            else return (Map.insert d (wd,ffm') fm)-  - 
− Happstack/Plugins/LiftName.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE TemplateHaskell, MagicHash #-}-module Happstack.Plugins.LiftName where--import GHC.Exts-import Language.Haskell.TH-import Language.Haskell.TH.Syntax-import Language.Haskell.TH.Syntax.Internals--liftName :: Name -> ExpQ-liftName (Name occName nameFlavour) = appE (appE [| Name |] (liftOccName occName)) (liftNameFlavour nameFlavour)--liftOccName :: OccName -> ExpQ-liftOccName (OccName str) = [| OccName str |]--liftNameSpace :: NameSpace -> ExpQ-liftNameSpace VarName   = [| VarName |]-liftNameSpace DataName  = [| DataName |]-liftNameSpace TcClsName = [| TcClsName |]--liftPkgName :: PkgName -> ExpQ-liftPkgName (PkgName str) = [| PkgName str |]--liftModName :: ModName -> ExpQ-liftModName (ModName str) = [| ModName str |]--liftNameFlavour :: NameFlavour -> ExpQ-liftNameFlavour NameS           = [| NameS |]-liftNameFlavour (NameQ modName) = appE [| NameQ |] (liftModName modName)-liftNameFlavour (NameU i)       = [| case $( lift (I# i) ) of-                                       I# i' -> NameU i' |]-liftNameFlavour (NameL i)       = [| case $( lift (I# i) ) of-                                       I# i' -> NameL i' |]-liftNameFlavour (NameG nameSpace pkgName modName) -                                = appE (appE (appE [| NameG |] (liftNameSpace nameSpace)) (liftPkgName pkgName)) (liftModName modName)
− Happstack/Plugins/Plugins.hs
@@ -1,313 +0,0 @@-{-# LANGUAGE EmptyDataDecls, TemplateHaskell #-}-module Happstack.Plugins.Plugins-    ( rebuild-    , func-    , funcTH-    , withIO-    , funcTH'-    , withIO'-    , PluginHandle-    , initPlugins-    ) where--import Control.Applicative        ((<$>))-import Control.Concurrent.MVar    (MVar,readMVar,modifyMVar_,newMVar,modifyMVar)-import Control.Concurrent         (threadDelay,killThread,ThreadId,forkIO)-import Control.Exception          (bracketOnError,bracket)-import Control.Monad(when)-import Data.List                  (nub)-import Data.Maybe                 (mapMaybe)-import qualified Data.Map         as Map-import           Data.Map         (Map)-import Language.Haskell.TH.Syntax (Name(Name),NameFlavour(NameG), occString, modString)-import System.FilePath            (addExtension, dropExtension)-import System.Plugins.Load        (Module, Symbol, LoadStatus(..), getImports, load, unloadAll)-import System.Plugins.Make        (Errors, MakeStatus(..), MakeCode(..), makeAll)-import Unsafe.Coerce              (unsafeCoerce)--import Happstack.Plugins.FileSystemWatcher---- A very unsafe version of Data.Dynamic--data Sym--toSym :: a -> Sym-toSym = unsafeCoerce--fromSym :: Sym -> a-fromSym = unsafeCoerce--data RecompilationState = RecompilationState -      { rsRecompiling :: MVar Bool                     -- Is recompilation in progress?-      , rsRecompilationNeeded :: MVar Bool             -- Is recompilation needed?-      , rsTimer :: Timer-      }--data PluginHandle = PluginHandle -  { phWatcher :: FSWatcher                         -- Inotify handle-  , phObjMap :: MVar-     ( Map FilePath                                -- source file being observed-         ( [FSWatchDescriptor]                       -- watch descriptor of the source file and its dependecies-         , [FilePath]                                -- depedencies of the source file-         , Maybe Errors                              -- errors when compiling the file if any-         , Map Symbol                                -- symbol defined in the source file-             ( FilePath -                 -> IO (Either Errors (Module, Sym))   -- function for reloading the symbol-             , Errors                                  -- error from last recompilation attempt if any-             , Maybe (Module, Sym)                     -- last succesfully loaded symbol-             )-         , RecompilationState-         )-     )-  }----- |initialize the plugin system and return a 'PluginHandle'-initPlugins :: IO PluginHandle-initPlugins =-    do inotify <- initFSWatcher-       objMap <- newMVar Map.empty-       return$ PluginHandle inotify objMap--newRecompilationState :: IO RecompilationState-newRecompilationState =  do-    recompiling <- newMVar False-    recompilationNeeded <- newMVar False-    timer <- newTimer -    return RecompilationState -             { rsRecompiling = recompiling-             , rsRecompilationNeeded = recompilationNeeded-             , rsTimer = timer-             }- --funcTH :: PluginHandle -> Name -> IO (Either Errors a)-funcTH objMap name = fmap reformatOutput$ funcTH' objMap name []--funcTH' :: PluginHandle -> Name -> [String] -> IO (Errors,Maybe a)-funcTH' objMap name args = -    do let (fp, sym) = nameToFileSym name-       func' objMap fp sym args--reformatOutput :: (Errors,Maybe a) -> Either Errors a-reformatOutput ([],Just a) = Right a-reformatOutput ([],_) = Left ["Module not loaded."]-reformatOutput (errs,_) = Left errs----withIO :: PluginHandle -> Name -> (a -> IO ()) -> IO ()-withIO objMap name use = withIO' objMap name use []--withIO' :: PluginHandle -> Name -> (a -> IO ()) -> [String] -> IO ()-withIO' objMap name use args =-    do (errs,ma) <- funcTH' objMap name args-       when (not$ null errs)$ putStrLn $ unlines errs-       maybe (return ()) use ma----nameToFileSym :: Name -> (FilePath, Symbol)-nameToFileSym (Name occName (NameG _ _ mn)) =-    let dotToSlash '.' = '/'-        dotToSlash c   = c-        fp  = (map dotToSlash (modString mn)) ++ ".hs"-        sym = occString occName-    in (fp, sym)-nameToFileSym n = error $ "nameToFileSym failed because Name was not the right kind. " ++ show n--func :: PluginHandle -> FilePath -> Symbol -> IO (Either Errors a)-func ph fp sym = fmap reformatOutput$ func' ph fp sym []--func' :: PluginHandle -> FilePath -> Symbol -> [String] -> IO (Errors,Maybe a)-func' ph fp sym args =-    do om <- readMVar$ phObjMap ph-       case Map.lookup fp om of-         Nothing -> -             do bracketOnError-                  (addSymbol ph fp sym args)-                  (const$ deleteSymbol ph fp sym)-                  (const$ rebuild' ph fp True args)-                func' ph fp sym args-         (Just (_, _, merrs, symbols, _)) ->-             case Map.lookup sym symbols of-               Nothing ->-                 case merrs of-                   Nothing -> -                     do bracketOnError-                          (addSymbol ph fp sym args)-                          (const$ deleteSymbol ph fp sym)-                          (const$ rebuild' ph fp True args)-                        func' ph fp sym args-                   Just errs -> -                     return (errs,Nothing)-               Just (_, [], mm) -> -                    return (maybe [] id merrs, fmap (fromSym . snd) mm)-               Just (_, errs, mm) -> -                    return (errs,fmap (fromSym . snd) mm)--replaceSuffix :: FilePath -> String -> FilePath-replaceSuffix p sfx = case [ i | (i,'.') <- zip [0..] p ] of-                        [] -> p++sfx-                        ixs -> take (last ixs) p ++ '.':sfx--rebuild :: PluginHandle   -- ^ list of currently loaded modules/symbols-        -> FilePath -- ^ source file to compile-        -> Bool-        -> IO ()-rebuild p fp forceReload = rebuild' p fp forceReload []- -rebuild' :: PluginHandle -> FilePath -> Bool -> [String] -> IO ()-rebuild' p fp forceReload args =-    do rs <- readMVar (phObjMap p) >>= maybe newRecompilationState (\(_,_,_,_,rs)->return rs) . Map.lookup fp-       bracket-         (signalRecompilationStarted rs)-         (\compile -> when compile$ signalRecompilationFinished rs (rebuild'' rs))-         (\compile -> when compile$ rebuild'' rs)-  where-    rebuild'' :: RecompilationState -> IO ()-    rebuild'' rs = do-       putStrLn ("Rebuilding " ++ fp)-       makeStatus <- makeAll fp (["-odir",".","-hidir",".","-o",replaceSuffix fp "o"]++args)-       case makeStatus of-         (MakeFailure errs) ->-             do modifyMVar_ (phObjMap p) $ \om ->-                           case Map.lookup fp om of-                             Nothing -> do wds <- observeFiles p fp [] args rs-                                           return$ Map.insert fp (wds, [], Just errs, Map.empty, rs) om-                             Just (wds, deps, _, symbols,_) ->-                                 let symbols' = Map.map (\(loader,_,mm) -> (loader,errs,mm)) symbols -- propogate error to all symbols-                                 in return$ Map.insert fp (wds, deps, Just errs, symbols',rs) om-                putStrLn $ unlines errs-         (MakeSuccess NotReq _objFilePath) | not forceReload -> -                                               do putStrLn "skipped reload."-                                                  return ()-         (MakeSuccess _makeCode objFilePath) -> -             do om <- readMVar$ phObjMap p-                case Map.lookup fp om of-                  Nothing -> return ()-                  Just (oldWds, _, _, symbols,_) ->-                      do mapM_ unloadAll (unloadList symbols)-                         mapM_ removeWatch oldWds-                         res <- mapM (load' objFilePath) (Map.assocs symbols)-                         imports <- map (\bn -> addExtension (mnameToPath bn) ".hs") <$> getImports (dropExtension objFilePath)-                         wds <- observeFiles p fp imports args rs-                         modifyMVar_ (phObjMap p) $ return . Map.insert fp (wds, [], Nothing, Map.fromList res,rs)-   -    unloadList symbols =-          nub$ mapMaybe (\(_, _, mm) -> fmap fst mm)$ Map.elems symbols--    load' :: FilePath -            -> (Symbol, (FilePath -> IO (Either Errors (Module, Sym)), Errors, Maybe (Module, Sym)))-            -> IO (Symbol, (FilePath -> IO (Either Errors (Module, Sym)), Errors, Maybe (Module, Sym)))-    load' obj (symbol, (reloader, _, _mm)) =-          do r <- reloader obj-             case r of-               (Left errs) -> putStrLn $ unlines errs-               (Right _) -> return ()-             return (symbol, (reloader, either id (const []) r,either (const Nothing) Just r))--mnameToPath :: FilePath -> FilePath-mnameToPath = replace '.' '/' - where replace x y = foldr (\a r -> if x==a then y:r else a:r) []--observeFiles :: PluginHandle -> FilePath -> [FilePath] -> [String] -> RecompilationState -> IO [FSWatchDescriptor]-observeFiles p fp imports args rs = -        mapM (\depFp -> do putStrLn ("Adding watch for: " ++ depFp)-                           let handler = putStrLn ("Got event for " ++ depFp) >> signalRecompilationNeeded rs (rebuild' p fp False args)-                           addWatch (phWatcher p) depFp handler-             ) (fp:imports)-                                   --addSymbol :: PluginHandle -> FilePath -> Symbol -> [String] -> IO ()-addSymbol p sourceFP sym args =-    do let reloader obj = -               do putStrLn $ "loading " ++ sym ++ " from " ++ sourceFP-                  ldStatus <- load obj ["."] [] sym-                  case ldStatus of-                    (LoadSuccess m s) -> -                        do putStrLn "Succeed." -                           return (Right (m, toSym s))-                    (LoadFailure errs) -> -                        do putStrLn "Failed."-                           return (Left errs)-           symVal       = (reloader, [], Nothing)-       modifyMVar_ (phObjMap p) $ \om ->-           case Map.lookup sourceFP om of-             Nothing -> do rs <- newRecompilationState-                           wds <- observeFiles p sourceFP [] args rs-                           return$ Map.insert sourceFP (wds, [], Nothing, Map.singleton sym symVal,rs) om-             (Just (wds, deps, errs, symbols,rs)) ->-                 let symbols' = Map.insert sym symVal symbols-                 in return$ Map.insert sourceFP (wds, deps, errs, symbols',rs) om-                          -       return ()--deleteSymbol :: PluginHandle -> FilePath -> Symbol -> IO ()-deleteSymbol ph sourceFP sym =-       modifyMVar_ (phObjMap ph) $ \om ->-           case Map.lookup sourceFP om of-             Nothing -> return om-             Just (wds, deps, errs, symbols,rs) ->-                 let symbols' = Map.delete sym symbols-                  in return$ Map.insert sourceFP (wds, deps, errs, symbols',rs) om------------------------------------- Recompilation handling------------------------------------- | Indicates that recompilation is needed. If compilation is in progress--- recompilation will be done afterwards, otherwise recompilation starts--- in a few milliseconds after the call.-signalRecompilationNeeded :: RecompilationState -- ^ Internal state for synchronizing recompilation requests-                          -> IO ()              -- ^ Command which starts recompilation-						  -> IO ()-signalRecompilationNeeded rs recomp = do-    modifyMVar_ (rsRecompilationNeeded rs)$ const$ return True-    mvarIf (rsRecompiling rs) (return ()) (testRecompilation rs recomp)----- | Indicates that recompilation is starting. The returned boolean indicates whether--- there is any other attempt for recompilation in progress.-signalRecompilationStarted :: RecompilationState -> IO Bool-signalRecompilationStarted rs = do-     modifyMVar (rsRecompiling rs)$ \b -> do-       when (not b)$ modifyMVar_ (rsRecompilationNeeded rs)$ const$ return False-       return (True,not b)----- | Indicates that recompilation has stopped.--- It test whether recompilation is needed, and if needed it starts it again.-signalRecompilationFinished :: RecompilationState   -- ^ Internal state for synchronizing recompilation requests-                            -> IO ()                -- ^ Command which starts recompilation-							-> IO ()-signalRecompilationFinished rs recomp = do -     modifyMVar_ (rsRecompiling rs)$ const$ return False-     testRecompilation rs recomp---- | Fires the recompilation command after a small timeout if recompilation is needed--- after the timeout expired. The timeout allows to delay recompilation if new requests--- for recompilation arrive before the recompilation starts.-testRecompilation :: RecompilationState -> IO () -> IO ()-testRecompilation rs recomp = setTimer (rsTimer rs) (400*1000)$-                  mvarIf (rsRecompilationNeeded rs) recomp (return ())--mvarIf :: MVar Bool -> IO a -> IO a -> IO a-mvarIf mb th els = readMVar mb >>= \b -> if b then th else els---------------------------------- --- Timer data type-----------------------------------newtype Timer = Timer (MVar (Maybe ThreadId))--newTimer :: IO Timer-newTimer = fmap Timer$ newMVar Nothing---- Register an action to perform after a timeout.--- Cancels previous timer setting.-setTimer :: Timer -> Int -> IO () -> IO ()-setTimer (Timer mmtid) delay action = modifyMVar_ mmtid$ \mtid -> do-          maybe (return ()) killThread mtid-          fmap Just$ forkIO$ threadDelay delay >> modifyMVar_ mmtid (const (return Nothing)) >> action-
− Happstack/Plugins/Static.hs
@@ -1,12 +0,0 @@-module Happstack.Plugins.Static -    ( PluginHandle(..) -    , initPlugins-    ) where--data PluginHandle = PluginHandle---- | pretend to initialize the plugin system. This is provided so that--- you can easily switch between dynamic and static mode by only--- changing the imports via a CPP flag.-initPlugins :: IO PluginHandle-initPlugins = return PluginHandle
Happstack/Server/Plugins/Dynamic.hs view
@@ -1,20 +1,21 @@ {-# LANGUAGE FlexibleContexts, TemplateHaskell #-} module Happstack.Server.Plugins.Dynamic     ( PluginHandle+    , PluginConf(..)     , initPlugins+    , initPluginsWithConf+    , defaultPluginConf     , withServerPart     , withServerPart_-    , withServerPart'-    , withServerPart_'     ) where -import Control.Monad.Trans        (MonadIO(liftIO))-import Language.Haskell.TH        (ExpQ, appE, varE)-import Language.Haskell.TH.Syntax (Name)-import Happstack.Plugins.Dynamic  (initPlugins)-import Happstack.Plugins.LiftName (liftName)-import Happstack.Plugins.Plugins  (PluginHandle, funcTH')-import Happstack.Server           (ServerMonad, FilterMonad, WebMonad, Response, internalServerError, escape, toResponse)+import Control.Monad.Trans          (MonadIO)+import Language.Haskell.TH          (ExpQ, appE, varE)+import Language.Haskell.TH.Syntax   (Name)+import System.Plugins.Auto          ( initPlugins,initPluginsWithConf,PluginHandle,withMonadIO_+                                    , PluginConf(..), defaultPluginConf)+import System.Plugins.Auto.LiftName (liftName)+import Happstack.Server             (ServerMonad, FilterMonad, WebMonad, Response, internalServerError, escape, toResponse)  -- |  dynamically load the specified symbol pass it as an argument to -- the supplied server monad function.@@ -24,15 +25,11 @@ --  -- Usage: ----- > $(withServerPart 'symbol) pluginHandle $ \a -> ...+-- > $(withServerPart 'symbol) pluginHandle id $ \errors a -> ... -- withServerPart :: Name -> ExpQ withServerPart name = appE (appE [| withServerPart_ |] (liftName name)) (varE name) -withServerPart' :: Name -> ExpQ-withServerPart' name = appE (appE [| withServerPart_' |] (liftName name)) (varE name)-- -- | dynamically load the specified symbol pass it as an argument to -- the supplied server monad function. --@@ -44,22 +41,13 @@                    Name         -- ^ name of the symbol to dynamically load                 -> a            -- ^ the symbol (must be the function refered to by the 'Name' argument)                 -> PluginHandle -- ^ Handle to the function reloader-                -> (a -> m b)   -- ^ function which uses the loaded result-                -> m b -withServerPart_ name fun ph use = withServerPart_' name fun ph [] use--withServerPart_' :: (MonadIO m, ServerMonad m, FilterMonad Response m, WebMonad Response m) => -                   Name         -- ^ name of the symbol to dynamically load-                -> a            -- ^ the symbol (must be the function refered to by the 'Name' argument)-                -> PluginHandle -- ^ Handle to the function reloader-                -> [String]     -- ^ arguments for ghc-                -> (a -> m b)   -- ^ function which uses the loaded result+                -> (PluginConf -> PluginConf)   -- ^ Modifications to the plugin configuration.+                -> ([String] -> a -> m b)   -- ^ function which uses the loaded result, and gets a list of compilation errors if any                 -> m b -withServerPart_' name _fun ph args use =-    do (errs,ma) <- liftIO $ funcTH' ph name args+withServerPart_ name fun ph fconf use = withMonadIO_ name fun ph fconf notLoaded use+ where+   notLoaded errs = escape $ internalServerError$ toResponse$         case errs of-         [] -> case ma of-                 Nothing -> escape $ internalServerError$ toResponse "Module not loaded yet."-                 Just a  -> use a-         _ -> escape $ internalServerError$ toResponse$ unlines errs+         [] -> "Module not loaded yet."+         _ -> unlines errs 
Happstack/Server/Plugins/Static.hs view
@@ -1,31 +1,28 @@-{-# LANGUAGE FlexibleContexts, TemplateHaskell #-}+{-# LANGUAGE EmptyDataDecls, FlexibleContexts, TemplateHaskell #-} module Happstack.Server.Plugins.Static      ( PluginHandle+    , PluginConf(..)     , initPlugins+    , initPluginsWithConf+    , defaultPluginConf     , withServerPart     , withServerPart_-    , withServerPart'-    , withServerPart_'     ) where -import Control.Monad.Trans        (MonadIO(..))-import Happstack.Plugins.Static   (PluginHandle, initPlugins) -import Happstack.Plugins.LiftName (liftName)-import Happstack.Server           (ServerMonad, FilterMonad, WebMonad, Response)-import Language.Haskell.TH        (ExpQ, Name, appE, varE)-+import Control.Monad.Trans          (MonadIO)+import Happstack.Server             (ServerMonad, FilterMonad, WebMonad, Response)+import Language.Haskell.TH          (ExpQ, Name, appE, varE)+import System.Plugins.Auto.LiftName+import System.Plugins.Auto          (PluginConf(..),defaultPluginConf)  -- | A template haskell wrapper around 'withServerPart_'. -- Usage: ----- > $(withServerPart 'symbol) pluginHandle $ \a -> ...+-- > $(withServerPart 'symbol) pluginHandle id $ \errors a -> ... -- withServerPart :: Name -> ExpQ withServerPart name = appE (appE [| withServerPart_ |] (liftName name)) (varE name) -withServerPart' :: Name -> ExpQ-withServerPart' name = appE (appE [| withServerPart_' |] (liftName name)) (varE name)- -- | a static version of 'Happstack.Server.Plugins.Dynamic.withServerPart_' -- -- This function has the same signature as its dynamic sibling, but it@@ -37,9 +34,17 @@ -- build. --  -- Use a CPP to select between the Dynamic and Static versions of this module.-withServerPart_ :: (MonadIO m, ServerMonad m, FilterMonad Response m, WebMonad Response m) => Name -> a -> PluginHandle -> (a -> m b) -> m b-withServerPart_ _name fun _objMap use = use fun+withServerPart_ :: (MonadIO m, ServerMonad m, FilterMonad Response m, WebMonad Response m) => Name -> a -> PluginHandle -> (PluginConf -> PluginConf) -> ([String] -> a -> m b) -> m b+withServerPart_ _name fun _objMap _args use = use [] fun -withServerPart_' :: (MonadIO m, ServerMonad m, FilterMonad Response m, WebMonad Response m) => Name -> a -> PluginHandle -> [String] -> (a -> m b) -> m b-withServerPart_' _name fun _objMap _args use = use fun+-- | Dummy plugin handle. In a static configuration its values are not used at all.+data PluginHandle++-- | Creates a dummy plugin handle.+initPlugins :: IO PluginHandle+initPlugins = initPluginsWithConf undefined++-- | Creates a dummy plugin handle.+initPluginsWithConf :: PluginConf -> IO PluginHandle+initPluginsWithConf = const$ return undefined 
happstack-plugins.cabal view
@@ -1,5 +1,5 @@ Name:                happstack-plugins-Version:             6.1.1+Version:             6.2.1 Synopsis:            The haskell application server stack + reload Description:         This library provides support for automatically recompiling and reloading modules into a running server. License:             BSD3@@ -24,24 +24,13 @@     Default: False  Library-  exposed-modules:     Happstack.Plugins.Plugins-                       Happstack.Plugins.Static-                       Happstack.Plugins.Dynamic-                       Happstack.Plugins.FileSystemWatcher-                       Happstack.Plugins.LiftName-                       Happstack.Server.Plugins.Dynamic+  exposed-modules:     Happstack.Server.Plugins.Dynamic                        Happstack.Server.Plugins.Static    build-depends:       base >= 3 && < 5,-                       containers,-                       filepath,-                       happstack-server >= 6.0 && < 6.4,-                       hinotify >= 0.3.2,+                       plugins-auto,                        mtl,-                       plugins >= 1.5.1.4,+                       happstack-server>=6,                        template-haskell                        -  if impl(ghc >= 6.12)-     ghc-options:      -Wall -fno-warn-unused-do-bind-  else-     ghc-options:      -Wall+  ghc-options:      -Wall