1-- | Stability: unstable 2module Test.Hspec.Core.Util ( 3-- * String functions 4 pluralize 5, strip 6, lineBreaksAt 7 8-- * Working with paths 9, Path 10, joinPath 11, formatRequirement 12, filterPredicate 13 14-- * Working with exception 15, safeTry 16, formatException 17) where 18 19import Data.List 20import Data.Char (isSpace) 21import GHC.IO.Exception 22import Control.Exception 23import Control.Concurrent.Async 24 25import Test.Hspec.Core.Compat (showType) 26 27-- | 28-- @pluralize count singular@ pluralizes the given @singular@ word unless given 29-- @count@ is 1. 30-- 31-- Examples: 32-- 33-- >>> pluralize 0 "example" 34-- "0 examples" 35-- 36-- >>> pluralize 1 "example" 37-- "1 example" 38-- 39-- >>> pluralize 2 "example" 40-- "2 examples" 41pluralize :: Int -> String -> String 42pluralize 1 s = "1 " ++ s 43pluralize n s = show n ++ " " ++ s ++ "s" 44 45-- | Strip leading and trailing whitespace 46strip :: String -> String 47strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse 48 49-- | 50-- ensure that lines are not longer than given `n`, insert line breaks at word 51-- boundaries 52lineBreaksAt :: Int -> String -> [String] 53lineBreaksAt n input = case words input of 54 [] -> [] 55 x:xs -> go (x, xs) 56 where 57 go :: (String, [String]) -> [String] 58 go c = case c of 59 (s, []) -> [s] 60 (s, y:ys) -> let r = s ++ " " ++ y in 61 if length r <= n 62 then go (r, ys) 63 else s : go (y, ys) 64 65-- | 66-- A `Path` describes the location of a spec item within a spec tree. 67-- 68-- It consists of a list of group descriptions and a requirement description. 69type Path = ([String], String) 70 71-- | 72-- Join a `Path` with slashes. The result will have a leading and a trailing 73-- slash. 74joinPath :: Path -> String 75joinPath (groups, requirement) = "/" ++ intercalate "/" (groups ++ [requirement]) ++ "/" 76 77-- | 78-- Try to create a proper English sentence from a path by applying some 79-- heuristics. 80formatRequirement :: Path -> String 81formatRequirement (groups, requirement) = groups_ ++ requirement 82 where 83 groups_ = case break (any isSpace) groups of 84 ([], ys) -> join ys 85 (xs, ys) -> join (intercalate "." xs : ys) 86 87 join xs = case xs of 88 [x] -> x ++ " " 89 ys -> concatMap (++ ", ") ys 90 91-- | A predicate that can be used to filter a spec tree. 92filterPredicate :: String -> Path -> Bool 93filterPredicate pattern path = 94 pattern `isInfixOf` plain 95 || pattern `isInfixOf` formatted 96 where 97 plain = joinPath path 98 formatted = formatRequirement path 99 100-- | The function `formatException` converts an exception to a string. 101-- 102-- This is different from `show`. The type of the exception is included, e.g.: 103-- 104-- >>> formatException (toException DivideByZero) 105-- "ArithException (divide by zero)" 106-- 107-- For `IOException`s the `IOErrorType` is included, as well. 108formatException :: SomeException -> String 109formatException err@(SomeException e) = case fromException err of 110 Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ "\n" ++ show ioe 111 Nothing -> showType e ++ "\n" ++ show e 112 where 113 showIOErrorType :: IOException -> String 114 showIOErrorType ioe = case ioe_type ioe of 115 AlreadyExists -> "AlreadyExists" 116 NoSuchThing -> "NoSuchThing" 117 ResourceBusy -> "ResourceBusy" 118 ResourceExhausted -> "ResourceExhausted" 119 EOF -> "EOF" 120 IllegalOperation -> "IllegalOperation" 121 PermissionDenied -> "PermissionDenied" 122 UserError -> "UserError" 123 UnsatisfiedConstraints -> "UnsatisfiedConstraints" 124 SystemError -> "SystemError" 125 ProtocolError -> "ProtocolError" 126 OtherError -> "OtherError" 127 InvalidArgument -> "InvalidArgument" 128 InappropriateType -> "InappropriateType" 129 HardwareFault -> "HardwareFault" 130 UnsupportedOperation -> "UnsupportedOperation" 131 TimeExpired -> "TimeExpired" 132 ResourceVanished -> "ResourceVanished" 133 Interrupted -> "Interrupted" 134 135-- | @safeTry@ evaluates given action and returns its result. If an exception 136-- occurs, the exception is returned instead. Unlike `try` it is agnostic to 137-- asynchronous exceptions. 138safeTry :: IO a -> IO (Either SomeException a) 139safeTry action = withAsync (action >>= evaluate) waitCatch 140