module System.Plugins.Criteria.LoadCriterion (LoadCriterion(..), Criterion(..)) where
import GHC.Exts
import System.Plugins.DynamicLoader
import Data.Dynamic
import Control.Monad.IO.Class
class LoadCriterion (c :: Constraint) t where
data Criterion c t
type Effective c t :: *
addDynamicLibrary :: Criterion c t -> String -> IO ()
addDynamicLibrary _ = addDLL
resolveSymbols :: Criterion c t -> IO ()
resolveSymbols _ = resolveFunctions
loadQualified :: c => Criterion c t -> String -> Effective c t
instance LoadCriterion (Typeable t) t where
data Criterion (Typeable t) t = DynamicCriterion
type Effective (Typeable t) t = IO (Maybe t)
loadQualified DynamicCriterion name = loadQualifiedDynFunction (adornSymbol name)
where adornSymbol n = n ++ "Dyn"
loadQualifiedDynFunction :: Typeable t => String -> IO (Maybe t)
loadQualifiedDynFunction name = fmap fromDynamic dyn
where dyn :: IO Dynamic
dyn = loadQualifiedFunction name
instance LoadCriterion (Typeable t, MonadIO m) t where
data Criterion (Typeable t, MonadIO m) t = DynamicFailableCriterion
type Effective (Typeable t, MonadIO m) t = m t
loadQualified DynamicFailableCriterion name = do sym <- liftIO $ loadQualifiedDynFunction (adornSymbol name)
case sym of
Nothing -> liftIO $ fail ("symbol " ++ name ++ " does not have the expected type")
Just it -> return it
where adornSymbol n = n ++ "Dyn"