{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
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 :: [a] -> (a -> b) -> (a -> c) -> Map b [c]
collect [a]
as a -> b
mkKey a -> c
mkVal = (a -> Map b [c] -> Map b [c]) -> Map b [c] -> [a] -> Map b [c]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Map b [c] -> Map b [c]
step Map b [c]
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 = ([c] -> [c] -> [c]) -> b -> [c] -> Map b [c] -> Map b [c]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
MS.insertWith [c] -> [c] -> [c]
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
"_" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"."
showT :: Show a => a -> Text
showT :: a -> Text
showT = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
showBS :: Show a => a -> B.ByteString
showBS :: a -> ByteString
showBS = String -> ByteString
B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
formatInt :: RealFrac a => a -> Text
formatInt :: a -> Text
formatInt a
i = Int -> Text
forall a. Show a => a -> Text
showT ((a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor a
i) :: Int)
formatDecimal
:: RealFloat a
=> Int
-> Bool
-> a
-> Text
formatDecimal :: Int -> Bool -> a -> Text
formatDecimal Int
n Bool
th a
i =
let res :: Text
res = String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) a
i (String -> Text) -> String -> Text
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') Text
t
n' :: Text
n' = Text -> Text
T.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
T.chunksOf Int
3 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
n
encodeCompress :: SC.SafeCopy a => a -> B.ByteString
encodeCompress :: a -> ByteString
encodeCompress = ByteString -> ByteString
toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
compress (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutLazy (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a. SafeCopy a => a -> Put
SC.safePut
decodeCompress :: (SC.SafeCopy a, Serialize a) => B.ByteString -> Either String a
decodeCompress :: ByteString -> Either String a
decodeCompress = ByteString -> Either String a
forall a.
(SafeCopy a, Serialize a) =>
ByteString -> Either String a
decodeWithFallback (ByteString -> Either String a)
-> (ByteString -> ByteString) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
where
decodeWithFallback :: ByteString -> Either String a
decodeWithFallback ByteString
lbs = Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetLazy Get a
forall a. SafeCopy a => Get a
SC.safeGet ByteString
lbs Either String a -> Either String a -> Either String a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Either String 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 = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall a. IO a -> IO ()
delayed (IO () -> IO ()) -> (IO () -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO () -> IO ()
logAndBackoff String
ctx
where
delayed :: IO a -> IO ()
delayed = (IO a -> IO () -> IO ()
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 = RetryPolicyM IO
-> [RetryStatus -> Handler IO Bool]
-> (RetryStatus -> IO ())
-> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m
-> [RetryStatus -> Handler m Bool] -> (RetryStatus -> m a) -> m a
recovering RetryPolicyM IO
forall (m :: * -> *). Monad m => RetryPolicyM m
policy [RetryStatus -> Handler IO Bool
forall p. p -> Handler IO Bool
h] ((RetryStatus -> IO ()) -> IO ())
-> (IO () -> RetryStatus -> IO ()) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> RetryStatus -> IO ()
forall a b. a -> b -> a
const
where
policy :: RetryPolicyM m
policy = Int -> RetryPolicyM m -> RetryPolicyM m
forall (m :: * -> *).
Monad m =>
Int -> RetryPolicyM m -> RetryPolicyM m
capDelay (Int -> Int
seconds Int
60) (Int -> forall (m :: * -> *). Monad m => RetryPolicyM m
exponentialBackoff (Int -> Int
milliseconds Int
50))
h :: p -> Handler IO Bool
h p
_ = (SomeException -> IO Bool) -> Handler IO Bool
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\SomeException
e -> SomeException -> IO ()
logError SomeException
e IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Retrying..."
seconds :: Int -> Int
seconds :: Int -> Int
seconds = (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
milliseconds Int
1000)
milliseconds :: Int -> Int
milliseconds :: Int -> Int
milliseconds = (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
for :: (Functor f) => f a -> (a -> b) -> f b
for :: f a -> (a -> b) -> f b
for = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap