{-# LANGUAGE OverloadedStrings #-}

-- | This module specifies any utilities used by this package. At this time,
-- consider everything in this module to be private to the curl-runnings package
module Testing.CurlRunnings.Internal
  ( makeRed
  , makeGreen
  , tracer
  , mapRight
  , mapLeft
  , arrayGet
  , makeLogger
  , makeUnsafeLogger
  , pShow
  , nowMillis
  , millisToS
  , LogLevel(..)
  , CurlRunningsLogger
  , CurlRunningsUnsafeLogger
  ) where

import           Control.Monad
import           Data.Monoid
import qualified Data.Text          as T
import qualified Data.Text.Lazy     as TL
import           Debug.Trace
import           System.Clock
import qualified Text.Pretty.Simple as P
import           Text.Printf


makeGreen :: T.Text -> T.Text
makeGreen :: Text -> Text
makeGreen Text
s = Text
"\x1B[32m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1B[0m"

makeRed :: T.Text -> T.Text
makeRed :: Text -> Text
makeRed Text
s = Text
"\x1B[31m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1B[0m"

pShow :: Show a => a -> T.Text
pShow :: a -> Text
pShow = Text -> Text
TL.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
P.pShow

tracer :: Show a => T.Text -> a -> a
tracer :: Text -> a -> a
tracer Text
a a
b = String -> a -> a
forall a. String -> a -> a
trace (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
pShow a
b) a
b

mapRight :: (b -> c) -> Either a b -> Either a c
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight b -> c
f (Right b
v) = c -> Either a c
forall a b. b -> Either a b
Right (c -> Either a c) -> c -> Either a c
forall a b. (a -> b) -> a -> b
$ b -> c
f b
v
mapRight b -> c
_ (Left a
v)  = a -> Either a c
forall a b. a -> Either a b
Left a
v

mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft :: (a -> c) -> Either a b -> Either c b
mapLeft a -> c
f (Left a
v)  = c -> Either c b
forall a b. a -> Either a b
Left (c -> Either c b) -> c -> Either c b
forall a b. (a -> b) -> a -> b
$ a -> c
f a
v
mapLeft a -> c
_ (Right b
v) = b -> Either c b
forall a b. b -> Either a b
Right b
v

-- | Array indexing with negative values allowed
arrayGet :: [a] -> Int -> Maybe a
arrayGet :: [a] -> Int -> Maybe a
arrayGet [a]
a Int
i
  | (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int
forall a. Num a => a -> a
abs Int
i) Bool -> Bool -> Bool
|| [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a Bool -> Bool -> Bool
|| (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int -> Int
forall a. Num a => a -> a
abs Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) = Maybe a
forall a. Maybe a
Nothing
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a]
a [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i
  | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a]
a [a] -> Int -> a
forall a. [a] -> Int -> a
!! ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)

data LogLevel
  = ERROR
  | INFO
  | DEBUG
  deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum)

-- | A logger that respects the verbosity level given by input args
type CurlRunningsLogger = (LogLevel -> T.Text -> IO ())

-- | A tracer that respects the verbosity level given by input args. Logging
-- with this calls out to Debug.trace and can be used in pure code, but be aware
-- of the unsafe IO.
type CurlRunningsUnsafeLogger a = (LogLevel -> T.Text -> a -> a)

makeLogger :: LogLevel -> CurlRunningsLogger
makeLogger :: LogLevel -> CurlRunningsLogger
makeLogger LogLevel
threshold LogLevel
level Text
text = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= LogLevel
threshold) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
text

makeUnsafeLogger :: Show a => LogLevel -> CurlRunningsUnsafeLogger a
makeUnsafeLogger :: LogLevel -> CurlRunningsUnsafeLogger a
makeUnsafeLogger LogLevel
threshold LogLevel
level Text
text a
object =
  if LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= LogLevel
threshold
    then Text -> a -> a
forall a. Show a => Text -> a -> a
tracer Text
text a
object
    else a
object

nowMillis :: IO Integer
nowMillis :: IO Integer
nowMillis = do
  TimeSpec
t <- Clock -> IO TimeSpec
getTime Clock
Realtime
  Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ (TimeSpec -> Integer
toNanoSecs TimeSpec
t) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000

roundToStr :: (PrintfArg a, Floating a) => a -> String
roundToStr :: a -> String
roundToStr = String -> a -> String
forall r. PrintfType r => String -> r
printf String
"%0.2f"

millisToS :: Integer -> Double
millisToS :: Integer -> Double
millisToS Integer
t = (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
t :: Double) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000.0