module System.Plugins.Hotswap ( Plugin (..), newPlugin, usePlugin, usePluginIO, runPlugin, reloadPlugin, readPlugin, withPlugin, withPluginIO, putPlugin ) where import System.Plugins.Load import Data.IORef data Plugin a = Plugin { pluginObject :: FilePath, -- ^ Path to object pluginIncludes :: [FilePath], -- ^ Include paths. pluginDataName :: String, -- ^ Name of the symbol to find. pluginData :: IORef a, -- ^ Loaded data. pluginModule :: IORef Module -- ^ Loaded module. } -- | 'usePlugin' provides a simple way to use plugins of type 'Plugin (a -> b)', ie, only -- single argumented ones. usePlugin :: Plugin (a -> b) -> a -> IO b usePlugin plug x = fmap ($ x) (readPlugin plug) -- | 'usePlugin' for plugins returning IO. usePluginIO :: Plugin (a -> IO b) -> a -> IO b usePluginIO plug x = readPlugin plug >>= ($ x) -- | 'runPlugin' runs an 'IO a' returning 'Plugin'. runPlugin :: Plugin (IO a) -> IO a runPlugin plug = readPlugin plug >>= id -- | 'withPlugin' provides a way to run a function on a plugin, modifying the plugin in-place. withPlugin :: Plugin a -> (a -> a) -> IO () withPlugin plug f = do pd <- readPlugin plug putPlugin plug (f pd) -- | 'withPlugin' for functions returning IO. withPluginIO :: Plugin a -> (a -> IO a) -> IO () withPluginIO plug f = do pd <- readPlugin plug r <- f pd putPlugin plug r -- | Create a new plugin, expecting a type. Don't use this to reload plugins. newPlugin :: FilePath -> [FilePath] -> String -> IO (Plugin a) newPlugin obj incs name = do plugin <- load_ obj incs name case plugin of LoadSuccess m f -> do fref <- newIORef f mref <- newIORef m return $! Plugin obj incs name fref mref _ -> error "no such module or function" -- | Reload a plugin in-place. reloadPlugin :: Plugin a -> IO () reloadPlugin (Plugin _ _ name fref mref) = do m <- readIORef mref plugin <- reload m name case plugin of LoadSuccess newm newf -> do writeIORef mref newm writeIORef fref newf _ -> error "no such module or function" -- | Read the 'pluginData' 'IORef'. readPlugin :: Plugin a -> IO a readPlugin = readIORef . pluginData -- | Replace the contents of the 'pluginData'. putPlugin :: Plugin a -> a -> IO () putPlugin = writeIORef . pluginData {- data Hotswap a = Hotswap { hotswapThread :: IORef (Maybe ThreadId), hotswapPlugin :: Plugin a -- something seems wrong about passing this around all the time, but alas... } -- | Automatically poll the filesystem for changes in the specified 'Plugin''s object file, and -- reload the plugin if necessary. newHotswap :: Plugin a -> IO (Hotswap a) newHotswap plug = do ht <- forkHotswapThread plug ref <- newIORef (Just ht) return $ Hotswap ref plug -- | 'newHotswap', only returning the ThreadId. forkHotswapThread :: Plugin a -> IO ThreadId forkHotswapThread plug = do md5 <- md5File $ pluginObject plug forkIO (loop md5) where md5File = fmap md5sum . B.readFile loop old = do threadDelay 100000 new <- md5File $ pluginObject plug if new == old then loop new else do reloadPlugin plug loop new -- | Restart a 'Hotswap' from one that was killed, otherwise, do nothing. restartHotswap :: Hotswap a -> IO () restartHotswap (Hotswap h p) = do r <- readIORef h case r of Nothing -> do thread <- forkHotswapThread p writeIORef h (Just thread) _ -> return () killHotswap :: Hotswap a -> IO () killHotswap (Hotswap h _) = do r <- readIORef h case r of Just thread -> do killThread thread writeIORef h Nothing _ -> return () -}