{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module OpenTelemetry.Util
( constructorName
, HasConstructor
, getThreadId
, bracketError
, AppendOnlyBoundedCollection
, emptyAppendOnlyBoundedCollection
, appendToBoundedCollection
, appendOnlyBoundedCollectionSize
, appendOnlyBoundedCollectionValues
, appendOnlyBoundedCollectionDroppedElementCount
, FrozenBoundedCollection
, frozenBoundedCollection
, frozenBoundedCollectionValues
, frozenBoundedCollectionDroppedElementCount
) where
import Data.Foldable
import Data.Kind
import qualified Data.Vector as V
import GHC.Generics
import GHC.Conc (ThreadId(ThreadId))
import GHC.Base (ThreadId#)
import Foreign.C (CInt(..))
import VectorBuilder.Builder (Builder)
import qualified VectorBuilder.Builder as Builder
import qualified VectorBuilder.Vector as Builder
import Control.Monad.IO.Unlift
import Control.Exception (SomeException)
import qualified Control.Exception as EUnsafe
constructorName :: (HasConstructor (Rep a), Generic a) => a -> String
constructorName :: a -> String
constructorName = Rep a Any -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName (Rep a Any -> String) -> (a -> Rep a Any) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
class HasConstructor (f :: Type -> Type) where
genericConstrName :: f x -> String
instance HasConstructor f => HasConstructor (D1 c f) where
genericConstrName :: D1 c f x -> String
genericConstrName (M1 f x
x) = f x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName f x
x
instance (HasConstructor x, HasConstructor y) => HasConstructor (x :+: y) where
genericConstrName :: (:+:) x y x -> String
genericConstrName (L1 x x
l) = x x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName x x
l
genericConstrName (R1 y x
r) = y x -> String
forall (f :: * -> *) x. HasConstructor f => f x -> String
genericConstrName y x
r
instance Constructor c => HasConstructor (C1 c f) where
genericConstrName :: C1 c f x -> String
genericConstrName C1 c f x
x = C1 c f x -> String
forall k (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
(f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
conName C1 c f x
x
foreign import ccall unsafe "rts_getThreadId" c_getThreadId :: ThreadId# -> CInt
getThreadId :: ThreadId -> Int
getThreadId :: ThreadId -> Int
getThreadId (ThreadId ThreadId#
tid#) = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ThreadId# -> CInt
c_getThreadId ThreadId#
tid#)
{-# INLINE getThreadId #-}
data AppendOnlyBoundedCollection a = AppendOnlyBoundedCollection
{ AppendOnlyBoundedCollection a -> Builder a
collection :: Builder a
, AppendOnlyBoundedCollection a -> Int
maxSize :: {-# UNPACK #-} !Int
, AppendOnlyBoundedCollection a -> Int
dropped :: {-# UNPACK #-} !Int
}
emptyAppendOnlyBoundedCollection ::
Int
-> AppendOnlyBoundedCollection a
emptyAppendOnlyBoundedCollection :: Int -> AppendOnlyBoundedCollection a
emptyAppendOnlyBoundedCollection Int
s = Builder a -> Int -> Int -> AppendOnlyBoundedCollection a
forall a. Builder a -> Int -> Int -> AppendOnlyBoundedCollection a
AppendOnlyBoundedCollection Builder a
forall a. Monoid a => a
mempty Int
s Int
0
appendOnlyBoundedCollectionValues :: AppendOnlyBoundedCollection a -> V.Vector a
appendOnlyBoundedCollectionValues :: AppendOnlyBoundedCollection a -> Vector a
appendOnlyBoundedCollectionValues (AppendOnlyBoundedCollection Builder a
a Int
_ Int
_) = Builder a -> Vector a
forall (vector :: * -> *) element.
Vector vector element =>
Builder element -> vector element
Builder.build Builder a
a
appendOnlyBoundedCollectionSize :: AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionSize :: AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionSize (AppendOnlyBoundedCollection Builder a
b Int
_ Int
_) = Builder a -> Int
forall element. Builder element -> Int
Builder.size Builder a
b
appendOnlyBoundedCollectionDroppedElementCount :: AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionDroppedElementCount :: AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionDroppedElementCount (AppendOnlyBoundedCollection Builder a
_ Int
_ Int
d) = Int
d
appendToBoundedCollection :: AppendOnlyBoundedCollection a -> a -> AppendOnlyBoundedCollection a
appendToBoundedCollection :: AppendOnlyBoundedCollection a -> a -> AppendOnlyBoundedCollection a
appendToBoundedCollection c :: AppendOnlyBoundedCollection a
c@(AppendOnlyBoundedCollection Builder a
b Int
ms Int
d) a
x = if AppendOnlyBoundedCollection a -> Int
forall a. AppendOnlyBoundedCollection a -> Int
appendOnlyBoundedCollectionSize AppendOnlyBoundedCollection a
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ms
then Builder a -> Int -> Int -> AppendOnlyBoundedCollection a
forall a. Builder a -> Int -> Int -> AppendOnlyBoundedCollection a
AppendOnlyBoundedCollection (Builder a
b Builder a -> Builder a -> Builder a
forall a. Semigroup a => a -> a -> a
<> a -> Builder a
forall element. element -> Builder element
Builder.singleton a
x) Int
ms Int
d
else Builder a -> Int -> Int -> AppendOnlyBoundedCollection a
forall a. Builder a -> Int -> Int -> AppendOnlyBoundedCollection a
AppendOnlyBoundedCollection Builder a
b Int
ms (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
data FrozenBoundedCollection a = FrozenBoundedCollection
{ FrozenBoundedCollection a -> Vector a
collection :: !(V.Vector a)
, FrozenBoundedCollection a -> Int
dropped :: !Int
}
frozenBoundedCollection :: Foldable f => Int -> f a -> FrozenBoundedCollection a
frozenBoundedCollection :: Int -> f a -> FrozenBoundedCollection a
frozenBoundedCollection Int
maxSize_ f a
coll = Vector a -> Int -> FrozenBoundedCollection a
forall a. Vector a -> Int -> FrozenBoundedCollection a
FrozenBoundedCollection (Int -> [a] -> Vector a
forall a. Int -> [a] -> Vector a
V.fromListN Int
maxSize_ ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
coll) (Int
collLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxSize_)
where
collLength :: Int
collLength = f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
coll
frozenBoundedCollectionValues :: FrozenBoundedCollection a -> V.Vector a
frozenBoundedCollectionValues :: FrozenBoundedCollection a -> Vector a
frozenBoundedCollectionValues (FrozenBoundedCollection Vector a
coll Int
_) = Vector a
coll
frozenBoundedCollectionDroppedElementCount :: FrozenBoundedCollection a -> Int
frozenBoundedCollectionDroppedElementCount :: FrozenBoundedCollection a -> Int
frozenBoundedCollectionDroppedElementCount (FrozenBoundedCollection Vector a
_ Int
dropped_) = Int
dropped_
bracketError :: MonadUnliftIO m => m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketError :: m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
bracketError m a
before Maybe SomeException -> a -> m b
after a -> m c
thing = ((forall a. m a -> IO a) -> IO c) -> m c
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO c) -> m c)
-> ((forall a. m a -> IO a) -> IO c) -> m c
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
EUnsafe.mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
a
x <- m a -> IO a
forall a. m a -> IO a
run m a
before
Either SomeException c
res1 <- IO c -> IO (Either SomeException c)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO c -> IO (Either SomeException c))
-> IO c -> IO (Either SomeException c)
forall a b. (a -> b) -> a -> b
$ IO c -> IO c
forall a. IO a -> IO a
restore (IO c -> IO c) -> IO c -> IO c
forall a b. (a -> b) -> a -> b
$ m c -> IO c
forall a. m a -> IO a
run (m c -> IO c) -> m c -> IO c
forall a b. (a -> b) -> a -> b
$ a -> m c
thing a
x
case Either SomeException c
res1 of
Left (SomeException
e1 :: SomeException) -> do
Either SomeException b
_ :: Either SomeException b <-
IO b -> IO (Either SomeException b)
forall e a. Exception e => IO a -> IO (Either e a)
EUnsafe.try (IO b -> IO (Either SomeException b))
-> IO b -> IO (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ IO b -> IO b
forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> a -> m b
after (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e1) a
x
SomeException -> IO c
forall e a. Exception e => e -> IO a
EUnsafe.throwIO SomeException
e1
Right c
y -> do
b
_ <- IO b -> IO b
forall a. IO a -> IO a
EUnsafe.uninterruptibleMask_ (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run (m b -> IO b) -> m b -> IO b
forall a b. (a -> b) -> a -> b
$ Maybe SomeException -> a -> m b
after Maybe SomeException
forall a. Maybe a
Nothing a
x
c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
y