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