module PostgreSQL.Binary.Prelude
( 
  module Exports,
  LazyByteString,
  ByteStringBuilder,
  LazyText,
  TextBuilder,
  bug,
  bottom,
  mapLeft,
  joinMap,
)
where


-- base-prelude
-------------------------
import BasePrelude as Exports hiding (assert, Data, fail)

-- transformers
-------------------------
import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch)
import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)
import Control.Monad.Trans.Class as Exports
import Data.Functor.Identity as Exports

-- bytestring
-------------------------
import Data.ByteString as Exports (ByteString)

-- text
-------------------------
import Data.Text as Exports (Text)

-- vector
-------------------------
import Data.Vector as Exports (Vector)

-- scientific
-------------------------
import Data.Scientific as Exports (Scientific)

-- uuid
-------------------------
import Data.UUID as Exports (UUID)

-- time
-------------------------
import Data.Time as Exports

-- unordered-containers
-------------------------
import Data.HashMap.Strict as Exports (HashMap)

-- containers
-------------------------
import Data.Map.Strict as Exports (Map)

-- placeholders
-------------------------
import Development.Placeholders as Exports

-- loch-th
-------------------------
import Debug.Trace.LocationTH as Exports

-- custom
-------------------------
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Builder
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified Debug.Trace.LocationTH


type LazyByteString =
  Data.ByteString.Lazy.ByteString

type ByteStringBuilder =
  Data.ByteString.Builder.Builder

type LazyText =
  Data.Text.Lazy.Text

type TextBuilder =
  Data.Text.Lazy.Builder.Builder


bug :: ExpQ
bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]
  where
    msg :: String
msg = String
"A \"postgresql-binary\" package bug: " :: String

bottom :: ExpQ
bottom = [e| $bug "Bottom evaluated" |]

{-# INLINE mapLeft #-}
mapLeft :: (a -> b) -> Either a x -> Either b x
mapLeft :: (a -> b) -> Either a x -> Either b x
mapLeft a -> b
f =
  (a -> Either b x) -> (x -> Either b x) -> Either a x -> Either b x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b x
forall a b. a -> Either a b
Left (b -> Either b x) -> (a -> b) -> a -> Either b x
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f) x -> Either b x
forall a b. b -> Either a b
Right

joinMap :: Monad m => (a -> m b) -> m a -> m b
joinMap :: (a -> m b) -> m a -> m b
joinMap a -> m b
f =
  m (m b) -> m b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m b) -> m b) -> (m a -> m (m b)) -> m a -> m b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> m b) -> m a -> m (m b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> m b
f