use of existential types for plugin support

This patch, which *changes the configuration format*, adds easy plugin support
by using an existential type for storing the list of commands to be
executed. Adding a plugin is just a matter of writing the appropriate
instance of the Exec class, after importing Commands.hs.
I must thank Claus Reinke for the help in understanding the mysteries of
reading existential types. The Read instance of Runnable must be credited to
him. See here:
http://www.haskell.org/pipermail/haskell-cafe/2007-July/028227.html

darcs-hash:20070712175034-d6583-f10174bb3b0a9b4f6e08d05052c18f30e539b319.gz

1 files changed, 50 insertions, 0 deletions

diff --git a/Runnable.hs b/Runnable.hs
new file mode 100644
index 0000000..90e01af
--- /dev/null
+++ b/Runnable.hs
@@ -0,0 +1,50 @@
+{-# OPTIONS -fglasgow-exts #-}
+module Runnable where
+
+import Control.Monad
+import Text.Read
+import Text.ParserCombinators.ReadPrec
+import Config (runnableTypes)
+import Commands
+
+data Runnable = forall r . (Exec r,Show r, Read r) => Run r
+
+instance Show Runnable where
+    show (Run a) = "Run " ++ show a
+
+instance Exec Runnable where
+     run (Run a) = run a
+     rate (Run a) = rate a
+     alias (Run a) = alias a
+
+instance Read Runnable where
+    readPrec = readRunnable
+
+-- read an existential as any of hidden types ts
+class ReadAsAnyOf ts ex where
+    readAsAnyOf :: ts -> ReadPrec ex
+
+instance ReadAsAnyOf () ex where 
+    readAsAnyOf ~() = mzero
+
+instance (Read t, Show t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where 
+    readAsAnyOf ~(t,ts) = r t `mplus` readAsAnyOf ts
+              where r ty = do { m <- readPrec; return (Run (m `asTypeOf` ty)) }
+
+
+
+readRunnable :: ReadPrec Runnable
+readRunnable = prec 10 $ do
+                 Ident "Run" <- lexP
+                 parens $ readAsAnyOf runnableTypes
+
+
+-- | Reads the configuration files or quits with an error
+readConfig :: FilePath -> IO Runnable
+readConfig f = 
+    do s <- readFile f
+       case reads s of
+         [(config,_)] -> return config
+         [] -> error ("Corrupt config file: " ++ f)
+         _ -> error ("Some problem occured. Aborting...")
+