[project @ 1997-03-14 08:02:40 by simonpj]
[nofib.git] / real / ebnf2ps / IOSupplement.hs
1 -- -*- Mode: Haskell -*-
2 -- Copyright 1994 by Peter Thiemann
3 -- IOSupplement.hs --- some enhancements to the IO operations
4 -- Author : Peter Thiemann
5 -- Created On : Mon Aug 30 09:41:30 1993
6 -- Last Modified By: Peter Thiemann
7 -- Last Modified On: Thu Dec 2 10:37:39 1993
8 -- Update Count : 13
9 -- Status : Unknown, Use with caution!
10 --
11 -- $Log: IOSupplement.hs,v $
12 -- Revision 1.3 1997/03/14 08:08:09 simonpj
13 -- Major update to more-or-less 2.02
14 --
15 -- Revision 1.2 1996/07/25 21:23:58 partain
16 -- Bulk of final changes for 2.01
17 --
18 -- Revision 1.1 1996/01/08 20:02:33 partain
19 -- Initial revision
20 --
21 -- Revision 1.2 1994/03/15 15:34:53 thiemann
22 -- generalized readPathFile
23 --
24 -- Revision 1.1 1993/08/31 12:31:32 thiemann
25 -- Initial revision
26 --
27 -- $Locker: $
28 --
29
30 module IOSupplement (PathCont, getPath, readPathFile)
31 where
32
33 import System -- 1.3
34 import IOBase ( IOError (..) )
35 --------------------------------------------------------------------------------
36
37 type PathCont = [String] -> IO ()
38 type FailCont = IOError -> IO ()
39 type StrCont = String -> IO ()
40
41 getPath :: String -> [String] -> PathCont -> IO ()
42 --
43 -- accepts the name of an environment variable and a [String] of default paths
44 -- and calls the continuation (::PathCont) with the resulting search path
45 --
46 getPath envVar dflt cont =
47 (do {path <- getEnv envVar; cont (manglePath path dflt)})
48 `catch`
49 (\ (NoSuchThing _) -> cont dflt)
50
51
52 -- mangle a colon separated pathstring with a default path
53
54 manglePath :: String -> [String] -> [String]
55 manglePath "" dflt = dflt
56 manglePath cs dflt = case span (/= ':') cs of
57 ("",':':cs') -> dflt ++ manglePath cs' []
58 ("", "") -> dflt
59 (path,':':cs') -> path: manglePath cs' dflt
60 (path,"") -> [path]
61
62 --------------------------------------------------------------------------------
63
64 readPathFile :: [String] -> String -> FailCont -> StrCont -> IO ()
65 --
66 -- readPathFile searchPath fileName fc sc
67 -- scan searchPath for fileName and read it
68 -- unless fileName starts with '.' or is absolute (starts with '/')
69 --
70 readPathFile _ fileName@('/':_) fc sc = myreadFile fileName fc sc
71 readPathFile _ fileName@('.':_) fc sc = myreadFile fileName fc sc
72 readPathFile [] fileName fc sc =
73 fc (userError ("readPathFile failed on :" ++ fileName))
74 readPathFile (path: paths) fileName fc sc =
75 -- appendChan stderr ("Trying path "++fullName++"...\n") exit
76 (myreadFile fullName failCont sc)
77 where
78 fullName = path ++ '/': fileName
79 failCont _ = readPathFile paths fileName fc sc
80
81
82 myreadFile :: String -> FailCont -> StrCont -> IO ()
83 myreadFile filename fc sc
84 = catch (readFile filename >>= \ cts -> sc cts)
85 fc