Update examples

testsuite/makewith/global_pragma/Makefile

@@ -0,0 +1,5 @@
+
+TEST=makewith/global_pragma
+
+TOP=../../..
+include ../../build.mk

testsuite/makewith/global_pragma/Plugin.hs

@@ -0,0 +1,17 @@
+{-# GLOBALOPTIONS -package mtl #-}
+
+module M ( resource ) where
+
+import API
+import System.IO.Unsafe
+import System.Process
+import System.IO
+
+resource = tiny { field = date }
+
+date :: String
+date = unsafePerformIO $ do
+            (_,outh,_,proc) <- runInteractiveProcess "echo" ["hello"] Nothing Nothing		
+    	    waitForProcess proc
+            s <- hGetContents outh
+            return s

testsuite/makewith/global_pragma/api/API.hs

@@ -0,0 +1,8 @@
+
+module API where
+
+data Tiny = Tiny { field :: String }
+
+tiny :: Tiny
+tiny = Tiny { field = "default value" }
+

testsuite/makewith/global_pragma/prog/Main.hs

@@ -0,0 +1,19 @@
+
+import System.Plugins
+import API
+
+conf    = "../Plugin.hs"
+apipath = "../api"
+
+main = do
+        status <- makeWith conf conf ["-i"++apipath]
+        o <- case status of
+                MakeFailure e   -> mapM_ putStrLn e >> error "compile failed"
+                MakeSuccess _ o -> return o
+        m_v   <- load o [apipath] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            LoadFailure ers -> mapM_ putStrLn ers >> error "load failed"
+        putStr $ field v 
+        makeCleaner o
+

testsuite/makewith/global_pragma/prog/expected

@@ -0,0 +1 @@
+hello

testsuite/makewith/io/Makefile

@@ -0,0 +1,4 @@
+TEST=makewith/io
+
+TOP=../../..
+include ../../build.mk

testsuite/makewith/io/README

@@ -0,0 +1,2 @@
+An example using IO monad fields in the .conf file.
+

testsuite/makewith/io/TestIO.conf.in

@@ -0,0 +1,22 @@
+{-# OPTIONS -cpp #-}
+--
+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
+-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)
+--
+
+import System.IO
+import System.Process
+
+resource = testio { field = date }
+
+--
+-- call a shell command , returning it's output
+--
+date :: IO String
+date = do
+#if !defined(CYGWIN) || !defined(__MINGW32__)
+          (_,out,_,_) <- catch (runInteractiveCommand "/bin/date") (\_->error "popen failed")
+#else
+          (_,out,_,_) <- catch (runInteractiveCommand "@PREFIX@/../../bin/date") (\_->error "popen failed")
+#endif
+          hGetLine out

testsuite/makewith/io/TestIO.stub

@@ -0,0 +1,10 @@
+
+module TestIO ( resource, resource_dyn )  where
+
+import API
+import Data.Dynamic
+
+resource = testio
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn resource

testsuite/makewith/io/api/API.hs

@@ -0,0 +1,16 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module API where
+
+import Data.Dynamic
+
+data TestIO = TestIO { 
+                field :: IO String 
+        }
+   deriving (Typeable, Show)
+
+instance Show (IO String) where
+    show _ = "<<io action>>"
+
+testio :: TestIO
+testio = TestIO { field = return "default value" }

testsuite/makewith/io/prog/Main.hs

@@ -0,0 +1,21 @@
+
+import System.Plugins
+import API
+
+conf    = "../TestIO.conf"
+stub    = "../TestIO.stub"
+apipath = "../api"
+
+main = do
+        status <- makeWith conf stub ["-i"++apipath]
+        o <- case status of
+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess _ o -> return o
+        m_v   <- load o [apipath] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            _               -> error "load failed"
+        s <- field v
+
+        makeCleaner o
+        if null s then print False else print True

testsuite/makewith/io/prog/expected

@@ -0,0 +1,6 @@
+merge failed:
+
+parse error in ../TestIO.conf
+line: 17, col: 1
+
+a.out: failed

testsuite/makewith/merge00/Bar.hs

@@ -0,0 +1,3 @@
+module Bar where
+
+resource :: Int

testsuite/makewith/merge00/Foo.hs

@@ -0,0 +1,4 @@
+module Foo where
+
+resource :: Integer
+resource = 0xBAD

testsuite/makewith/merge00/Main.hs

@@ -0,0 +1,38 @@
+
+import System.Plugins
+
+import System.Directory
+
+a    = "Foo.hs" -- uesr code
+b    = "Bar.hs" -- trusted code. Result is "Bar.o"
+
+main = do
+        status <- merge a b 
+        f <- case status of
+                MergeFailure e     -> error "merge failure"
+                MergeSuccess _ _ f -> return f
+
+        status <- merge a b 
+        f' <- case status of
+                MergeFailure e          -> error "merge failure"
+                MergeSuccess ReComp _ f -> error "unnec. merge"
+                MergeSuccess NotReq _ f -> return f
+
+        print ( f == f' )
+
+        status <- make f' []
+        o <- case status of
+                  MakeFailure   e -> error "make failed"
+                  MakeSuccess _ o -> return o
+
+        m_v   <- load o [] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            _               -> error "load failed"
+        putStrLn $ show $ (v :: Int)
+
+        removeFile o
+        return ()
+
+        makeCleaner f
+

testsuite/makewith/merge00/Makefile

@@ -0,0 +1,4 @@
+TEST=makewith/merge00
+
+TOP=../../..
+include ../../eval.mk

testsuite/makewith/merge00/expected

@@ -0,0 +1,2 @@
+True
+2989

testsuite/makewith/mergeto0/Bar.hs

@@ -0,0 +1,3 @@
+module Bar where
+
+resource :: Int

testsuite/makewith/mergeto0/Foo.hs

@@ -0,0 +1,4 @@
+module Foo where
+
+resource :: Integer
+resource = 0xBAD

testsuite/makewith/mergeto0/Main.hs

@@ -0,0 +1,37 @@
+
+import System.Plugins
+
+import System.Directory
+
+a    = "Foo.hs" -- uesr code
+b    = "Bar.hs" -- trusted code. Result is "Bar.o"
+c    = "Out.hs"
+
+main = do
+        status <- mergeTo a b c
+        f <- case status of
+                MergeFailure e     -> error "mergeto failure"
+                MergeSuccess _ _ f -> return f
+        print $ f == c
+
+        status <- mergeTo a b c
+        f' <- case status of
+                MergeFailure e          -> error "mergeto failure"
+                MergeSuccess ReComp _ f -> error "unnec. mergeto"
+                MergeSuccess NotReq _ f -> return f -- good, not req
+
+        print $ f == f' && f == c
+
+        status <- make f' []
+        o <- case status of
+                  MakeFailure   e -> error "make failed"
+                  MakeSuccess _ o -> return o
+
+        m_v   <- load o [] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            _               -> error "load failed"
+        putStrLn $ show $ (v :: Int)
+
+        makeCleaner c
+

testsuite/makewith/mergeto0/Makefile

@@ -0,0 +1,4 @@
+TEST=makewith/mergeto0
+
+TOP=../../..
+include ../../eval.mk

testsuite/makewith/mergeto0/expected

@@ -0,0 +1,3 @@
+True
+True
+2989

testsuite/makewith/module_name/Bar.hs

@@ -0,0 +1,3 @@
+module Bar where
+
+resource :: Int

testsuite/makewith/module_name/Foo.hs

@@ -0,0 +1,4 @@
+module Foo where
+
+resource :: Integer
+resource = 1

testsuite/makewith/module_name/Main.hs

@@ -0,0 +1,33 @@
+
+import System.Plugins
+
+import System.Directory
+
+a    = "Foo.hs" -- uesr code
+b    = "Bar.hs" -- trusted code. Result is "Bar.o"
+
+main = do
+        status <- makeWith a b []
+        s <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        status <- makeWith a b []
+        s' <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        status <- makeWith a b []
+        s'' <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        print $ (s == s') && (s' == s'')
+
+        m_v   <- load s [] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            _               -> error "load failed"
+        putStrLn $ show $ (v :: Int)
+
+        makeCleaner s''

testsuite/makewith/module_name/Makefile

@@ -0,0 +1,4 @@
+TEST=makewith/module_name
+
+TOP=../../..
+include ../../eval.mk

testsuite/makewith/module_name/expected

@@ -0,0 +1,5 @@
+ReComp
+NotReq
+NotReq
+True
+1

testsuite/makewith/multi_make/Bar.hs

@@ -0,0 +1,4 @@
+module Bar where
+
+resource :: Int
+resource = 2

testsuite/makewith/multi_make/Foo.hs

@@ -0,0 +1,4 @@
+module Foo where
+
+resource :: Integer
+resource = 1

testsuite/makewith/multi_make/Main.hs

@@ -0,0 +1,37 @@
+
+import System.Plugins
+
+import System.Directory
+
+a    = "Foo.hs" -- user code
+b    = "Bar.hs" -- more user code
+z    = "Stub.hs" -- and a stub
+
+main = do
+        status <- makeWith a z []
+        s <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        status <- makeWith b z []
+        s' <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        -- shouldn't need to remerge (a,z)
+        status <- makeWith a z []
+        t <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        -- shouldn't need to remerge (b,z)
+        status <- makeWith b z []
+        t' <- case status of
+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess n s -> print n >> return s
+
+        print $ s /= s' -- test we got unique modules
+        print $ t /= t' -- test we got unique modules
+
+        mapM_ makeCleaner [s,s']
+

testsuite/makewith/multi_make/Makefile

@@ -0,0 +1,4 @@
+TEST=makewith/multi_make
+
+TOP=../../..
+include ../../eval.mk

testsuite/makewith/multi_make/Stub.hs

@@ -0,0 +1,4 @@
+module Stub where
+
+resource :: Int
+

testsuite/makewith/multi_make/expected

@@ -0,0 +1,6 @@
+ReComp
+ReComp
+NotReq
+NotReq
+True
+True

testsuite/makewith/should_fail_0/Makefile

@@ -0,0 +1,4 @@
+TEST=makewith/should_fail_0
+
+TOP=../../..
+include ../../build.mk

testsuite/makewith/should_fail_0/Plugin.in

@@ -0,0 +1,3 @@
+module Plugin where
+
+resource = 0xBAD :: Int

testsuite/makewith/should_fail_0/Plugin.stub

@@ -0,0 +1,6 @@
+module Plugin ( resource ) where
+
+import API
+
+resource :: Interface
+resource = plugin

testsuite/makewith/should_fail_0/api/API.hs

@@ -0,0 +1,10 @@
+
+module API where
+
+data Interface = Interface { 
+        function :: String
+   }
+
+plugin :: Interface
+plugin = Interface  { function = "goodbye" }
+

testsuite/makewith/should_fail_0/prog/Main.hs

@@ -0,0 +1,19 @@
+
+import System.Plugins
+import API
+
+conf    = "../Plugin.in"
+stub    = "../Plugin.stub"
+
+main = do 
+        status <- makeWith conf stub ["-i../api"]
+        case status of
+                MakeFailure e    -> putStrLn "make failed"
+                MakeSuccess _  o ->  do
+                        m_v   <- load o ["../api"] [] "resource"
+                        v     <- case m_v of
+                                    LoadSuccess _ v -> return v
+                                    _               -> error "load failed"
+                        putStrLn $ (function v)
+                        makeCleaner o
+

testsuite/makewith/should_fail_0/prog/expected

@@ -0,0 +1 @@
+make failed

testsuite/makewith/tiny/Makefile

@@ -0,0 +1,5 @@
+
+TEST=makewith/tiny
+
+TOP=../../..
+include ../../build.mk

testsuite/makewith/tiny/Tiny.conf

@@ -0,0 +1,8 @@
+resource = tiny { 
+
+    field = "hello strange world"
+    
+}
+
+
+

testsuite/makewith/tiny/Tiny.stub

@@ -0,0 +1,31 @@
+module Tiny ( resource, resource_dyn )  where
+
+import API
+import Data.Dynamic
+
+resource = tiny
+
+resource_dyn :: Dynamic
+resource_dyn = toDyn resource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

testsuite/makewith/tiny/api/API.hs

@@ -0,0 +1,13 @@
+{-# OPTIONS -fglasgow-exts #-}
+-- ^ needed to derive Typeable
+
+module API where
+
+import Data.Dynamic
+
+data Tiny = Tiny { field :: String }
+   deriving (Typeable, Show)
+
+tiny :: Tiny
+tiny = Tiny { field = "default value" }
+

testsuite/makewith/tiny/prog/Main.hs

@@ -0,0 +1,21 @@
+
+import System.Plugins
+import API
+import Data.Either
+
+conf    = "../Tiny.conf"
+stub    = "../Tiny.stub"
+apipath = "../api"
+
+main = do
+        status <- makeWith conf stub ["-i"++apipath]
+        o <- case status of
+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess _ o -> return o
+        m_v   <- load o [apipath] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            _               -> error "load failed"
+        putStrLn $ field v 
+        makeCleaner o
+

testsuite/makewith/tiny/prog/expected

@@ -0,0 +1 @@
+hello strange world

testsuite/makewith/unsafeio/Makefile

@@ -0,0 +1,5 @@
+
+TEST=makewith/unsafeio
+
+TOP=../../..
+include ../../build.mk

testsuite/makewith/unsafeio/README

@@ -0,0 +1,3 @@
+hmm. on 6.3  we need to add 'mtl' to a package dependency, other
+HSlang complains of a missing symbol. Is this a bug in the
+package.conf for HSlang?

testsuite/makewith/unsafeio/Unsafe.conf.in

@@ -0,0 +1,21 @@
+{-# GLOBALOPTIONS -package mtl #-}
+-- illustrates the use of static options in pragmas
+
+import System.IO.Unsafe
+import System.IO
+import System.Process
+
+resource = unsafe { field = date }
+
+-- illustrates the use of the devil's work
+date :: String
+date = unsafePerformIO $ do
+#if !defined(CYGWIN) || !defined(__MINGW32__)
+            (_,outh,_,proc) <- runInteractiveProcess "date" [] Nothing Nothing		
+#else
+            (_,outh,_,proc) <- runInteractiveProcess "@PREFIX@/../../bin/date" [] Nothing Nothing		
+#endif
+    	    waitForProcess proc
+            s <- hGetContents outh
+            return s
+

testsuite/makewith/unsafeio/Unsafe.stub

@@ -0,0 +1,13 @@
+
+module Unsafe ( resource, resource_dyn )  where
+
+import API
+import Data.Dynamic
+
+resource = unsafe
+
+--
+-- special
+--
+resource_dyn :: Dynamic
+resource_dyn = toDyn resource

testsuite/makewith/unsafeio/api/API.hs

@@ -0,0 +1,13 @@
+{-# OPTIONS -fglasgow-exts #-}
+
+module API where
+
+import Data.Dynamic
+
+data Unsafe = Unsafe { 
+                field :: String 
+        }
+   deriving (Typeable, Show)
+
+unsafe :: Unsafe
+unsafe = Unsafe { field = "default value" }

testsuite/makewith/unsafeio/prog/Main.hs

@@ -0,0 +1,20 @@
+import System.Plugins
+import API
+import Data.Either
+
+conf    = "../Unsafe.conf"
+stub    = "../Unsafe.stub"
+apipath = "../api"
+
+main = do
+        status <- makeWith conf stub ["-i"++apipath]
+        o <- case status of
+                MakeFailure e -> mapM_ putStrLn e >> error "failed"
+                MakeSuccess _ o -> return o
+        m_v   <- load o [apipath] [] "resource"
+        v <- case m_v of
+            LoadSuccess _ v -> return v
+            _               -> error "load failed"
+        let s = field v
+        makeCleaner o
+        if null s then print False else print True

testsuite/makewith/unsafeio/prog/README

@@ -0,0 +1,8 @@
+this is an example of an application that uses the HSConf library to
+dynamically load compiled conf files.
+
+We use the .conf file in the parent directory, and communicate with
+the plugin via the API in the api_package/ directory.
+
+The plugin is a .o file
+The api is a GHC package archive

testsuite/makewith/unsafeio/prog/expected

@@ -0,0 +1,6 @@
+merge failed:
+
+parse error in ../Unsafe.conf
+line: 13, col: 1
+
+a.out: failed