plugins-auto 0.0.2 → 0.0.3
raw patch · 3 files changed
+56/−42 lines, 3 files
Files
- System/Plugins/Auto.hs +6/−7
- System/Plugins/Auto/Reloader.hs +42/−32
- plugins-auto.cabal +8/−3
System/Plugins/Auto.hs view
@@ -7,6 +7,7 @@ , initPlugins , initPluginsWithConf , defaultPluginConf+ , updatePluginConf , withMonadIO , withMonadIO_ , withMonadIOFile@@ -17,7 +18,7 @@ import Language.Haskell.TH.Syntax (Name) import System.Plugins.Auto.LiftName (liftName) import System.Plugins.Auto.Reloader ( PluginHandle, func, funcTH, initPlugins, initPluginsWithConf- , defaultPluginConf, getPluginConf, PluginConf(..))+ , defaultPluginConf, updatePluginConf, PluginConf(..)) -- | Dynamically load the specified symbol pass it as an argument to@@ -39,15 +40,14 @@ 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+withMonadIO_ name _ ph notloaded use = do+ (errs,ma) <- liftIO $ funcTH ph name maybe (notloaded errs) (use errs) ma @@ -57,15 +57,14 @@ FilePath -- ^ path to file to load symbol from -> String -- ^ name of the symbol to dynamically load -> 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-withMonadIOFile fp sym ph fconf notloaded use = do- (errs,ma) <- liftIO $ func ph fp sym $ getPluginConf ph fconf+withMonadIOFile fp sym ph notloaded use = do+ (errs,ma) <- liftIO$ func ph fp sym maybe (notloaded errs) (use errs) ma
System/Plugins/Auto/Reloader.hs view
@@ -8,7 +8,7 @@ , initPlugins , initPluginsWithConf , defaultPluginConf- , getPluginConf+ , updatePluginConf ) where import Control.Applicative ((<$>))@@ -16,6 +16,7 @@ import Control.Concurrent (threadDelay,killThread,ThreadId,forkIO) import Control.Exception (bracketOnError,bracket) import Control.Monad(when)+import Data.IORef (atomicModifyIORef,IORef,newIORef,readIORef) import Data.List (nub) import Data.Maybe (mapMaybe) import qualified Data.Map as Map@@ -57,7 +58,9 @@ { pcGHCArgs = [] , pcWhenCompiling = const$ return () , pcWhenCompiled = const$ const$ return ()- , pcWhenReloaded = const$ const$ const$ return ()+ , pcWhenReloaded = \f s errs -> if null errs then return ()+ else do putStrLn ("Error when reloading "++f++": "++s)+ putStrLn (unlines errs) , pcWhenWatched = const$ return () , pcWhenChanged = const$ return () }@@ -75,7 +78,7 @@ -- | A handle holding the reloader state. data PluginHandle = PluginHandle { phWatcher :: FSWatcher -- Inotify handle- , phConf :: PluginConf+ , phConf :: IORef PluginConf , phObjMap :: MVar ( Map FilePath -- source file being observed ( [FSWatchDescriptor] -- watch descriptor of the source file and its dependecies@@ -102,8 +105,19 @@ initPluginsWithConf conf = do inotify <- initFSWatcher objMap <- newMVar Map.empty- return$ PluginHandle inotify conf objMap+ rconf <- newIORef conf+ return$ PluginHandle inotify rconf objMap ++-- | Updates the configuration used by the plugin handle.+--+-- Yields the plugin configuration resulting from modifying the +-- plugin handle configuration with the given function.+updatePluginConf :: PluginHandle -> (PluginConf -> PluginConf) -> IO PluginConf+updatePluginConf ph f = atomicModifyIORef (phConf ph)$ \c -> let fc = f c in (fc,fc)+++ newRecompilationState :: IO RecompilationState newRecompilationState = do recompiling <- newMVar False@@ -115,24 +129,17 @@ , 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 = +funcTH objMap name = do let (fp, sym) = nameToFileSym name- func objMap fp sym conf+ func objMap fp sym nameToFileSym :: Name -> (FilePath, Symbol)@@ -147,26 +154,26 @@ -- | Like 'funcTH' but instead of a Name it takes the source file and -- the contained symbol to load.-func :: PluginHandle -> FilePath -> Symbol -> PluginConf -> IO ([String],Maybe a)-func ph fp sym conf =+func :: PluginHandle -> FilePath -> Symbol -> IO ([String],Maybe a)+func ph fp sym = do om <- readMVar$ phObjMap ph case Map.lookup fp om of Nothing -> do bracketOnError- (addSymbol ph fp sym conf)+ (addSymbol ph fp sym) (const$ deleteSymbol ph fp sym)- (const$ rebuild ph fp True conf)- func ph fp sym conf+ (const$ rebuild ph fp True)+ func ph fp sym (Just (_, _, merrs, symbols, _)) -> case Map.lookup sym symbols of Nothing -> case merrs of Nothing -> do bracketOnError- (addSymbol ph fp sym conf)+ (addSymbol ph fp sym) (const$ deleteSymbol ph fp sym)- (const$ rebuild ph fp True conf)- func ph fp sym conf+ (const$ rebuild ph fp True)+ func ph fp sym Just errs -> return (errs,Nothing) Just (_, [], mm) -> @@ -179,12 +186,14 @@ [] -> p++sfx ixs -> take (last ixs) p ++ '.':sfx +getPluginConf :: PluginHandle -> IO PluginConf+getPluginConf = readIORef . phConf+ rebuild :: PluginHandle -- ^ list of currently loaded modules/symbols -> FilePath -- ^ source file to compile -> Bool- -> PluginConf -> IO ()-rebuild p fp forceReload conf =+rebuild p fp forceReload = do rs <- readMVar (phObjMap p) >>= maybe newRecompilationState (\(_,_,_,_,rs)->return rs) . Map.lookup fp bracket (signalRecompilationStarted rs)@@ -193,6 +202,7 @@ where rebuild' :: RecompilationState -> IO () rebuild' rs = do+ conf <- getPluginConf p pcWhenCompiling conf fp makeStatus <- makeAll fp (["-odir",".","-hidir",".","-o",replaceSuffix fp "o"]++pcGHCArgs conf) case makeStatus of@@ -214,7 +224,7 @@ do pcWhenCompiled conf fp [] mapM_ unloadAll (unloadList symbols) mapM_ removeWatch oldWds- res <- mapM (load' objFilePath) (Map.assocs symbols)+ res <- mapM (load' conf 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)@@ -222,10 +232,11 @@ unloadList symbols = nub$ mapMaybe (\(_, _, mm) -> fmap fst mm)$ Map.elems symbols - load' :: FilePath + load' :: PluginConf+ -> 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)) =+ load' conf 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))@@ -236,15 +247,16 @@ 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)+ mapM (\depFp -> do let handler = pcWhenChanged conf depFp >> signalRecompilationNeeded rs (rebuild p fp False) 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 = +addSymbol :: PluginHandle -> FilePath -> Symbol -> IO ()+addSymbol p sourceFP sym =+ do conf <- getPluginConf p+ let reloader obj = do ldStatus <- load obj ["."] [] sym case ldStatus of (LoadSuccess m s) -> return (Right (m, toSym s))@@ -258,8 +270,6 @@ (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 =
plugins-auto.cabal view
@@ -1,5 +1,5 @@ Name: plugins-auto-Version: 0.0.2+Version: 0.0.3 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. @@ -24,7 +24,7 @@ > prompt ph = do > putStr "> " > input <- getLine - > $(withMonadIO 'getAnswer) ph id notLoaded$ \errs getAnswer ->+ > $(withMonadIO 'getAnswer) ph notLoaded$ \errs getAnswer -> > mapM_ putStrLn errs >> getAnswer input > > notLoaded errs =@@ -49,10 +49,15 @@ source-repository head type: darcs location: http://patch-tag.com/r/facundo/plugins-auto- tag: 0.0.2 +source-repository this+ type: darcs+ location: http://patch-tag.com/r/facundo/plugins-auto+ tag: 0.0.3+ Library exposed-modules: System.Plugins.Auto+ other-modules: System.Plugins.Auto.Reloader System.Plugins.Auto.FileSystemWatcher System.Plugins.Auto.LiftName