{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Control.Monad.Freer.Extras.Beam.Common where import Cardano.BM.Data.Tracer (ToObject (..)) import Control.Exception (Exception) import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Database.Beam (Beamable, QBaseScope) import Database.Beam.Backend (BeamSqlBackendCanSerialize) import Database.Beam.Query.Internal (QNested) import Database.Beam.Schema.Tables (FieldsFulfillConstraint) import GHC.Generics (Generic) import Prettyprinter (Pretty (..), colon, (<+>)) type BeamableDb db table = (Beamable table, FieldsFulfillConstraint (BeamSqlBackendCanSerialize db) table) type BeamThreadingArg = QNested (QNested QBaseScope) newtype BeamError = SqlError Text deriving stock (BeamError -> BeamError -> Bool (BeamError -> BeamError -> Bool) -> (BeamError -> BeamError -> Bool) -> Eq BeamError forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: BeamError -> BeamError -> Bool $c/= :: BeamError -> BeamError -> Bool == :: BeamError -> BeamError -> Bool $c== :: BeamError -> BeamError -> Bool Eq, Int -> BeamError -> ShowS [BeamError] -> ShowS BeamError -> String (Int -> BeamError -> ShowS) -> (BeamError -> String) -> ([BeamError] -> ShowS) -> Show BeamError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [BeamError] -> ShowS $cshowList :: [BeamError] -> ShowS show :: BeamError -> String $cshow :: BeamError -> String showsPrec :: Int -> BeamError -> ShowS $cshowsPrec :: Int -> BeamError -> ShowS Show, (forall x. BeamError -> Rep BeamError x) -> (forall x. Rep BeamError x -> BeamError) -> Generic BeamError forall x. Rep BeamError x -> BeamError forall x. BeamError -> Rep BeamError x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep BeamError x -> BeamError $cfrom :: forall x. BeamError -> Rep BeamError x Generic) deriving anyclass (Value -> Parser [BeamError] Value -> Parser BeamError (Value -> Parser BeamError) -> (Value -> Parser [BeamError]) -> FromJSON BeamError forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [BeamError] $cparseJSONList :: Value -> Parser [BeamError] parseJSON :: Value -> Parser BeamError $cparseJSON :: Value -> Parser BeamError FromJSON, [BeamError] -> Encoding [BeamError] -> Value BeamError -> Encoding BeamError -> Value (BeamError -> Value) -> (BeamError -> Encoding) -> ([BeamError] -> Value) -> ([BeamError] -> Encoding) -> ToJSON BeamError forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [BeamError] -> Encoding $ctoEncodingList :: [BeamError] -> Encoding toJSONList :: [BeamError] -> Value $ctoJSONList :: [BeamError] -> Value toEncoding :: BeamError -> Encoding $ctoEncoding :: BeamError -> Encoding toJSON :: BeamError -> Value $ctoJSON :: BeamError -> Value ToJSON, TracingVerbosity -> BeamError -> Object BeamError -> Object -> Text (TracingVerbosity -> BeamError -> Object) -> (BeamError -> Object -> Text) -> ToObject BeamError forall a. (TracingVerbosity -> a -> Object) -> (a -> Object -> Text) -> ToObject a textTransformer :: BeamError -> Object -> Text $ctextTransformer :: BeamError -> Object -> Text toObject :: TracingVerbosity -> BeamError -> Object $ctoObject :: TracingVerbosity -> BeamError -> Object ToObject) instance Exception BeamError instance Pretty BeamError where pretty :: BeamError -> Doc ann pretty = \case SqlError Text s -> Doc ann "SqlError (via Beam)" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann colon Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Text s newtype BeamLog = SqlLog String deriving stock (BeamLog -> BeamLog -> Bool (BeamLog -> BeamLog -> Bool) -> (BeamLog -> BeamLog -> Bool) -> Eq BeamLog forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: BeamLog -> BeamLog -> Bool $c/= :: BeamLog -> BeamLog -> Bool == :: BeamLog -> BeamLog -> Bool $c== :: BeamLog -> BeamLog -> Bool Eq, Int -> BeamLog -> ShowS [BeamLog] -> ShowS BeamLog -> String (Int -> BeamLog -> ShowS) -> (BeamLog -> String) -> ([BeamLog] -> ShowS) -> Show BeamLog forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [BeamLog] -> ShowS $cshowList :: [BeamLog] -> ShowS show :: BeamLog -> String $cshow :: BeamLog -> String showsPrec :: Int -> BeamLog -> ShowS $cshowsPrec :: Int -> BeamLog -> ShowS Show, (forall x. BeamLog -> Rep BeamLog x) -> (forall x. Rep BeamLog x -> BeamLog) -> Generic BeamLog forall x. Rep BeamLog x -> BeamLog forall x. BeamLog -> Rep BeamLog x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep BeamLog x -> BeamLog $cfrom :: forall x. BeamLog -> Rep BeamLog x Generic) deriving anyclass (Value -> Parser [BeamLog] Value -> Parser BeamLog (Value -> Parser BeamLog) -> (Value -> Parser [BeamLog]) -> FromJSON BeamLog forall a. (Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a parseJSONList :: Value -> Parser [BeamLog] $cparseJSONList :: Value -> Parser [BeamLog] parseJSON :: Value -> Parser BeamLog $cparseJSON :: Value -> Parser BeamLog FromJSON, [BeamLog] -> Encoding [BeamLog] -> Value BeamLog -> Encoding BeamLog -> Value (BeamLog -> Value) -> (BeamLog -> Encoding) -> ([BeamLog] -> Value) -> ([BeamLog] -> Encoding) -> ToJSON BeamLog forall a. (a -> Value) -> (a -> Encoding) -> ([a] -> Value) -> ([a] -> Encoding) -> ToJSON a toEncodingList :: [BeamLog] -> Encoding $ctoEncodingList :: [BeamLog] -> Encoding toJSONList :: [BeamLog] -> Value $ctoJSONList :: [BeamLog] -> Value toEncoding :: BeamLog -> Encoding $ctoEncoding :: BeamLog -> Encoding toJSON :: BeamLog -> Value $ctoJSON :: BeamLog -> Value ToJSON, TracingVerbosity -> BeamLog -> Object BeamLog -> Object -> Text (TracingVerbosity -> BeamLog -> Object) -> (BeamLog -> Object -> Text) -> ToObject BeamLog forall a. (TracingVerbosity -> a -> Object) -> (a -> Object -> Text) -> ToObject a textTransformer :: BeamLog -> Object -> Text $ctextTransformer :: BeamLog -> Object -> Text toObject :: TracingVerbosity -> BeamLog -> Object $ctoObject :: TracingVerbosity -> BeamLog -> Object ToObject) instance Pretty BeamLog where pretty :: BeamLog -> Doc ann pretty = \case SqlLog String s -> Doc ann "SqlLog" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann colon Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty String s