Import hs-plugins cvs
This commit is contained in:
4
examples/makewith/io/Makefile
Normal file
4
examples/makewith/io/Makefile
Normal file
@ -0,0 +1,4 @@
|
||||
TEST=makewith/io
|
||||
|
||||
TOP=../../..
|
||||
include ../../build.mk
|
2
examples/makewith/io/README
Normal file
2
examples/makewith/io/README
Normal file
@ -0,0 +1,2 @@
|
||||
An example using IO monad fields in the .conf file.
|
||||
|
76
examples/makewith/io/TestIO.conf
Normal file
76
examples/makewith/io/TestIO.conf
Normal file
@ -0,0 +1,76 @@
|
||||
{-# 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.Posix.Types ( ProcessID, Fd )
|
||||
import System.Posix.Process ( forkProcess, executeFile, getProcessID )
|
||||
import System.Posix.IO ( createPipe, stdInput,
|
||||
stdOutput, fdToHandle, closeFd, dupTo )
|
||||
|
||||
resource = testio { field = date }
|
||||
|
||||
--
|
||||
-- call a shell command , returning it's output
|
||||
--
|
||||
date :: IO String
|
||||
date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed")
|
||||
hGetLine hdl
|
||||
|
||||
------------------------------------------------------------------------
|
||||
--
|
||||
-- my implementation of $val = `cmd`; (if this was perl)
|
||||
--
|
||||
-- provide similar functionality to popen(3),
|
||||
-- along with bidirectional ipc via pipes
|
||||
-- return's the pid of the child process
|
||||
--
|
||||
-- there are two different forkProcess functions. the pre-620 was a
|
||||
-- unix-fork style function, and the modern function has semantics more
|
||||
-- like the Awkward-Squad paper. We provide implementations of popen
|
||||
-- using both versions, depending on which GHC the user wants to try.
|
||||
--
|
||||
|
||||
popen :: FilePath -> IO (Handle, Handle, ProcessID)
|
||||
popen cmd = do
|
||||
(pr, pw) <- createPipe
|
||||
(cr, cw) <- createPipe
|
||||
|
||||
-- parent --
|
||||
let parent = do closeFd cw
|
||||
closeFd pr
|
||||
-- child --
|
||||
let child = do closeFd pw
|
||||
closeFd cr
|
||||
exec cmd (pr,cw)
|
||||
error "exec cmd failed!" -- typing only
|
||||
|
||||
-- if the parser front end understood cpp, this would work
|
||||
-- #if __GLASGOW_HASKELL__ >= 601
|
||||
pid <- forkProcess child -- fork child
|
||||
parent -- and run parent code
|
||||
-- #else
|
||||
-- p <- forkProcess
|
||||
-- pid <- case p of
|
||||
-- Just pid -> parent >> return pid
|
||||
-- Nothing -> child
|
||||
-- #endif
|
||||
|
||||
hcr <- fdToHandle cr
|
||||
hpw <- fdToHandle pw
|
||||
|
||||
return (hcr,hpw,pid)
|
||||
|
||||
--
|
||||
-- execve cmd in the child process, dup'ing the file descriptors passed
|
||||
-- as arguments to become the child's stdin and stdout.
|
||||
--
|
||||
exec :: FilePath -> (Fd,Fd) -> IO ()
|
||||
exec cmd (pr,cw) = do
|
||||
dupTo pr stdInput
|
||||
dupTo cw stdOutput
|
||||
executeFile cmd False [] Nothing
|
||||
|
||||
------------------------------------------------------------------------
|
10
examples/makewith/io/TestIO.stub
Normal file
10
examples/makewith/io/TestIO.stub
Normal file
@ -0,0 +1,10 @@
|
||||
|
||||
module TestIO ( resource, resource_dyn ) where
|
||||
|
||||
import API
|
||||
import Data.Dynamic
|
||||
|
||||
resource = testio
|
||||
|
||||
resource_dyn :: Dynamic
|
||||
resource_dyn = toDyn resource
|
16
examples/makewith/io/api/API.hs
Normal file
16
examples/makewith/io/api/API.hs
Normal file
@ -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" }
|
21
examples/makewith/io/prog/Main.hs
Normal file
21
examples/makewith/io/prog/Main.hs
Normal file
@ -0,0 +1,21 @@
|
||||
|
||||
import 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
|
1
examples/makewith/io/prog/expected
Normal file
1
examples/makewith/io/prog/expected
Normal file
@ -0,0 +1 @@
|
||||
True
|
Reference in New Issue
Block a user