--  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
FilePath
""   fileFindIn :: FilePath -> [FilePath] -> IO FilePath
`fileFindIn` [FilePath]
paths  = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Empty file name"
FilePath
file `fileFindIn` [FilePath]
paths  =
  do
    let ([FilePath]
paths', FilePath
file') = if forall a. [a] -> a
head FilePath
file forall a. Eq a => a -> a -> Bool
== Char
'/'
                          then (FilePath -> FilePath
dirname FilePath
file forall a. a -> [a] -> [a]
: [FilePath]
paths, FilePath -> FilePath
stripDirname FilePath
file)
                          else ([FilePath]
paths, FilePath
file)
        files :: [FilePath]
files  = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`addPath` FilePath
file') [FilePath]
paths'
    [Bool]
existsFlags <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Bool
doesFileExist [FilePath]
files
    let existingFiles :: [FilePath]
existingFiles = [FilePath
file | (FilePath
file, Bool
flag) <- forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
files [Bool]
existsFlags, Bool
flag]
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
existingFiles
      then forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
": File does not exist")
      else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [FilePath]
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 :: FilePath -> FilePath -> IO (Handle, FilePath)
mktemp FilePath
pre FilePath
post =
  do
    [Int]
rs <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
0, Int
61)) forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
                         -- range for lower and upper case letters plus digits
    Int -> [Int] -> IO (Handle, FilePath)
createLoop Int
100 [Int]
rs
  where
    createLoop :: Int -> [Int] -> IO (Handle, FilePath)
createLoop Int
0        [Int]
_  = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"mktemp: failed 100 times"
    createLoop Int
attempts [Int]
rs = let
                               ([Int]
rs', FilePath
fname) = [Int] -> ([Int], FilePath)
nextName [Int]
rs
                             in do
                               Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
fname IOMode
ReadWriteMode
                               forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, FilePath
fname)
                             forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` Int -> [Int] -> SomeException -> IO (Handle, FilePath)
handler Int
attempts [Int]
rs'
    --
    handler :: Int -> [Int] -> SomeException -> IO (Handle,FilePath)
    handler :: Int -> [Int] -> SomeException -> IO (Handle, FilePath)
handler Int
attempts [Int]
rs' SomeException
_ = Int -> [Int] -> IO (Handle, FilePath)
createLoop (Int
attempts forall a. Num a => a -> a -> a
- Int
1) [Int]
rs'

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