{-# LANGUAGE ViewPatterns #-}
module Test.Hspec.Core.Util (
pluralize
, strip
, lineBreaksAt
, stripAnsi
, Path
, joinPath
, formatRequirement
, filterPredicate
, safeTry
, formatException
, formatExceptionWith
) where
import Prelude ()
import Test.Hspec.Core.Compat hiding (join)
import Data.Char (isSpace)
import GHC.IO.Exception
import Control.Concurrent.Async
pluralize :: Int -> String -> String
pluralize :: Int -> String -> String
pluralize Int
1 String
s = String
"1 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
pluralize Int
n String
s = Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
strip :: String -> String
strip :: String -> String
strip = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
lineBreaksAt :: Int -> String -> [String]
lineBreaksAt :: Int -> String -> [String]
lineBreaksAt Int
n = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
f ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where
f :: String -> [String]
f String
input = case String -> [String]
words String
input of
[] -> []
String
x:[String]
xs -> (String, [String]) -> [String]
go (String
x, [String]
xs)
go :: (String, [String]) -> [String]
go :: (String, [String]) -> [String]
go (String, [String])
c = case (String, [String])
c of
(String
s, []) -> [String
s]
(String
s, String
y:[String]
ys) -> let r :: String
r = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y in
if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
then (String, [String]) -> [String]
go (String
r, [String]
ys)
else String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String, [String]) -> [String]
go (String
y, [String]
ys)
stripAnsi :: String -> String
stripAnsi :: String -> String
stripAnsi = String -> String
go
where
go :: String -> String
go String
input = case String
input of
Char
'\ESC' : Char
'[' : ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"0123456789;") -> Char
'm' : String
xs) -> String -> String
go String
xs
Char
x : String
xs -> Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
go String
xs
[] -> []
type Path = ([String], String)
joinPath :: Path -> String
joinPath :: Path -> String
joinPath ([String]
groups, String
requirement) = String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String]
groups [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
requirement]) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
formatRequirement :: Path -> String
formatRequirement :: Path -> String
formatRequirement ([String]
groups, String
requirement) = String
groups_ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
requirement
where
groups_ :: String
groups_ = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace) [String]
groups of
([], [String]
ys) -> [String] -> String
join [String]
ys
([String]
xs, [String]
ys) -> [String] -> String
join (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
xs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ys)
join :: [String] -> String
join [String]
xs = case [String]
xs of
[String
x] -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
[String]
ys -> (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", ") [String]
ys
filterPredicate :: String -> Path -> Bool
filterPredicate :: String -> Path -> Bool
filterPredicate String
pattern Path
path =
String
pattern String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
plain
Bool -> Bool -> Bool
|| String
pattern String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
formatted
where
plain :: String
plain = Path -> String
joinPath Path
path
formatted :: String
formatted = Path -> String
formatRequirement Path
path
formatException :: SomeException -> String
formatException :: SomeException -> String
formatException = (SomeException -> String) -> SomeException -> String
formatExceptionWith SomeException -> String
forall a. Show a => a -> String
show
formatExceptionWith :: (SomeException -> String) -> SomeException -> String
formatExceptionWith :: (SomeException -> String) -> SomeException -> String
formatExceptionWith SomeException -> String
showException err :: SomeException
err@(SomeException e
e) = case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err of
Just IOException
ioe -> IOException -> String
forall a. Typeable a => a -> String
showType IOException
ioe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOException -> String
showIOErrorType IOException
ioe String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
showException (IOException -> SomeException
forall e. Exception e => e -> SomeException
toException IOException
ioe)
Maybe IOException
Nothing -> e -> String
forall a. Typeable a => a -> String
showType e
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
showException (e -> SomeException
forall e. Exception e => e -> SomeException
SomeException e
e)
where
showIOErrorType :: IOException -> String
showIOErrorType :: IOException -> String
showIOErrorType IOException
ioe = case IOException -> IOErrorType
ioe_type IOException
ioe of
IOErrorType
AlreadyExists -> String
"AlreadyExists"
IOErrorType
NoSuchThing -> String
"NoSuchThing"
IOErrorType
ResourceBusy -> String
"ResourceBusy"
IOErrorType
ResourceExhausted -> String
"ResourceExhausted"
IOErrorType
EOF -> String
"EOF"
IOErrorType
IllegalOperation -> String
"IllegalOperation"
IOErrorType
PermissionDenied -> String
"PermissionDenied"
IOErrorType
UserError -> String
"UserError"
IOErrorType
UnsatisfiedConstraints -> String
"UnsatisfiedConstraints"
IOErrorType
SystemError -> String
"SystemError"
IOErrorType
ProtocolError -> String
"ProtocolError"
IOErrorType
OtherError -> String
"OtherError"
IOErrorType
InvalidArgument -> String
"InvalidArgument"
IOErrorType
InappropriateType -> String
"InappropriateType"
IOErrorType
HardwareFault -> String
"HardwareFault"
IOErrorType
UnsupportedOperation -> String
"UnsupportedOperation"
IOErrorType
TimeExpired -> String
"TimeExpired"
IOErrorType
ResourceVanished -> String
"ResourceVanished"
IOErrorType
Interrupted -> String
"Interrupted"
safeTry :: IO a -> IO (Either SomeException a)
safeTry :: forall a. IO a -> IO (Either SomeException a)
safeTry IO a
action = IO a
-> (Async a -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (IO a
action IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate) Async a -> IO (Either SomeException a)
forall a. Async a -> IO (Either SomeException a)
waitCatch