module Sqel.Data.Codec where

import Data.Functor.Invariant (Invariant (invmap), invmapContravariant)
import qualified Hasql.Decoders as Decoders
import Hasql.Decoders (Row)
import qualified Hasql.Encoders as Encoders
import Hasql.Encoders (Params)

import Sqel.SOP.Constraint (symbolText)

data Encoder a =
  Encoder {
    forall a. Encoder a -> Params a
encodeValue :: Params a,
    forall a. Encoder a -> Params ()
encodeNulls :: Params ()
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Encoder a) x -> Encoder a
forall a x. Encoder a -> Rep (Encoder a) x
$cto :: forall a x. Rep (Encoder a) x -> Encoder a
$cfrom :: forall a x. Encoder a -> Rep (Encoder a) x
Generic)

instance Semigroup (Encoder a) where
  Encoder Params a
vl Params ()
nl <> :: Encoder a -> Encoder a -> Encoder a
<> Encoder Params a
vr Params ()
nr =
    forall a. Params a -> Params () -> Encoder a
Encoder (Params a
vl forall a. Semigroup a => a -> a -> a
<> Params a
vr) (Params ()
nl forall a. Semigroup a => a -> a -> a
<> Params ()
nr)

instance Monoid (Encoder a) where
  mempty :: Encoder a
mempty =
    forall a. Params a -> Params () -> Encoder a
Encoder forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Contravariant Encoder where
  contramap :: forall a' a. (a' -> a) -> Encoder a -> Encoder a'
contramap a' -> a
f Encoder {Params a
Params ()
encodeNulls :: Params ()
encodeValue :: Params a
$sel:encodeNulls:Encoder :: forall a. Encoder a -> Params ()
$sel:encodeValue:Encoder :: forall a. Encoder a -> Params a
..} =
    forall a. Params a -> Params () -> Encoder a
Encoder (a' -> a
f forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Params a
encodeValue) Params ()
encodeNulls

instance Invariant Encoder where
  invmap :: forall a b. (a -> b) -> (b -> a) -> Encoder a -> Encoder b
invmap = forall (f :: * -> *) a b.
Contravariant f =>
(a -> b) -> (b -> a) -> f a -> f b
invmapContravariant

data Decoder a =
  Decoder {
    forall a. Decoder a -> Row a
decodeValue :: Row a,
    forall a. Decoder a -> Row ()
decodeNulls :: Row ()
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Decoder a) x -> Decoder a
forall a x. Decoder a -> Rep (Decoder a) x
$cto :: forall a x. Rep (Decoder a) x -> Decoder a
$cfrom :: forall a x. Decoder a -> Rep (Decoder a) x
Generic)

instance Functor Decoder where
  fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
fmap a -> b
f Decoder {Row a
Row ()
decodeNulls :: Row ()
decodeValue :: Row a
$sel:decodeNulls:Decoder :: forall a. Decoder a -> Row ()
$sel:decodeValue:Decoder :: forall a. Decoder a -> Row a
..} =
    forall a. Row a -> Row () -> Decoder a
Decoder (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Row a
decodeValue) Row ()
decodeNulls

instance Applicative Decoder where
  pure :: forall a. a -> Decoder a
pure a
a =
    forall a. Row a -> Row () -> Decoder a
Decoder (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

  liftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
liftA2 a -> b -> c
f (Decoder Row a
vl Row ()
nl) (Decoder Row b
vr Row ()
nr) =
    forall a. Row a -> Row () -> Decoder a
Decoder (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Row a
vl Row b
vr) (Row ()
nl forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Row ()
nr)

data Codec e d a =
  Codec {
    forall {k} (e :: k -> *) (d :: k -> *) (a :: k). Codec e d a -> e a
encoder :: e a,
    forall {k} (e :: k -> *) (d :: k -> *) (a :: k). Codec e d a -> d a
decoder :: d a
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (e :: k -> *) (d :: k -> *) (a :: k) x.
Rep (Codec e d a) x -> Codec e d a
forall k (e :: k -> *) (d :: k -> *) (a :: k) x.
Codec e d a -> Rep (Codec e d a) x
$cto :: forall k (e :: k -> *) (d :: k -> *) (a :: k) x.
Rep (Codec e d a) x -> Codec e d a
$cfrom :: forall k (e :: k -> *) (d :: k -> *) (a :: k) x.
Codec e d a -> Rep (Codec e d a) x
Generic)

type ValueCodec =
  Codec Encoders.Value Decoders.Value

instance (
    Contravariant e,
    Functor d
  ) => Invariant (Codec e d) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Codec e d a -> Codec e d b
invmap a -> b
f b -> a
c Codec {e a
d a
decoder :: d a
encoder :: e a
$sel:decoder:Codec :: forall {k} (e :: k -> *) (d :: k -> *) (a :: k). Codec e d a -> d a
$sel:encoder:Codec :: forall {k} (e :: k -> *) (d :: k -> *) (a :: k). Codec e d a -> e a
..} =
      Codec {
        $sel:encoder:Codec :: e b
encoder = b -> a
c forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< e a
encoder,
        $sel:decoder:Codec :: d b
decoder = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> d a
decoder
      }

type FullCodec =
  Codec Encoder Decoder

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

symbolColumnName ::
  ∀ (name :: Symbol) .
  KnownSymbol name =>
  ColumnName
symbolColumnName :: forall (name :: Symbol). KnownSymbol name => ColumnName
symbolColumnName =
  Text -> ColumnName
ColumnName (forall (name :: Symbol). KnownSymbol name => Text
symbolText @name)