module Sqel.Data.Mods where

import Exon (exon)
import Generics.SOP (All, Compose, I, K (K), NP (Nil), hcmap, hcollapse)
import Prelude hiding (Compose)
import Prettyprinter (Pretty (pretty), hsep, viaShow)
import qualified Text.Show as Show

import Sqel.Data.PgTypeName (PgTableName)
import Sqel.Data.Sql (Sql)

newtype Mods ps = Mods { forall (ps :: [*]). Mods ps -> NP I ps
unMods :: NP I ps }

type NoMods = '[]

pattern NoMods :: () => (ps ~ '[]) => Mods ps
pattern $bNoMods :: forall (ps :: [*]). (ps ~ '[]) => Mods ps
$mNoMods :: forall {r} {ps :: [*]}.
Mods ps -> ((ps ~ '[]) => r) -> ((# #) -> r) -> r
NoMods = Mods Nil

instance (
    All (Compose Show I) ps
  ) => Show (Mods ps) where
  showsPrec :: Int -> Mods ps -> ShowS
showsPrec Int
d (Mods NP I ps
ps) =
    Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) [exon|Mods #{showsPrec 11 ps}|]

instance All Show ps => Pretty (Mods ps) where
  pretty :: forall ann. Mods ps -> Doc ann
pretty (Mods NP I ps
ps) =
    forall ann. [Doc ann] -> Doc ann
hsep (forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
Proxy @Show) (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Show a => a -> Doc ann
viaShow) NP I ps
ps))

data Nullable = Nullable
  deriving stock (Int -> Nullable -> ShowS
[Nullable] -> ShowS
Nullable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nullable] -> ShowS
$cshowList :: [Nullable] -> ShowS
show :: Nullable -> String
$cshow :: Nullable -> String
showsPrec :: Int -> Nullable -> ShowS
$cshowsPrec :: Int -> Nullable -> ShowS
Show)

data Unique = Unique
  deriving stock (Int -> Unique -> ShowS
[Unique] -> ShowS
Unique -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unique] -> ShowS
$cshowList :: [Unique] -> ShowS
show :: Unique -> String
$cshow :: Unique -> String
showsPrec :: Int -> Unique -> ShowS
$cshowsPrec :: Int -> Unique -> ShowS
Show)

data PrimaryKey = PrimaryKey
  deriving stock (Int -> PrimaryKey -> ShowS
[PrimaryKey] -> ShowS
PrimaryKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimaryKey] -> ShowS
$cshowList :: [PrimaryKey] -> ShowS
show :: PrimaryKey -> String
$cshow :: PrimaryKey -> String
showsPrec :: Int -> PrimaryKey -> ShowS
$cshowsPrec :: Int -> PrimaryKey -> ShowS
Show)

data PgDefault = PgDefault Sql
  deriving stock (Int -> PgDefault -> ShowS
[PgDefault] -> ShowS
PgDefault -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PgDefault] -> ShowS
$cshowList :: [PgDefault] -> ShowS
show :: PgDefault -> String
$cshow :: PgDefault -> String
showsPrec :: Int -> PgDefault -> ShowS
$cshowsPrec :: Int -> PgDefault -> ShowS
Show)

data EnumColumn = EnumColumn
  deriving stock (EnumColumn -> EnumColumn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumColumn -> EnumColumn -> Bool
$c/= :: EnumColumn -> EnumColumn -> Bool
== :: EnumColumn -> EnumColumn -> Bool
$c== :: EnumColumn -> EnumColumn -> Bool
Eq, Int -> EnumColumn -> ShowS
[EnumColumn] -> ShowS
EnumColumn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumColumn] -> ShowS
$cshowList :: [EnumColumn] -> ShowS
show :: EnumColumn -> String
$cshow :: EnumColumn -> String
showsPrec :: Int -> EnumColumn -> ShowS
$cshowsPrec :: Int -> EnumColumn -> ShowS
Show, forall x. Rep EnumColumn x -> EnumColumn
forall x. EnumColumn -> Rep EnumColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnumColumn x -> EnumColumn
$cfrom :: forall x. EnumColumn -> Rep EnumColumn x
Generic)

data ReadShowColumn = ReadShowColumn
  deriving stock (ReadShowColumn -> ReadShowColumn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReadShowColumn -> ReadShowColumn -> Bool
$c/= :: ReadShowColumn -> ReadShowColumn -> Bool
== :: ReadShowColumn -> ReadShowColumn -> Bool
$c== :: ReadShowColumn -> ReadShowColumn -> Bool
Eq, Int -> ReadShowColumn -> ShowS
[ReadShowColumn] -> ShowS
ReadShowColumn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadShowColumn] -> ShowS
$cshowList :: [ReadShowColumn] -> ShowS
show :: ReadShowColumn -> String
$cshow :: ReadShowColumn -> String
showsPrec :: Int -> ReadShowColumn -> ShowS
$cshowsPrec :: Int -> ReadShowColumn -> ShowS
Show, forall x. Rep ReadShowColumn x -> ReadShowColumn
forall x. ReadShowColumn -> Rep ReadShowColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReadShowColumn x -> ReadShowColumn
$cfrom :: forall x. ReadShowColumn -> Rep ReadShowColumn x
Generic)

type ArrayColumn :: (Type -> Type) -> Type
data ArrayColumn f = ArrayColumn
  deriving stock (ArrayColumn f -> ArrayColumn f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *). ArrayColumn f -> ArrayColumn f -> Bool
/= :: ArrayColumn f -> ArrayColumn f -> Bool
$c/= :: forall (f :: * -> *). ArrayColumn f -> ArrayColumn f -> Bool
== :: ArrayColumn f -> ArrayColumn f -> Bool
$c== :: forall (f :: * -> *). ArrayColumn f -> ArrayColumn f -> Bool
Eq, Int -> ArrayColumn f -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *). Int -> ArrayColumn f -> ShowS
forall (f :: * -> *). [ArrayColumn f] -> ShowS
forall (f :: * -> *). ArrayColumn f -> String
showList :: [ArrayColumn f] -> ShowS
$cshowList :: forall (f :: * -> *). [ArrayColumn f] -> ShowS
show :: ArrayColumn f -> String
$cshow :: forall (f :: * -> *). ArrayColumn f -> String
showsPrec :: Int -> ArrayColumn f -> ShowS
$cshowsPrec :: forall (f :: * -> *). Int -> ArrayColumn f -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (ArrayColumn f) x -> ArrayColumn f
forall (f :: * -> *) x. ArrayColumn f -> Rep (ArrayColumn f) x
$cto :: forall (f :: * -> *) x. Rep (ArrayColumn f) x -> ArrayColumn f
$cfrom :: forall (f :: * -> *) x. ArrayColumn f -> Rep (ArrayColumn f) x
Generic)

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

data Newtype a w =
  Newtype {
    forall a w. Newtype a w -> a -> w
unwrap :: a -> w,
    forall a w. Newtype a w -> w -> a
wrap :: w -> a
  }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a w x. Rep (Newtype a w) x -> Newtype a w
forall a w x. Newtype a w -> Rep (Newtype a w) x
$cto :: forall a w x. Rep (Newtype a w) x -> Newtype a w
$cfrom :: forall a w x. Newtype a w -> Rep (Newtype a w) x
Generic)

instance Show (Newtype a w) where
  show :: Newtype a w -> String
show Newtype a w
_ =
    String
"Newtype"

data Ignore = Ignore
  deriving stock (Ignore -> Ignore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ignore -> Ignore -> Bool
$c/= :: Ignore -> Ignore -> Bool
== :: Ignore -> Ignore -> Bool
$c== :: Ignore -> Ignore -> Bool
Eq, Int -> Ignore -> ShowS
[Ignore] -> ShowS
Ignore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ignore] -> ShowS
$cshowList :: [Ignore] -> ShowS
show :: Ignore -> String
$cshow :: Ignore -> String
showsPrec :: Int -> Ignore -> ShowS
$cshowsPrec :: Int -> Ignore -> ShowS
Show, forall x. Rep Ignore x -> Ignore
forall x. Ignore -> Rep Ignore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ignore x -> Ignore
$cfrom :: forall x. Ignore -> Rep Ignore x
Generic)