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 = FilePath -> IO FilePath
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 FilePath -> Char
forall a. [a] -> a
head FilePath
file Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
then (FilePath -> FilePath
dirname FilePath
file FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
paths, FilePath -> FilePath
stripDirname FilePath
file)
else ([FilePath]
paths, FilePath
file)
files :: [FilePath]
files = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> FilePath
`addPath` FilePath
file') [FilePath]
paths'
[Bool]
existsFlags <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
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) <- [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
files [Bool]
existsFlags, Bool
flag]
if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
existingFiles
then FilePath -> IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": File does not exist")
else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
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 <- (StdGen -> [Int]) -> IO StdGen -> IO [Int]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Int, Int) -> StdGen -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
0, Int
61)) IO StdGen
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]
_ = FilePath -> IO (Handle, FilePath)
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
(Handle, FilePath) -> IO (Handle, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, FilePath
fname)
IO (Handle, FilePath)
-> (SomeException -> IO (Handle, FilePath))
-> IO (Handle, FilePath)
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 Int -> Int -> Int
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') = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
6 [Int]
is
toChar :: Int -> Char
toChar Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
36 = Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
10) (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
i
| Bool
otherwise = Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
36) (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
i
in
([Int]
is', (Int -> Char) -> [Int] -> FilePath
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 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rndChars FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
post)