{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Instrument.Utils
  ( formatDecimal,
    formatInt,
    showT,
    showBS,
    collect,
    noDots,
    encodeCompress,
    decodeCompress,
    indefinitely,
    seconds,
    milliseconds,
    for,
  )
where

-------------------------------------------------------------------------------
import Codec.Compression.GZip
import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import Control.Exception (SomeException)
import Control.Monad
import Control.Monad.Catch (Handler (..))
import Control.Retry
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Lazy (fromStrict, toStrict)
import qualified Data.Map as M
import qualified Data.Map.Strict as MS
import qualified Data.SafeCopy as SC
import Data.Serialize
import Data.Text (Text)
import qualified Data.Text as T
import Numeric
import System.IO

-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
collect ::
  (Ord b) =>
  [a] ->
  (a -> b) ->
  (a -> c) ->
  M.Map b [c]
collect :: forall b a c. Ord b => [a] -> (a -> b) -> (a -> c) -> Map b [c]
collect [a]
as a -> b
mkKey a -> c
mkVal = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Map b [c] -> Map b [c]
step forall k a. Map k a
M.empty [a]
as
  where
    step :: a -> Map b [c] -> Map b [c]
step a
x Map b [c]
acc = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
MS.insertWith forall a. [a] -> [a] -> [a]
(++) (a -> b
mkKey a
x) ([a -> c
mkVal a
x]) Map b [c]
acc

-------------------------------------------------------------------------------
noDots :: Text -> Text
noDots :: Text -> Text
noDots = Text -> [Text] -> Text
T.intercalate Text
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"."

-------------------------------------------------------------------------------
showT :: Show a => a -> Text
showT :: forall a. Show a => a -> Text
showT = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

showBS :: Show a => a -> B.ByteString
showBS :: forall a. Show a => a -> ByteString
showBS = String -> ByteString
B.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-------------------------------------------------------------------------------
formatInt :: RealFrac a => a -> Text
formatInt :: forall a. RealFrac a => a -> Text
formatInt a
i = forall a. Show a => a -> Text
showT ((forall a b. (RealFrac a, Integral b) => a -> b
floor a
i) :: Int)

-------------------------------------------------------------------------------
formatDecimal ::
  RealFloat a =>
  -- | Digits after the point
  Int ->
  -- | Add thousands sep?
  Bool ->
  -- | Number
  a ->
  Text
formatDecimal :: forall a. RealFloat a => Int -> Bool -> a -> Text
formatDecimal Int
n Bool
th a
i =
  let res :: Text
res = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Int
n) a
i forall a b. (a -> b) -> a -> b
$ String
""
   in if Bool
th then Text -> Text
addThousands Text
res else Text
res

-------------------------------------------------------------------------------
addThousands :: Text -> Text
addThousands :: Text -> Text
addThousands Text
t = [Text] -> Text
T.concat [Text
n', Text
dec]
  where
    (Text
n, Text
dec) = (Char -> Bool) -> Text -> (Text, Text)
T.span (forall a. Eq a => a -> a -> Bool
/= Char
'.') Text
t
    n' :: Text
n' = Text -> Text
T.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
T.chunksOf Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse forall a b. (a -> b) -> a -> b
$ Text
n

-------------------------------------------------------------------------------

-- | Serialize and compress with GZip in that order. This is the only
-- function we use for serializing to Redis.
encodeCompress :: SC.SafeCopy a => a -> B.ByteString
encodeCompress :: forall a. SafeCopy a => a -> ByteString
encodeCompress = ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SafeCopy a => a -> Put
SC.safePut

-------------------------------------------------------------------------------

-- | Decompress from GZip and deserialize in that order. Tries to
-- decode SafeCopy first and falls back to Serialize if that fails to
-- account for old data. Note that encodeCompress only serializes to
-- SafeCopy so writes will be updated.
decodeCompress :: (SC.SafeCopy a, Serialize a) => B.ByteString -> Either String a
decodeCompress :: forall a.
(SafeCopy a, Serialize a) =>
ByteString -> Either String a
decodeCompress = forall {a}.
(SafeCopy a, Serialize a) =>
ByteString -> Either String a
decodeWithFallback forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
  where
    decodeWithFallback :: ByteString -> Either String a
decodeWithFallback ByteString
lbs = forall a. Get a -> ByteString -> Either String a
runGetLazy forall a. SafeCopy a => Get a
SC.safeGet ByteString
lbs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Serialize a => ByteString -> Either String a
decodeLazy ByteString
lbs

-------------------------------------------------------------------------------

-- | Run an IO repeatedly with the given delay in microseconds. If
-- there are exceptions in the inner loop, they are logged to stderr,
-- prefixed with the given string context and retried at an exponential
-- backoff capped at 60 seconds between.
indefinitely :: String -> Int -> IO () -> IO ()
indefinitely :: String -> Int -> IO () -> IO ()
indefinitely String
ctx Int
n = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IO a -> IO ()
delayed forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO () -> IO ()
logAndBackoff String
ctx
  where
    delayed :: IO a -> IO ()
delayed = (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
threadDelay Int
n)

-------------------------------------------------------------------------------
logAndBackoff :: String -> IO () -> IO ()
logAndBackoff :: String -> IO () -> IO ()
logAndBackoff String
ctx = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering forall {m :: * -> *}. Monad m => RetryPolicyM m
policy [forall {p}. p -> Handler IO Bool
h] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  where
    policy :: RetryPolicyM m
policy = forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
capDelay (Int -> Int
seconds Int
60) (forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
exponentialBackoff (Int -> Int
milliseconds Int
50))
    h :: p -> Handler IO Bool
h p
_ = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\SomeException
e -> SomeException -> IO ()
logError SomeException
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
    logError :: SomeException -> IO ()
    logError :: SomeException -> IO ()
logError SomeException
e = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
      where
        msg :: String
msg = String
"Caught exception in " forall a. [a] -> [a] -> [a]
++ String
ctx forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SomeException
e forall a. [a] -> [a] -> [a]
++ String
". Retrying..."

-------------------------------------------------------------------------------

-- | Convert seconds to microseconds
seconds :: Int -> Int
seconds :: Int -> Int
seconds = (forall a. Num a => a -> a -> a
* Int -> Int
milliseconds Int
1000)

-------------------------------------------------------------------------------

-- | Convert milliseconds to microseconds
milliseconds :: Int -> Int
milliseconds :: Int -> Int
milliseconds = (forall a. Num a => a -> a -> a
* Int
1000)

-------------------------------------------------------------------------------
for :: (Functor f) => f a -> (a -> b) -> f b
for :: forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
for = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap