module Unix.hs
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
Re: A Haskell-Shell
Jim Mattson's "Haskell shell" may still be distributed as
misc/examples/hsh/Hsh.hs in GHC. I include what I believe
to be a reasonably current (1997) version below.
Will
Peter Hancock <[EMAIL PROTECTED]> wrote:
I found an old (and stale) URL
http://www.dcs.gla.ac.uk/~mattson/Hsh.html">Unix shell in GHC
which may be relevant to this thread. As I dimly recall it was a few
screenfulls of code, and only a "proof of concept". Perhaps one can
find a non-stale link by a web search?
==
module Main (main) where
import IO
import Posix
import Directory (setCurrentDirectory)
import System( getEnv, exitWith, ExitCode(..) )
import Char (isSpace)
main :: IO ()
main =
do
initialize
commandLoop
{-
Standard shell practice: move std descriptors out of the way so
it's more convenient to set them up for children. Also set up an
interrupt handler which will put us back in the main loop.
-}
initialize :: IO ()
initialize =
dupTo stdInput myStdin >>
dupTo stdOutput myStdout>>
dupTo stdError myStderr>>
fdClose stdInput>>
fdClose stdOutput >>
-- fdClose stdError>>
installHandler sigINT (Catch intr) Nothing >>
return ()
-- some random fd numbers...
myStdin = intToFd 16
myStdout = intToFd 17
myStderr = intToFd 18
-- For user interrupts
intr :: IO ()
intr =
fdWrite myStdout "\n" >>
commandLoop
{-
Simple command loop: print a prompt, read a command, process the command.
Repeat as necessary.
-}
commandLoop :: IO ()
commandLoop =
fdWrite myStdout "$ " >>
try (readCommand myStdin) >>=
either
(\ err ->
if isEOFError err then
return ()
else
dieHorribly)
(\ cmd ->
try (processCommand cmd) >>= either (\ err -> commandLoop) (\ succ ->
commandLoop))
where
dieHorribly :: IO ()
dieHorribly =
do
errMsg "read failed"
exitWith (ExitFailure 1)
{-
Read a command a character at a time (to allow for fancy processing later).
On newline, you're done, unless the newline was escaped by a backslash.
-}
readCommand :: Fd -> IO String
readCommand fd =
accumString "" >>= \ cmd ->
return cmd
where
accumString :: String -> IO String
accumString s =
myGetChar fd>>= \ c ->
case c of
'\\' ->
myGetChar fd>>= \ c' ->
accumString (c':c:s)
'\n' -> return (reverse s)
ch -> accumString (ch:s)
myGetChar :: Fd -> IO Char
myGetChar chan =
do
(s,len) <- fdRead chan 1
case len of
0 -> myGetChar chan
1 -> return (head s)
{-
To process a command, first parse it into words, then do the necessary
redirections, and finally perform the desired command. Built-ins are
checked first, and if none match, we execute an external command.
-}
processCommand :: String -> IO ()
processCommand "" = return ()
processCommand s =
do
words <- parseCommand s
(inFile, outFile, words) <- parseRedirection words
performRedirections inFile outFile
let
cmd = head words
args = tail words
case builtin cmd of
Just f ->
do
f args
fdClose stdInput
fdClose stdOutput
Nothing -> exec cmd args
{-
Redirections are a bit of a pain, really. If none are specified, we
dup our own file descriptors. Otherwise, we try to open the files
as requested.
-}
performRedirections :: Maybe String -> Maybe String -> IO ()
performRedirections inFile outFile =
(case inFile of
Nothing -> dupTo myStdin stdInput
Just x ->
try (openFd x ReadOnly Nothing defaultFileFlags)
>>=
either
(\ err ->
errMsg ("Can't redirect input from " ++ x) >>
fail (userError "redirect"))
(\ succ -> return ()))>>
(case outFile of
Nothing ->
dupTo myStdout stdOutput
Just x ->
try (createFile x stdFileMode) >>=
either
(\ err ->
do
errMsg ("Can't redirect output to " ++ x)
fdClose stdInput
fail (userError "redirect"))
(\ succ -> return ()))
{-
We parse a command line into words according to the following rules:
1) Anything inside pairs of "" or '' is parsed literally.
2) Anything (outside of quotes) escaped by \ is taken literally.
3) '<' and '>' are words all by themselves, unless escaped or quoted.
4) Whitespace separates words
-}
parseCommand :: String -> IO [String]
parseCommand = getTokens []
where
getTokens :: [String] -> String -> IO [String]
getTokens ts "
Re: A Haskell-Shell
Hi,
The appended patch to Hugs98 (to be applied in the src subdirectory)
might be of some help for those who want to do shell scripting in
Haskell. It modifies IO.openFile as follows:
- If the name of a file opened in ReadMode ends in "|", then the part
before the "|" is considered a program and its standard output is
read.
- If the name of a file opened in WriteMode begins with "|", then the
part after the "|" is considered a program and it is written to its
standard input.
Several Unix programs have such a behaviour.
With the patch applied, you can do things like this:
do h <- openFile "cat /etc/group|" ReadMode
h' <- openFile "|tr aeiou '*'" WriteMode
hGetContents h >>= hPutStr h'
hClose h
hClose h'
Now for the disclaimers.
The patched program is in no way meant to be elegant. I rather tried to
keep the patch itself as small as possible. I also have not tested it on
any environment other than my Linux machine. And to be honest, I didn't
completely understand what I was doing. (What are, e.g., `ap' and
`HANDCELL'?)
The patch is also not a complete solution to the needs of script
programmers because you can only access the standard input *or* the
standard output of a program. A cleaner solution would be based on the
`pipe', `fork' and `execve' system calls made available as Haskell
primitives. But I don't understand enough of the hugs internals to
implement that.
Heribert.
--
*** storage.c.orig Fri Aug 20 18:34:05 1999
--- storage.c Sat Aug 21 09:33:34 1999
***
*** 2441,2446
--- 2441,2460
ERRMSG(0) "Too many handles open; cannot open \"%s\"", s
EEND;
}
+ else if (hmode&HREAD && s[strlen(s)-1]=='|') {
+ s[strlen(s)-1] = (char) 0;
+ /* Is this side effect harmless? */
+ if (handles[i].hfp=popen(s,"r")) {
+ handles[i].hmode = hmode;
+ return (handles[i].hcell = ap(HANDCELL,i));
+ }
+ }
+ else if (hmode&HWRITE && s[0]=='|') {
+ if (handles[i].hfp=popen(s+1,"w")) {
+ handles[i].hmode = hmode;
+ return (handles[i].hcell = ap(HANDCELL,i));
+ }
+ }
else { /* prepare to open file*/
String stmode;
if (binary) {
***
*** 2464,2470
Int n; {/* heap references to it remain*/
if (0<=n && nHSTDERR && handles[n].hmode!=HCLOSED && handles[n].hfp) {
! fclose(handles[n].hfp);
handles[n].hfp = 0;
}
fst(handles[n].hcell) = snd(handles[n].hcell) = NIL;
--- 2478,2488
Int n; {/* heap references to it remain*/
if (0<=n && nHSTDERR && handles[n].hmode!=HCLOSED && handles[n].hfp) {
! if (pclose(handles[n].hfp) == -1) {
! /* Is there a more elegant way to find out whether a
!FILE is actually a pipe? */
! fclose(handles[n].hfp);
! }
handles[n].hfp = 0;
}
fst(handles[n].hcell) = snd(handles[n].hcell) = NIL;
Re: A Haskell-Shell
Koen Claessen wrote: > > Hello, > > | Just wondering if someone uses Hugs for writing Unix-Shell Scripts. Or > | what would you think about a Haskell-Shell. > > These are two quite separate issues of course. I can comment on the first > one. > Of course you're rigth, and I better had just asked if someone like to have a Haskell Shell. I just thought that this would be a nice application. Regards Friedrich
