{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
module Test.Framework.Utils where
import System.Directory
import Data.Char
import System.Time hiding (diffClockTimes)
import System.Random
import Data.Array.IO
import Control.Monad
infixr 6 </>
(</>) :: FilePath -> FilePath -> FilePath
[] </> :: FilePath -> FilePath -> FilePath
</> FilePath
b = FilePath
b
FilePath
a </> FilePath
b = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b
basename :: FilePath -> FilePath
basename :: FilePath -> FilePath
basename FilePath
p = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
p
dirname :: FilePath -> FilePath
dirname :: FilePath -> FilePath
dirname FilePath
p =
case FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
p of
[] -> FilePath
"."
FilePath
p' -> FilePath
p'
startswith :: String -> String -> Bool
startswith :: FilePath -> FilePath -> Bool
startswith FilePath
s FilePath
pref =
let n :: Int
n = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pref
in Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
n FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
pref
endswith :: String -> String -> Bool
endswith :: FilePath -> FilePath -> Bool
endswith FilePath
s FilePath
suf =
let n :: Int
n = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
suf
in Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
n FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
suf
dropPrefix :: String -> String -> String
dropPrefix :: FilePath -> FilePath -> FilePath
dropPrefix FilePath
s FilePath
pref =
if FilePath -> FilePath -> Bool
startswith FilePath
s FilePath
pref
then Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
pref) FilePath
s
else FilePath
s
dropSuffix :: FilePath -> FilePath
dropSuffix :: FilePath -> FilePath
dropSuffix FilePath
f = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
tail (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
f
replaceSuffix :: FilePath -> String -> FilePath
replaceSuffix :: FilePath -> FilePath -> FilePath
replaceSuffix FilePath
f FilePath
suf = FilePath -> FilePath
dropSuffix FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suf
dropSpace :: [Char] -> [Char]
dropSpace :: FilePath -> FilePath
dropSpace = let f :: FilePath -> FilePath
f = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace in FilePath -> FilePath
f (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
f
data DirectoryEntryType = File | Directory | Other
deriving (DirectoryEntryType -> DirectoryEntryType -> Bool
(DirectoryEntryType -> DirectoryEntryType -> Bool)
-> (DirectoryEntryType -> DirectoryEntryType -> Bool)
-> Eq DirectoryEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirectoryEntryType -> DirectoryEntryType -> Bool
$c/= :: DirectoryEntryType -> DirectoryEntryType -> Bool
== :: DirectoryEntryType -> DirectoryEntryType -> Bool
$c== :: DirectoryEntryType -> DirectoryEntryType -> Bool
Eq, Int -> DirectoryEntryType -> FilePath -> FilePath
[DirectoryEntryType] -> FilePath -> FilePath
DirectoryEntryType -> FilePath
(Int -> DirectoryEntryType -> FilePath -> FilePath)
-> (DirectoryEntryType -> FilePath)
-> ([DirectoryEntryType] -> FilePath -> FilePath)
-> Show DirectoryEntryType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [DirectoryEntryType] -> FilePath -> FilePath
$cshowList :: [DirectoryEntryType] -> FilePath -> FilePath
show :: DirectoryEntryType -> FilePath
$cshow :: DirectoryEntryType -> FilePath
showsPrec :: Int -> DirectoryEntryType -> FilePath -> FilePath
$cshowsPrec :: Int -> DirectoryEntryType -> FilePath -> FilePath
Show)
directoryEntryType :: FilePath -> IO DirectoryEntryType
directoryEntryType :: FilePath -> IO DirectoryEntryType
directoryEntryType FilePath
fp =
do Bool
b <- FilePath -> IO Bool
doesFileExist FilePath
fp
if Bool
b then DirectoryEntryType -> IO DirectoryEntryType
forall (m :: * -> *) a. Monad m => a -> m a
return DirectoryEntryType
File else do Bool
b <- FilePath -> IO Bool
doesDirectoryExist FilePath
fp
DirectoryEntryType -> IO DirectoryEntryType
forall (m :: * -> *) a. Monad m => a -> m a
return (DirectoryEntryType -> IO DirectoryEntryType)
-> DirectoryEntryType -> IO DirectoryEntryType
forall a b. (a -> b) -> a -> b
$ if Bool
b then DirectoryEntryType
Directory else DirectoryEntryType
Other
collectFiles :: FilePath
-> String
-> (FilePath -> [FilePath] -> IO Bool)
-> IO [FilePath]
collectFiles :: FilePath
-> FilePath -> (FilePath -> [FilePath] -> IO Bool) -> IO [FilePath]
collectFiles FilePath
root FilePath
suf FilePath -> [FilePath] -> IO Bool
prune =
do [FilePath]
entries <- FilePath -> IO [FilePath]
getDirectoryContents FilePath
root
Bool
b <- FilePath -> [FilePath] -> IO Bool
prune FilePath
root [FilePath]
entries
if Bool
b then [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do [[FilePath]]
all <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> FilePath -> IO [FilePath]
collect FilePath
root) [FilePath]
entries
[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 (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
all
where collect :: FilePath -> FilePath -> IO [FilePath]
collect FilePath
root FilePath
f | FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." Bool -> Bool -> Bool
|| FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".." = [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise =
do DirectoryEntryType
t <- FilePath -> IO DirectoryEntryType
directoryEntryType (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
f)
case DirectoryEntryType
t of
DirectoryEntryType
Directory -> FilePath
-> FilePath -> (FilePath -> [FilePath] -> IO Bool) -> IO [FilePath]
collectFiles (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
f) FilePath
suf FilePath -> [FilePath] -> IO Bool
prune
DirectoryEntryType
File | FilePath
f FilePath -> FilePath -> Bool
`endswith` FilePath
suf -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
f]
DirectoryEntryType
_ -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
maybeFile :: FilePath -> IO (Maybe FilePath)
maybeFile :: FilePath -> IO (Maybe FilePath)
maybeFile FilePath
f =
do Bool
b <- FilePath -> IO Bool
doesFileExist FilePath
f
Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ if Bool
b then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f else Maybe FilePath
forall a. Maybe a
Nothing
mapAccumLM :: Monad m
=> (acc -> x -> m (acc, y))
-> acc
-> [x]
-> m (acc, [y])
mapAccumLM :: (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
_ acc
s [] = (acc, [y]) -> m (acc, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, [])
mapAccumLM acc -> x -> m (acc, y)
f acc
s (x
x:[x]
xs) = do (acc
s', y
y ) <- acc -> x -> m (acc, y)
f acc
s x
x
(acc
s'',[y]
ys) <- (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
s' [x]
xs
(acc, [y]) -> m (acc, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s'',y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys)
#if !(MIN_VERSION_base(4,13,0))
readM :: (Monad m, Read a) => String -> m a
#else
readM :: (MonadFail m, Read a) => String -> m a
#endif
readM :: FilePath -> m a
readM FilePath
s | [a
x] <- [a]
parse = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
| Bool
otherwise = FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed parse: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
s
where
parse :: [a]
parse = [a
x | (a
x, []) <- ReadS a
forall a. Read a => ReadS a
reads FilePath
s]
ensureNewline :: String -> String
ensureNewline :: FilePath -> FilePath
ensureNewline FilePath
s =
FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ case (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
s) of
Char
'\n':FilePath
_ -> FilePath
""
FilePath
_ | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s -> FilePath
""
| Bool
otherwise -> FilePath
"\n"
strip :: String -> String
strip :: FilePath -> FilePath
strip = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
measure :: IO a -> IO (a, Int)
measure :: IO a -> IO (a, Int)
measure IO a
ma =
do ClockTime
t0 <- IO ClockTime
getClockTime
a
a <- IO a
ma
ClockTime
t1 <- a
a a -> IO ClockTime -> IO ClockTime
`seq` IO ClockTime
getClockTime
let diffMicro :: Integer
diffMicro = ClockTime
t1 ClockTime -> ClockTime -> Integer
`diffClockTimes` ClockTime
t0
(a, Int) -> IO (a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
diffMicro Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000))
diffClockTimes :: ClockTime -> ClockTime -> Integer
diffClockTimes :: ClockTime -> ClockTime -> Integer
diffClockTimes (TOD Integer
s1 Integer
p1) (TOD Integer
s0 Integer
p0) =
(Integer -> Integer
forall a. Integral a => a -> a
picoseconds Integer
p1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Num a => a -> a
seconds Integer
s1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-
(Integer -> Integer
forall a. Integral a => a -> a
picoseconds Integer
p0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Num a => a -> a
seconds Integer
s0)
where
picoseconds :: a -> a
picoseconds a
i = a
i a -> a -> a
forall a. Integral a => a -> a -> a
`div` (a
1000 a -> a -> a
forall a. Num a => a -> a -> a
* a
1000)
seconds :: a -> a
seconds a
i = a
i a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000
shuffleIO :: [a] -> IO [a]
shuffleIO :: [a] -> IO [a]
shuffleIO [a]
xs = do
IOArray Int a
ar <- Int -> [a] -> IO (IOArray Int a)
forall a. Int -> [a] -> IO (IOArray Int a)
newArray Int
n [a]
xs
[Int] -> (Int -> IO a) -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..Int
n] ((Int -> IO a) -> IO [a]) -> (Int -> IO a) -> IO [a]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
Int
j <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
i,Int
n)
a
vi <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
ar Int
i
a
vj <- IOArray Int a -> Int -> IO a
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int a
ar Int
j
IOArray Int a -> Int -> a -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int a
ar Int
j a
vi
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
vj
where
n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
newArray :: Int -> [a] -> IO (IOArray Int a)
newArray :: Int -> [a] -> IO (IOArray Int a)
newArray Int
n [a]
xs = (Int, Int) -> [a] -> IO (IOArray Int a)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> [e] -> m (a i e)
newListArray (Int
1,Int
n) [a]
xs