infinity-0.3: PLoader.hs

module PLoader where
import Control.Monad.Writer
import System.Directory
import System.Plugins
import Text.Printf
import Config
import List
import API


-- plugin based functions
compilePlugins :: IO [String]
compilePlugins = do
  c <- getDirectoryContents "Plugins/"
  let plugs = filter (isSuffixOf ".hs") c -- ugly
  objs <- execWriterT $ compile plugs
  return objs
 where
  compile :: [String] -> WriterT [String] IO ()
  compile []     = return ()
  compile (x:xs) = do
    o <- liftIO $ make ("Plugins/"++x) []
    case o of
      MakeSuccess code obj -> do
                     tell [obj]
                     case code of
                                ReComp -> liftIO $ putStrLn $ "Plugin compiled: " ++ x
                                _      -> return ()
      MakeFailure e -> do
                     liftIO $ putStrLn $ "Compile of plugin '"++x++"' failed:"
                     liftIO $ mapM_ putStrLn e
    compile xs

loadPlugins :: [String] -> IO [(InfinityPlugin,Module)]
loadPlugins l = do
  lo <- execWriterT $ loadplugs l
  return lo
 where
  loadplugs :: [String] -> WriterT [(InfinityPlugin,Module)] IO ()
  loadplugs [] = return ()
  loadplugs (x:xs) = do
    ls <- liftIO $ load_ x ["."] "plugin"
    case ls of
      LoadSuccess m v -> do
                       liftIO $ putStrLn $ "Plugin loaded: " ++ (name v)
                       tell [(v,m)]
      LoadFailure err -> do
                       liftIO $ putStrLn $ "Loading of plugin '"++x++"' failed:"
                       liftIO $ mapM_ putStrLn err
    loadplugs xs


-- simple wrapper to load & compile in one swoop
getPlugins :: IO [(InfinityPlugin,Module)]
getPlugins = compilePlugins >>= loadPlugins


lookupPlugin :: String -> [InfinityPlugin] -> Either String InfinityPlugin
lookupPlugin n l = 
    let x = filter (elem n . fst . unzip . commands) l in
    case x of
      [] -> Left $ "No plugin with command '"++n++"' found"
      _  -> if (length x) > 1 then
                Left $ "Multiple modules with same command '"++n++"' found!"
            else
                Right $ head x