packages feed

plugins-auto (empty) → 0.0.1

raw patch · 7 files changed

+614/−0 lines, 7 filesdep +basedep +containersdep +filepathsetup-changed

Dependencies added: base, containers, filepath, hinotify, mtl, plugins, template-haskell

Files

+ COPYING view
@@ -0,0 +1,30 @@+Copyright (c) 2010, Jeremy Shaw+Copyright (c) 2011, Facundo Dominguez+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.++Neither the name of the HAppS.org; nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT OWNER OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMainWithHooks simpleUserHooks
+ System/Plugins/Auto.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts, TemplateHaskell #-}+-- | This module implements the public interface of plugins-auto+-- Create a plugin handle with 'initPlugins' and use it later with 'withMonadIO'.+module System.Plugins.Auto+    ( PluginHandle+    , PluginConf(..)+    , initPlugins+    , initPluginsWithConf+    , defaultPluginConf+    , withMonadIO+    , withMonadIO_+    ) where++import Control.Monad.Trans          (MonadIO(liftIO))+import Language.Haskell.TH          (ExpQ, appE, varE)+import Language.Haskell.TH.Syntax   (Name)+import System.Plugins.Auto.LiftName (liftName)+import System.Plugins.Auto.Reloader ( PluginHandle, funcTH, initPlugins, initPluginsWithConf+                                    , defaultPluginConf, getPluginConf, PluginConf(..))+++-- |  Dynamically load the specified symbol pass it as an argument to+-- the supplied server monad function.+--+-- This is a wrapper around 'withMonadIO_' which ensures the first+-- and second argument stay in-sync.+-- +-- Usage:+--+-- > $(withMonadIO 'symbol) pluginHandle id (error "symbol could not be loaded") $ \previous_errors a -> ...+--+withMonadIO :: Name -> ExpQ+withMonadIO name = appE (appE [| withMonadIO_ |] (liftName name)) (varE name)++-- | Dynamically load the specified symbol.+--+withMonadIO_ :: (MonadIO 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+                -> (PluginConf -> PluginConf)  -- ^ introduces variations on the plugin configuration+                -> ([String] -> m b)        -- ^ function called if the symbol is not loaded ( either because the+                                            --   last recompilation attempt failed or because it is being +                                            --   compiled right now by another thread).+                -> ([String] -> a -> m b)   -- ^ function which uses the loaded result, receives also a +                                            -- list of errors in the last recompilation attempt+                -> m b+withMonadIO_ name _ ph fconf notloaded use = do+       (errs,ma) <- liftIO $ funcTH ph name$ getPluginConf ph fconf+       maybe (notloaded errs) (use errs) ma++++
+ System/Plugins/Auto/FileSystemWatcher.hs view
@@ -0,0 +1,95 @@+-- | 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 System.Plugins.Auto.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)++-- | A FSWatcher watches several files for changes. If a file is deleted from the+-- containing folder, it keeps watching the folder in case the file is added +-- again.+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+                )+           )+         )++-- | Identifier used to stop watching files. +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)+  + 
+ System/Plugins/Auto/LiftName.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE TemplateHaskell, MagicHash #-}+module System.Plugins.Auto.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)
+ System/Plugins/Auto/Reloader.hs view
@@ -0,0 +1,327 @@+{-# LANGUAGE EmptyDataDecls, TemplateHaskell #-}+-- | This module implements recompilation and reloading of symbols.+module System.Plugins.Auto.Reloader+    ( funcTH+    , PluginHandle+    , PluginConf(..)+    , initPlugins+    , initPluginsWithConf+    , defaultPluginConf+    , getPluginConf+    ) 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 System.Plugins.Auto.FileSystemWatcher++-- A very unsafe version of Data.Dynamic++data Sym++toSym :: a -> Sym+toSym = unsafeCoerce++fromSym :: Sym -> a+fromSym = unsafeCoerce++-- | Configuration options for recompiling plugins. So far we store here event callbacks and ghc arguments.+data PluginConf = PluginConf +       { pcGHCArgs :: [String]                            -- ^Arguments to ghc+       , pcWhenCompiling :: FilePath -> IO ()             -- ^ Called when compilation is about to start. Takes the path of the file to compile.+       , pcWhenCompiled :: FilePath -> [String] -> IO ()  -- ^ Called after compilation finished. +                                                          --   Takes the path of the compiled file and the compilation errors if any.+       , pcWhenReloaded :: FilePath -> String -> [String] -> IO ()  -- ^ Called after reloading of the symbol finished. +                                                                    -- Takes the path of the object file, the symbol name and the list +                                                                    -- of errors if any.+       , pcWhenWatched :: FilePath -> IO ()               -- ^ Called when a file is registered for watching.+       , pcWhenChanged :: FilePath -> IO ()               -- ^ Called when a watched file is modified.+       }++-- | Contains no arguments for GHC, and noop callbacks.+defaultPluginConf :: PluginConf+defaultPluginConf = PluginConf +  { pcGHCArgs       = []+  , pcWhenCompiling = const$ return ()+  , pcWhenCompiled  = const$ const$ return ()+  , pcWhenReloaded  = const$ const$ const$ return ()+  , pcWhenWatched   = const$ return ()+  , pcWhenChanged   = const$ return ()+  }+++-- | Represents the state of the recompilation for a source file.+data RecompilationState = RecompilationState +      { rsRecompiling :: MVar Bool                -- ^ Is recompilation in progress?+      , rsRecompilationNeeded :: MVar Bool        -- ^ Is recompilation needed?+      , rsTimer :: Timer                          -- ^ The timer is used to delay recompilation a fraction of a second+                                                  -- so we can recompile in one pass changes in multiple source code+                                                  -- files. +      }++-- | A handle holding the reloader state.+data PluginHandle = PluginHandle +  { phWatcher :: FSWatcher                         -- Inotify handle+  , phConf :: PluginConf+  , 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+         )+     )+  }++-- | Initializes the plugin system and return a 'PluginHandle' +-- using the default plugin configuration 'defaultPluginConf'.+initPlugins :: IO PluginHandle+initPlugins = initPluginsWithConf defaultPluginConf++-- | Initializes the plugin system and return a 'PluginHandle'.+initPluginsWithConf :: PluginConf -> IO PluginHandle+initPluginsWithConf conf =+    do inotify <- initFSWatcher+       objMap <- newMVar Map.empty+       return$ PluginHandle inotify conf objMap++newRecompilationState :: IO RecompilationState+newRecompilationState =  do+    recompiling <- newMVar False+    recompilationNeeded <- newMVar False+    timer <- newTimer +    return RecompilationState +             { rsRecompiling = recompiling+             , rsRecompilationNeeded = recompilationNeeded+             , rsTimer = timer+             }++-- | Yields the plugin configuration resulting from modifying the +-- PluginHandle configuration with the given function.+getPluginConf :: PluginHandle -> (PluginConf -> PluginConf) -> PluginConf+getPluginConf ph fconf = fconf$ phConf ph++++-- | Loads a symbol. It may not return the symbol if it was never +-- loaded before and there are compiler errors, or if another +-- thread is already loading the symbol. This call should probably+-- be changed to be blocking.+funcTH :: PluginHandle  -- ^ Plugin handle+       -> Name          -- ^ Name of the symbol to load+       -> PluginConf      -- ^ Arguments to pass to the compiler in case that recompilation is required.+       -> IO ([String],Maybe a) -- ^ A list of errors if any, and the last succesfully loaded version of the symbol.+funcTH objMap name conf = +    do let (fp, sym) = nameToFileSym name+       func objMap fp sym conf+++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 -> PluginConf -> IO (Errors,Maybe a)+func ph fp sym conf =+    do om <- readMVar$ phObjMap ph+       case Map.lookup fp om of+         Nothing -> +             do bracketOnError+                  (addSymbol ph fp sym conf)+                  (const$ deleteSymbol ph fp sym)+                  (const$ rebuild ph fp True conf)+                func ph fp sym conf+         (Just (_, _, merrs, symbols, _)) ->+             case Map.lookup sym symbols of+               Nothing ->+                 case merrs of+                   Nothing -> +                     do bracketOnError+                          (addSymbol ph fp sym conf)+                          (const$ deleteSymbol ph fp sym)+                          (const$ rebuild ph fp True conf)+                        func ph fp sym conf+                   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+        -> PluginConf+        -> IO ()+rebuild p fp forceReload conf =+    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+       pcWhenCompiling conf fp+       makeStatus <- makeAll fp (["-odir",".","-hidir",".","-o",replaceSuffix fp "o"]++pcGHCArgs conf)+       case makeStatus of+         (MakeFailure errs) ->+             do modifyMVar_ (phObjMap p) $ \om ->+                           case Map.lookup fp om of+                             Nothing -> do wds <- observeFiles p fp [] conf 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+                pcWhenCompiled conf fp errs+         (MakeSuccess NotReq _objFilePath) | not forceReload -> pcWhenCompiled conf fp []+         (MakeSuccess _makeCode objFilePath) -> +             do om <- readMVar$ phObjMap p+                case Map.lookup fp om of+                  Nothing -> return ()+                  Just (oldWds, _, _, symbols,_) ->+                      do pcWhenCompiled conf fp []+                         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 conf 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+             pcWhenReloaded conf obj symbol$ either id (const []) r +             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] -> PluginConf -> RecompilationState -> IO [FSWatchDescriptor]+observeFiles p fp imports conf rs = +        mapM (\depFp -> do let handler = pcWhenChanged conf depFp >> signalRecompilationNeeded rs (rebuild p fp False conf)+                           wd<-addWatch (phWatcher p) depFp handler+                           pcWhenWatched conf depFp >> return wd+             ) (fp:imports)+                                   ++addSymbol :: PluginHandle -> FilePath -> Symbol -> PluginConf -> IO ()+addSymbol p sourceFP sym conf =+    do let reloader obj = +               do ldStatus <- load obj ["."] [] sym+                  case ldStatus of+                    (LoadSuccess m s) -> return (Right (m, toSym s))+                    (LoadFailure errs) -> return (Left errs)+           symVal       = (reloader, [], Nothing)+       modifyMVar_ (phObjMap p) $ \om ->+           case Map.lookup sourceFP om of+             Nothing -> do rs <- newRecompilationState+                           wds <- observeFiles p sourceFP [] conf 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+
+ plugins-auto.cabal view
@@ -0,0 +1,71 @@+Name:                plugins-auto+Version:             0.0.1+Synopsis:            Automatic recompilation and reloading of haskell modules.+Description:         This library provides support for automatically recompiling and reloading+                     modules into your programs when the source code is modified. +                     .+                     Any program called ghc in your PATH will be used for recompiling.+ .+ > module Main where+ > import System.IO           (hSetBuffering,stdout,BufferMode(..))+ > import System.Plugins.Auto (withMonadIO,initPlugins) + > import Answer+ >+ > main :: IO ()+ > main = do ph<-initPlugins+ >         hSetBuffering stdout NoBuffering+ >         putStrLn "This program interacts with you in a loop."+ >         putStrLn "Type something, and the program will respond when you hit the Enter Key."+ >         putStrLn "Modify Answer.hs while interacting and you should see the answers"+ >         putStrLn "change accordingly."+ >         let interactiveLoop = prompt ph >> interactiveLoop+ >         interactiveLoop+ > where+ >   prompt ph = do+ >      putStr "> "+ >      input <- getLine + >      $(withMonadIO 'getAnswer) ph id notLoaded$ \errs getAnswer ->+ >          mapM_ putStrLn errs  >> getAnswer input+ >       + >   notLoaded errs =+ >      if null errs then putStrLn "Plugin not loaded yet."+ >        else putStrLn "Errors found:" >> mapM_ (putStrLn . ("  "++)) errs + >               >> putStrLn "Try fixing the errors and come back here."+ .+ > module Answer where+ > + > getAnswer :: String -> IO ()+ > getAnswer input = putStrLn ("What you typed: "++input)+++License:             BSD3+License-file:        COPYING+Author:              Happstack team, HAppS LLC+Maintainer:          Happstack team <happs@googlegroups.com>+Category:            System+Build-Type:          Simple+Cabal-Version:       >= 1.6++source-repository head+    type:     darcs+    location: http://patch-tag.com/r/facundo/plugins-auto++Flag tests+    Description: Build the testsuite, and include the tests in the library+    Default: False++Library+  exposed-modules:     System.Plugins.Auto+                       System.Plugins.Auto.Reloader+                       System.Plugins.Auto.FileSystemWatcher+                       System.Plugins.Auto.LiftName++  build-depends:       base >= 3 && < 5,+                       containers,+                       filepath,+                       hinotify >= 0.3.2,+                       mtl,+                       plugins >= 1.5.1.4,+                       template-haskell+                       +  ghc-options:      -Wall