{-# 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 =>
Int ->
Bool ->
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
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
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
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..."
seconds :: Int -> Int
seconds :: Int -> Int
seconds = (forall a. Num a => a -> a -> a
* Int -> Int
milliseconds Int
1000)
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