module Sqel.Data.PgTypeName where

import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.GADT.Show (GShow (gshowsPrec))
import Exon (exon)
import Prettyprinter (Pretty (pretty))

import Sqel.Data.Sel (SelPrefix (DefaultPrefix), TypeName)
import Sqel.Data.Sql (ToSql (toSql), sql, sqlQuote)
import Sqel.Data.SqlFragment (From (From), Into (Into))
import Sqel.SOP.Constraint (symbolText)
import Sqel.Text.DbIdentifier (dbIdentifierT)

type PgTypeName :: Bool -> Type
data PgTypeName table where
  UnsafePgTableName :: Text -> PgTypeName 'True
  UnsafePgCompName :: Text -> PgTypeName 'False

instance GShow PgTypeName where gshowsPrec :: forall (a :: Bool). Int -> PgTypeName a -> ShowS
gshowsPrec = forall a. Show a => Int -> a -> ShowS
showsPrec

type PgTableName =
  PgTypeName 'True

type PgCompName =
  PgTypeName 'False

getPgTypeName :: PgTypeName table -> Text
getPgTypeName :: forall (table :: Bool). PgTypeName table -> Text
getPgTypeName = \case
  UnsafePgTableName Text
n -> Text
n
  UnsafePgCompName Text
n -> Text
n

pattern PgTypeName :: Text -> PgTypeName table
pattern $mPgTypeName :: forall {r} {table :: Bool}.
PgTypeName table -> (Text -> r) -> ((# #) -> r) -> r
PgTypeName name <- (getPgTypeName -> name)
{-# complete PgTypeName #-}

pattern PgTableName :: Text -> PgTypeName table
pattern $mPgTableName :: forall {r} {table :: Bool}.
PgTypeName table -> (Text -> r) -> ((# #) -> r) -> r
PgTableName name <- (UnsafePgTableName name)

pattern PgCompName :: Text -> PgTypeName table
pattern $mPgCompName :: forall {r} {table :: Bool}.
PgTypeName table -> (Text -> r) -> ((# #) -> r) -> r
PgCompName name <- (UnsafePgCompName name)

{-# complete PgTableName, PgCompName #-}

pattern PgOnlyTableName :: Text -> PgTypeName 'True
pattern $mPgOnlyTableName :: forall {r}. PgTableName -> (Text -> r) -> ((# #) -> r) -> r
PgOnlyTableName name <- (UnsafePgTableName name)

{-# complete PgOnlyTableName #-}

pattern PgOnlyCompName :: Text -> PgTypeName 'False
pattern $mPgOnlyCompName :: forall {r}. PgCompName -> (Text -> r) -> ((# #) -> r) -> r
PgOnlyCompName name <- (UnsafePgCompName name)

{-# complete PgOnlyCompName #-}

instance Eq (PgTypeName table) where
  UnsafePgTableName Text
l == :: PgTypeName table -> PgTypeName table -> Bool
== UnsafePgTableName Text
r = Text
l forall a. Eq a => a -> a -> Bool
== Text
r
  UnsafePgCompName Text
l == UnsafePgCompName Text
r = Text
l forall a. Eq a => a -> a -> Bool
== Text
r

instance Show (PgTypeName table) where
  showsPrec :: Int -> PgTypeName table -> ShowS
showsPrec Int
d =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      UnsafePgTableName Text
n -> [exon|UnsafePgTableName #{showsPrec 11 n}|]
      UnsafePgCompName Text
n -> [exon|UnsafePgCompName #{showsPrec 11 n}|]

instance Pretty (PgTypeName table) where
  pretty :: forall ann. PgTypeName table -> Doc ann
pretty (UnsafePgCompName Text
n) = forall a ann. Pretty a => a -> Doc ann
pretty Text
n
  pretty (UnsafePgTableName Text
n) = forall a ann. Pretty a => a -> Doc ann
pretty Text
n

instance ToSql (PgTypeName table) where
  toSql :: PgTypeName table -> Sql
toSql (PgTypeName Text
n) =
    Text -> Sql
sqlQuote Text
n

instance ToSql (From PgTableName) where
  toSql :: From PgTableName -> Sql
toSql (From PgTableName
n) =
    [sql|from ##{n}|]

instance ToSql (Into PgTableName) where
  toSql :: Into PgTableName -> Sql
toSql (Into PgTableName
n) =
    [sql|into ##{n}|]

instance FromJSON PgTableName where
  parseJSON :: Value -> Parser PgTableName
parseJSON Value
v = Text -> PgTableName
UnsafePgTableName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance FromJSON PgCompName where
  parseJSON :: Value -> Parser PgCompName
parseJSON Value
v = Text -> PgCompName
UnsafePgCompName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON (PgTypeName t) where
  toJSON :: PgTypeName t -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (table :: Bool). PgTypeName table -> Text
getPgTypeName

pgTableName ::
  Text ->
  PgTypeName 'True
pgTableName :: Text -> PgTableName
pgTableName =
  Text -> PgTableName
UnsafePgTableName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dbIdentifierT

pgCompName ::
  Text ->
  PgTypeName 'False
pgCompName :: Text -> PgCompName
pgCompName Text
name =
  Text -> PgCompName
UnsafePgCompName (Text -> Text
dbIdentifierT Text
name)

instance IsString PgTableName where
  fromString :: String -> PgTableName
fromString =
    Text -> PgTableName
pgTableName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance IsString PgCompName where
  fromString :: String -> PgCompName
fromString =
    Text -> PgCompName
pgCompName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance Ord (PgTypeName table) where
  compare :: PgTypeName table -> PgTypeName table -> Ordering
compare = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (table :: Bool). PgTypeName table -> Text
getPgTypeName

type MkPgTypeName :: SelPrefix -> Symbol -> Bool -> Symbol -> Constraint
class KnownSymbol tname => MkPgTypeName prefix name table tname | prefix name table -> tname where
  pgTypeName :: PgTypeName table

instance (
    KnownSymbol name
  ) => MkPgTypeName 'DefaultPrefix name 'True name where
    pgTypeName :: PgTableName
pgTypeName = Text -> PgTableName
pgTableName (forall (name :: Symbol). KnownSymbol name => Text
symbolText @name)

instance (
    TypeName prefix name tname
  ) => MkPgTypeName prefix name 'False tname where
    pgTypeName :: PgCompName
pgTypeName = Text -> PgCompName
pgCompName (forall (name :: Symbol). KnownSymbol name => Text
symbolText @tname)