module Sq.Encoders
   ( Encode (..)
   , ErrEncode (..)
   , encodeRefine
   , EncodeDefault (..)
   , encodeMaybe
   , encodeEither
   , encodeSizedIntegral
   , encodeBinary
   , encodeShow
   , encodeAeson
   )
where

import Control.Exception.Safe qualified as Ex
import Data.Aeson qualified as Ae
import Data.Aeson.Text qualified as Ae
import Data.Bifunctor
import Data.Binary.Put qualified as Bin
import Data.Bits
import Data.Bool
import Data.ByteString qualified as B
import Data.ByteString.Builder qualified as BB
import Data.ByteString.Lazy qualified as BL
import Data.ByteString.Short qualified as BS
import Data.Coerce
import Data.Functor.Contravariant
import Data.Int
import Data.List qualified as List
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TB
import Data.Time qualified as Time
import Data.Time.Format.ISO8601 qualified as Time
import Data.Void
import Data.Word
import Database.SQLite3 qualified as S
import GHC.Float (float2Double)
import GHC.Stack
import Numeric.Natural

import Sq.Null (Null)

--------------------------------------------------------------------------------

-- | How to encode a single Haskell value of type @a@ into a SQLite value.
newtype Encode a
   = -- | Encode a value of type @a@ as 'S.SQLData'.
     --
     -- Ideally, the type @a@ should be small enough that this function always
     -- returns 'Right'. However, that can sometimes be annoying, so we allow
     -- this function to fail with 'ErrEncode' if necessary, in which case an
     -- 'Sq.ErrInput' exception will be eventually thrown while trying to bind the
     -- relevant 'Sq.Input' to a 'Statement'. Why? Because for example, not all
     -- 'String's can be safely encoded as a 'S.SQLText' seeing as some
     -- non-unicode characters will silently be lost in the conversion. So, we
     -- could either not have an 'Encode'r for 'String' at all, which would be
     -- annoying, or we could have 'ErrEncode' as we do here in order to safely
     -- deal with those obscure corner cases.
     Encode (a -> Either ErrEncode S.SQLData)
   deriving ((forall a' a. (a' -> a) -> Encode a -> Encode a')
-> (forall b a. b -> Encode b -> Encode a) -> Contravariant Encode
forall b a. b -> Encode b -> Encode a
forall a' a. (a' -> a) -> Encode a -> Encode a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall a' a. (a' -> a) -> Encode a -> Encode a'
contramap :: forall a' a. (a' -> a) -> Encode a -> Encode a'
$c>$ :: forall b a. b -> Encode b -> Encode a
>$ :: forall b a. b -> Encode b -> Encode a
Contravariant) via Op (Either ErrEncode S.SQLData)

unEncode :: Encode a -> a -> Either ErrEncode S.SQLData
unEncode :: forall a. Encode a -> a -> Either ErrEncode SQLData
unEncode = Encode a -> a -> Either ErrEncode SQLData
forall a b. Coercible a b => a -> b
coerce
{-# INLINE unEncode #-}

-- | See v'Encode'.
newtype ErrEncode = ErrEncode Ex.SomeException
   deriving stock (Int -> ErrEncode -> ShowS
[ErrEncode] -> ShowS
ErrEncode -> String
(Int -> ErrEncode -> ShowS)
-> (ErrEncode -> String)
-> ([ErrEncode] -> ShowS)
-> Show ErrEncode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ErrEncode -> ShowS
showsPrec :: Int -> ErrEncode -> ShowS
$cshow :: ErrEncode -> String
show :: ErrEncode -> String
$cshowList :: [ErrEncode] -> ShowS
showList :: [ErrEncode] -> ShowS
Show)
   deriving anyclass (Show ErrEncode
Typeable ErrEncode
(Typeable ErrEncode, Show ErrEncode) =>
(ErrEncode -> SomeException)
-> (SomeException -> Maybe ErrEncode)
-> (ErrEncode -> String)
-> Exception ErrEncode
SomeException -> Maybe ErrEncode
ErrEncode -> String
ErrEncode -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ErrEncode -> SomeException
toException :: ErrEncode -> SomeException
$cfromException :: SomeException -> Maybe ErrEncode
fromException :: SomeException -> Maybe ErrEncode
$cdisplayException :: ErrEncode -> String
displayException :: ErrEncode -> String
Ex.Exception)

--------------------------------------------------------------------------------

-- | Default way to encode a Haskell value of type @a@ into a single
-- SQLite column value.
--
-- If there there exist also a 'Sq.DecodeDefault' instance for @a@, then it
-- must roundtrip with the 'Sq.EncodeDefault' instance for @a@.
class EncodeDefault a where
   -- | Default way to encode a Haskell value of type @a@ into a single
   -- SQLite column value.
   encodeDefault :: (HasCallStack) => Encode a

-- | A convenience function for refining an 'Encode'r through a function that
-- may fail with a 'String' error message. The 'CallStack' is preserved.
--
-- If you need a more sophisticated refinement, use the 'Encode' constructor.
encodeRefine
   :: (HasCallStack)
   => (a -> Either String b)
   -> Encode b
   -> Encode a
encodeRefine :: forall a b.
HasCallStack =>
(a -> Either String b) -> Encode b -> Encode a
encodeRefine a -> Either String b
f (Encode b -> Either ErrEncode SQLData
g) = (a -> Either ErrEncode SQLData) -> Encode a
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode \a
a ->
   case a -> Either String b
f a
a of
      Right b
b -> b -> Either ErrEncode SQLData
g b
b
      Left String
e -> (SomeException -> ErrEncode)
-> Either SomeException SQLData -> Either ErrEncode SQLData
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SomeException -> ErrEncode
ErrEncode (String -> Either SomeException SQLData
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
Ex.throwString String
e)

--------------------------------------------------------------------------------
-- Core encodes

-- | Literal 'S.SQLData' 'Encode'.
instance EncodeDefault S.SQLData where
   encodeDefault :: HasCallStack => Encode SQLData
encodeDefault = (SQLData -> Either ErrEncode SQLData) -> Encode SQLData
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode SQLData -> Either ErrEncode SQLData
forall a b. b -> Either a b
Right
   {-# INLINE encodeDefault #-}

-- | 'S.TextColumn'.
instance EncodeDefault T.Text where
   encodeDefault :: HasCallStack => Encode Text
encodeDefault = Text -> SQLData
S.SQLText (Text -> SQLData) -> Encode SQLData -> Encode Text
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode SQLData
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

{- TODO  avoid encoding '\000' ?

   encodeDefault = Encode \t ->
      case T.elem '\000' t of
         False -> Right $ S.SQLText t
         True ->
            first ErrEncode $
               Ex.throwString ("Invalid character " <> show '\000' <> " in " <> show t)
-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Int64 where
   encodeDefault :: HasCallStack => Encode Int64
encodeDefault = Int64 -> SQLData
S.SQLInteger (Int64 -> SQLData) -> Encode SQLData -> Encode Int64
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode SQLData
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.FloatColumn'.
instance EncodeDefault Double where
   encodeDefault :: HasCallStack => Encode Double
encodeDefault = Double -> SQLData
S.SQLFloat (Double -> SQLData) -> Encode SQLData -> Encode Double
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode SQLData
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.BlobColumn'.
instance EncodeDefault B.ByteString where
   encodeDefault :: HasCallStack => Encode ByteString
encodeDefault = ByteString -> SQLData
S.SQLBlob (ByteString -> SQLData) -> Encode SQLData -> Encode ByteString
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode SQLData
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.NullColumn'.
instance EncodeDefault Null where
   encodeDefault :: HasCallStack => Encode Null
encodeDefault = SQLData -> Null -> SQLData
forall a b. a -> b -> a
const SQLData
S.SQLNull (Null -> SQLData) -> Encode SQLData -> Encode Null
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode SQLData
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

--------------------------------------------------------------------------------
-- Extra encodes

-- | This is 'absurd'.
instance EncodeDefault Void where
   encodeDefault :: HasCallStack => Encode Void
encodeDefault = (Void -> Either ErrEncode SQLData) -> Encode Void
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode Void -> Either ErrEncode SQLData
forall a. Void -> a
absurd

-- | See 'encodeMaybe'.
instance (EncodeDefault a) => EncodeDefault (Maybe a) where
   encodeDefault :: HasCallStack => Encode (Maybe a)
encodeDefault = Encode a -> Encode (Maybe a)
forall a. Encode a -> Encode (Maybe a)
encodeMaybe Encode a
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | @a@'s 'S.ColumnType' if 'Just', otherwise 'S.NullColumn'.
encodeMaybe :: Encode a -> Encode (Maybe a)
encodeMaybe :: forall a. Encode a -> Encode (Maybe a)
encodeMaybe (Encode a -> Either ErrEncode SQLData
f) = (Maybe a -> Either ErrEncode SQLData) -> Encode (Maybe a)
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode ((Maybe a -> Either ErrEncode SQLData) -> Encode (Maybe a))
-> (Maybe a -> Either ErrEncode SQLData) -> Encode (Maybe a)
forall a b. (a -> b) -> a -> b
$ Either ErrEncode SQLData
-> (a -> Either ErrEncode SQLData)
-> Maybe a
-> Either ErrEncode SQLData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SQLData -> Either ErrEncode SQLData
forall a b. b -> Either a b
Right SQLData
S.SQLNull) a -> Either ErrEncode SQLData
f
{-# INLINE encodeMaybe #-}

-- | See 'encodeEither'.
instance
   (EncodeDefault a, EncodeDefault b)
   => EncodeDefault (Either a b)
   where
   encodeDefault :: HasCallStack => Encode (Either a b)
encodeDefault = Encode a -> Encode b -> Encode (Either a b)
forall a b. Encode a -> Encode b -> Encode (Either a b)
encodeEither Encode a
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault Encode b
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | @a@'s 'S.ColumnType' if 'Left', otherwise @b@'s 'S.ColumnType'.
encodeEither :: Encode a -> Encode b -> Encode (Either a b)
encodeEither :: forall a b. Encode a -> Encode b -> Encode (Either a b)
encodeEither (Encode a -> Either ErrEncode SQLData
fa) (Encode b -> Either ErrEncode SQLData
fb) = (Either a b -> Either ErrEncode SQLData) -> Encode (Either a b)
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode ((Either a b -> Either ErrEncode SQLData) -> Encode (Either a b))
-> (Either a b -> Either ErrEncode SQLData) -> Encode (Either a b)
forall a b. (a -> b) -> a -> b
$ (a -> Either ErrEncode SQLData)
-> (b -> Either ErrEncode SQLData)
-> Either a b
-> Either ErrEncode SQLData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either ErrEncode SQLData
fa b -> Either ErrEncode SQLData
fb
{-# INLINE encodeEither #-}

-- | 'S.IntegerColumn'. Encodes 'False' as @0@ and 'True' as @1@.
instance EncodeDefault Bool where
   encodeDefault :: HasCallStack => Encode Bool
encodeDefault = Int64 -> Int64 -> Bool -> Int64
forall a. a -> a -> Bool -> a
bool Int64
0 Int64
1 (Bool -> Int64) -> Encode Int64 -> Encode Bool
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.FloatColumn'.
instance EncodeDefault Float where
   encodeDefault :: HasCallStack => Encode Float
encodeDefault = Float -> Double
float2Double (Float -> Double) -> Encode Double -> Encode Float
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode Double
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Int8 where
   encodeDefault :: HasCallStack => Encode Int8
encodeDefault = Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int64) -> Encode Int64 -> Encode Int8
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Word8 where
   encodeDefault :: HasCallStack => Encode Word8
encodeDefault = Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int64) -> Encode Int64 -> Encode Word8
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Int16 where
   encodeDefault :: HasCallStack => Encode Int16
encodeDefault = Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int64) -> Encode Int64 -> Encode Int16
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Word16 where
   encodeDefault :: HasCallStack => Encode Word16
encodeDefault = Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int64) -> Encode Int64 -> Encode Word16
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Int32 where
   encodeDefault :: HasCallStack => Encode Int32
encodeDefault = Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int64) -> Encode Int64 -> Encode Int32
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Word32 where
   encodeDefault :: HasCallStack => Encode Word32
encodeDefault = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> Encode Int64 -> Encode Word32
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn'.
instance EncodeDefault Int where
   encodeDefault :: HasCallStack => Encode Int
encodeDefault = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Encode Int64 -> Encode Int
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn' if it fits in 'Int64', otherwise 'S.TextColumn'.
instance EncodeDefault Word where
   encodeDefault :: HasCallStack => Encode Word
encodeDefault = Encode Word
forall a. (Integral a, Bits a, HasCallStack) => Encode a
encodeSizedIntegral
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn' if it fits in 'Int64', otherwise 'S.TextColumn'.
instance EncodeDefault Word64 where
   encodeDefault :: HasCallStack => Encode Word64
encodeDefault = Encode Word64
forall a. (Integral a, Bits a, HasCallStack) => Encode a
encodeSizedIntegral
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn' if it fits in 'Int64', otherwise 'S.TextColumn'.
instance EncodeDefault Integer where
   encodeDefault :: HasCallStack => Encode Integer
encodeDefault = Encode Integer
forall a. (Integral a, Bits a, HasCallStack) => Encode a
encodeSizedIntegral
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn' if it fits in 'Int64', otherwise 'S.TextColumn'.
instance EncodeDefault Natural where
   encodeDefault :: HasCallStack => Encode Natural
encodeDefault = Encode Natural
forall a. (Integral a, Bits a, HasCallStack) => Encode a
encodeSizedIntegral
   {-# INLINE encodeDefault #-}

-- | 'S.IntegerColumn' if it fits in 'Int64', otherwise 'S.TextColumn'.
encodeSizedIntegral :: (Integral a, Bits a, HasCallStack) => Encode a
encodeSizedIntegral :: forall a. (Integral a, Bits a, HasCallStack) => Encode a
encodeSizedIntegral = (a -> Either ErrEncode SQLData) -> Encode a
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode \a
a ->
   case a -> Maybe Int64
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
toIntegralSized a
a of
      Just Int64
i -> Encode Int64 -> Int64 -> Either ErrEncode SQLData
forall a. Encode a -> a -> Either ErrEncode SQLData
unEncode (forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @Int64) Int64
i
      Maybe Int64
Nothing -> Encode String -> String -> Either ErrEncode SQLData
forall a. Encode a -> a -> Either ErrEncode SQLData
unEncode (forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @String) (Integer -> String
forall a. Show a => a -> String
show (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
a))

-- | 'S.TextColumn'.
instance EncodeDefault TL.Text where
   encodeDefault :: HasCallStack => Encode Text
encodeDefault = Text -> Text
TL.toStrict (Text -> Text) -> Encode Text -> Encode Text
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode Text
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.TextColumn'.
instance EncodeDefault TB.Builder where
   encodeDefault :: HasCallStack => Encode Builder
encodeDefault = Builder -> Text
TB.toLazyText (Builder -> Text) -> Encode Text -> Encode Builder
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode Text
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.TextColumn'.
instance EncodeDefault Char where
   encodeDefault :: HasCallStack => Encode Char
encodeDefault = Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> String) -> Encode String -> Encode Char
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @String
   {-# INLINE encodeDefault #-}

-- | 'S.TextColumn'.
instance EncodeDefault String where
   encodeDefault :: HasCallStack => Encode String
encodeDefault = (String -> Either ErrEncode SQLData) -> Encode String
forall a. (a -> Either ErrEncode SQLData) -> Encode a
Encode \String
xc ->
      case (Char -> Bool) -> String -> Maybe Char
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find Char -> Bool
invalid String
xc of
         Maybe Char
Nothing -> Encode Text -> Text -> Either ErrEncode SQLData
forall a. Encode a -> a -> Either ErrEncode SQLData
unEncode Encode Text
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault (String -> Text
T.pack String
xc)
         Just Char
c ->
            (SomeException -> ErrEncode)
-> Either SomeException SQLData -> Either ErrEncode SQLData
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SomeException -> ErrEncode
ErrEncode (Either SomeException SQLData -> Either ErrEncode SQLData)
-> Either SomeException SQLData -> Either ErrEncode SQLData
forall a b. (a -> b) -> a -> b
$
               String -> Either SomeException SQLData
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
String -> m a
Ex.throwString (String
"Invalid character " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c)
     where
      invalid :: Char -> Bool
      invalid :: Char -> Bool
invalid = \Char
c -> Char
'\55296' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\57343'

-- | 'S.BlobColumn'.
instance EncodeDefault BL.ByteString where
   encodeDefault :: HasCallStack => Encode ByteString
encodeDefault = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> Encode ByteString -> Encode ByteString
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode ByteString
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.BlobColumn'.
instance EncodeDefault BS.ShortByteString where
   encodeDefault :: HasCallStack => Encode ShortByteString
encodeDefault = ShortByteString -> ByteString
BS.fromShort (ShortByteString -> ByteString)
-> Encode ByteString -> Encode ShortByteString
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode ByteString
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'S.BlobColumn'.
instance EncodeDefault BB.Builder where
   encodeDefault :: HasCallStack => Encode Builder
encodeDefault = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Encode ByteString -> Encode Builder
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode ByteString
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault
   {-# INLINE encodeDefault #-}

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @yyyy-mm-ddThh:mm:ss/[.ssssssssssss]/+00:00@
--
-- * Sorting these lexicographically in SQL corresponds to sorting them by time.
--
-- * __WARNING__: SQLite date and time functions support resolution only up to
-- milliseconds.
--
-- * __WARNING__: SQLite date and time functions don't support leap seconds.
instance EncodeDefault Time.UTCTime where
   encodeDefault :: HasCallStack => Encode UTCTime
encodeDefault = TimeZone -> UTCTime -> ZonedTime
Time.utcToZonedTime TimeZone
Time.utc (UTCTime -> ZonedTime) -> Encode ZonedTime -> Encode UTCTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode ZonedTime
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @yyyy-mm-ddThh:mm:ss/[.ssssssssssss]/±hh:mm@
--
-- * __WARNING__: Sorting these lexicographically in SQL won't work unless the
-- offset is always the same! Convert to 'Time.UTCTime' first.
--
-- * __WARNING__: SQLite date and time functions support resolution only up to
-- milliseconds.
--
-- * __WARNING__: SQLite date and time functions don't support leap seconds.
instance EncodeDefault Time.ZonedTime where
   encodeDefault :: HasCallStack => Encode ZonedTime
encodeDefault = ZonedTime -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (ZonedTime -> String) -> Encode String -> Encode ZonedTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @yyyy-mm-ddThh:mm:ss/[.ssssssssssss]/@
--
-- * Sorting these lexicographically in SQL corresponds to sorting them by time.
--
-- * __WARNING__: SQLite date and time functions support resolution only up to
-- milliseconds.
--
-- * __WARNING__: SQLite date and time functions don't support leap seconds.
instance EncodeDefault Time.LocalTime where
   encodeDefault :: HasCallStack => Encode LocalTime
encodeDefault = LocalTime -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (LocalTime -> String) -> Encode String -> Encode LocalTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | ISO-8601 in a @'S.TextColumn'.
--
-- @yyyy-mm-dd@
--
-- * Sorting these lexicographically in SQL corresponds to sorting them by time.
instance EncodeDefault Time.Day where
   encodeDefault :: HasCallStack => Encode Day
encodeDefault = Day -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (Day -> String) -> Encode String -> Encode Day
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @hh:mm:ss/[.ssssssssssss]/@
--
-- * Sorting these lexicographically in SQL corresponds to sorting them by time.
--
-- * __WARNING__: SQLite date and time functions support resolution only up to
-- milliseconds.
--
-- * __WARNING__: SQLite date and time functions don't support leap seconds.
instance EncodeDefault Time.TimeOfDay where
   encodeDefault :: HasCallStack => Encode TimeOfDay
encodeDefault = TimeOfDay -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (TimeOfDay -> String) -> Encode String -> Encode TimeOfDay
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @PyYmMdD@
instance EncodeDefault Time.CalendarDiffDays where
   encodeDefault :: HasCallStack => Encode CalendarDiffDays
encodeDefault = CalendarDiffDays -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (CalendarDiffDays -> String)
-> Encode String -> Encode CalendarDiffDays
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @PyYmMdDThHmMs/[.ssssssssssss]/S@
--
-- * __WARNING__: SQLite date and time functions support resolution only up to
-- milliseconds.
instance EncodeDefault Time.CalendarDiffTime where
   encodeDefault :: HasCallStack => Encode CalendarDiffTime
encodeDefault = CalendarDiffTime -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (CalendarDiffTime -> String)
-> Encode String -> Encode CalendarDiffTime
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault

-- | 'Time.ISO8601' in a @'S.TextColumn'.
--
-- @±hh:mm@
instance EncodeDefault Time.TimeZone where
   encodeDefault :: HasCallStack => Encode TimeZone
encodeDefault = TimeZone -> String
forall t. ISO8601 t => t -> String
Time.iso8601Show (TimeZone -> String) -> Encode String -> Encode TimeZone
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Encode String
forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault


--------------------------------------------------------------------------------

-- | 'S.BlobColumn'.
encodeBinary :: (a -> Bin.Put) -> Encode a
encodeBinary :: forall a. (a -> Put) -> Encode a
encodeBinary a -> Put
f = (a -> ByteString) -> Encode ByteString -> Encode a
forall a' a. (a' -> a) -> Encode a -> Encode a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Put -> ByteString
Bin.runPut (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
f) (forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @BL.ByteString)
{-# INLINE encodeBinary #-}

-- | 'S.TextColumn'.
encodeShow :: (Show a) => Encode a
encodeShow :: forall a. Show a => Encode a
encodeShow = a -> String
forall a. Show a => a -> String
show (a -> String) -> Encode String -> Encode a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< (forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @String)
{-# INLINE encodeShow #-}

-- | Encodes as 'S.TextColumn'.
encodeAeson :: (a -> Ae.Value) -> Encode a
encodeAeson :: forall a. (a -> Value) -> Encode a
encodeAeson a -> Value
f = (a -> Text) -> Encode Text -> Encode a
forall a' a. (a' -> a) -> Encode a -> Encode a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (Value -> Text
forall a. ToJSON a => a -> Text
Ae.encodeToLazyText (Value -> Text) -> (a -> Value) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
f) (forall a. (EncodeDefault a, HasCallStack) => Encode a
encodeDefault @TL.Text)
{-# INLINE encodeAeson #-}