{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module OTel.API.Common.Internal
  ( -- * Disclaimer
    -- $disclaimer

    -- * General
    KV(..)
  , IsTextKV
  , Key(..)

  , Timestamp(..)
  , timestampFromNanoseconds
  , timestampToNanoseconds
  , TimestampSource(..)

  , InstrumentationScope(..)
  , defaultInstrumentationScope
  , InstrumentationScopeName(..)
  , Version(..)
  , SchemaURL(..)
  , schemaURLFromText
  , schemaURLToText

    -- * Attributes
  , WithAttrs(..)
  , Attrs(..)
  , emptyAttrs
  , nullAttrs
  , sizeAttrs
  , memberAttrs
  , lookupAttrs
  , foldMapWithKeyAttrs
  , filterWithKeyAttrs
  , mapWithKeyAttrs
  , convertWithKeyAttrs
  , droppedAttrsCount
  , AttrsBuilder(..)
  , runAttrsBuilder
  , jsonAttrs
  , AttrsAcc(..)
  , AttrsBuilderElem(..)
  , AttrsFor(..)
  , AttrsLimits(..)
  , defaultAttrsLimits
  , SomeAttr(..)
  , Attr(..)
  , asTextAttr
  , AttrVals(..)
  , AttrType(..)
  , KnownAttrType(..)
  , ToAttrVal(..)

  , with

  , OnException(..)
  , askException
  , askExceptionMetadata

  , OnTimeout(..)
  , askTimeoutMicros
  , askTimeoutMetadata

  , BufferedLoggerSpec(..)
  , defaultBufferedLoggerSpec
  , includeLogAggregateViaAeson
  , withBufferedLogger
  , withBufferedLoggerIO
  , BufferedLogs
  , insertBufferedLog
  , insertBufferedLogWithAgg
  , BufferedLog(..)
  , toBufferedLog
  , BufferedLogAgg(..)
  , Logger
  ) where

import Control.Exception.Safe
  ( SomeException(..), MonadCatch, MonadMask, MonadThrow, catchAny, displayException, finally
  )
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.IO.Unlift (MonadUnliftIO(..))
import Control.Monad.Logger.Aeson
  ( Loc(..), LogLevel(..), LoggingT(..), Message(..), ToLogStr(..), LogSource, LogStr, MonadLogger
  , MonadLoggerIO, SeriesElem, fromLogStr, logError
  )
import Control.Monad.Trans.Reader (ReaderT(..))
import Data.Aeson (KeyValue((.=)), ToJSON(..), Value(..), (.:), (.:?), object)
import Data.Aeson.KeyMap (KeyMap)
import Data.Aeson.Types (Parser)
import Data.ByteString (ByteString)
import Data.DList (DList)
import Data.Function ((&))
import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable(..))
import Data.IORef (IORef)
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Constraint, Type)
import Data.Monoid (Ap(..))
import Data.Proxy (Proxy(..))
import Data.Sequence (Seq)
import Data.String (IsString(fromString))
import Data.Text (Text)
import Data.Vector (Vector)
import Data.Word (Word16, Word32, Word8)
import GHC.Float (float2Double)
import Prelude hiding (span)
import qualified Control.Concurrent as Concurrent
import qualified Control.Concurrent.Async as Async
import qualified Control.Monad as Monad
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson.Key
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
import qualified Data.Aeson.Parser as Aeson.Parser
import qualified Data.Aeson.Types as Aeson.Types
import qualified Data.DList as DList
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Strict as HashMap
import qualified Data.IORef as IORef
import qualified Data.Maybe as Maybe
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Vector as Vector
import qualified System.Timeout as Timeout
import qualified Data.Text.Encoding as Text.Encoding

class KV (kv :: Type) where
  type KVConstraints kv :: Type -> Type -> Constraint
  (.@) :: KVConstraints kv from to => Key to -> from -> kv

infixr 8 .@

instance KV (AttrsBuilder af) where
  type KVConstraints (AttrsBuilder af) = ToAttrVal
  .@ :: forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
(.@) = Key to -> from -> AttrsBuilder af
forall to from.
ToAttrVal from to =>
Key to -> from -> AttrsBuilder af
go
    where
    go :: forall to from. (ToAttrVal from to) => Key to -> from -> AttrsBuilder af
    go :: forall to from.
ToAttrVal from to =>
Key to -> from -> AttrsBuilder af
go Key to
k from
v =
      (Int -> DList AttrsBuilderElem) -> AttrsBuilder af
forall (af :: AttrsFor).
(Int -> DList AttrsBuilderElem) -> AttrsBuilder af
AttrsBuilder \Int
textLengthLimit ->
        AttrsBuilderElem -> DList AttrsBuilderElem
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AttrsBuilderElem -> DList AttrsBuilderElem)
-> AttrsBuilderElem -> DList AttrsBuilderElem
forall a b. (a -> b) -> a -> b
$
          AttrsBuilderElem
            { attrsBuilderElemKey :: Text
attrsBuilderElemKey = Key to -> Text
forall a. Key a -> Text
unKey Key to
k
            , attrsBuilderElemVal :: SomeAttr
attrsBuilderElemVal =
                Attr to -> SomeAttr
forall a. Attr a -> SomeAttr
SomeAttr Attr
                  { AttrType to
attrType :: AttrType to
attrType :: AttrType to
attrType
                  , attrVal :: to
attrVal =
                      case AttrType to
attrType of
                        AttrType to
AttrTypeText -> Int -> Text -> Text
Text.take Int
textLengthLimit to
Text
val
                        AttrType to
AttrTypeTextArray -> (Text -> Text) -> AttrVals Text -> AttrVals Text
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
Text.take Int
textLengthLimit) to
AttrVals Text
val
                        AttrType to
_ -> to
val
                  }
            }
      where
      attrType :: AttrType to
attrType = Proxy to -> AttrType to
forall a. KnownAttrType a => Proxy a -> AttrType a
attrTypeVal (Proxy to -> AttrType to) -> Proxy to -> AttrType to
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @to
      val :: to
val = forall from to. ToAttrVal from to => from -> to
toAttrVal @from @to from
v

class (k ~ Text, v ~ Text) => IsTextKV k v
instance IsTextKV Text Text

newtype Key a = Key
  { forall a. Key a -> Text
unKey :: Text
  } deriving stock (Key a -> Key a -> Bool
(Key a -> Key a -> Bool) -> (Key a -> Key a -> Bool) -> Eq (Key a)
forall a. Key a -> Key a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Key a -> Key a -> Bool
== :: Key a -> Key a -> Bool
$c/= :: forall a. Key a -> Key a -> Bool
/= :: Key a -> Key a -> Bool
Eq, Eq (Key a)
Eq (Key a) =>
(Key a -> Key a -> Ordering)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Bool)
-> (Key a -> Key a -> Key a)
-> (Key a -> Key a -> Key a)
-> Ord (Key a)
Key a -> Key a -> Bool
Key a -> Key a -> Ordering
Key a -> Key a -> Key a
forall a. Eq (Key a)
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
forall a. Key a -> Key a -> Bool
forall a. Key a -> Key a -> Ordering
forall a. Key a -> Key a -> Key a
$ccompare :: forall a. Key a -> Key a -> Ordering
compare :: Key a -> Key a -> Ordering
$c< :: forall a. Key a -> Key a -> Bool
< :: Key a -> Key a -> Bool
$c<= :: forall a. Key a -> Key a -> Bool
<= :: Key a -> Key a -> Bool
$c> :: forall a. Key a -> Key a -> Bool
> :: Key a -> Key a -> Bool
$c>= :: forall a. Key a -> Key a -> Bool
>= :: Key a -> Key a -> Bool
$cmax :: forall a. Key a -> Key a -> Key a
max :: Key a -> Key a -> Key a
$cmin :: forall a. Key a -> Key a -> Key a
min :: Key a -> Key a -> Key a
Ord, Int -> Key a -> ShowS
[Key a] -> ShowS
Key a -> String
(Int -> Key a -> ShowS)
-> (Key a -> String) -> ([Key a] -> ShowS) -> Show (Key a)
forall a. Int -> Key a -> ShowS
forall a. [Key a] -> ShowS
forall a. Key a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Key a -> ShowS
showsPrec :: Int -> Key a -> ShowS
$cshow :: forall a. Key a -> String
show :: Key a -> String
$cshowList :: forall a. [Key a] -> ShowS
showList :: [Key a] -> ShowS
Show)

instance IsString (Key a) where
  fromString :: String -> Key a
fromString = Text -> Key a
forall a. Text -> Key a
Key (Text -> Key a) -> (String -> Text) -> String -> Key a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

newtype Timestamp = Timestamp
  { Timestamp -> Integer
unTimestamp :: Integer -- ^ nanoseconds
  } deriving stock (Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
/= :: Timestamp -> Timestamp -> Bool
Eq, Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timestamp -> ShowS
showsPrec :: Int -> Timestamp -> ShowS
$cshow :: Timestamp -> String
show :: Timestamp -> String
$cshowList :: [Timestamp] -> ShowS
showList :: [Timestamp] -> ShowS
Show)
    deriving ([Timestamp] -> Value
[Timestamp] -> Encoding
Timestamp -> Bool
Timestamp -> Value
Timestamp -> Encoding
(Timestamp -> Value)
-> (Timestamp -> Encoding)
-> ([Timestamp] -> Value)
-> ([Timestamp] -> Encoding)
-> (Timestamp -> Bool)
-> ToJSON Timestamp
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Timestamp -> Value
toJSON :: Timestamp -> Value
$ctoEncoding :: Timestamp -> Encoding
toEncoding :: Timestamp -> Encoding
$ctoJSONList :: [Timestamp] -> Value
toJSONList :: [Timestamp] -> Value
$ctoEncodingList :: [Timestamp] -> Encoding
toEncodingList :: [Timestamp] -> Encoding
$comitField :: Timestamp -> Bool
omitField :: Timestamp -> Bool
ToJSON) via (Integer)

timestampFromNanoseconds :: Integer -> Timestamp
timestampFromNanoseconds :: Integer -> Timestamp
timestampFromNanoseconds = Integer -> Timestamp
Timestamp

timestampToNanoseconds :: Timestamp -> Integer
timestampToNanoseconds :: Timestamp -> Integer
timestampToNanoseconds = Timestamp -> Integer
unTimestamp

data TimestampSource
  = TimestampSourceNow
  | TimestampSourceAt Timestamp
  deriving stock (TimestampSource -> TimestampSource -> Bool
(TimestampSource -> TimestampSource -> Bool)
-> (TimestampSource -> TimestampSource -> Bool)
-> Eq TimestampSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimestampSource -> TimestampSource -> Bool
== :: TimestampSource -> TimestampSource -> Bool
$c/= :: TimestampSource -> TimestampSource -> Bool
/= :: TimestampSource -> TimestampSource -> Bool
Eq, Int -> TimestampSource -> ShowS
[TimestampSource] -> ShowS
TimestampSource -> String
(Int -> TimestampSource -> ShowS)
-> (TimestampSource -> String)
-> ([TimestampSource] -> ShowS)
-> Show TimestampSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimestampSource -> ShowS
showsPrec :: Int -> TimestampSource -> ShowS
$cshow :: TimestampSource -> String
show :: TimestampSource -> String
$cshowList :: [TimestampSource] -> ShowS
showList :: [TimestampSource] -> ShowS
Show)

data InstrumentationScope = InstrumentationScope
  { InstrumentationScope -> InstrumentationScopeName
instrumentationScopeName :: InstrumentationScopeName
  , InstrumentationScope -> Maybe Version
instrumentationScopeVersion :: Maybe Version
  , InstrumentationScope -> Maybe SchemaURL
instrumentationScopeSchemaURL :: Maybe SchemaURL
  } deriving stock (InstrumentationScope -> InstrumentationScope -> Bool
(InstrumentationScope -> InstrumentationScope -> Bool)
-> (InstrumentationScope -> InstrumentationScope -> Bool)
-> Eq InstrumentationScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstrumentationScope -> InstrumentationScope -> Bool
== :: InstrumentationScope -> InstrumentationScope -> Bool
$c/= :: InstrumentationScope -> InstrumentationScope -> Bool
/= :: InstrumentationScope -> InstrumentationScope -> Bool
Eq, Eq InstrumentationScope
Eq InstrumentationScope =>
(InstrumentationScope -> InstrumentationScope -> Ordering)
-> (InstrumentationScope -> InstrumentationScope -> Bool)
-> (InstrumentationScope -> InstrumentationScope -> Bool)
-> (InstrumentationScope -> InstrumentationScope -> Bool)
-> (InstrumentationScope -> InstrumentationScope -> Bool)
-> (InstrumentationScope
    -> InstrumentationScope -> InstrumentationScope)
-> (InstrumentationScope
    -> InstrumentationScope -> InstrumentationScope)
-> Ord InstrumentationScope
InstrumentationScope -> InstrumentationScope -> Bool
InstrumentationScope -> InstrumentationScope -> Ordering
InstrumentationScope
-> InstrumentationScope -> InstrumentationScope
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
$ccompare :: InstrumentationScope -> InstrumentationScope -> Ordering
compare :: InstrumentationScope -> InstrumentationScope -> Ordering
$c< :: InstrumentationScope -> InstrumentationScope -> Bool
< :: InstrumentationScope -> InstrumentationScope -> Bool
$c<= :: InstrumentationScope -> InstrumentationScope -> Bool
<= :: InstrumentationScope -> InstrumentationScope -> Bool
$c> :: InstrumentationScope -> InstrumentationScope -> Bool
> :: InstrumentationScope -> InstrumentationScope -> Bool
$c>= :: InstrumentationScope -> InstrumentationScope -> Bool
>= :: InstrumentationScope -> InstrumentationScope -> Bool
$cmax :: InstrumentationScope
-> InstrumentationScope -> InstrumentationScope
max :: InstrumentationScope
-> InstrumentationScope -> InstrumentationScope
$cmin :: InstrumentationScope
-> InstrumentationScope -> InstrumentationScope
min :: InstrumentationScope
-> InstrumentationScope -> InstrumentationScope
Ord, Int -> InstrumentationScope -> ShowS
[InstrumentationScope] -> ShowS
InstrumentationScope -> String
(Int -> InstrumentationScope -> ShowS)
-> (InstrumentationScope -> String)
-> ([InstrumentationScope] -> ShowS)
-> Show InstrumentationScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstrumentationScope -> ShowS
showsPrec :: Int -> InstrumentationScope -> ShowS
$cshow :: InstrumentationScope -> String
show :: InstrumentationScope -> String
$cshowList :: [InstrumentationScope] -> ShowS
showList :: [InstrumentationScope] -> ShowS
Show)

instance ToJSON InstrumentationScope where
  toJSON :: InstrumentationScope -> Value
toJSON InstrumentationScope
instrumentationScope =
    [Pair] -> Value
Aeson.object
      [ Key
"name" Key -> InstrumentationScopeName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= InstrumentationScopeName
instrumentationScopeName
      , Key
"version" Key -> Maybe Version -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Version
instrumentationScopeVersion
      , Key
"schemaURL" Key -> Maybe SchemaURL -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe SchemaURL
instrumentationScopeSchemaURL
      ]
    where
    InstrumentationScope
      { InstrumentationScopeName
instrumentationScopeName :: InstrumentationScope -> InstrumentationScopeName
instrumentationScopeName :: InstrumentationScopeName
instrumentationScopeName
      , Maybe Version
instrumentationScopeVersion :: InstrumentationScope -> Maybe Version
instrumentationScopeVersion :: Maybe Version
instrumentationScopeVersion
      , Maybe SchemaURL
instrumentationScopeSchemaURL :: InstrumentationScope -> Maybe SchemaURL
instrumentationScopeSchemaURL :: Maybe SchemaURL
instrumentationScopeSchemaURL
      } = InstrumentationScope
instrumentationScope

instance IsString InstrumentationScope where
  fromString :: String -> InstrumentationScope
fromString String
s =
    InstrumentationScope
defaultInstrumentationScope
      { instrumentationScopeName = fromString s
      }

defaultInstrumentationScope :: InstrumentationScope
defaultInstrumentationScope :: InstrumentationScope
defaultInstrumentationScope =
  InstrumentationScope
    { instrumentationScopeName :: InstrumentationScopeName
instrumentationScopeName = InstrumentationScopeName
""
    , instrumentationScopeVersion :: Maybe Version
instrumentationScopeVersion = Maybe Version
forall a. Maybe a
Nothing
    , instrumentationScopeSchemaURL :: Maybe SchemaURL
instrumentationScopeSchemaURL = Maybe SchemaURL
forall a. Maybe a
Nothing
    }

newtype InstrumentationScopeName = InstrumentationScopeName
  { InstrumentationScopeName -> Text
unInstrumentationScopeName :: Text
  } deriving stock (InstrumentationScopeName -> InstrumentationScopeName -> Bool
(InstrumentationScopeName -> InstrumentationScopeName -> Bool)
-> (InstrumentationScopeName -> InstrumentationScopeName -> Bool)
-> Eq InstrumentationScopeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
== :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
$c/= :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
/= :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
Eq, Eq InstrumentationScopeName
Eq InstrumentationScopeName =>
(InstrumentationScopeName -> InstrumentationScopeName -> Ordering)
-> (InstrumentationScopeName -> InstrumentationScopeName -> Bool)
-> (InstrumentationScopeName -> InstrumentationScopeName -> Bool)
-> (InstrumentationScopeName -> InstrumentationScopeName -> Bool)
-> (InstrumentationScopeName -> InstrumentationScopeName -> Bool)
-> (InstrumentationScopeName
    -> InstrumentationScopeName -> InstrumentationScopeName)
-> (InstrumentationScopeName
    -> InstrumentationScopeName -> InstrumentationScopeName)
-> Ord InstrumentationScopeName
InstrumentationScopeName -> InstrumentationScopeName -> Bool
InstrumentationScopeName -> InstrumentationScopeName -> Ordering
InstrumentationScopeName
-> InstrumentationScopeName -> InstrumentationScopeName
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
$ccompare :: InstrumentationScopeName -> InstrumentationScopeName -> Ordering
compare :: InstrumentationScopeName -> InstrumentationScopeName -> Ordering
$c< :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
< :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
$c<= :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
<= :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
$c> :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
> :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
$c>= :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
>= :: InstrumentationScopeName -> InstrumentationScopeName -> Bool
$cmax :: InstrumentationScopeName
-> InstrumentationScopeName -> InstrumentationScopeName
max :: InstrumentationScopeName
-> InstrumentationScopeName -> InstrumentationScopeName
$cmin :: InstrumentationScopeName
-> InstrumentationScopeName -> InstrumentationScopeName
min :: InstrumentationScopeName
-> InstrumentationScopeName -> InstrumentationScopeName
Ord, Int -> InstrumentationScopeName -> ShowS
[InstrumentationScopeName] -> ShowS
InstrumentationScopeName -> String
(Int -> InstrumentationScopeName -> ShowS)
-> (InstrumentationScopeName -> String)
-> ([InstrumentationScopeName] -> ShowS)
-> Show InstrumentationScopeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstrumentationScopeName -> ShowS
showsPrec :: Int -> InstrumentationScopeName -> ShowS
$cshow :: InstrumentationScopeName -> String
show :: InstrumentationScopeName -> String
$cshowList :: [InstrumentationScopeName] -> ShowS
showList :: [InstrumentationScopeName] -> ShowS
Show)
    deriving ([InstrumentationScopeName] -> Value
[InstrumentationScopeName] -> Encoding
InstrumentationScopeName -> Bool
InstrumentationScopeName -> Value
InstrumentationScopeName -> Encoding
(InstrumentationScopeName -> Value)
-> (InstrumentationScopeName -> Encoding)
-> ([InstrumentationScopeName] -> Value)
-> ([InstrumentationScopeName] -> Encoding)
-> (InstrumentationScopeName -> Bool)
-> ToJSON InstrumentationScopeName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InstrumentationScopeName -> Value
toJSON :: InstrumentationScopeName -> Value
$ctoEncoding :: InstrumentationScopeName -> Encoding
toEncoding :: InstrumentationScopeName -> Encoding
$ctoJSONList :: [InstrumentationScopeName] -> Value
toJSONList :: [InstrumentationScopeName] -> Value
$ctoEncodingList :: [InstrumentationScopeName] -> Encoding
toEncodingList :: [InstrumentationScopeName] -> Encoding
$comitField :: InstrumentationScopeName -> Bool
omitField :: InstrumentationScopeName -> Bool
ToJSON) via (Text)

instance IsString InstrumentationScopeName where
  fromString :: String -> InstrumentationScopeName
fromString = Text -> InstrumentationScopeName
InstrumentationScopeName (Text -> InstrumentationScopeName)
-> (String -> Text) -> String -> InstrumentationScopeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

newtype Version = Version
  { Version -> Text
unVersion :: Text
  } deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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
$ccompare :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> String
show :: Version -> String
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
Show)
    deriving ([Version] -> Value
[Version] -> Encoding
Version -> Bool
Version -> Value
Version -> Encoding
(Version -> Value)
-> (Version -> Encoding)
-> ([Version] -> Value)
-> ([Version] -> Encoding)
-> (Version -> Bool)
-> ToJSON Version
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Version -> Value
toJSON :: Version -> Value
$ctoEncoding :: Version -> Encoding
toEncoding :: Version -> Encoding
$ctoJSONList :: [Version] -> Value
toJSONList :: [Version] -> Value
$ctoEncodingList :: [Version] -> Encoding
toEncodingList :: [Version] -> Encoding
$comitField :: Version -> Bool
omitField :: Version -> Bool
ToJSON) via (Text)

instance IsString Version where
  fromString :: String -> Version
fromString = Text -> Version
Version (Text -> Version) -> (String -> Text) -> String -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

newtype SchemaURL = SchemaURL
  { SchemaURL -> Text
unSchemaURL :: Text
  } deriving stock (SchemaURL -> SchemaURL -> Bool
(SchemaURL -> SchemaURL -> Bool)
-> (SchemaURL -> SchemaURL -> Bool) -> Eq SchemaURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaURL -> SchemaURL -> Bool
== :: SchemaURL -> SchemaURL -> Bool
$c/= :: SchemaURL -> SchemaURL -> Bool
/= :: SchemaURL -> SchemaURL -> Bool
Eq, Eq SchemaURL
Eq SchemaURL =>
(SchemaURL -> SchemaURL -> Ordering)
-> (SchemaURL -> SchemaURL -> Bool)
-> (SchemaURL -> SchemaURL -> Bool)
-> (SchemaURL -> SchemaURL -> Bool)
-> (SchemaURL -> SchemaURL -> Bool)
-> (SchemaURL -> SchemaURL -> SchemaURL)
-> (SchemaURL -> SchemaURL -> SchemaURL)
-> Ord SchemaURL
SchemaURL -> SchemaURL -> Bool
SchemaURL -> SchemaURL -> Ordering
SchemaURL -> SchemaURL -> SchemaURL
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
$ccompare :: SchemaURL -> SchemaURL -> Ordering
compare :: SchemaURL -> SchemaURL -> Ordering
$c< :: SchemaURL -> SchemaURL -> Bool
< :: SchemaURL -> SchemaURL -> Bool
$c<= :: SchemaURL -> SchemaURL -> Bool
<= :: SchemaURL -> SchemaURL -> Bool
$c> :: SchemaURL -> SchemaURL -> Bool
> :: SchemaURL -> SchemaURL -> Bool
$c>= :: SchemaURL -> SchemaURL -> Bool
>= :: SchemaURL -> SchemaURL -> Bool
$cmax :: SchemaURL -> SchemaURL -> SchemaURL
max :: SchemaURL -> SchemaURL -> SchemaURL
$cmin :: SchemaURL -> SchemaURL -> SchemaURL
min :: SchemaURL -> SchemaURL -> SchemaURL
Ord, Int -> SchemaURL -> ShowS
[SchemaURL] -> ShowS
SchemaURL -> String
(Int -> SchemaURL -> ShowS)
-> (SchemaURL -> String)
-> ([SchemaURL] -> ShowS)
-> Show SchemaURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaURL -> ShowS
showsPrec :: Int -> SchemaURL -> ShowS
$cshow :: SchemaURL -> String
show :: SchemaURL -> String
$cshowList :: [SchemaURL] -> ShowS
showList :: [SchemaURL] -> ShowS
Show)
    deriving (Eq SchemaURL
Eq SchemaURL =>
(Int -> SchemaURL -> Int)
-> (SchemaURL -> Int) -> Hashable SchemaURL
Int -> SchemaURL -> Int
SchemaURL -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SchemaURL -> Int
hashWithSalt :: Int -> SchemaURL -> Int
$chash :: SchemaURL -> Int
hash :: SchemaURL -> Int
Hashable, [SchemaURL] -> Value
[SchemaURL] -> Encoding
SchemaURL -> Bool
SchemaURL -> Value
SchemaURL -> Encoding
(SchemaURL -> Value)
-> (SchemaURL -> Encoding)
-> ([SchemaURL] -> Value)
-> ([SchemaURL] -> Encoding)
-> (SchemaURL -> Bool)
-> ToJSON SchemaURL
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SchemaURL -> Value
toJSON :: SchemaURL -> Value
$ctoEncoding :: SchemaURL -> Encoding
toEncoding :: SchemaURL -> Encoding
$ctoJSONList :: [SchemaURL] -> Value
toJSONList :: [SchemaURL] -> Value
$ctoEncodingList :: [SchemaURL] -> Encoding
toEncodingList :: [SchemaURL] -> Encoding
$comitField :: SchemaURL -> Bool
omitField :: SchemaURL -> Bool
ToJSON) via (Text)

schemaURLFromText :: Text -> Either Text SchemaURL
schemaURLFromText :: Text -> Either Text SchemaURL
schemaURLFromText = SchemaURL -> Either Text SchemaURL
forall a b. b -> Either a b
Right (SchemaURL -> Either Text SchemaURL)
-> (Text -> SchemaURL) -> Text -> Either Text SchemaURL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SchemaURL
SchemaURL

schemaURLToText :: SchemaURL -> Text
schemaURLToText :: SchemaURL -> Text
schemaURLToText = SchemaURL -> Text
unSchemaURL

class WithAttrs (a :: Type) where
  type WithAttrsAttrType a :: AttrsFor
  (.:@) :: a -> AttrsBuilder (WithAttrsAttrType a) -> a

infixr 6 .:@

data Attrs (af :: AttrsFor) = Attrs
  { forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap :: HashMap Text SomeAttr
  , forall (af :: AttrsFor). Attrs af -> Int
attrsDropped :: Int
  } deriving stock (Attrs af -> Attrs af -> Bool
(Attrs af -> Attrs af -> Bool)
-> (Attrs af -> Attrs af -> Bool) -> Eq (Attrs af)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (af :: AttrsFor). Attrs af -> Attrs af -> Bool
$c== :: forall (af :: AttrsFor). Attrs af -> Attrs af -> Bool
== :: Attrs af -> Attrs af -> Bool
$c/= :: forall (af :: AttrsFor). Attrs af -> Attrs af -> Bool
/= :: Attrs af -> Attrs af -> Bool
Eq, Int -> Attrs af -> ShowS
[Attrs af] -> ShowS
Attrs af -> String
(Int -> Attrs af -> ShowS)
-> (Attrs af -> String) -> ([Attrs af] -> ShowS) -> Show (Attrs af)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (af :: AttrsFor). Int -> Attrs af -> ShowS
forall (af :: AttrsFor). [Attrs af] -> ShowS
forall (af :: AttrsFor). Attrs af -> String
$cshowsPrec :: forall (af :: AttrsFor). Int -> Attrs af -> ShowS
showsPrec :: Int -> Attrs af -> ShowS
$cshow :: forall (af :: AttrsFor). Attrs af -> String
show :: Attrs af -> String
$cshowList :: forall (af :: AttrsFor). [Attrs af] -> ShowS
showList :: [Attrs af] -> ShowS
Show)

instance ToJSON (Attrs af) where
  toJSON :: Attrs af -> Value
toJSON Attrs af
attrs =
    [Pair] -> Value
Aeson.object
      [ Key
"attributePairs" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HashMap Text SomeAttr -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap Text SomeAttr
attrsMap
      , Key
"attributesDropped" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
attrsDropped
      ]
    where
    Attrs { HashMap Text SomeAttr
attrsMap :: forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap :: HashMap Text SomeAttr
attrsMap, Int
attrsDropped :: forall (af :: AttrsFor). Attrs af -> Int
attrsDropped :: Int
attrsDropped } = Attrs af
attrs

emptyAttrs :: Attrs af
emptyAttrs :: forall (af :: AttrsFor). Attrs af
emptyAttrs =
  Attrs
    { attrsMap :: HashMap Text SomeAttr
attrsMap = HashMap Text SomeAttr
forall a. Monoid a => a
mempty
    , attrsDropped :: Int
attrsDropped = Int
0
    }

nullAttrs :: Attrs af -> Bool
nullAttrs :: forall (af :: AttrsFor). Attrs af -> Bool
nullAttrs = HashMap Text SomeAttr -> Bool
forall k v. HashMap k v -> Bool
HashMap.null (HashMap Text SomeAttr -> Bool)
-> (Attrs af -> HashMap Text SomeAttr) -> Attrs af -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrs af -> HashMap Text SomeAttr
forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap

sizeAttrs :: Attrs af -> Int
sizeAttrs :: forall (af :: AttrsFor). Attrs af -> Int
sizeAttrs = HashMap Text SomeAttr -> Int
forall k v. HashMap k v -> Int
HashMap.size (HashMap Text SomeAttr -> Int)
-> (Attrs af -> HashMap Text SomeAttr) -> Attrs af -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrs af -> HashMap Text SomeAttr
forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap

memberAttrs :: Key a -> Attrs af -> Bool
memberAttrs :: forall a (af :: AttrsFor). Key a -> Attrs af -> Bool
memberAttrs Key a
key = Text -> HashMap Text SomeAttr -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member (Key a -> Text
forall a. Key a -> Text
unKey Key a
key) (HashMap Text SomeAttr -> Bool)
-> (Attrs af -> HashMap Text SomeAttr) -> Attrs af -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attrs af -> HashMap Text SomeAttr
forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap

lookupAttrs
  :: forall a af
   . (KnownAttrType a)
  => Key a
  -> Attrs af
  -> Maybe (Attr a)
lookupAttrs :: forall a (af :: AttrsFor).
KnownAttrType a =>
Key a -> Attrs af -> Maybe (Attr a)
lookupAttrs Key a
key Attrs af
attrs =
  case Text -> HashMap Text SomeAttr -> Maybe SomeAttr
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Key a -> Text
forall a. Key a -> Text
unKey Key a
key) (HashMap Text SomeAttr -> Maybe SomeAttr)
-> HashMap Text SomeAttr -> Maybe SomeAttr
forall a b. (a -> b) -> a -> b
$ Attrs af -> HashMap Text SomeAttr
forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap Attrs af
attrs of
    Maybe SomeAttr
Nothing -> Maybe (Attr a)
forall a. Maybe a
Nothing
    Just (SomeAttr Attr a
attr) ->
      case (Proxy a -> AttrType a
forall a. KnownAttrType a => Proxy a -> AttrType a
attrTypeVal (Proxy a -> AttrType a) -> Proxy a -> AttrType a
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a, Attr a -> AttrType a
forall a. Attr a -> AttrType a
attrType Attr a
attr) of
        (AttrType a
AttrTypeText, AttrType a
AttrTypeText) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeBool, AttrType a
AttrTypeBool) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeDouble, AttrType a
AttrTypeDouble) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeInt, AttrType a
AttrTypeInt) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeTextArray, AttrType a
AttrTypeTextArray) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeBoolArray, AttrType a
AttrTypeBoolArray) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeDoubleArray, AttrType a
AttrTypeDoubleArray) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
AttrTypeIntArray, AttrType a
AttrTypeIntArray) -> Attr a -> Maybe (Attr a)
forall a. a -> Maybe a
Just Attr a
Attr a
attr
        (AttrType a
_, AttrType a
_) -> Maybe (Attr a)
forall a. Maybe a
Nothing

foldMapWithKeyAttrs
  :: forall m af
   . (Monoid m)
  => (forall a. Key a -> Attr a -> m)
  -> Attrs af
  -> m
foldMapWithKeyAttrs :: forall m (af :: AttrsFor).
Monoid m =>
(forall a. Key a -> Attr a -> m) -> Attrs af -> m
foldMapWithKeyAttrs forall a. Key a -> Attr a -> m
f Attrs af
attrs =
  ((Text -> SomeAttr -> m) -> HashMap Text SomeAttr -> m)
-> HashMap Text SomeAttr -> (Text -> SomeAttr -> m) -> m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> SomeAttr -> m) -> HashMap Text SomeAttr -> m
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
HashMap.foldMapWithKey (Attrs af -> HashMap Text SomeAttr
forall (af :: AttrsFor). Attrs af -> HashMap Text SomeAttr
attrsMap Attrs af
attrs) \Text
keyText SomeAttr
someAttr ->
    case SomeAttr
someAttr of
      SomeAttr Attr a
attr -> Key a -> Attr a -> m
forall a. Key a -> Attr a -> m
f (Text -> Key a
forall a. Text -> Key a
Key Text
keyText) Attr a
attr

filterWithKeyAttrs
  :: forall af
   . (forall a. Key a -> Attr a -> Bool)
  -> Attrs af
  -> Attrs af
filterWithKeyAttrs :: forall (af :: AttrsFor).
(forall a. Key a -> Attr a -> Bool) -> Attrs af -> Attrs af
filterWithKeyAttrs forall a. Key a -> Attr a -> Bool
f Attrs af
attrs =
  Attrs af
attrs
    { attrsMap =
        flip HashMap.filterWithKey (attrsMap attrs) \Text
keyText SomeAttr
someAttr ->
          case SomeAttr
someAttr of
            SomeAttr Attr a
attr -> Key a -> Attr a -> Bool
forall a. Key a -> Attr a -> Bool
f (Text -> Key a
forall a. Text -> Key a
Key Text
keyText) Attr a
attr
    }

mapWithKeyAttrs
  :: forall af
   . (forall a. Key a -> Attr a -> Attr a)
  -> Attrs af
  -> Attrs af
mapWithKeyAttrs :: forall (af :: AttrsFor).
(forall a. Key a -> Attr a -> Attr a) -> Attrs af -> Attrs af
mapWithKeyAttrs forall a. Key a -> Attr a -> Attr a
f = (forall a. Key a -> Attr a -> SomeAttr) -> Attrs af -> Attrs af
forall (af :: AttrsFor).
(forall a. Key a -> Attr a -> SomeAttr) -> Attrs af -> Attrs af
convertWithKeyAttrs Key a -> Attr a -> SomeAttr
forall a. Key a -> Attr a -> SomeAttr
go
  where
  go :: Key a -> Attr a -> SomeAttr
  go :: forall a. Key a -> Attr a -> SomeAttr
go Key a
k Attr a
v = Attr a -> SomeAttr
forall a. Attr a -> SomeAttr
SomeAttr (Attr a -> SomeAttr) -> Attr a -> SomeAttr
forall a b. (a -> b) -> a -> b
$ Key a -> Attr a -> Attr a
forall a. Key a -> Attr a -> Attr a
f Key a
k Attr a
v

-- | Equivalent to 'mapWithKeyAttrs' but allows for changing both the type and
-- value of each attribute rather than just the value of the attribute.
convertWithKeyAttrs
  :: forall af
   . (forall a. Key a -> Attr a -> SomeAttr)
  -> Attrs af
  -> Attrs af
convertWithKeyAttrs :: forall (af :: AttrsFor).
(forall a. Key a -> Attr a -> SomeAttr) -> Attrs af -> Attrs af
convertWithKeyAttrs forall a. Key a -> Attr a -> SomeAttr
f Attrs af
attrs =
  Attrs af
attrs
    { attrsMap =
        flip HashMap.mapWithKey (attrsMap attrs) \Text
keyText SomeAttr
someAttr ->
          case SomeAttr
someAttr of
            SomeAttr Attr a
attr -> Key a -> Attr a -> SomeAttr
forall a. Key a -> Attr a -> SomeAttr
f (Text -> Key a
forall a. Text -> Key a
Key Text
keyText) Attr a
attr
    }

droppedAttrsCount :: Attrs af -> Int
droppedAttrsCount :: forall (af :: AttrsFor). Attrs af -> Int
droppedAttrsCount = Attrs af -> Int
forall (af :: AttrsFor). Attrs af -> Int
attrsDropped

newtype AttrsBuilder (af :: AttrsFor) = AttrsBuilder
  { forall (af :: AttrsFor).
AttrsBuilder af -> Int -> DList AttrsBuilderElem
unAttrsBuilder :: Int -> DList AttrsBuilderElem
  } deriving (NonEmpty (AttrsBuilder af) -> AttrsBuilder af
AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
(AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af)
-> (NonEmpty (AttrsBuilder af) -> AttrsBuilder af)
-> (forall b.
    Integral b =>
    b -> AttrsBuilder af -> AttrsBuilder af)
-> Semigroup (AttrsBuilder af)
forall b. Integral b => b -> AttrsBuilder af -> AttrsBuilder af
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (af :: AttrsFor).
NonEmpty (AttrsBuilder af) -> AttrsBuilder af
forall (af :: AttrsFor).
AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
forall (af :: AttrsFor) b.
Integral b =>
b -> AttrsBuilder af -> AttrsBuilder af
$c<> :: forall (af :: AttrsFor).
AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
<> :: AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
$csconcat :: forall (af :: AttrsFor).
NonEmpty (AttrsBuilder af) -> AttrsBuilder af
sconcat :: NonEmpty (AttrsBuilder af) -> AttrsBuilder af
$cstimes :: forall (af :: AttrsFor) b.
Integral b =>
b -> AttrsBuilder af -> AttrsBuilder af
stimes :: forall b. Integral b => b -> AttrsBuilder af -> AttrsBuilder af
Semigroup, Semigroup (AttrsBuilder af)
AttrsBuilder af
Semigroup (AttrsBuilder af) =>
AttrsBuilder af
-> (AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af)
-> ([AttrsBuilder af] -> AttrsBuilder af)
-> Monoid (AttrsBuilder af)
[AttrsBuilder af] -> AttrsBuilder af
AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (af :: AttrsFor). Semigroup (AttrsBuilder af)
forall (af :: AttrsFor). AttrsBuilder af
forall (af :: AttrsFor). [AttrsBuilder af] -> AttrsBuilder af
forall (af :: AttrsFor).
AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
$cmempty :: forall (af :: AttrsFor). AttrsBuilder af
mempty :: AttrsBuilder af
$cmappend :: forall (af :: AttrsFor).
AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
mappend :: AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
$cmconcat :: forall (af :: AttrsFor). [AttrsBuilder af] -> AttrsBuilder af
mconcat :: [AttrsBuilder af] -> AttrsBuilder af
Monoid) via (Int -> DList AttrsBuilderElem)

data AttrsBuilderElem = AttrsBuilderElem
  { AttrsBuilderElem -> Text
attrsBuilderElemKey :: Text
  , AttrsBuilderElem -> SomeAttr
attrsBuilderElemVal :: SomeAttr
  }

runAttrsBuilder :: AttrsBuilder af -> AttrsLimits af -> Attrs af
runAttrsBuilder :: forall (af :: AttrsFor).
AttrsBuilder af -> AttrsLimits af -> Attrs af
runAttrsBuilder AttrsBuilder af
attrsBuilder AttrsLimits af
attrsLimits =
  Attrs
    { attrsMap :: HashMap Text SomeAttr
attrsMap = AttrsAcc -> HashMap Text SomeAttr
attrsAccMap AttrsAcc
finalAcc
    , attrsDropped :: Int
attrsDropped = AttrsAcc -> Int
attrsAccDropped AttrsAcc
finalAcc
    }
  where
  finalAcc :: AttrsAcc
  finalAcc :: AttrsAcc
finalAcc = (AttrsAcc -> AttrsBuilderElem -> AttrsAcc)
-> AttrsAcc -> DList AttrsBuilderElem -> AttrsAcc
forall b a. (b -> a -> b) -> b -> DList a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' AttrsAcc -> AttrsBuilderElem -> AttrsAcc
buildAcc AttrsAcc
initAcc DList AttrsBuilderElem
attrsDList

  buildAcc :: AttrsAcc -> AttrsBuilderElem -> AttrsAcc
  buildAcc :: AttrsAcc -> AttrsBuilderElem -> AttrsAcc
buildAcc AttrsAcc
attrsAcc AttrsBuilderElem
attrsBuilderElem
    | Text
attrsBuilderElemKey Text -> HashMap Text SomeAttr -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HashMap.member` HashMap Text SomeAttr
attrsAccMap =
        AttrsAcc
attrsAcc
    | Int
attrsAccMapSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
countLimit =
        AttrsAcc
attrsAcc
          { attrsAccDropped = 1 + attrsAccDropped
          }
    | Bool
otherwise =
        AttrsAcc
attrsAcc
          { attrsAccMap =
              HashMap.insert attrsBuilderElemKey attrsBuilderElemVal attrsAccMap
          , attrsAccMapSize = 1 + attrsAccMapSize
          }
    where
    AttrsAcc
      { HashMap Text SomeAttr
attrsAccMap :: AttrsAcc -> HashMap Text SomeAttr
attrsAccMap :: HashMap Text SomeAttr
attrsAccMap
      , Int
attrsAccMapSize :: Int
attrsAccMapSize :: AttrsAcc -> Int
attrsAccMapSize
      , Int
attrsAccDropped :: AttrsAcc -> Int
attrsAccDropped :: Int
attrsAccDropped
      } = AttrsAcc
attrsAcc
    AttrsBuilderElem
      { Text
attrsBuilderElemKey :: AttrsBuilderElem -> Text
attrsBuilderElemKey :: Text
attrsBuilderElemKey
      , SomeAttr
attrsBuilderElemVal :: AttrsBuilderElem -> SomeAttr
attrsBuilderElemVal :: SomeAttr
attrsBuilderElemVal
      } = AttrsBuilderElem
attrsBuilderElem

  initAcc :: AttrsAcc
  initAcc :: AttrsAcc
initAcc =
    AttrsAcc
      { attrsAccMap :: HashMap Text SomeAttr
attrsAccMap = HashMap Text SomeAttr
forall a. Monoid a => a
mempty
      , attrsAccMapSize :: Int
attrsAccMapSize = Int
0
      , attrsAccDropped :: Int
attrsAccDropped = Int
0
      }

  attrsDList :: DList AttrsBuilderElem
  attrsDList :: DList AttrsBuilderElem
attrsDList = AttrsBuilder af -> Int -> DList AttrsBuilderElem
forall (af :: AttrsFor).
AttrsBuilder af -> Int -> DList AttrsBuilderElem
unAttrsBuilder AttrsBuilder af
attrsBuilder Int
textLengthLimit
    where
    textLengthLimit :: Int
    textLengthLimit :: Int
textLengthLimit = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
Maybe.fromMaybe (forall a. Bounded a => a
maxBound @Int) Maybe Int
attrsLimitsValueLength

  countLimit :: Int
  countLimit :: Int
countLimit = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
Maybe.fromMaybe (forall a. Bounded a => a
maxBound @Int) Maybe Int
attrsLimitsCount

  AttrsLimits { Maybe Int
attrsLimitsCount :: Maybe Int
attrsLimitsCount :: forall (af :: AttrsFor). AttrsLimits af -> Maybe Int
attrsLimitsCount, Maybe Int
attrsLimitsValueLength :: Maybe Int
attrsLimitsValueLength :: forall (af :: AttrsFor). AttrsLimits af -> Maybe Int
attrsLimitsValueLength } = AttrsLimits af
attrsLimits

jsonAttrs :: forall a af. (ToJSON a) => Text -> a -> AttrsBuilder af
jsonAttrs :: forall a (af :: AttrsFor). ToJSON a => Text -> a -> AttrsBuilder af
jsonAttrs Text
initKeyText = Text -> Value -> AttrsBuilder af
go Text
initKeyText (Value -> AttrsBuilder af) -> (a -> Value) -> a -> AttrsBuilder af
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON
  where
  go :: Text -> Value -> AttrsBuilder af
  go :: Text -> Value -> AttrsBuilder af
go Text
keyText = \case
    Value
Null -> Text -> Key Text
forall a. Text -> Key a
Key Text
keyText Key Text -> Text -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ (Text
"(null)" :: Text)
    Bool Bool
x -> Text -> Key Bool
forall a. Text -> Key a
Key Text
keyText Key Bool -> Bool -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ Bool
x
    String Text
x -> Text -> Key Text
forall a. Text -> Key a
Key Text
keyText Key Text -> Text -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ Text
x
    Number Scientific
x
      | Just Int64
i <- Scientific -> Maybe Int64
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
x ->
          Text -> Key Int64
forall a. Text -> Key a
Key Text
keyText Key Int64 -> Int64 -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ (Int64
i :: Int64)
      | Right Double
d <- Scientific -> Either Double Double
forall a. RealFloat a => Scientific -> Either a a
Scientific.toBoundedRealFloat Scientific
x ->
          Text -> Key Double
forall a. Text -> Key a
Key Text
keyText Key Double -> Double -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ (Double
d :: Double)
      | Bool
otherwise ->
          Text -> Key Text
forall a. Text -> Key a
Key Text
keyText Key Text -> String -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ Scientific -> String
forall a. Show a => a -> String
show Scientific
x
    Array Array
xs
      | Array -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Array
xs -> Text -> Key Text
forall a. Text -> Key a
Key Text
keyText Key Text -> Text -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ (Text
"(empty array)" :: Text)
      | Bool
otherwise ->
          (AttrsBuilder af -> Int -> Value -> AttrsBuilder af)
-> AttrsBuilder af -> Array -> AttrsBuilder af
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
Vector.ifoldl'
            (\AttrsBuilder af
acc Int
i Value
x -> AttrsBuilder af
acc AttrsBuilder af -> AttrsBuilder af -> AttrsBuilder af
forall a. Semigroup a => a -> a -> a
<> Text -> Value -> AttrsBuilder af
go (Text
keyText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show @Int Int
i)) Value
x)
            AttrsBuilder af
forall a. Monoid a => a
mempty
            Array
xs
    Object KeyMap Value
kvs
      | KeyMap Value -> Bool
forall a. KeyMap a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null KeyMap Value
kvs -> Text -> Key Text
forall a. Text -> Key a
Key Text
keyText Key Text -> Text -> AttrsBuilder af
forall kv from to.
(KV kv, KVConstraints kv from to) =>
Key to -> from -> kv
forall from to.
KVConstraints (AttrsBuilder af) from to =>
Key to -> from -> AttrsBuilder af
.@ (Text
"(empty object)" :: Text)
      | Bool
otherwise ->
          (Key -> Value -> AttrsBuilder af)
-> KeyMap Value -> AttrsBuilder af
forall m a. Monoid m => (Key -> a -> m) -> KeyMap a -> m
Aeson.KeyMap.foldMapWithKey
            (\Key
k Value
v -> Text -> Value -> AttrsBuilder af
go (Text
keyText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
Aeson.Key.toText Key
k) Value
v)
            KeyMap Value
kvs

-- N.B. Little ad-hoc type for use in 'runAttrsBuilder'.
data AttrsAcc = AttrsAcc
  { AttrsAcc -> HashMap Text SomeAttr
attrsAccMap :: HashMap Text SomeAttr
  , AttrsAcc -> Int
attrsAccMapSize :: Int
  , AttrsAcc -> Int
attrsAccDropped :: Int
  }

data AttrsFor
  = AttrsForResource
  | AttrsForSpan
  | AttrsForSpanEvent
  | AttrsForSpanLink

data AttrsLimits (af :: AttrsFor) = AttrsLimits
  { forall (af :: AttrsFor). AttrsLimits af -> Maybe Int
attrsLimitsCount :: Maybe Int
  , forall (af :: AttrsFor). AttrsLimits af -> Maybe Int
attrsLimitsValueLength :: Maybe Int
  }

instance ToJSON (AttrsLimits af) where
  toJSON :: AttrsLimits af -> Value
toJSON AttrsLimits af
attrsLimits =
    [Pair] -> Value
object
      [ Key
"count" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Int
attrsLimitsCount
      , Key
"valueLength" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Int -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe Int
attrsLimitsValueLength
      ]
    where
    AttrsLimits { Maybe Int
attrsLimitsCount :: forall (af :: AttrsFor). AttrsLimits af -> Maybe Int
attrsLimitsCount :: Maybe Int
attrsLimitsCount, Maybe Int
attrsLimitsValueLength :: forall (af :: AttrsFor). AttrsLimits af -> Maybe Int
attrsLimitsValueLength :: Maybe Int
attrsLimitsValueLength } = AttrsLimits af
attrsLimits

defaultAttrsLimits :: AttrsLimits af
defaultAttrsLimits :: forall (af :: AttrsFor). AttrsLimits af
defaultAttrsLimits =
  AttrsLimits
    { attrsLimitsCount :: Maybe Int
attrsLimitsCount = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
128
    , attrsLimitsValueLength :: Maybe Int
attrsLimitsValueLength = Maybe Int
forall a. Maybe a
Nothing
    }

data SomeAttr where
  SomeAttr :: Attr a -> SomeAttr

instance Eq SomeAttr where
  SomeAttr
sa1 == :: SomeAttr -> SomeAttr -> Bool
== SomeAttr
sa2 =
    case (SomeAttr
sa1, SomeAttr
sa2) of
      (SomeAttr Attr a
a1, SomeAttr Attr a
a2) ->
        case (Attr a -> AttrType a
forall a. Attr a -> AttrType a
attrType Attr a
a1, Attr a -> AttrType a
forall a. Attr a -> AttrType a
attrType Attr a
a2) of
          (AttrType a
AttrTypeText, AttrType a
AttrTypeText) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeBool, AttrType a
AttrTypeBool) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeDouble, AttrType a
AttrTypeDouble) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeInt, AttrType a
AttrTypeInt) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeTextArray, AttrType a
AttrTypeTextArray) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeBoolArray, AttrType a
AttrTypeBoolArray) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeDoubleArray, AttrType a
AttrTypeDoubleArray) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
AttrTypeIntArray, AttrType a
AttrTypeIntArray) -> Attr a
a1 Attr a -> Attr a -> Bool
forall a. Eq a => a -> a -> Bool
== Attr a
Attr a
a2
          (AttrType a
_, AttrType a
_) -> Bool
False

instance Show SomeAttr where
  show :: SomeAttr -> String
show (SomeAttr Attr a
attr) =
    case Attr a -> AttrType a
forall a. Attr a -> AttrType a
attrType Attr a
attr of
      AttrType a
AttrTypeText -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeBool -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeDouble -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeInt -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeTextArray -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeBoolArray -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeDoubleArray -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr
      AttrType a
AttrTypeIntArray -> Attr a -> String
forall a. Show a => a -> String
show Attr a
attr

instance ToJSON SomeAttr where
  toJSON :: SomeAttr -> Value
toJSON = \case
    SomeAttr Attr { AttrType a
attrType :: forall a. Attr a -> AttrType a
attrType :: AttrType a
attrType, a
attrVal :: forall a. Attr a -> a
attrVal :: a
attrVal } ->
      case AttrType a
attrType of
        AttrType a
AttrTypeText ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"text" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeBool ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"bool" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeDouble ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"double" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeInt ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"int" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeTextArray ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"textArray" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeBoolArray ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"boolArray" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeDoubleArray ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"doubleArray" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]
        AttrType a
AttrTypeIntArray ->
          [Pair] -> Value
Aeson.object
            [ Key
"tag" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"intArray" :: Text)
            , Key
"content" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= a -> Value
forall a. ToJSON a => a -> Value
toJSON a
attrVal
            ]

data Attr a = Attr
  { forall a. Attr a -> AttrType a
attrType :: AttrType a
  , forall a. Attr a -> a
attrVal :: a
  } deriving stock (Attr a -> Attr a -> Bool
(Attr a -> Attr a -> Bool)
-> (Attr a -> Attr a -> Bool) -> Eq (Attr a)
forall a. Eq a => Attr a -> Attr a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Attr a -> Attr a -> Bool
== :: Attr a -> Attr a -> Bool
$c/= :: forall a. Eq a => Attr a -> Attr a -> Bool
/= :: Attr a -> Attr a -> Bool
Eq, Int -> Attr a -> ShowS
[Attr a] -> ShowS
Attr a -> String
(Int -> Attr a -> ShowS)
-> (Attr a -> String) -> ([Attr a] -> ShowS) -> Show (Attr a)
forall a. Show a => Int -> Attr a -> ShowS
forall a. Show a => [Attr a] -> ShowS
forall a. Show a => Attr a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Attr a -> ShowS
showsPrec :: Int -> Attr a -> ShowS
$cshow :: forall a. Show a => Attr a -> String
show :: Attr a -> String
$cshowList :: forall a. Show a => [Attr a] -> ShowS
showList :: [Attr a] -> ShowS
Show)

-- | Convert an attribute to a text attribute.
--
-- This function is identity if the attribute already is a text attribute.
-- Otherwise, the attribute value is passed to 'show'.
asTextAttr :: Attr a -> Attr Text
asTextAttr :: forall a. Attr a -> Attr Text
asTextAttr Attr a
attr =
  case Attr a -> AttrType a
forall a. Attr a -> AttrType a
attrType Attr a
attr of
    AttrType a
AttrTypeText -> Attr a
Attr Text
attr
    AttrType a
AttrTypeBool ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
    AttrType a
AttrTypeDouble ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
    AttrType a
AttrTypeInt ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
    AttrType a
AttrTypeTextArray ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
    AttrType a
AttrTypeBoolArray ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
    AttrType a
AttrTypeDoubleArray ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
    AttrType a
AttrTypeIntArray ->
      Attr { attrType :: AttrType Text
attrType = AttrType Text
AttrTypeText, attrVal :: Text
attrVal = a -> Text
forall v. Show v => v -> Text
packShow (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ Attr a -> a
forall a. Attr a -> a
attrVal Attr a
attr }
  where
  packShow :: (Show v) => v -> Text
  packShow :: forall v. Show v => v -> Text
packShow = String -> Text
Text.pack (String -> Text) -> (v -> String) -> v -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> String
forall a. Show a => a -> String
show


newtype AttrVals a = AttrVals
  { forall a. AttrVals a -> Vector a
unAttrVals :: Vector a
  } deriving (AttrVals a -> AttrVals a -> Bool
(AttrVals a -> AttrVals a -> Bool)
-> (AttrVals a -> AttrVals a -> Bool) -> Eq (AttrVals a)
forall a. Eq a => AttrVals a -> AttrVals a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => AttrVals a -> AttrVals a -> Bool
== :: AttrVals a -> AttrVals a -> Bool
$c/= :: forall a. Eq a => AttrVals a -> AttrVals a -> Bool
/= :: AttrVals a -> AttrVals a -> Bool
Eq, Semigroup (AttrVals a)
AttrVals a
Semigroup (AttrVals a) =>
AttrVals a
-> (AttrVals a -> AttrVals a -> AttrVals a)
-> ([AttrVals a] -> AttrVals a)
-> Monoid (AttrVals a)
[AttrVals a] -> AttrVals a
AttrVals a -> AttrVals a -> AttrVals a
forall a. Semigroup (AttrVals a)
forall a. AttrVals a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [AttrVals a] -> AttrVals a
forall a. AttrVals a -> AttrVals a -> AttrVals a
$cmempty :: forall a. AttrVals a
mempty :: AttrVals a
$cmappend :: forall a. AttrVals a -> AttrVals a -> AttrVals a
mappend :: AttrVals a -> AttrVals a -> AttrVals a
$cmconcat :: forall a. [AttrVals a] -> AttrVals a
mconcat :: [AttrVals a] -> AttrVals a
Monoid, NonEmpty (AttrVals a) -> AttrVals a
AttrVals a -> AttrVals a -> AttrVals a
(AttrVals a -> AttrVals a -> AttrVals a)
-> (NonEmpty (AttrVals a) -> AttrVals a)
-> (forall b. Integral b => b -> AttrVals a -> AttrVals a)
-> Semigroup (AttrVals a)
forall b. Integral b => b -> AttrVals a -> AttrVals a
forall a. NonEmpty (AttrVals a) -> AttrVals a
forall a. AttrVals a -> AttrVals a -> AttrVals a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> AttrVals a -> AttrVals a
$c<> :: forall a. AttrVals a -> AttrVals a -> AttrVals a
<> :: AttrVals a -> AttrVals a -> AttrVals a
$csconcat :: forall a. NonEmpty (AttrVals a) -> AttrVals a
sconcat :: NonEmpty (AttrVals a) -> AttrVals a
$cstimes :: forall a b. Integral b => b -> AttrVals a -> AttrVals a
stimes :: forall b. Integral b => b -> AttrVals a -> AttrVals a
Semigroup, Int -> AttrVals a -> ShowS
[AttrVals a] -> ShowS
AttrVals a -> String
(Int -> AttrVals a -> ShowS)
-> (AttrVals a -> String)
-> ([AttrVals a] -> ShowS)
-> Show (AttrVals a)
forall a. Show a => Int -> AttrVals a -> ShowS
forall a. Show a => [AttrVals a] -> ShowS
forall a. Show a => AttrVals a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AttrVals a -> ShowS
showsPrec :: Int -> AttrVals a -> ShowS
$cshow :: forall a. Show a => AttrVals a -> String
show :: AttrVals a -> String
$cshowList :: forall a. Show a => [AttrVals a] -> ShowS
showList :: [AttrVals a] -> ShowS
Show, [AttrVals a] -> Value
[AttrVals a] -> Encoding
AttrVals a -> Bool
AttrVals a -> Value
AttrVals a -> Encoding
(AttrVals a -> Value)
-> (AttrVals a -> Encoding)
-> ([AttrVals a] -> Value)
-> ([AttrVals a] -> Encoding)
-> (AttrVals a -> Bool)
-> ToJSON (AttrVals a)
forall a. ToJSON a => [AttrVals a] -> Value
forall a. ToJSON a => [AttrVals a] -> Encoding
forall a. ToJSON a => AttrVals a -> Bool
forall a. ToJSON a => AttrVals a -> Value
forall a. ToJSON a => AttrVals a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => AttrVals a -> Value
toJSON :: AttrVals a -> Value
$ctoEncoding :: forall a. ToJSON a => AttrVals a -> Encoding
toEncoding :: AttrVals a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [AttrVals a] -> Value
toJSONList :: [AttrVals a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [AttrVals a] -> Encoding
toEncodingList :: [AttrVals a] -> Encoding
$comitField :: forall a. ToJSON a => AttrVals a -> Bool
omitField :: AttrVals a -> Bool
ToJSON) via (Vector a)
    deriving ((forall m. Monoid m => AttrVals m -> m)
-> (forall m a. Monoid m => (a -> m) -> AttrVals a -> m)
-> (forall m a. Monoid m => (a -> m) -> AttrVals a -> m)
-> (forall a b. (a -> b -> b) -> b -> AttrVals a -> b)
-> (forall a b. (a -> b -> b) -> b -> AttrVals a -> b)
-> (forall b a. (b -> a -> b) -> b -> AttrVals a -> b)
-> (forall b a. (b -> a -> b) -> b -> AttrVals a -> b)
-> (forall a. (a -> a -> a) -> AttrVals a -> a)
-> (forall a. (a -> a -> a) -> AttrVals a -> a)
-> (forall a. AttrVals a -> [a])
-> (forall a. AttrVals a -> Bool)
-> (forall a. AttrVals a -> Int)
-> (forall a. Eq a => a -> AttrVals a -> Bool)
-> (forall a. Ord a => AttrVals a -> a)
-> (forall a. Ord a => AttrVals a -> a)
-> (forall a. Num a => AttrVals a -> a)
-> (forall a. Num a => AttrVals a -> a)
-> Foldable AttrVals
forall a. Eq a => a -> AttrVals a -> Bool
forall a. Num a => AttrVals a -> a
forall a. Ord a => AttrVals a -> a
forall m. Monoid m => AttrVals m -> m
forall a. AttrVals a -> Bool
forall a. AttrVals a -> Int
forall a. AttrVals a -> [a]
forall a. (a -> a -> a) -> AttrVals a -> a
forall m a. Monoid m => (a -> m) -> AttrVals a -> m
forall b a. (b -> a -> b) -> b -> AttrVals a -> b
forall a b. (a -> b -> b) -> b -> AttrVals a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => AttrVals m -> m
fold :: forall m. Monoid m => AttrVals m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AttrVals a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AttrVals a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AttrVals a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> AttrVals a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> AttrVals a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AttrVals a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AttrVals a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AttrVals a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AttrVals a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AttrVals a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AttrVals a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> AttrVals a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> AttrVals a -> a
foldr1 :: forall a. (a -> a -> a) -> AttrVals a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AttrVals a -> a
foldl1 :: forall a. (a -> a -> a) -> AttrVals a -> a
$ctoList :: forall a. AttrVals a -> [a]
toList :: forall a. AttrVals a -> [a]
$cnull :: forall a. AttrVals a -> Bool
null :: forall a. AttrVals a -> Bool
$clength :: forall a. AttrVals a -> Int
length :: forall a. AttrVals a -> Int
$celem :: forall a. Eq a => a -> AttrVals a -> Bool
elem :: forall a. Eq a => a -> AttrVals a -> Bool
$cmaximum :: forall a. Ord a => AttrVals a -> a
maximum :: forall a. Ord a => AttrVals a -> a
$cminimum :: forall a. Ord a => AttrVals a -> a
minimum :: forall a. Ord a => AttrVals a -> a
$csum :: forall a. Num a => AttrVals a -> a
sum :: forall a. Num a => AttrVals a -> a
$cproduct :: forall a. Num a => AttrVals a -> a
product :: forall a. Num a => AttrVals a -> a
Foldable, (forall a b. (a -> b) -> AttrVals a -> AttrVals b)
-> (forall a b. a -> AttrVals b -> AttrVals a) -> Functor AttrVals
forall a b. a -> AttrVals b -> AttrVals a
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> AttrVals a -> AttrVals b
fmap :: forall a b. (a -> b) -> AttrVals a -> AttrVals b
$c<$ :: forall a b. a -> AttrVals b -> AttrVals a
<$ :: forall a b. a -> AttrVals b -> AttrVals a
Functor, Functor AttrVals
Functor AttrVals =>
(forall a. a -> AttrVals a)
-> (forall a b. AttrVals (a -> b) -> AttrVals a -> AttrVals b)
-> (forall a b c.
    (a -> b -> c) -> AttrVals a -> AttrVals b -> AttrVals c)
-> (forall a b. AttrVals a -> AttrVals b -> AttrVals b)
-> (forall a b. AttrVals a -> AttrVals b -> AttrVals a)
-> Applicative AttrVals
forall a. a -> AttrVals a
forall a b. AttrVals a -> AttrVals b -> AttrVals a
forall a b. AttrVals a -> AttrVals b -> AttrVals b
forall a b. AttrVals (a -> b) -> AttrVals a -> AttrVals b
forall a b c.
(a -> b -> c) -> AttrVals a -> AttrVals b -> AttrVals c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> AttrVals a
pure :: forall a. a -> AttrVals a
$c<*> :: forall a b. AttrVals (a -> b) -> AttrVals a -> AttrVals b
<*> :: forall a b. AttrVals (a -> b) -> AttrVals a -> AttrVals b
$cliftA2 :: forall a b c.
(a -> b -> c) -> AttrVals a -> AttrVals b -> AttrVals c
liftA2 :: forall a b c.
(a -> b -> c) -> AttrVals a -> AttrVals b -> AttrVals c
$c*> :: forall a b. AttrVals a -> AttrVals b -> AttrVals b
*> :: forall a b. AttrVals a -> AttrVals b -> AttrVals b
$c<* :: forall a b. AttrVals a -> AttrVals b -> AttrVals a
<* :: forall a b. AttrVals a -> AttrVals b -> AttrVals a
Applicative, Applicative AttrVals
Applicative AttrVals =>
(forall a b. AttrVals a -> (a -> AttrVals b) -> AttrVals b)
-> (forall a b. AttrVals a -> AttrVals b -> AttrVals b)
-> (forall a. a -> AttrVals a)
-> Monad AttrVals
forall a. a -> AttrVals a
forall a b. AttrVals a -> AttrVals b -> AttrVals b
forall a b. AttrVals a -> (a -> AttrVals b) -> AttrVals b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. AttrVals a -> (a -> AttrVals b) -> AttrVals b
>>= :: forall a b. AttrVals a -> (a -> AttrVals b) -> AttrVals b
$c>> :: forall a b. AttrVals a -> AttrVals b -> AttrVals b
>> :: forall a b. AttrVals a -> AttrVals b -> AttrVals b
$creturn :: forall a. a -> AttrVals a
return :: forall a. a -> AttrVals a
Monad) via Vector

instance Traversable AttrVals where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AttrVals a -> f (AttrVals b)
traverse a -> f b
f (AttrVals Vector a
xs) = (Vector b -> AttrVals b) -> f (Vector b) -> f (AttrVals b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector b -> AttrVals b
forall a. Vector a -> AttrVals a
AttrVals (f (Vector b) -> f (AttrVals b)) -> f (Vector b) -> f (AttrVals b)
forall a b. (a -> b) -> a -> b
$ (a -> f b) -> Vector a -> f (Vector b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse a -> f b
f Vector a
xs

data AttrType (a :: Type) where
  AttrTypeText        :: AttrType Text
  AttrTypeBool        :: AttrType Bool
  AttrTypeDouble      :: AttrType Double
  AttrTypeInt         :: AttrType Int64
  AttrTypeTextArray   :: AttrType (AttrVals Text)
  AttrTypeBoolArray   :: AttrType (AttrVals Bool)
  AttrTypeDoubleArray :: AttrType (AttrVals Double)
  AttrTypeIntArray    :: AttrType (AttrVals Int64)

deriving stock instance (Eq a) => Eq (AttrType a)
deriving stock instance (Show a) => Show (AttrType a)

class KnownAttrType a where
  attrTypeVal :: Proxy a -> AttrType a

instance KnownAttrType Text where
  attrTypeVal :: Proxy Text -> AttrType Text
attrTypeVal Proxy Text
_ = AttrType Text
AttrTypeText

instance KnownAttrType Bool where
  attrTypeVal :: Proxy Bool -> AttrType Bool
attrTypeVal Proxy Bool
_ = AttrType Bool
AttrTypeBool

instance KnownAttrType Double where
  attrTypeVal :: Proxy Double -> AttrType Double
attrTypeVal Proxy Double
_ = AttrType Double
AttrTypeDouble

instance KnownAttrType Int64 where
  attrTypeVal :: Proxy Int64 -> AttrType Int64
attrTypeVal Proxy Int64
_ = AttrType Int64
AttrTypeInt

instance KnownAttrType (AttrVals Text) where
  attrTypeVal :: Proxy (AttrVals Text) -> AttrType (AttrVals Text)
attrTypeVal Proxy (AttrVals Text)
_ = AttrType (AttrVals Text)
AttrTypeTextArray

instance KnownAttrType (AttrVals Bool) where
  attrTypeVal :: Proxy (AttrVals Bool) -> AttrType (AttrVals Bool)
attrTypeVal Proxy (AttrVals Bool)
_ = AttrType (AttrVals Bool)
AttrTypeBoolArray

instance KnownAttrType (AttrVals Double) where
  attrTypeVal :: Proxy (AttrVals Double) -> AttrType (AttrVals Double)
attrTypeVal Proxy (AttrVals Double)
_ = AttrType (AttrVals Double)
AttrTypeDoubleArray

instance KnownAttrType (AttrVals Int64) where
  attrTypeVal :: Proxy (AttrVals Int64) -> AttrType (AttrVals Int64)
attrTypeVal Proxy (AttrVals Int64)
_ = AttrType (AttrVals Int64)
AttrTypeIntArray

class (KnownAttrType to) => ToAttrVal from to | from -> to where
  toAttrVal :: from -> to

instance ToAttrVal Text Text where
  toAttrVal :: Text -> Text
toAttrVal = Text -> Text
forall a. a -> a
id

instance ToAttrVal Text.Lazy.Text Text where
  toAttrVal :: Text -> Text
toAttrVal = Text -> Text
Text.Lazy.toStrict

instance ToAttrVal String Text where
  toAttrVal :: String -> Text
toAttrVal = String -> Text
Text.pack

instance ToAttrVal Bool Bool where
  toAttrVal :: Bool -> Bool
toAttrVal = Bool -> Bool
forall a. a -> a
id

instance ToAttrVal Double Double where
  toAttrVal :: Double -> Double
toAttrVal = Double -> Double
forall a. a -> a
id

instance ToAttrVal Float Double where
  toAttrVal :: Float -> Double
toAttrVal = Float -> Double
float2Double

-- | Precision may be lost.
instance ToAttrVal Rational Double where
  toAttrVal :: Rational -> Double
toAttrVal = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational

instance ToAttrVal Int Int64 where
  toAttrVal :: Int -> Int64
toAttrVal = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal Int8 Int64 where
  toAttrVal :: Int8 -> Int64
toAttrVal = Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal Int16 Int64 where
  toAttrVal :: Int16 -> Int64
toAttrVal = Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal Int32 Int64 where
  toAttrVal :: Int32 -> Int64
toAttrVal = Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal Int64 Int64 where
  toAttrVal :: Int64 -> Int64
toAttrVal = Int64 -> Int64
forall a. a -> a
id

instance ToAttrVal Word8 Int64 where
  toAttrVal :: Word8 -> Int64
toAttrVal = Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal Word16 Int64 where
  toAttrVal :: Word16 -> Int64
toAttrVal = Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal Word32 Int64 where
  toAttrVal :: Word32 -> Int64
toAttrVal = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToAttrVal (AttrVals Text) (AttrVals Text) where
  toAttrVal :: AttrVals Text -> AttrVals Text
toAttrVal = AttrVals Text -> AttrVals Text
forall a. a -> a
id

instance ToAttrVal [Text] (AttrVals Text) where
  toAttrVal :: [Text] -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> ([Text] -> Vector Text) -> [Text] -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList

instance ToAttrVal (Seq Text) (AttrVals Text) where
  toAttrVal :: Seq Text -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> (Seq Text -> Vector Text) -> Seq Text -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList ([Text] -> Vector Text)
-> (Seq Text -> [Text]) -> Seq Text -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

instance ToAttrVal (Vector Text) (AttrVals Text) where
  toAttrVal :: Vector Text -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals

instance ToAttrVal (AttrVals Text.Lazy.Text) (AttrVals Text) where
  toAttrVal :: AttrVals Text -> AttrVals Text
toAttrVal = (Text -> Text) -> AttrVals Text -> AttrVals Text
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Text.Lazy.Text @Text)

instance ToAttrVal [Text.Lazy.Text] (AttrVals Text) where
  toAttrVal :: [Text] -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> ([Text] -> Vector Text) -> [Text] -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList ([Text] -> Vector Text)
-> ([Text] -> [Text]) -> [Text] -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Text.Lazy.Text @Text)

instance ToAttrVal (Seq Text.Lazy.Text) (AttrVals Text) where
  toAttrVal :: Seq Text -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> (Seq Text -> Vector Text) -> Seq Text -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList ([Text] -> Vector Text)
-> (Seq Text -> [Text]) -> Seq Text -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Text -> [Text])
-> (Seq Text -> Seq Text) -> Seq Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Seq Text -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Text.Lazy.Text @Text)

instance ToAttrVal (Vector Text.Lazy.Text) (AttrVals Text) where
  toAttrVal :: Vector Text -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> (Vector Text -> Vector Text) -> Vector Text -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Vector Text -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Text.Lazy.Text @Text)

instance ToAttrVal (AttrVals String) (AttrVals Text) where
  toAttrVal :: AttrVals String -> AttrVals Text
toAttrVal = (String -> Text) -> AttrVals String -> AttrVals Text
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @String @Text)

instance ToAttrVal [String] (AttrVals Text) where
  toAttrVal :: [String] -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> ([String] -> Vector Text) -> [String] -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList ([Text] -> Vector Text)
-> ([String] -> [Text]) -> [String] -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @String @Text)

instance ToAttrVal (Seq String) (AttrVals Text) where
  toAttrVal :: Seq String -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> (Seq String -> Vector Text) -> Seq String -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Vector Text
forall a. [a] -> Vector a
Vector.fromList ([Text] -> Vector Text)
-> (Seq String -> [Text]) -> Seq String -> Vector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Text -> [Text])
-> (Seq String -> Seq Text) -> Seq String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Seq String -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @String @Text)

instance ToAttrVal (Vector String) (AttrVals Text) where
  toAttrVal :: Vector String -> AttrVals Text
toAttrVal = Vector Text -> AttrVals Text
forall a. Vector a -> AttrVals a
AttrVals (Vector Text -> AttrVals Text)
-> (Vector String -> Vector Text) -> Vector String -> AttrVals Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Vector String -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @String @Text)

instance ToAttrVal (AttrVals Bool) (AttrVals Bool) where
  toAttrVal :: AttrVals Bool -> AttrVals Bool
toAttrVal = AttrVals Bool -> AttrVals Bool
forall a. a -> a
id

instance ToAttrVal [Bool] (AttrVals Bool) where
  toAttrVal :: [Bool] -> AttrVals Bool
toAttrVal = Vector Bool -> AttrVals Bool
forall a. Vector a -> AttrVals a
AttrVals (Vector Bool -> AttrVals Bool)
-> ([Bool] -> Vector Bool) -> [Bool] -> AttrVals Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Vector Bool
forall a. [a] -> Vector a
Vector.fromList

instance ToAttrVal (Seq Bool) (AttrVals Bool) where
  toAttrVal :: Seq Bool -> AttrVals Bool
toAttrVal = Vector Bool -> AttrVals Bool
forall a. Vector a -> AttrVals a
AttrVals (Vector Bool -> AttrVals Bool)
-> (Seq Bool -> Vector Bool) -> Seq Bool -> AttrVals Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Vector Bool
forall a. [a] -> Vector a
Vector.fromList ([Bool] -> Vector Bool)
-> (Seq Bool -> [Bool]) -> Seq Bool -> Vector Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Bool -> [Bool]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

instance ToAttrVal (Vector Bool) (AttrVals Bool) where
  toAttrVal :: Vector Bool -> AttrVals Bool
toAttrVal = Vector Bool -> AttrVals Bool
forall a. Vector a -> AttrVals a
AttrVals

instance ToAttrVal (AttrVals Double) (AttrVals Double) where
  toAttrVal :: AttrVals Double -> AttrVals Double
toAttrVal = AttrVals Double -> AttrVals Double
forall a. a -> a
id

instance ToAttrVal [Double] (AttrVals Double) where
  toAttrVal :: [Double] -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> ([Double] -> Vector Double) -> [Double] -> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
Vector.fromList

instance ToAttrVal (Seq Double) (AttrVals Double) where
  toAttrVal :: Seq Double -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> (Seq Double -> Vector Double) -> Seq Double -> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
Vector.fromList ([Double] -> Vector Double)
-> (Seq Double -> [Double]) -> Seq Double -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Double -> [Double]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

instance ToAttrVal (Vector Double) (AttrVals Double) where
  toAttrVal :: Vector Double -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals

instance ToAttrVal (AttrVals Float) (AttrVals Double) where
  toAttrVal :: AttrVals Float -> AttrVals Double
toAttrVal = (Float -> Double) -> AttrVals Float -> AttrVals Double
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Float @Double)

instance ToAttrVal [Float] (AttrVals Double) where
  toAttrVal :: [Float] -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> ([Float] -> Vector Double) -> [Float] -> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
Vector.fromList ([Double] -> Vector Double)
-> ([Float] -> [Double]) -> [Float] -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Double) -> [Float] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Float @Double)

instance ToAttrVal (Seq Float) (AttrVals Double) where
  toAttrVal :: Seq Float -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> (Seq Float -> Vector Double) -> Seq Float -> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
Vector.fromList ([Double] -> Vector Double)
-> (Seq Float -> [Double]) -> Seq Float -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Double -> [Double]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Double -> [Double])
-> (Seq Float -> Seq Double) -> Seq Float -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Double) -> Seq Float -> Seq Double
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Float @Double)

instance ToAttrVal (Vector Float) (AttrVals Double) where
  toAttrVal :: Vector Float -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> (Vector Float -> Vector Double)
-> Vector Float
-> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Double) -> Vector Float -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Float @Double)

-- | Precision may be lost.
instance ToAttrVal (AttrVals Rational) (AttrVals Double) where
  toAttrVal :: AttrVals Rational -> AttrVals Double
toAttrVal = (Rational -> Double) -> AttrVals Rational -> AttrVals Double
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Rational @Double)

-- | Precision may be lost.
instance ToAttrVal [Rational] (AttrVals Double) where
  toAttrVal :: [Rational] -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> ([Rational] -> Vector Double) -> [Rational] -> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
Vector.fromList ([Double] -> Vector Double)
-> ([Rational] -> [Double]) -> [Rational] -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> [Rational] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Rational @Double)

-- | Precision may be lost.
instance ToAttrVal (Seq Rational) (AttrVals Double) where
  toAttrVal :: Seq Rational -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> (Seq Rational -> Vector Double)
-> Seq Rational
-> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
Vector.fromList ([Double] -> Vector Double)
-> (Seq Rational -> [Double]) -> Seq Rational -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Double -> [Double]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Double -> [Double])
-> (Seq Rational -> Seq Double) -> Seq Rational -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> Seq Rational -> Seq Double
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Rational @Double)

-- | Precision may be lost.
instance ToAttrVal (Vector Rational) (AttrVals Double) where
  toAttrVal :: Vector Rational -> AttrVals Double
toAttrVal = Vector Double -> AttrVals Double
forall a. Vector a -> AttrVals a
AttrVals (Vector Double -> AttrVals Double)
-> (Vector Rational -> Vector Double)
-> Vector Rational
-> AttrVals Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Double) -> Vector Rational -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Rational @Double)

instance ToAttrVal (AttrVals Int) (AttrVals Int64) where
  toAttrVal :: AttrVals Int -> AttrVals Int64
toAttrVal = (Int -> Int64) -> AttrVals Int -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int @Int64)

instance ToAttrVal [Int] (AttrVals Int64) where
  toAttrVal :: [Int] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Int] -> Vector Int64) -> [Int] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Int] -> [Int64]) -> [Int] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int64) -> [Int] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int @Int64)

instance ToAttrVal (Seq Int) (AttrVals Int64) where
  toAttrVal :: Seq Int -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Int -> Vector Int64) -> Seq Int -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Int -> [Int64]) -> Seq Int -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Int -> Seq Int64) -> Seq Int -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int64) -> Seq Int -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int @Int64)

instance ToAttrVal (Vector Int) (AttrVals Int64) where
  toAttrVal :: Vector Int -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Int -> Vector Int64) -> Vector Int -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int64) -> Vector Int -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int @Int64)

instance ToAttrVal (AttrVals Int8) (AttrVals Int64) where
  toAttrVal :: AttrVals Int8 -> AttrVals Int64
toAttrVal = (Int8 -> Int64) -> AttrVals Int8 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int8 @Int64)

instance ToAttrVal [Int8] (AttrVals Int64) where
  toAttrVal :: [Int8] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Int8] -> Vector Int64) -> [Int8] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Int8] -> [Int64]) -> [Int8] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int64) -> [Int8] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int8 @Int64)

instance ToAttrVal (Seq Int8) (AttrVals Int64) where
  toAttrVal :: Seq Int8 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Int8 -> Vector Int64) -> Seq Int8 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Int8 -> [Int64]) -> Seq Int8 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Int8 -> Seq Int64) -> Seq Int8 -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int64) -> Seq Int8 -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int8 @Int64)

instance ToAttrVal (Vector Int8) (AttrVals Int64) where
  toAttrVal :: Vector Int8 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Int8 -> Vector Int64) -> Vector Int8 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int64) -> Vector Int8 -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int8 @Int64)

instance ToAttrVal (AttrVals Int16) (AttrVals Int64) where
  toAttrVal :: AttrVals Int16 -> AttrVals Int64
toAttrVal = (Int16 -> Int64) -> AttrVals Int16 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int16 @Int64)

instance ToAttrVal [Int16] (AttrVals Int64) where
  toAttrVal :: [Int16] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Int16] -> Vector Int64) -> [Int16] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Int16] -> [Int64]) -> [Int16] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> Int64) -> [Int16] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int16 @Int64)

instance ToAttrVal (Seq Int16) (AttrVals Int64) where
  toAttrVal :: Seq Int16 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Int16 -> Vector Int64) -> Seq Int16 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Int16 -> [Int64]) -> Seq Int16 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Int16 -> Seq Int64) -> Seq Int16 -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> Int64) -> Seq Int16 -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int16 @Int64)

instance ToAttrVal (Vector Int16) (AttrVals Int64) where
  toAttrVal :: Vector Int16 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Int16 -> Vector Int64) -> Vector Int16 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> Int64) -> Vector Int16 -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int16 @Int64)

instance ToAttrVal (AttrVals Int32) (AttrVals Int64) where
  toAttrVal :: AttrVals Int32 -> AttrVals Int64
toAttrVal = (Int32 -> Int64) -> AttrVals Int32 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int32 @Int64)

instance ToAttrVal [Int32] (AttrVals Int64) where
  toAttrVal :: [Int32] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Int32] -> Vector Int64) -> [Int32] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Int32] -> [Int64]) -> [Int32] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int64) -> [Int32] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int32 @Int64)

instance ToAttrVal (Seq Int32) (AttrVals Int64) where
  toAttrVal :: Seq Int32 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Int32 -> Vector Int64) -> Seq Int32 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Int32 -> [Int64]) -> Seq Int32 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Int32 -> Seq Int64) -> Seq Int32 -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int64) -> Seq Int32 -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int32 @Int64)

instance ToAttrVal (Vector Int32) (AttrVals Int64) where
  toAttrVal :: Vector Int32 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Int32 -> Vector Int64) -> Vector Int32 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int64) -> Vector Int32 -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int32 @Int64)

instance ToAttrVal (AttrVals Int64) (AttrVals Int64) where
  toAttrVal :: AttrVals Int64 -> AttrVals Int64
toAttrVal = (Int64 -> Int64) -> AttrVals Int64 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Int64 @Int64)

instance ToAttrVal [Int64] (AttrVals Int64) where
  toAttrVal :: [Int64] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Int64] -> Vector Int64) -> [Int64] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList

instance ToAttrVal (Seq Int64) (AttrVals Int64) where
  toAttrVal :: Seq Int64 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Int64 -> Vector Int64) -> Seq Int64 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Int64 -> [Int64]) -> Seq Int64 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList

instance ToAttrVal (Vector Int64) (AttrVals Int64) where
  toAttrVal :: Vector Int64 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals

instance ToAttrVal (AttrVals Word8) (AttrVals Int64) where
  toAttrVal :: AttrVals Word8 -> AttrVals Int64
toAttrVal = (Word8 -> Int64) -> AttrVals Word8 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word8 @Int64)

instance ToAttrVal [Word8] (AttrVals Int64) where
  toAttrVal :: [Word8] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Word8] -> Vector Int64) -> [Word8] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Word8] -> [Int64]) -> [Word8] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int64) -> [Word8] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word8 @Int64)

instance ToAttrVal (Seq Word8) (AttrVals Int64) where
  toAttrVal :: Seq Word8 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Word8 -> Vector Int64) -> Seq Word8 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Word8 -> [Int64]) -> Seq Word8 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Word8 -> Seq Int64) -> Seq Word8 -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int64) -> Seq Word8 -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word8 @Int64)

instance ToAttrVal (Vector Word8) (AttrVals Int64) where
  toAttrVal :: Vector Word8 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Word8 -> Vector Int64) -> Vector Word8 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Int64) -> Vector Word8 -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word8 @Int64)

instance ToAttrVal (AttrVals Word16) (AttrVals Int64) where
  toAttrVal :: AttrVals Word16 -> AttrVals Int64
toAttrVal = (Word16 -> Int64) -> AttrVals Word16 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word16 @Int64)

instance ToAttrVal [Word16] (AttrVals Int64) where
  toAttrVal :: [Word16] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Word16] -> Vector Int64) -> [Word16] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Word16] -> [Int64]) -> [Word16] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int64) -> [Word16] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word16 @Int64)

instance ToAttrVal (Seq Word16) (AttrVals Int64) where
  toAttrVal :: Seq Word16 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Word16 -> Vector Int64) -> Seq Word16 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Word16 -> [Int64]) -> Seq Word16 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Word16 -> Seq Int64) -> Seq Word16 -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int64) -> Seq Word16 -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word16 @Int64)

instance ToAttrVal (Vector Word16) (AttrVals Int64) where
  toAttrVal :: Vector Word16 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Word16 -> Vector Int64)
-> Vector Word16
-> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int64) -> Vector Word16 -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word16 @Int64)

instance ToAttrVal (AttrVals Word32) (AttrVals Int64) where
  toAttrVal :: AttrVals Word32 -> AttrVals Int64
toAttrVal = (Word32 -> Int64) -> AttrVals Word32 -> AttrVals Int64
forall a b. (a -> b) -> AttrVals a -> AttrVals b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word32 @Int64)

instance ToAttrVal [Word32] (AttrVals Int64) where
  toAttrVal :: [Word32] -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> ([Word32] -> Vector Int64) -> [Word32] -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> ([Word32] -> [Int64]) -> [Word32] -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Int64) -> [Word32] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word32 @Int64)

instance ToAttrVal (Seq Word32) (AttrVals Int64) where
  toAttrVal :: Seq Word32 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Seq Word32 -> Vector Int64) -> Seq Word32 -> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Vector Int64
forall a. [a] -> Vector a
Vector.fromList ([Int64] -> Vector Int64)
-> (Seq Word32 -> [Int64]) -> Seq Word32 -> Vector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int64 -> [Int64]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq Int64 -> [Int64])
-> (Seq Word32 -> Seq Int64) -> Seq Word32 -> [Int64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Int64) -> Seq Word32 -> Seq Int64
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word32 @Int64)

instance ToAttrVal (Vector Word32) (AttrVals Int64) where
  toAttrVal :: Vector Word32 -> AttrVals Int64
toAttrVal = Vector Int64 -> AttrVals Int64
forall a. Vector a -> AttrVals a
AttrVals (Vector Int64 -> AttrVals Int64)
-> (Vector Word32 -> Vector Int64)
-> Vector Word32
-> AttrVals Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Int64) -> Vector Word32 -> Vector Int64
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. ToAttrVal from to => from -> to
toAttrVal @Word32 @Int64)

with :: a -> (a -> b) -> b
with :: forall a b. a -> (a -> b) -> b
with = a -> (a -> b) -> b
forall a b. a -> (a -> b) -> b
(&)

type OnException :: Type -> Type
newtype OnException a = OnException
  { forall a.
OnException a -> SomeException -> [SeriesElem] -> LoggingT IO a
runOnException :: SomeException -> [SeriesElem] -> LoggingT IO a
  } deriving
      ( Functor OnException
Functor OnException =>
(forall a. a -> OnException a)
-> (forall a b.
    OnException (a -> b) -> OnException a -> OnException b)
-> (forall a b c.
    (a -> b -> c) -> OnException a -> OnException b -> OnException c)
-> (forall a b. OnException a -> OnException b -> OnException b)
-> (forall a b. OnException a -> OnException b -> OnException a)
-> Applicative OnException
forall a. a -> OnException a
forall a b. OnException a -> OnException b -> OnException a
forall a b. OnException a -> OnException b -> OnException b
forall a b. OnException (a -> b) -> OnException a -> OnException b
forall a b c.
(a -> b -> c) -> OnException a -> OnException b -> OnException c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> OnException a
pure :: forall a. a -> OnException a
$c<*> :: forall a b. OnException (a -> b) -> OnException a -> OnException b
<*> :: forall a b. OnException (a -> b) -> OnException a -> OnException b
$cliftA2 :: forall a b c.
(a -> b -> c) -> OnException a -> OnException b -> OnException c
liftA2 :: forall a b c.
(a -> b -> c) -> OnException a -> OnException b -> OnException c
$c*> :: forall a b. OnException a -> OnException b -> OnException b
*> :: forall a b. OnException a -> OnException b -> OnException b
$c<* :: forall a b. OnException a -> OnException b -> OnException a
<* :: forall a b. OnException a -> OnException b -> OnException a
Applicative, (forall a b. (a -> b) -> OnException a -> OnException b)
-> (forall a b. a -> OnException b -> OnException a)
-> Functor OnException
forall a b. a -> OnException b -> OnException a
forall a b. (a -> b) -> OnException a -> OnException b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OnException a -> OnException b
fmap :: forall a b. (a -> b) -> OnException a -> OnException b
$c<$ :: forall a b. a -> OnException b -> OnException a
<$ :: forall a b. a -> OnException b -> OnException a
Functor, Applicative OnException
Applicative OnException =>
(forall a b.
 OnException a -> (a -> OnException b) -> OnException b)
-> (forall a b. OnException a -> OnException b -> OnException b)
-> (forall a. a -> OnException a)
-> Monad OnException
forall a. a -> OnException a
forall a b. OnException a -> OnException b -> OnException b
forall a b. OnException a -> (a -> OnException b) -> OnException b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. OnException a -> (a -> OnException b) -> OnException b
>>= :: forall a b. OnException a -> (a -> OnException b) -> OnException b
$c>> :: forall a b. OnException a -> OnException b -> OnException b
>> :: forall a b. OnException a -> OnException b -> OnException b
$creturn :: forall a. a -> OnException a
return :: forall a. a -> OnException a
Monad, Monad OnException
Monad OnException =>
(forall a. IO a -> OnException a) -> MonadIO OnException
forall a. IO a -> OnException a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> OnException a
liftIO :: forall a. IO a -> OnException a
MonadIO -- @base@
      , MonadThrow OnException
MonadThrow OnException =>
(forall e a.
 (HasCallStack, Exception e) =>
 OnException a -> (e -> OnException a) -> OnException a)
-> MonadCatch OnException
forall e a.
(HasCallStack, Exception e) =>
OnException a -> (e -> OnException a) -> OnException a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
OnException a -> (e -> OnException a) -> OnException a
catch :: forall e a.
(HasCallStack, Exception e) =>
OnException a -> (e -> OnException a) -> OnException a
MonadCatch, MonadCatch OnException
MonadCatch OnException =>
(forall b.
 HasCallStack =>
 ((forall a. OnException a -> OnException a) -> OnException b)
 -> OnException b)
-> (forall b.
    HasCallStack =>
    ((forall a. OnException a -> OnException a) -> OnException b)
    -> OnException b)
-> (forall a b c.
    HasCallStack =>
    OnException a
    -> (a -> ExitCase b -> OnException c)
    -> (a -> OnException b)
    -> OnException (b, c))
-> MonadMask OnException
forall b.
HasCallStack =>
((forall a. OnException a -> OnException a) -> OnException b)
-> OnException b
forall a b c.
HasCallStack =>
OnException a
-> (a -> ExitCase b -> OnException c)
-> (a -> OnException b)
-> OnException (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. OnException a -> OnException a) -> OnException b)
-> OnException b
mask :: forall b.
HasCallStack =>
((forall a. OnException a -> OnException a) -> OnException b)
-> OnException b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. OnException a -> OnException a) -> OnException b)
-> OnException b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. OnException a -> OnException a) -> OnException b)
-> OnException b
$cgeneralBracket :: forall a b c.
HasCallStack =>
OnException a
-> (a -> ExitCase b -> OnException c)
-> (a -> OnException b)
-> OnException (b, c)
generalBracket :: forall a b c.
HasCallStack =>
OnException a
-> (a -> ExitCase b -> OnException c)
-> (a -> OnException b)
-> OnException (b, c)
MonadMask, Monad OnException
Monad OnException =>
(forall e a. (HasCallStack, Exception e) => e -> OnException a)
-> MonadThrow OnException
forall e a. (HasCallStack, Exception e) => e -> OnException a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> OnException a
throwM :: forall e a. (HasCallStack, Exception e) => e -> OnException a
MonadThrow -- @exceptions@
      , MonadIO OnException
MonadIO OnException =>
(forall b.
 ((forall a. OnException a -> IO a) -> IO b) -> OnException b)
-> MonadUnliftIO OnException
forall b.
((forall a. OnException a -> IO a) -> IO b) -> OnException b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b.
((forall a. OnException a -> IO a) -> IO b) -> OnException b
withRunInIO :: forall b.
((forall a. OnException a -> IO a) -> IO b) -> OnException b
MonadUnliftIO -- @unliftio-core@
      , Monad OnException
Monad OnException =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> OnException ())
-> MonadLogger OnException
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> OnException ()
forall (m :: * -> *).
Monad m =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
$cmonadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> OnException ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> OnException ()
MonadLogger, MonadIO OnException
MonadLogger OnException
OnException Logger
(MonadLogger OnException, MonadIO OnException) =>
OnException Logger -> MonadLoggerIO OnException
forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
m Logger -> MonadLoggerIO m
$caskLoggerIO :: OnException Logger
askLoggerIO :: OnException Logger
MonadLoggerIO -- @monad-logger@
      ) via (ReaderT SomeException (ReaderT [SeriesElem] (LoggingT IO)))
    deriving
      ( NonEmpty (OnException a) -> OnException a
OnException a -> OnException a -> OnException a
(OnException a -> OnException a -> OnException a)
-> (NonEmpty (OnException a) -> OnException a)
-> (forall b. Integral b => b -> OnException a -> OnException a)
-> Semigroup (OnException a)
forall b. Integral b => b -> OnException a -> OnException a
forall a. Semigroup a => NonEmpty (OnException a) -> OnException a
forall a.
Semigroup a =>
OnException a -> OnException a -> OnException a
forall a b.
(Semigroup a, Integral b) =>
b -> OnException a -> OnException a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a.
Semigroup a =>
OnException a -> OnException a -> OnException a
<> :: OnException a -> OnException a -> OnException a
$csconcat :: forall a. Semigroup a => NonEmpty (OnException a) -> OnException a
sconcat :: NonEmpty (OnException a) -> OnException a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> OnException a -> OnException a
stimes :: forall b. Integral b => b -> OnException a -> OnException a
Semigroup, Semigroup (OnException a)
OnException a
Semigroup (OnException a) =>
OnException a
-> (OnException a -> OnException a -> OnException a)
-> ([OnException a] -> OnException a)
-> Monoid (OnException a)
[OnException a] -> OnException a
OnException a -> OnException a -> OnException a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (OnException a)
forall a. Monoid a => OnException a
forall a. Monoid a => [OnException a] -> OnException a
forall a.
Monoid a =>
OnException a -> OnException a -> OnException a
$cmempty :: forall a. Monoid a => OnException a
mempty :: OnException a
$cmappend :: forall a.
Monoid a =>
OnException a -> OnException a -> OnException a
mappend :: OnException a -> OnException a -> OnException a
$cmconcat :: forall a. Monoid a => [OnException a] -> OnException a
mconcat :: [OnException a] -> OnException a
Monoid -- @base@
      ) via (Ap (ReaderT SomeException (ReaderT [SeriesElem] (LoggingT IO))) a)

askException :: OnException SomeException
askException :: OnException SomeException
askException = (SomeException -> [SeriesElem] -> LoggingT IO SomeException)
-> OnException SomeException
forall a.
(SomeException -> [SeriesElem] -> LoggingT IO a) -> OnException a
OnException \SomeException
someEx [SeriesElem]
_pairs -> SomeException -> LoggingT IO SomeException
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SomeException
someEx

askExceptionMetadata :: OnException [SeriesElem]
askExceptionMetadata :: OnException [SeriesElem]
askExceptionMetadata = (SomeException -> [SeriesElem] -> LoggingT IO [SeriesElem])
-> OnException [SeriesElem]
forall a.
(SomeException -> [SeriesElem] -> LoggingT IO a) -> OnException a
OnException \SomeException
_someEx [SeriesElem]
pairs -> [SeriesElem] -> LoggingT IO [SeriesElem]
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SeriesElem]
pairs

type OnTimeout :: Type -> Type
newtype OnTimeout a = OnTimeout
  { forall a. OnTimeout a -> Int -> [SeriesElem] -> LoggingT IO a
runOnTimeout :: Int -> [SeriesElem] -> LoggingT IO a
  } deriving
      ( Functor OnTimeout
Functor OnTimeout =>
(forall a. a -> OnTimeout a)
-> (forall a b. OnTimeout (a -> b) -> OnTimeout a -> OnTimeout b)
-> (forall a b c.
    (a -> b -> c) -> OnTimeout a -> OnTimeout b -> OnTimeout c)
-> (forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b)
-> (forall a b. OnTimeout a -> OnTimeout b -> OnTimeout a)
-> Applicative OnTimeout
forall a. a -> OnTimeout a
forall a b. OnTimeout a -> OnTimeout b -> OnTimeout a
forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b
forall a b. OnTimeout (a -> b) -> OnTimeout a -> OnTimeout b
forall a b c.
(a -> b -> c) -> OnTimeout a -> OnTimeout b -> OnTimeout c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> OnTimeout a
pure :: forall a. a -> OnTimeout a
$c<*> :: forall a b. OnTimeout (a -> b) -> OnTimeout a -> OnTimeout b
<*> :: forall a b. OnTimeout (a -> b) -> OnTimeout a -> OnTimeout b
$cliftA2 :: forall a b c.
(a -> b -> c) -> OnTimeout a -> OnTimeout b -> OnTimeout c
liftA2 :: forall a b c.
(a -> b -> c) -> OnTimeout a -> OnTimeout b -> OnTimeout c
$c*> :: forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b
*> :: forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b
$c<* :: forall a b. OnTimeout a -> OnTimeout b -> OnTimeout a
<* :: forall a b. OnTimeout a -> OnTimeout b -> OnTimeout a
Applicative, (forall a b. (a -> b) -> OnTimeout a -> OnTimeout b)
-> (forall a b. a -> OnTimeout b -> OnTimeout a)
-> Functor OnTimeout
forall a b. a -> OnTimeout b -> OnTimeout a
forall a b. (a -> b) -> OnTimeout a -> OnTimeout b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OnTimeout a -> OnTimeout b
fmap :: forall a b. (a -> b) -> OnTimeout a -> OnTimeout b
$c<$ :: forall a b. a -> OnTimeout b -> OnTimeout a
<$ :: forall a b. a -> OnTimeout b -> OnTimeout a
Functor, Applicative OnTimeout
Applicative OnTimeout =>
(forall a b. OnTimeout a -> (a -> OnTimeout b) -> OnTimeout b)
-> (forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b)
-> (forall a. a -> OnTimeout a)
-> Monad OnTimeout
forall a. a -> OnTimeout a
forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b
forall a b. OnTimeout a -> (a -> OnTimeout b) -> OnTimeout b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. OnTimeout a -> (a -> OnTimeout b) -> OnTimeout b
>>= :: forall a b. OnTimeout a -> (a -> OnTimeout b) -> OnTimeout b
$c>> :: forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b
>> :: forall a b. OnTimeout a -> OnTimeout b -> OnTimeout b
$creturn :: forall a. a -> OnTimeout a
return :: forall a. a -> OnTimeout a
Monad, Monad OnTimeout
Monad OnTimeout =>
(forall a. IO a -> OnTimeout a) -> MonadIO OnTimeout
forall a. IO a -> OnTimeout a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> OnTimeout a
liftIO :: forall a. IO a -> OnTimeout a
MonadIO -- @base@
      , MonadThrow OnTimeout
MonadThrow OnTimeout =>
(forall e a.
 (HasCallStack, Exception e) =>
 OnTimeout a -> (e -> OnTimeout a) -> OnTimeout a)
-> MonadCatch OnTimeout
forall e a.
(HasCallStack, Exception e) =>
OnTimeout a -> (e -> OnTimeout a) -> OnTimeout a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
OnTimeout a -> (e -> OnTimeout a) -> OnTimeout a
catch :: forall e a.
(HasCallStack, Exception e) =>
OnTimeout a -> (e -> OnTimeout a) -> OnTimeout a
MonadCatch, MonadCatch OnTimeout
MonadCatch OnTimeout =>
(forall b.
 HasCallStack =>
 ((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
 -> OnTimeout b)
-> (forall b.
    HasCallStack =>
    ((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
    -> OnTimeout b)
-> (forall a b c.
    HasCallStack =>
    OnTimeout a
    -> (a -> ExitCase b -> OnTimeout c)
    -> (a -> OnTimeout b)
    -> OnTimeout (b, c))
-> MonadMask OnTimeout
forall b.
HasCallStack =>
((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
-> OnTimeout b
forall a b c.
HasCallStack =>
OnTimeout a
-> (a -> ExitCase b -> OnTimeout c)
-> (a -> OnTimeout b)
-> OnTimeout (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
-> OnTimeout b
mask :: forall b.
HasCallStack =>
((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
-> OnTimeout b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
-> OnTimeout b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. OnTimeout a -> OnTimeout a) -> OnTimeout b)
-> OnTimeout b
$cgeneralBracket :: forall a b c.
HasCallStack =>
OnTimeout a
-> (a -> ExitCase b -> OnTimeout c)
-> (a -> OnTimeout b)
-> OnTimeout (b, c)
generalBracket :: forall a b c.
HasCallStack =>
OnTimeout a
-> (a -> ExitCase b -> OnTimeout c)
-> (a -> OnTimeout b)
-> OnTimeout (b, c)
MonadMask, Monad OnTimeout
Monad OnTimeout =>
(forall e a. (HasCallStack, Exception e) => e -> OnTimeout a)
-> MonadThrow OnTimeout
forall e a. (HasCallStack, Exception e) => e -> OnTimeout a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> OnTimeout a
throwM :: forall e a. (HasCallStack, Exception e) => e -> OnTimeout a
MonadThrow -- @exceptions@
      , MonadIO OnTimeout
MonadIO OnTimeout =>
(forall b.
 ((forall a. OnTimeout a -> IO a) -> IO b) -> OnTimeout b)
-> MonadUnliftIO OnTimeout
forall b. ((forall a. OnTimeout a -> IO a) -> IO b) -> OnTimeout b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall b. ((forall a. OnTimeout a -> IO a) -> IO b) -> OnTimeout b
withRunInIO :: forall b. ((forall a. OnTimeout a -> IO a) -> IO b) -> OnTimeout b
MonadUnliftIO -- @unliftio-core@
      , Monad OnTimeout
Monad OnTimeout =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> OnTimeout ())
-> MonadLogger OnTimeout
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> OnTimeout ()
forall (m :: * -> *).
Monad m =>
(forall msg.
 ToLogStr msg =>
 Loc -> Text -> LogLevel -> msg -> m ())
-> MonadLogger m
$cmonadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> OnTimeout ()
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> OnTimeout ()
MonadLogger, MonadIO OnTimeout
MonadLogger OnTimeout
OnTimeout Logger
(MonadLogger OnTimeout, MonadIO OnTimeout) =>
OnTimeout Logger -> MonadLoggerIO OnTimeout
forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
m Logger -> MonadLoggerIO m
$caskLoggerIO :: OnTimeout Logger
askLoggerIO :: OnTimeout Logger
MonadLoggerIO -- @monad-logger@
      ) via (ReaderT Int (ReaderT [SeriesElem] (LoggingT IO)))
    deriving
      ( NonEmpty (OnTimeout a) -> OnTimeout a
OnTimeout a -> OnTimeout a -> OnTimeout a
(OnTimeout a -> OnTimeout a -> OnTimeout a)
-> (NonEmpty (OnTimeout a) -> OnTimeout a)
-> (forall b. Integral b => b -> OnTimeout a -> OnTimeout a)
-> Semigroup (OnTimeout a)
forall b. Integral b => b -> OnTimeout a -> OnTimeout a
forall a. Semigroup a => NonEmpty (OnTimeout a) -> OnTimeout a
forall a. Semigroup a => OnTimeout a -> OnTimeout a -> OnTimeout a
forall a b.
(Semigroup a, Integral b) =>
b -> OnTimeout a -> OnTimeout a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a. Semigroup a => OnTimeout a -> OnTimeout a -> OnTimeout a
<> :: OnTimeout a -> OnTimeout a -> OnTimeout a
$csconcat :: forall a. Semigroup a => NonEmpty (OnTimeout a) -> OnTimeout a
sconcat :: NonEmpty (OnTimeout a) -> OnTimeout a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> OnTimeout a -> OnTimeout a
stimes :: forall b. Integral b => b -> OnTimeout a -> OnTimeout a
Semigroup, Semigroup (OnTimeout a)
OnTimeout a
Semigroup (OnTimeout a) =>
OnTimeout a
-> (OnTimeout a -> OnTimeout a -> OnTimeout a)
-> ([OnTimeout a] -> OnTimeout a)
-> Monoid (OnTimeout a)
[OnTimeout a] -> OnTimeout a
OnTimeout a -> OnTimeout a -> OnTimeout a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (OnTimeout a)
forall a. Monoid a => OnTimeout a
forall a. Monoid a => [OnTimeout a] -> OnTimeout a
forall a. Monoid a => OnTimeout a -> OnTimeout a -> OnTimeout a
$cmempty :: forall a. Monoid a => OnTimeout a
mempty :: OnTimeout a
$cmappend :: forall a. Monoid a => OnTimeout a -> OnTimeout a -> OnTimeout a
mappend :: OnTimeout a -> OnTimeout a -> OnTimeout a
$cmconcat :: forall a. Monoid a => [OnTimeout a] -> OnTimeout a
mconcat :: [OnTimeout a] -> OnTimeout a
Monoid -- @base@
      ) via (Ap (ReaderT Int (ReaderT [SeriesElem] (LoggingT IO))) a)

askTimeoutMicros :: OnTimeout Int
askTimeoutMicros :: OnTimeout Int
askTimeoutMicros = (Int -> [SeriesElem] -> LoggingT IO Int) -> OnTimeout Int
forall a. (Int -> [SeriesElem] -> LoggingT IO a) -> OnTimeout a
OnTimeout \Int
timeoutMicros [SeriesElem]
_pairs -> Int -> LoggingT IO Int
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
timeoutMicros

askTimeoutMetadata :: OnTimeout [SeriesElem]
askTimeoutMetadata :: OnTimeout [SeriesElem]
askTimeoutMetadata = (Int -> [SeriesElem] -> LoggingT IO [SeriesElem])
-> OnTimeout [SeriesElem]
forall a. (Int -> [SeriesElem] -> LoggingT IO a) -> OnTimeout a
OnTimeout \Int
_timeoutMicros [SeriesElem]
pairs -> [SeriesElem] -> LoggingT IO [SeriesElem]
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SeriesElem]
pairs

data BufferedLoggerSpec = BufferedLoggerSpec
  { -- | Predicate that determines if a log message should be buffered. The
    -- default is no buffering, so all log messages are logged immediately.
    BufferedLoggerSpec -> Loc -> Text -> LogLevel -> LogStr -> Bool
bufferedLoggerSpecShouldBuffer
      :: Loc -> LogSource -> LogLevel -> LogStr -> Bool
    -- | The logger to wrap. For all unbuffered log messages, these
    -- are passed to 'bufferedLoggerSpecLogger' immediately. For
    -- buffered log messages, aggregates will eventually be passed
    -- to 'bufferedLoggerSpecLogger' on the configured period (see
    -- 'bufferedLoggerSpecFlushPeriod').
  , BufferedLoggerSpec -> Logger
bufferedLoggerSpecLogger :: Logger
    -- | Buffered logs are regularly flushed from internal storage on this
    -- period (in microseconds). The default is 5 minutes.
  , BufferedLoggerSpec -> Int
bufferedLoggerSpecFlushPeriod :: Int
    -- | Max amount of time allowed for flushing buffered logs (in
    -- microseconds). The default is 10 seconds.
  , BufferedLoggerSpec -> Int
bufferedLoggerSpecFlushTimeout :: Int
    -- | Handler that is run if flushing buffered logs takes longer than
    -- 'bufferedLoggerSpecFlushTimeout'. The default is to log the timeout using
    -- 'bufferedLoggerSpecOnFlushExceptionLogger'. This may be overridden if the
    -- timeout needs to be reported or dealt with via some means other than
    -- logging. Note that if the handler throws a synchronous exception, that
    -- exception will be caught and ignored.
    --
    -- The input argument is all remaining buffered logs that were unable to
    -- be flushed within the timeout.
  , BufferedLoggerSpec -> BufferedLogs -> OnTimeout ()
bufferedLoggerSpecOnFlushTimeout
      :: BufferedLogs -> OnTimeout ()
    -- | Handler that is run if a synchronous exception is encountered during
    -- log flushing. The default is to log the exception using
    -- 'bufferedLoggerSpecOnFlushExceptionLogger'. This may be overridden if the
    -- exception needs to be reported or dealt with via some means other than
    -- logging. Note that if the handler rethrows the exception, the exception
    -- will be caught and ignored.
    --
    -- The input arguments are the specific buffered log and aggregate
    -- that encountered an exception during flushing.
  , BufferedLoggerSpec
-> BufferedLog -> BufferedLogAgg -> OnException ()
bufferedLoggerSpecOnFlushException
      :: BufferedLog -> BufferedLogAgg -> OnException ()
    -- | The 'bufferedLoggerSpecOnFlushTimeout' and
    -- 'bufferedLoggerSpecOnFlushException' handlers are run using this logger.
    -- This logger is intentionally different from 'bufferedLoggerSpecLogger',
    -- as 'bufferedLoggerSpecLogger' may have ultimately been what triggered
    -- running either handler in the first place.
  , BufferedLoggerSpec -> Logger
bufferedLoggerSpecOnFlushExceptionLogger :: Logger
    -- | The internal storage tracks a count of each buffered log message's
    -- occurrences (rather than tracking each occurrence) and each occurrence's
    -- metadata (convenience for @monad-logger-aeson@ users). This function
    -- enables including this aggregate info in the log message when it is
    -- eventually logged. The default is to not include the aggregate info.
    --
    -- @monad-logger-aeson@ users may find it convenient to set this function
    -- to @includeLogAggregateViaAeson Just@. This will include the aggregate in
    -- full. If there is a risk that a buffered log's aggregated metadata may
    -- exceed a logging system's max payload per message, 'Just' can be replaced
    -- with a function that more carefully summarizes the metadata. For example,
    -- to ignore the metadata altogether and instead only log the count of
    -- aggregated messages, the following could be used:
    --
    -- @
    -- 'includeLogAggregateViaAeson' \\bufferedLogAgg ->
    --   'Just' $ 'object' ["count" '.=' 'bufferedLogAggCount' bufferedLogAgg]
    -- @
  , BufferedLoggerSpec
-> BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
bufferedLoggerSpecIncludeLogAggregate
      :: BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
  }

defaultBufferedLoggerSpec :: BufferedLoggerSpec
defaultBufferedLoggerSpec :: BufferedLoggerSpec
defaultBufferedLoggerSpec =
  BufferedLoggerSpec
    { bufferedLoggerSpecShouldBuffer :: Loc -> Text -> LogLevel -> LogStr -> Bool
bufferedLoggerSpecShouldBuffer = \Loc
_loc Text
_logSource LogLevel
_logLevel LogStr
_logStr ->
        Bool
False
    , bufferedLoggerSpecLogger :: Logger
bufferedLoggerSpecLogger = Logger
forall a. Monoid a => a
mempty
    , bufferedLoggerSpecFlushPeriod :: Int
bufferedLoggerSpecFlushPeriod = Int
300_000_000 -- 5 minutes
    , bufferedLoggerSpecFlushTimeout :: Int
bufferedLoggerSpecFlushTimeout = Int
10_000_000 -- 10 seconds
    , bufferedLoggerSpecOnFlushTimeout :: BufferedLogs -> OnTimeout ()
bufferedLoggerSpecOnFlushTimeout = \BufferedLogs
unflushedLogs -> do
        Int
timeoutMicros <- OnTimeout Int
askTimeoutMicros
        [SeriesElem]
pairs <- OnTimeout [SeriesElem]
askTimeoutMetadata
        Message -> OnTimeout ()
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError (Message -> OnTimeout ()) -> Message -> OnTimeout ()
forall a b. (a -> b) -> a -> b
$ Text
"Flushing buffered logs took too long" Text -> [SeriesElem] -> Message
:#
          Key
"timeoutMicros" Key -> Int -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
timeoutMicros
            SeriesElem -> [SeriesElem] -> [SeriesElem]
forall a. a -> [a] -> [a]
: Key
"unflushedLogs" Key -> [Value] -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
                ((BufferedLog, BufferedLogAgg) -> Value)
-> [(BufferedLog, BufferedLogAgg)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                  ( \(BufferedLog
bufferedLog, BufferedLogAgg
bufferedLogAgg) ->
                      [Pair] -> Value
object
                        [ Key
"bufferedLog" Key -> BufferedLog -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BufferedLog
bufferedLog
                        , Key
"bufferedLogAgg" Key -> BufferedLogAgg -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BufferedLogAgg
bufferedLogAgg
                        ]
                  )
                  (BufferedLogs -> [(BufferedLog, BufferedLogAgg)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList BufferedLogs
unflushedLogs)
            SeriesElem -> [SeriesElem] -> [SeriesElem]
forall a. a -> [a] -> [a]
: [SeriesElem]
pairs
    , bufferedLoggerSpecOnFlushException :: BufferedLog -> BufferedLogAgg -> OnException ()
bufferedLoggerSpecOnFlushException = \BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg -> do
        SomeException e
ex <- OnException SomeException
askException
        [SeriesElem]
pairs <- OnException [SeriesElem]
askExceptionMetadata
        Message -> OnException ()
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError (Message -> OnException ()) -> Message -> OnException ()
forall a b. (a -> b) -> a -> b
$ Text
"Ignoring exception from flushing buffered log" Text -> [SeriesElem] -> Message
:#
          Key
"exception" Key -> String -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= e -> String
forall e. Exception e => e -> String
displayException e
ex
            SeriesElem -> [SeriesElem] -> [SeriesElem]
forall a. a -> [a] -> [a]
: Key
"bufferedLog" Key -> BufferedLog -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BufferedLog
bufferedLog
            SeriesElem -> [SeriesElem] -> [SeriesElem]
forall a. a -> [a] -> [a]
: Key
"bufferedLogAgg" Key -> BufferedLogAgg -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BufferedLogAgg
bufferedLogAgg
            SeriesElem -> [SeriesElem] -> [SeriesElem]
forall a. a -> [a] -> [a]
: [SeriesElem]
pairs
    , bufferedLoggerSpecOnFlushExceptionLogger :: Logger
bufferedLoggerSpecOnFlushExceptionLogger = Logger
forall a. Monoid a => a
mempty
    , bufferedLoggerSpecIncludeLogAggregate :: BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
bufferedLoggerSpecIncludeLogAggregate =
        (BufferedLogAgg -> Maybe BufferedLogAgg)
-> BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
forall a.
ToJSON a =>
(BufferedLogAgg -> Maybe a)
-> BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
includeLogAggregateViaAeson ((BufferedLogAgg -> Maybe BufferedLogAgg)
 -> BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr)
-> (BufferedLogAgg -> Maybe BufferedLogAgg)
-> BufferedLog
-> BufferedLogAgg
-> [SeriesElem]
-> LogStr
forall a b. (a -> b) -> a -> b
$ Maybe BufferedLogAgg -> BufferedLogAgg -> Maybe BufferedLogAgg
forall a b. a -> b -> a
const (Maybe BufferedLogAgg -> BufferedLogAgg -> Maybe BufferedLogAgg)
-> Maybe BufferedLogAgg -> BufferedLogAgg -> Maybe BufferedLogAgg
forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing @BufferedLogAgg
    }

includeLogAggregateViaAeson
  :: forall a
   . (ToJSON a)
  => (BufferedLogAgg -> Maybe a) -- ^ Summarizes the aggregated info
  -> BufferedLog
  -> BufferedLogAgg
  -> [SeriesElem]
  -> LogStr
includeLogAggregateViaAeson :: forall a.
ToJSON a =>
(BufferedLogAgg -> Maybe a)
-> BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
includeLogAggregateViaAeson BufferedLogAgg -> Maybe a
summarizeAgg BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg [SeriesElem]
pairs =
  case Either ByteString Text
logStrBytesOrMsgText of
    Left ByteString
logStrBytes -> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr ByteString
logStrBytes
    Right Text
msgText ->
      Message -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Message -> LogStr) -> Message -> LogStr
forall a b. (a -> b) -> a -> b
$ Text
msgText Text -> [SeriesElem] -> Message
:#
        Key
"bufferedLogAgg" Key -> Maybe a -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= BufferedLogAgg -> Maybe a
summarizeAgg BufferedLogAgg
bufferedLogAgg SeriesElem -> [SeriesElem] -> [SeriesElem]
forall a. a -> [a] -> [a]
: [SeriesElem]
pairs
  where
  BufferedLog
    { bufferedLogLogStr :: BufferedLog -> Either ByteString Text
bufferedLogLogStr = Either ByteString Text
logStrBytesOrMsgText
    } = BufferedLog
bufferedLog

withBufferedLogger
  :: forall m a
   . (MonadUnliftIO m)
  => BufferedLoggerSpec
  -> (Logger -> m a)
  -> m a
withBufferedLogger :: forall (m :: * -> *) a.
MonadUnliftIO m =>
BufferedLoggerSpec -> (Logger -> m a) -> m a
withBufferedLogger BufferedLoggerSpec
bufferedLoggerSpec Logger -> m a
action =
  ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
runInIO ->
    BufferedLoggerSpec -> (Logger -> IO a) -> IO a
forall a. BufferedLoggerSpec -> (Logger -> IO a) -> IO a
withBufferedLoggerIO BufferedLoggerSpec
bufferedLoggerSpec (m a -> IO a
forall a. m a -> IO a
runInIO (m a -> IO a) -> (Logger -> m a) -> Logger -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> m a
action)

withBufferedLoggerIO
  :: forall a
   . BufferedLoggerSpec
  -> (Logger -> IO a)
  -> IO a
withBufferedLoggerIO :: forall a. BufferedLoggerSpec -> (Logger -> IO a) -> IO a
withBufferedLoggerIO BufferedLoggerSpec
bufferedLoggerSpec Logger -> IO a
action = do
  IORef BufferedLogs
bufferedLogsRef <- BufferedLogs -> IO (IORef BufferedLogs)
forall a. a -> IO (IORef a)
IORef.newIORef BufferedLogs
forall a. Monoid a => a
mempty
  IO () -> (Async () -> IO a) -> IO a
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (IORef BufferedLogs -> IO ()
mkWorker IORef BufferedLogs
bufferedLogsRef) ((Async () -> IO a) -> IO a) -> (Async () -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> Async () -> IO a
forall a b. a -> b -> a
const do
    Logger -> IO a
action (IORef BufferedLogs -> Logger
logger' IORef BufferedLogs
bufferedLogsRef) IO a -> IO () -> IO a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`finally` IORef BufferedLogs -> IO ()
flush IORef BufferedLogs
bufferedLogsRef
  where
  logger'
    :: IORef BufferedLogs
    -> Loc
    -> LogSource
    -> LogLevel
    -> LogStr
    -> IO ()
  logger' :: IORef BufferedLogs -> Logger
logger' IORef BufferedLogs
bufferedLogsRef Loc
loc Text
logSource LogLevel
logLevel LogStr
logStr = do
    if Loc -> Text -> LogLevel -> LogStr -> Bool
shouldBuffer Loc
loc Text
logSource LogLevel
logLevel LogStr
logStr then do
      (BufferedLog -> KeyMap Value -> IO ())
-> (BufferedLog, KeyMap Value) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (IORef BufferedLogs -> BufferedLog -> KeyMap Value -> IO ()
buffer IORef BufferedLogs
bufferedLogsRef) ((BufferedLog, KeyMap Value) -> IO ())
-> (BufferedLog, KeyMap Value) -> IO ()
forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> LogStr -> (BufferedLog, KeyMap Value)
toBufferedLog Loc
loc Text
logSource LogLevel
logLevel LogStr
logStr
    else do
      Logger
logger Loc
loc Text
logSource LogLevel
logLevel LogStr
logStr

  mkWorker :: IORef BufferedLogs -> IO ()
  mkWorker :: IORef BufferedLogs -> IO ()
mkWorker IORef BufferedLogs
bufferedLogsRef = do
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
Monad.forever do
      Int -> IO ()
Concurrent.threadDelay Int
period
      IORef BufferedLogs -> IO ()
flush IORef BufferedLogs
bufferedLogsRef

  buffer :: IORef BufferedLogs -> BufferedLog -> KeyMap Value -> IO ()
  buffer :: IORef BufferedLogs -> BufferedLog -> KeyMap Value -> IO ()
buffer IORef BufferedLogs
bufferedLogsRef BufferedLog
bufferedLog KeyMap Value
meta = do
    IORef BufferedLogs -> (BufferedLogs -> (BufferedLogs, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef BufferedLogs
bufferedLogsRef \BufferedLogs
bufferedLogs ->
      (BufferedLog -> KeyMap Value -> BufferedLogs -> BufferedLogs
insertBufferedLog BufferedLog
bufferedLog KeyMap Value
meta BufferedLogs
bufferedLogs, ())

  flush :: IORef BufferedLogs -> IO ()
  flush :: IORef BufferedLogs -> IO ()
flush IORef BufferedLogs
bufferedLogsRef = do
    IORef BufferedLogs
flushedLogsRef <- BufferedLogs -> IO (IORef BufferedLogs)
forall a. a -> IO (IORef a)
IORef.newIORef BufferedLogs
forall a. Monoid a => a
mempty
    BufferedLogs
bufferedLogs <- IORef BufferedLogs
-> (BufferedLogs -> (BufferedLogs, BufferedLogs))
-> IO BufferedLogs
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef BufferedLogs
bufferedLogsRef (BufferedLogs
forall a. Monoid a => a
mempty,)
    (LoggingT IO () -> Logger -> IO ())
-> Logger -> LoggingT IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO () -> Logger -> IO ()
forall (m :: * -> *) a. LoggingT m a -> Logger -> m a
runLoggingT Logger
onFlushExLogger do
      Maybe ()
mResult <- ((forall a. LoggingT IO a -> IO a) -> IO (Maybe ()))
-> LoggingT IO (Maybe ())
forall b.
((forall a. LoggingT IO a -> IO a) -> IO b) -> LoggingT IO b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. LoggingT IO a -> IO a
runInIO -> do
        Int -> IO () -> IO (Maybe ())
forall a. Int -> IO a -> IO (Maybe a)
Timeout.timeout Int
timeoutMicros (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ LoggingT IO () -> IO ()
forall a. LoggingT IO a -> IO a
runInIO do
          [(BufferedLog, BufferedLogAgg)]
-> ((BufferedLog, BufferedLogAgg) -> LoggingT IO ())
-> LoggingT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
Foldable.for_ (BufferedLogs -> [(BufferedLog, BufferedLogAgg)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList BufferedLogs
bufferedLogs) \(BufferedLog
bufferedLog, BufferedLogAgg
bufferedLogAgg) -> do
            IO () -> LoggingT IO ()
forall a. IO a -> LoggingT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef BufferedLogs -> BufferedLog -> BufferedLogAgg -> IO ()
flushElem IORef BufferedLogs
flushedLogsRef BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg) LoggingT IO ()
-> (SomeException -> LoggingT IO ()) -> LoggingT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
someEx -> do
              OnException () -> SomeException -> [SeriesElem] -> LoggingT IO ()
forall a.
OnException a -> SomeException -> [SeriesElem] -> LoggingT IO a
runOnException (BufferedLog -> BufferedLogAgg -> OnException ()
onFlushEx BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg) SomeException
someEx [SeriesElem]
loggingMeta LoggingT IO ()
-> (SomeException -> LoggingT IO ()) -> LoggingT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
_ ->
                -- If the custom handler throws a synchronous exception, we
                -- ignore it, as we don't want to kill the async worker.
                () -> LoggingT IO ()
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      BufferedLogs
flushedLogElems <- IO BufferedLogs -> LoggingT IO BufferedLogs
forall a. IO a -> LoggingT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BufferedLogs -> LoggingT IO BufferedLogs)
-> IO BufferedLogs -> LoggingT IO BufferedLogs
forall a b. (a -> b) -> a -> b
$ IORef BufferedLogs -> IO BufferedLogs
forall a. IORef a -> IO a
IORef.readIORef IORef BufferedLogs
flushedLogsRef
      let unflushedLogs :: BufferedLogs
unflushedLogs = BufferedLogs
bufferedLogs BufferedLogs -> BufferedLogs -> BufferedLogs
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
`HashMap.difference` BufferedLogs
flushedLogElems
      case Maybe ()
mResult of
        Just () -> () -> LoggingT IO ()
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Maybe ()
Nothing ->
          OnTimeout () -> Int -> [SeriesElem] -> LoggingT IO ()
forall a. OnTimeout a -> Int -> [SeriesElem] -> LoggingT IO a
runOnTimeout (BufferedLogs -> OnTimeout ()
onFlushTimeout BufferedLogs
unflushedLogs) Int
timeoutMicros [SeriesElem]
loggingMeta LoggingT IO ()
-> (SomeException -> LoggingT IO ()) -> LoggingT IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
_ ->
            -- If the custom handler throws a synchronous exception, we ignore
            -- it, as we don't want to kill the async worker.
            () -> LoggingT IO ()
forall a. a -> LoggingT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  flushElem :: IORef BufferedLogs -> BufferedLog -> BufferedLogAgg -> IO ()
  flushElem :: IORef BufferedLogs -> BufferedLog -> BufferedLogAgg -> IO ()
flushElem IORef BufferedLogs
flushedLogsRef BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg = do
    Logger
logger Loc
loc Text
logSource LogLevel
logLevel (LogStr -> IO ()) -> LogStr -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
includeLogAgg BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg [SeriesElem]
loggingMeta
    IORef BufferedLogs -> (BufferedLogs -> (BufferedLogs, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef BufferedLogs
flushedLogsRef \BufferedLogs
flushedLogs ->
      (BufferedLog -> BufferedLogAgg -> BufferedLogs -> BufferedLogs
insertBufferedLogWithAgg BufferedLog
bufferedLog BufferedLogAgg
bufferedLogAgg BufferedLogs
flushedLogs, ())
    where
    BufferedLog
      { bufferedLogLoc :: BufferedLog -> Loc
bufferedLogLoc = Loc
loc
      , bufferedLogLogSource :: BufferedLog -> Text
bufferedLogLogSource = Text
logSource
      , bufferedLogLogLevel :: BufferedLog -> LogLevel
bufferedLogLogLevel = LogLevel
logLevel
      } = BufferedLog
bufferedLog

  loggingMeta :: [SeriesElem]
  loggingMeta :: [SeriesElem]
loggingMeta =
    [ Key
"bufferedLogger" Key -> Value -> SeriesElem
forall v. ToJSON v => Key -> v -> SeriesElem
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
        [ Key
"flushPeriod" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
period
        , Key
"flushTimeout" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
timeoutMicros
        ]
    ]

  BufferedLoggerSpec
    { bufferedLoggerSpecShouldBuffer :: BufferedLoggerSpec -> Loc -> Text -> LogLevel -> LogStr -> Bool
bufferedLoggerSpecShouldBuffer = Loc -> Text -> LogLevel -> LogStr -> Bool
shouldBuffer
    , bufferedLoggerSpecLogger :: BufferedLoggerSpec -> Logger
bufferedLoggerSpecLogger = Logger
logger
    , bufferedLoggerSpecFlushPeriod :: BufferedLoggerSpec -> Int
bufferedLoggerSpecFlushPeriod = Int
period
    , bufferedLoggerSpecFlushTimeout :: BufferedLoggerSpec -> Int
bufferedLoggerSpecFlushTimeout = Int
timeoutMicros
    , bufferedLoggerSpecOnFlushTimeout :: BufferedLoggerSpec -> BufferedLogs -> OnTimeout ()
bufferedLoggerSpecOnFlushTimeout = BufferedLogs -> OnTimeout ()
onFlushTimeout
    , bufferedLoggerSpecOnFlushException :: BufferedLoggerSpec
-> BufferedLog -> BufferedLogAgg -> OnException ()
bufferedLoggerSpecOnFlushException = BufferedLog -> BufferedLogAgg -> OnException ()
onFlushEx
    , bufferedLoggerSpecOnFlushExceptionLogger :: BufferedLoggerSpec -> Logger
bufferedLoggerSpecOnFlushExceptionLogger = Logger
onFlushExLogger
    , bufferedLoggerSpecIncludeLogAggregate :: BufferedLoggerSpec
-> BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
bufferedLoggerSpecIncludeLogAggregate = BufferedLog -> BufferedLogAgg -> [SeriesElem] -> LogStr
includeLogAgg
    } = BufferedLoggerSpec
bufferedLoggerSpec

type BufferedLogs = HashMap BufferedLog BufferedLogAgg

insertBufferedLog
  :: BufferedLog
  -> KeyMap Value
  -> BufferedLogs
  -> BufferedLogs
insertBufferedLog :: BufferedLog -> KeyMap Value -> BufferedLogs -> BufferedLogs
insertBufferedLog BufferedLog
bufferedLog KeyMap Value
meta =
  BufferedLog -> BufferedLogAgg -> BufferedLogs -> BufferedLogs
insertBufferedLogWithAgg BufferedLog
bufferedLog
    BufferedLogAgg
      { bufferedLogAggCount :: Int
bufferedLogAggCount = Int
1
      , bufferedLogAggMetas :: DList (KeyMap Value)
bufferedLogAggMetas =
          if KeyMap Value -> Bool
forall a. KeyMap a -> Bool
Aeson.KeyMap.null KeyMap Value
meta then
            DList (KeyMap Value)
forall a. Monoid a => a
mempty
          else
            KeyMap Value -> DList (KeyMap Value)
forall a. a -> DList a
DList.singleton KeyMap Value
meta
      }

insertBufferedLogWithAgg
  :: BufferedLog
  -> BufferedLogAgg
  -> BufferedLogs
  -> BufferedLogs
insertBufferedLogWithAgg :: BufferedLog -> BufferedLogAgg -> BufferedLogs -> BufferedLogs
insertBufferedLogWithAgg = (BufferedLogAgg -> BufferedLogAgg -> BufferedLogAgg)
-> BufferedLog -> BufferedLogAgg -> BufferedLogs -> BufferedLogs
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith BufferedLogAgg -> BufferedLogAgg -> BufferedLogAgg
forall a. Semigroup a => a -> a -> a
(<>)

data BufferedLog = BufferedLog
  { BufferedLog -> Loc
bufferedLogLoc :: Loc
  , BufferedLog -> Text
bufferedLogLogSource :: LogSource
  , BufferedLog -> LogLevel
bufferedLogLogLevel :: LogLevel
    -- | 'Right' when the log message was parsed as a 'Message', 'Left'
    -- otherwise.
  , BufferedLog -> Either ByteString Text
bufferedLogLogStr :: Either ByteString Text
  } deriving stock (BufferedLog -> BufferedLog -> Bool
(BufferedLog -> BufferedLog -> Bool)
-> (BufferedLog -> BufferedLog -> Bool) -> Eq BufferedLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferedLog -> BufferedLog -> Bool
== :: BufferedLog -> BufferedLog -> Bool
$c/= :: BufferedLog -> BufferedLog -> Bool
/= :: BufferedLog -> BufferedLog -> Bool
Eq)

instance Hashable BufferedLog where
  hashWithSalt :: Int -> BufferedLog -> Int
hashWithSalt Int
salt BufferedLog
bufferedLog =
    Int
salt
      Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
loc_filename
      Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
loc_package
      Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
loc_module
      Int -> CharPos -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` CharPos
loc_start
      Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Text
logSource
      Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` LogLevel -> String
forall a. Show a => a -> String
show LogLevel
logLevel
      Int -> Either ByteString Text -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Either ByteString Text
logStrBytesOrMsgText
    where
    BufferedLog
      { bufferedLogLoc :: BufferedLog -> Loc
bufferedLogLoc =
          Loc { String
loc_filename :: String
loc_filename :: Loc -> String
loc_filename, String
loc_package :: String
loc_package :: Loc -> String
loc_package, String
loc_module :: String
loc_module :: Loc -> String
loc_module, CharPos
loc_start :: CharPos
loc_start :: Loc -> CharPos
loc_start }
      , bufferedLogLogSource :: BufferedLog -> Text
bufferedLogLogSource = Text
logSource
      , bufferedLogLogLevel :: BufferedLog -> LogLevel
bufferedLogLogLevel = LogLevel
logLevel
      , bufferedLogLogStr :: BufferedLog -> Either ByteString Text
bufferedLogLogStr = Either ByteString Text
logStrBytesOrMsgText
      } = BufferedLog
bufferedLog

instance ToJSON BufferedLog where
  toJSON :: BufferedLog -> Value
toJSON BufferedLog
bufferedLog =
    [Pair] -> Value
object
      [ Key
"loc" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
          [Pair] -> Value
object
            [ Key
"package" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
loc_package
            , Key
"module" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
loc_module
            , Key
"file" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
loc_filename
            , Key
"line" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CharPos -> Int
forall a b. (a, b) -> a
fst CharPos
loc_start
            , Key
"char" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CharPos -> Int
forall a b. (a, b) -> b
snd CharPos
loc_start
            ]
      , Key
"source" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
logSource
      , Key
"level" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
          case LogLevel
logLevel of
            LogLevel
LevelDebug -> Text
"debug"
            LogLevel
LevelInfo -> Text
"info"
            LogLevel
LevelWarn -> Text
"warn"
            LogLevel
LevelError -> Text
"error"
            LevelOther Text
otherLevel -> Text
otherLevel
      , Key
"text" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=
          case Either ByteString Text
logStrBytesOrMsgText of
            Left ByteString
logStrBytes ->
              case ByteString -> Either UnicodeException Text
Text.Encoding.decodeUtf8' ByteString
logStrBytes of
                Left UnicodeException
_unicodeEx -> Text
"Log message could not be decoded via UTF-8"
                Right Text
text -> Text
text
            Right Text
msgText -> Text
msgText
      ]
    where
    BufferedLog
      { bufferedLogLoc :: BufferedLog -> Loc
bufferedLogLoc =
          Loc { String
loc_filename :: Loc -> String
loc_filename :: String
loc_filename, String
loc_package :: Loc -> String
loc_package :: String
loc_package, String
loc_module :: Loc -> String
loc_module :: String
loc_module, CharPos
loc_start :: Loc -> CharPos
loc_start :: CharPos
loc_start }
      , bufferedLogLogSource :: BufferedLog -> Text
bufferedLogLogSource = Text
logSource
      , bufferedLogLogLevel :: BufferedLog -> LogLevel
bufferedLogLogLevel = LogLevel
logLevel
      , bufferedLogLogStr :: BufferedLog -> Either ByteString Text
bufferedLogLogStr = Either ByteString Text
logStrBytesOrMsgText
      } = BufferedLog
bufferedLog

toBufferedLog
  :: Loc
  -> LogSource
  -> LogLevel
  -> LogStr
  -> (BufferedLog, KeyMap Value)
toBufferedLog :: Loc -> Text -> LogLevel -> LogStr -> (BufferedLog, KeyMap Value)
toBufferedLog Loc
loc Text
logSource LogLevel
logLevel LogStr
logStr =
  ( BufferedLog
      { bufferedLogLoc :: Loc
bufferedLogLoc = Loc
loc
      , bufferedLogLogSource :: Text
bufferedLogLogSource = Text
logSource
      , bufferedLogLogLevel :: LogLevel
bufferedLogLogLevel = LogLevel
logLevel
      , Either ByteString Text
bufferedLogLogStr :: Either ByteString Text
bufferedLogLogStr :: Either ByteString Text
bufferedLogLogStr
      }
  , KeyMap Value
meta
  )
  where
  (Either ByteString Text
bufferedLogLogStr, KeyMap Value
meta) =
    case (Value -> Parser (Text, KeyMap Value))
-> ByteString -> Maybe (Text, KeyMap Value)
forall a. (Value -> Parser a) -> ByteString -> Maybe a
runAesonParser Value -> Parser (Text, KeyMap Value)
parseMessage ByteString
logStrBytes of
      Maybe (Text, KeyMap Value)
Nothing -> (ByteString -> Either ByteString Text
forall a b. a -> Either a b
Left ByteString
logStrBytes, KeyMap Value
forall a. Monoid a => a
mempty)
      Just (Text
text, KeyMap Value
keyMap) -> (Text -> Either ByteString Text
forall a b. b -> Either a b
Right Text
text, KeyMap Value
keyMap)

  logStrBytes :: ByteString
logStrBytes = LogStr -> ByteString
fromLogStr LogStr
logStr

  parseMessage :: Value -> Parser (Text, KeyMap Value)
  parseMessage :: Value -> Parser (Text, KeyMap Value)
parseMessage = String
-> (KeyMap Value -> Parser (Text, KeyMap Value))
-> Value
-> Parser (Text, KeyMap Value)
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Message" \KeyMap Value
obj ->
    (,) (Text -> KeyMap Value -> (Text, KeyMap Value))
-> Parser Text -> Parser (KeyMap Value -> (Text, KeyMap Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value
obj KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"text" Parser (KeyMap Value -> (Text, KeyMap Value))
-> Parser (KeyMap Value) -> Parser (Text, KeyMap Value)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Value -> Parser (KeyMap Value)
parsePairs (Maybe Value -> Parser (KeyMap Value))
-> Parser (Maybe Value) -> Parser (KeyMap Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KeyMap Value
obj KeyMap Value -> Key -> Parser (Maybe Value)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"meta")

  parsePairs :: Maybe Value -> Parser (KeyMap Value)
  parsePairs :: Maybe Value -> Parser (KeyMap Value)
parsePairs = \case
    Maybe Value
Nothing -> KeyMap Value -> Parser (KeyMap Value)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
forall a. Monoid a => a
mempty
    Just Value
value -> ((KeyMap Value -> Parser (KeyMap Value))
 -> Value -> Parser (KeyMap Value))
-> Value
-> (KeyMap Value -> Parser (KeyMap Value))
-> Parser (KeyMap Value)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String
-> (KeyMap Value -> Parser (KeyMap Value))
-> Value
-> Parser (KeyMap Value)
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
Aeson.withObject String
"[Pair]") Value
value \KeyMap Value
obj -> do
      KeyMap Value -> Parser (KeyMap Value)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMap Value
obj

  runAesonParser :: (Value -> Parser a) -> ByteString -> Maybe a
  runAesonParser :: forall a. (Value -> Parser a) -> ByteString -> Maybe a
runAesonParser Value -> Parser a
parser =
    Parser Value -> (Value -> Result a) -> ByteString -> Maybe a
forall a.
Parser Value -> (Value -> Result a) -> ByteString -> Maybe a
Aeson.Parser.decodeStrictWith Parser Value
Aeson.Parser.json' ((Value -> Parser a) -> Value -> Result a
forall a b. (a -> Parser b) -> a -> Result b
Aeson.Types.parse Value -> Parser a
parser)

data BufferedLogAgg = BufferedLogAgg
  { BufferedLogAgg -> Int
bufferedLogAggCount :: Int
  , BufferedLogAgg -> DList (KeyMap Value)
bufferedLogAggMetas :: DList (KeyMap Value)
  } deriving stock (BufferedLogAgg -> BufferedLogAgg -> Bool
(BufferedLogAgg -> BufferedLogAgg -> Bool)
-> (BufferedLogAgg -> BufferedLogAgg -> Bool) -> Eq BufferedLogAgg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BufferedLogAgg -> BufferedLogAgg -> Bool
== :: BufferedLogAgg -> BufferedLogAgg -> Bool
$c/= :: BufferedLogAgg -> BufferedLogAgg -> Bool
/= :: BufferedLogAgg -> BufferedLogAgg -> Bool
Eq)

instance Semigroup BufferedLogAgg where
  <> :: BufferedLogAgg -> BufferedLogAgg -> BufferedLogAgg
(<>) BufferedLogAgg
x BufferedLogAgg
y =
    BufferedLogAgg
      { bufferedLogAggCount :: Int
bufferedLogAggCount = BufferedLogAgg -> Int
bufferedLogAggCount BufferedLogAgg
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ BufferedLogAgg -> Int
bufferedLogAggCount BufferedLogAgg
y
      , bufferedLogAggMetas :: DList (KeyMap Value)
bufferedLogAggMetas = BufferedLogAgg -> DList (KeyMap Value)
bufferedLogAggMetas BufferedLogAgg
x DList (KeyMap Value)
-> DList (KeyMap Value) -> DList (KeyMap Value)
forall a. Semigroup a => a -> a -> a
<> BufferedLogAgg -> DList (KeyMap Value)
bufferedLogAggMetas BufferedLogAgg
y
      }

instance ToJSON BufferedLogAgg where
  toJSON :: BufferedLogAgg -> Value
toJSON BufferedLogAgg
bufferedLogAgg =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Key
"count" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
count
      Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Key
"metas" Key -> [KeyMap Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DList (KeyMap Value) -> [KeyMap Value]
forall a. DList a -> [a]
DList.toList DList (KeyMap Value)
metas | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DList (KeyMap Value) -> Bool
forall a. DList a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null DList (KeyMap Value)
metas]
    where
    BufferedLogAgg
      { bufferedLogAggCount :: BufferedLogAgg -> Int
bufferedLogAggCount = Int
count
      , bufferedLogAggMetas :: BufferedLogAgg -> DList (KeyMap Value)
bufferedLogAggMetas = DList (KeyMap Value)
metas
      } = BufferedLogAgg
bufferedLogAgg

type Logger = Loc -> LogSource -> LogLevel -> LogStr -> IO ()

-- $disclaimer
--
-- In general, changes to this module will not be reflected in the library's
-- version updates. Direct use of this module should be done with utmost care,
-- otherwise invariants will easily be violated.