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 a. FilePath -> IO a
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. HasCallStack => [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'
existsFlags <- (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO Bool
doesFileExist [FilePath]
files
let 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 null existingFiles
then fail (file ++ ": File does not exist")
else return $ head existingFiles
mktemp :: FilePath -> FilePath -> IO (Handle, FilePath)
mktemp :: FilePath -> FilePath -> IO (Handle, FilePath)
mktemp FilePath
pre FilePath
post =
do
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]
forall g. RandomGen g => (Int, Int) -> g -> [Int]
randomRs (Int
0, Int
61)) IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
createLoop 100 rs
where
createLoop :: Int -> [Int] -> IO (Handle, FilePath)
createLoop Int
0 [Int]
_ = FilePath -> IO (Handle, FilePath)
forall a. FilePath -> IO a
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
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
fname IOMode
ReadWriteMode
return (h, 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)