diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMainWithHooks simpleUserHooks diff --git a/System/Plugins/Auto.hs b/System/Plugins/Auto.hs new file mode 100644 --- /dev/null +++ b/System/Plugins/Auto.hs @@ -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 + + + + diff --git a/System/Plugins/Auto/FileSystemWatcher.hs b/System/Plugins/Auto/FileSystemWatcher.hs new file mode 100644 --- /dev/null +++ b/System/Plugins/Auto/FileSystemWatcher.hs @@ -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) + + diff --git a/System/Plugins/Auto/LiftName.hs b/System/Plugins/Auto/LiftName.hs new file mode 100644 --- /dev/null +++ b/System/Plugins/Auto/LiftName.hs @@ -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) diff --git a/System/Plugins/Auto/Reloader.hs b/System/Plugins/Auto/Reloader.hs new file mode 100644 --- /dev/null +++ b/System/Plugins/Auto/Reloader.hs @@ -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 + diff --git a/plugins-auto.cabal b/plugins-auto.cabal new file mode 100644 --- /dev/null +++ b/plugins-auto.cabal @@ -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 +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