FileOps.hs

--  Compiler Toolkit: operations on file
--
--  Author : Manuel M T Chakravarty
--  Created: 6 November 1999
--
--  Version $Revision: 1.1.1.1 $ from $Date: 2004/11/13 16:42:49 $
--
--  Copyright (c) [1999..2003] Manuel M T Chakravarty
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  Typical operations needed when manipulating file names.
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--- TODO ----------------------------------------------------------------------
--

module FileOps (fileFindIn, mktemp)
where

import Prelude hiding (catch)
-- standard libs
import Data.Char      (chr, ord)
import System.Directory (doesFileExist)
import System.IO	 (Handle, IOMode(..), openFile)
import Control.Monad	 (liftM)
import Control.Exception (catch, SomeException)
import System.Random    (newStdGen, randomRs)

import FNameOps  (dirname, stripDirname, addPath)


-- search for the given file in the given list of directories (EXPORTED)
--
-- * if the file does not exist, an exception is raised
--
-- * if the given file name is absolute, it is first tried whether this file
--   exists, afterwards the path component is stripped and the given
--   directories are searched; otherwise, if the file name is not absolute,
--   the path component is retained while searching the directories
--
fileFindIn              :: FilePath -> [FilePath] -> IO FilePath
""   `fileFindIn` paths  = fail "Empty file name"
file `fileFindIn` paths  =
  do
    let (paths', file') = if head file == '/' 
			  then (dirname file : paths, stripDirname file)
			  else (paths, file)
        files  = map (`addPath` file') paths'
    existsFlags <- mapM doesFileExist files
    let existingFiles = [file | (file, flag) <- zip files existsFlags, flag]
    if null existingFiles
      then fail (file ++ ": File does not exist")
      else return $ head existingFiles

-- |Create a temporary file with a unique name.
--
-- * A unique sequence of at least six characters and digits is added
--   inbetween the two given components (the latter of which must include the
--   file suffix if any is needed)
--
-- * Default permissions are used, which might not be optimal, but
--   unfortunately the Haskell standard libs don't support proper permission
--   management. 
--
-- * We make 100 attempts on getting a unique filename before giving up.
--
mktemp :: FilePath -> FilePath -> IO (Handle, FilePath)
mktemp pre post =
  do
    rs <- liftM (randomRs (0, 61)) newStdGen
			 -- range for lower and upper case letters plus digits
    createLoop 100 rs
  where
    createLoop 0        _  = fail "mktemp: failed 100 times"
    createLoop attempts rs = let
			       (rs', fname) = nextName rs
			     in do
			       h <- openFile fname ReadWriteMode
			       return (h, fname)
			     `catch` handler attempts rs'
    --
    handler :: Int -> [Int] -> SomeException -> IO (Handle,FilePath)
    handler attempts rs' _ = createLoop (attempts - 1) rs'

    sixChars :: [Int] -> ([Int], String)
    sixChars is = 
      let
        (sixInts, is') = splitAt 6 is
	--
	toChar i | i < 10    = chr . (ord '0' +)                 $ i
		 | i < 36    = chr . (ord 'A' +) . (subtract 10) $ i
		 | otherwise = chr . (ord 'a' +) . (subtract 36) $ i
	in
	(is', map toChar sixInts)
    --
    nextName :: [Int] -> ([Int], String)
    nextName is = let
		    (is', rndChars) = sixChars is
		  in
		  (is', pre ++ rndChars ++ post)