1 {-# OPTIONS -cpp #-} 2 -- -*- Mode: Haskell -*- 3 -- Copyright 1994 by Peter Thiemann 4 -- IOSupplement.hs --- some enhancements to the IO operations 5 -- Author : Peter Thiemann 6 -- Created On : Mon Aug 30 09:41:30 1993 7 -- Last Modified By: Peter Thiemann 8 -- Last Modified On: Thu Dec 2 10:37:39 1993 9 -- Update Count : 13 10 -- Status : Unknown, Use with caution! 11 -- 12 -- $Log: IOSupplement.hs,v $ 13 -- Revision 1.7 2002/01/29 11:03:21 simonmar 14 -- Tweaks to make the real suite run with GHCi. 15 -- 16 -- Revision 1.6 1999/01/18 19:38:46 sof 17 -- Misc (backward compatible) changes to make srcs acceptable 18 -- to a Haskell 98 compiler. 19 -- 20 -- Revision 1.5 1998/02/19 17:02:22 simonm 21 -- updates for library re-organisation in GHC 3.01. 22 -- 23 -- Revision 1.4 1997/03/17 20:35:25 simonpj 24 -- More small changes towards 2.02 25 -- 26 -- Revision 1.3 1997/03/14 08:08:09 simonpj 27 -- Major update to more-or-less 2.02 28 -- 29 -- Revision 1.2 1996/07/25 21:23:58 partain 30 -- Bulk of final changes for 2.01 31 -- 32 -- Revision 1.1 1996/01/08 20:02:33 partain 33 -- Initial revision 34 -- 35 -- Revision 1.2 1994/03/15 15:34:53 thiemann 36 -- generalized readPathFile 37 -- 38 -- Revision 1.1 1993/08/31 12:31:32 thiemann 39 -- Initial revision 40 -- 41 -- $Locker: $ 42 -- 43 44 module IOSupplement ( 45 getPath, readPathFile 46 ) where 47 48 import System -- 1.3 49 import IO 50 51 #if __HASKELL1__ >= 5 52 #define fail ioError 53 #endif 54 55 -------------------------------------------------------------------------------- 56 57 58 getPath :: String -> [String] -> IO [String] 59 60 -- Accepts the name of an environment variable and a [String] of default paths 61 -- and calls the continuation (::PathCont) with the resulting search path 62 63 getPath envVar dflt = 64 (do {path <- getEnv envVar; return (manglePath path dflt)}) 65 `catch` 66 (\ _ -> return dflt) 67 68 69 -- mangle a colon separated pathstring with a default path 70 71 manglePath :: String -> [String] -> [String] 72 manglePath "" dflt = dflt 73 manglePath cs dflt = case span (/= ':') cs of 74 ("",':':cs') -> dflt ++ manglePath cs' [] 75 ("", "") -> dflt 76 (path,':':cs') -> path: manglePath cs' dflt 77 (path,"") -> [path] 78 79 -------------------------------------------------------------------------------- 80 81 readPathFile :: [String] -> String -> IO String 82 83 -- readPathFile searchPath fileName fc sc 84 -- scan searchPath for fileName and read it 85 -- unless fileName starts with '.' or is absolute (starts with '/') 86 87 readPathFile _ fileName@('/':_) = readFile fileName 88 readPathFile _ fileName@('.':_) = readFile fileName 89 90 readPathFile [] fileName 91 = fail (userError ("readPathFile failed on :" ++ fileName)) 92 93 readPathFile (path: paths) fileName 94 = readFile fullName `catch` 95 (\ _ -> readPathFile paths fileName) 96 where 97 fullName = path ++ '/': fileName 98