{-# LANGUAGE  ViewPatterns #-}
-- | Stability: unstable
module Test.Hspec.Core.Util (
-- * String functions
  pluralize
, strip
, lineBreaksAt
, stripAnsi

-- * Working with paths
, Path
, joinPath
, formatRequirement
, filterPredicate

-- * Working with exceptions
, safeTry
, formatException
) where

import           Prelude ()
import           Test.Hspec.Core.Compat hiding (join)

import           Data.Char (isSpace)
import           GHC.IO.Exception
import           Control.Concurrent.Async

-- |
-- @pluralize count singular@ pluralizes the given @singular@ word unless given
-- @count@ is 1.
--
-- Examples:
--
-- >>> pluralize 0 "example"
-- "0 examples"
--
-- >>> pluralize 1 "example"
-- "1 example"
--
-- >>> pluralize 2 "example"
-- "2 examples"
--
-- @since 2.0.0
pluralize :: Int -> String -> String
pluralize :: Int -> String -> String
pluralize Int
1 String
s = String
"1 " forall a. [a] -> [a] -> [a]
++ String
s
pluralize Int
n String
s = forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"s"

-- | Strip leading and trailing whitespace
--
-- @since 2.0.0
strip :: String -> String
strip :: String -> String
strip = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- |
-- Ensure that lines are not longer than given `n`, insert line breaks at word
-- boundaries
--
-- @since 2.0.0
lineBreaksAt :: Int -> String -> [String]
lineBreaksAt :: Int -> String -> [String]
lineBreaksAt Int
n = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
f 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 forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
y in
        if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r forall a. Ord a => a -> a -> Bool
<= Int
n
          then (String, [String]) -> [String]
go (String
r, [String]
ys)
          else String
s forall a. a -> [a] -> [a]
: (String, [String]) -> [String]
go (String
y, [String]
ys)

-- |
-- Remove ANSI color escape sequences.
--
-- @since 2.11.0
stripAnsi :: String -> String
stripAnsi :: String -> String
stripAnsi = String -> String
go
  where
    go :: String -> String
go String
input = case String
input of
      Char
'\ESC' : Char
'[' : (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (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 forall a. a -> [a] -> [a]
: String -> String
go String
xs
      [] -> []

-- |
-- A `Path` describes the location of a spec item within a spec tree.
--
-- It consists of a list of group descriptions and a requirement description.
--
-- @since 2.0.0
type Path = ([String], String)

-- |
-- Join a `Path` with slashes.  The result will have a leading and a trailing
-- slash.
--
-- @since 2.5.4
joinPath :: Path -> String
joinPath :: Path -> String
joinPath ([String]
groups, String
requirement) = String
"/" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String]
groups forall a. [a] -> [a] -> [a]
++ [String
requirement]) forall a. [a] -> [a] -> [a]
++ String
"/"

-- |
-- Try to create a proper English sentence from a path by applying some
-- heuristics.
--
-- @since 2.0.0
formatRequirement :: Path -> String
formatRequirement :: Path -> String
formatRequirement ([String]
groups, String
requirement) = String
groups_ forall a. [a] -> [a] -> [a]
++ String
requirement
  where
    groups_ :: String
groups_ = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (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 (forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
xs forall a. a -> [a] -> [a]
: [String]
ys)

    join :: [String] -> String
join [String]
xs = case [String]
xs of
      [String
x] -> String
x forall a. [a] -> [a] -> [a]
++ String
" "
      [String]
ys  -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. [a] -> [a] -> [a]
++ String
", ") [String]
ys

-- | A predicate that can be used to filter a spec tree.
--
-- @since 2.0.0
filterPredicate :: String -> Path -> Bool
filterPredicate :: String -> Path -> Bool
filterPredicate String
pattern Path
path =
     String
pattern forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
plain
  Bool -> Bool -> Bool
|| String
pattern 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

-- | The function `formatException` converts an exception to a string.
--
-- This is different from `show`.  The type of the exception is included, e.g.:
--
-- >>> formatException (toException DivideByZero)
-- "ArithException\ndivide by zero"
--
-- For `IOException`s the `IOErrorType` is included, as well.
--
-- @since 2.0.0
formatException :: SomeException -> String
formatException :: SomeException -> String
formatException err :: SomeException
err@(SomeException e
e) = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err of
  Just IOException
ioe -> forall a. Typeable a => a -> String
showType IOException
ioe forall a. [a] -> [a] -> [a]
++ String
" of type " forall a. [a] -> [a] -> [a]
++ IOException -> String
showIOErrorType IOException
ioe forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IOException
ioe
  Maybe IOException
Nothing  -> forall a. Typeable a => a -> String
showType e
e forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show 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@ evaluates given action and returns its result.  If an exception
-- occurs, the exception is returned instead.  Unlike `try` it is agnostic to
-- asynchronous exceptions.
--
-- @since 2.0.0
safeTry :: IO a -> IO (Either SomeException a)
safeTry :: forall a. IO a -> IO (Either SomeException a)
safeTry IO a
action = forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (IO a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate) forall a. Async a -> IO (Either SomeException a)
waitCatch