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