Hi all,
I am just sending this because there were some people who thought it could
be useful. It works for Hugs98, but some hacks I use might be specific to
our local system.
I think a built-in module with the same function signatures would be
extremely useful!
Regards,
Koen.
--------------------------------------------------------------------
module Unix
( Command --:: String
, sys --:: Command -> IO ()
-- using stdin and stdout
, sysIn --:: Command -> String -> IO ()
, sysOut --:: Command -> IO String
, sysInOut --:: Command -> String -> IO String
-- using files as arguments
, sysWithIn --:: (FilePath -> Command) -> String -> IO ()
, sysWithOut --:: (FilePath -> Command) -> IO String
, sysInWithOut --:: (FilePath -> Command) -> String -> IO String
, sysWithInOut --:: (FilePath -> FilePath -> Command) -> String -> IO String
-- lazily generating output
, sysOutLazy --:: Command -> IO String
, sysInOutLazy --:: Command -> String -> IO String
, sysWithOutLazy --:: (FilePath -> Command) -> IO String
, sysInWithOutLazy --:: (FilePath -> Command) -> String -> IO String
, sysWithInOutLazy --:: (FilePath -> FilePath -> Command) -> String -> IO String
)
where
import System( system )
import IO( try )
--------------------------------------------------------------------
-- internal file names
prefix :: FilePath
prefix = "/tmp/hugs-sys-"
lockfile = prefix ++ "lock"
numfile = prefix ++ "number"
tmpfile n = prefix ++ show n
--------------------------------------------------------------------
-- comm
type Command
= String
type Comm
= ([FilePath] -> String, IO String)
comm0 :: Command -> Comm
comm0 s = (\_ -> s, return "")
comm1 :: (FilePath -> Command) -> Comm
comm1 f = (\(s:_) -> f s, return "")
comm2 :: (FilePath -> FilePath -> Command) -> Comm
comm2 f = (\(s1:s2:_) -> f s1 s2, return "")
-- decorator
type Decorator
= Comm -> IO Comm
sysDecorate :: Decorator -> Comm -> IO String
sysDecorate decorate comm =
do (f, after) <- decorate comm
system (f [])
after
--------------------------------------------------------------------
-- several decorators
inputArg :: String -> Decorator
inputArg inpS (f, after) =
do inpF <- uniqueTmpName
writeFile inpF inpS
return (\args -> f (args ++ [inpF]), after)
input :: String -> Decorator
input inpS (f, after) =
do inpF <- uniqueTmpName
writeFile inpF inpS
let after' = do s <- after
rm inpF
return s
return (\args -> f args ++ " < " ++ inpF, after')
outputArg :: Decorator
outputArg (f, after) =
do outP <- uniqueTmpName
writeFile outP ""
let after' = do s1 <- after
s2 <- readFile outP
rm outP
return (s1 ++ s2)
return (\args -> f (args ++ [outP]), after')
output :: Decorator
output (f, after) =
do outP <- uniqueTmpName
writeFile outP ""
let after' = do s1 <- after
s2 <- readFile outP
rm outP
return (s1 ++ s2)
return (\args -> f args ++ " > " ++ outP, after')
outputArgLazy :: Decorator
outputArgLazy (f, after) =
do outP <- uniqueTmpName
mkpipe outP
let after' = do s1 <- after
s2 <- readFile outP
rm outP
return (s1 ++ s2)
return (\args -> f (args ++ [outP]) ++ " &", after')
outputLazy :: Decorator
outputLazy (f, after) =
do outP <- uniqueTmpName
mkpipe outP
let after' = do s1 <- after
s2 <- readFile outP
rm outP
return (s1 ++ s2)
return (\args -> f args ++ " > " ++ outP ++ " &", after')
--------------------------------------------------------------------
-- several system functions
sys :: Command -> IO ()
sys comm = void (system comm)
sysIn :: Command -> String -> IO ()
sysIn comm inpS = void $
sysDecorate (input inpS) (comm0 comm)
sysOut :: Command -> IO String
sysOut comm =
sysDecorate (output) (comm0 comm)
sysInOut :: Command -> String -> IO String
sysInOut comm inpS =
sysDecorate (input inpS <> output) (comm0 comm)
sysWithIn :: (FilePath -> Command) -> String -> IO ()
sysWithIn comm inpS = void $
sysDecorate (inputArg inpS) (comm1 comm)
sysWithOut :: (FilePath -> Command) -> IO String
sysWithOut comm =
sysDecorate (outputArg) (comm1 comm)
sysInWithOut :: (FilePath -> Command) -> String -> IO String
sysInWithOut comm inpS =
sysDecorate (input inpS <> outputArg) (comm1 comm)
sysWithInOut :: (FilePath -> FilePath -> Command) -> String -> IO String
sysWithInOut comm inpS =
sysDecorate (inputArg inpS <> outputArg) (comm2 comm)
-- lazy versions
sysOutLazy :: Command -> IO String
sysOutLazy comm =
sysDecorate (outputLazy) (comm0 comm)
sysInOutLazy :: Command -> String -> IO String
sysInOutLazy comm inpS =
sysDecorate (input inpS <> outputLazy) (comm0 comm)
sysWithOutLazy :: (FilePath -> Command) -> IO String
sysWithOutLazy comm =
sysDecorate (outputArgLazy) (comm1 comm)
sysInWithOutLazy :: (FilePath -> Command) -> String -> IO String
sysInWithOutLazy comm inpS =
sysDecorate (input inpS <> outputArgLazy) (comm1 comm)
sysWithInOutLazy :: (FilePath -> FilePath -> Command) -> String -> IO String
sysWithInOutLazy comm inpS =
sysDecorate (inputArg inpS <> outputArgLazy) (comm2 comm)
--------------------------------------------------------------------
-- create unique names
uniqueTmpName :: IO String
uniqueTmpName = mutex $
do enum <- try (readFile numfile)
let num = either (const 0) read enum
num `seq` writeFile numfile (show (num+1))
chmod "a+w" numfile
return (tmpfile num)
mutex :: IO a -> IO a
mutex io =
do lock
a <- io
rm lockfile
return a
--------------------------------------------------------------------
-- calls to system
chmod :: String -> FilePath -> IO ()
chmod s file = void $ system ("chmod " ++ s ++ " " ++ file)
lock :: IO ()
lock = void $ system ("lockfile -1 -l 4 " ++ lockfile)
rm :: FilePath -> IO ()
rm file = void $ system ("rm -f " ++ file)
mkpipe :: FilePath -> IO ()
mkpipe file = void $ system ("mknod " ++ file ++ " p")
--------------------------------------------------------------------
-- monadic help functions
void :: Monad m => m a -> m ()
void m = m >> return ()
(<>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
m1 <> m2 = \x -> m1 x >>= m2
--------------------------------------------------------------------
-- the end.
