module Sqel.Mods where

import qualified Data.Aeson as Aeson
import Data.Aeson (FromJSON, ToJSON)
import Generics.SOP (I (I), NP (Nil, (:*)))
import qualified Hasql.Decoders as Decoders
import qualified Hasql.Encoders as Encoders
import Sqel.Data.Codec (Codec (Codec))
import Sqel.Data.Mods (
  EnumColumn (EnumColumn),
  Mods (Mods),
  ReadShowColumn (ReadShowColumn),
  SetTableName (SetTableName),
  )
import Sqel.Data.PgType (PgPrimName)
import Sqel.Data.PgTypeName (PgTableName)
import Text.Show (show)

jsonEncoder ::
  ToJSON a =>
  Encoders.Value a
jsonEncoder :: forall a. ToJSON a => Value a
jsonEncoder =
  forall l s. LazyStrict l s => l -> s
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Value ByteString
Encoders.jsonBytes

jsonDecoder ::
  FromJSON a =>
  Decoders.Value a
jsonDecoder :: forall a. FromJSON a => Value a
jsonDecoder =
  forall a. (ByteString -> Either Text a) -> Value a
Decoders.jsonBytes (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. ToText a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict')

data PrimCodec f a =
  PrimCodec (f a)

instance Show (PrimCodec f a) where
  show :: PrimCodec f a -> String
show PrimCodec f a
_ =
    String
"PrimCodec"

type PrimValueCodec a =
  PrimCodec (Codec Encoders.Value Decoders.Value) a

type PrimValueEncoder a =
  PrimCodec Encoders.Value a

primJsonMods ::
  ToJSON a =>
  FromJSON a =>
  Mods [PgPrimName, PrimValueCodec a]
primJsonMods :: forall a.
(ToJSON a, FromJSON a) =>
Mods '[PgPrimName, PrimValueCodec a]
primJsonMods =
  forall (ps :: [*]). NP I ps -> Mods ps
Mods (forall a. a -> I a
I PgPrimName
"json" forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall a. a -> I a
I (forall {k} (f :: k -> *) (a :: k). f a -> PrimCodec f a
PrimCodec (forall {k} (e :: k -> *) (d :: k -> *) (a :: k).
e a -> d a -> Codec e d a
Codec forall a. ToJSON a => Value a
jsonEncoder forall a. FromJSON a => Value a
jsonDecoder)) forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil)

-- TODO change to "enum", create the type just like other composites
primEnumMods :: Mods [PgPrimName, EnumColumn]
primEnumMods :: Mods '[PgPrimName, EnumColumn]
primEnumMods =
  forall (ps :: [*]). NP I ps -> Mods ps
Mods (forall a. a -> I a
I PgPrimName
"text" forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall a. a -> I a
I EnumColumn
EnumColumn forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil)

primReadShowMods :: Mods [PgPrimName, ReadShowColumn]
primReadShowMods :: Mods '[PgPrimName, ReadShowColumn]
primReadShowMods =
  forall (ps :: [*]). NP I ps -> Mods ps
Mods (forall a. a -> I a
I PgPrimName
"text" forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall a. a -> I a
I ReadShowColumn
ReadShowColumn forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil)

tableNameMods :: PgTableName -> Mods '[SetTableName]
tableNameMods :: PgTableName -> Mods '[SetTableName]
tableNameMods PgTableName
n =
  forall (ps :: [*]). NP I ps -> Mods ps
Mods (forall a. a -> I a
I (PgTableName -> SetTableName
SetTableName PgTableName
n) forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil)