module FileOps (fileFindIn, mktemp)
where
import Prelude hiding (catch)
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)
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
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
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)