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)