module Sqel.Data.Dd where

import Generics.SOP (I, NP (Nil, (:*)))
import Prettyprinter (Doc, Pretty (pretty), brackets, nest, parens, vsep, (<+>))

import Sqel.Data.Mods (Mods)
import Sqel.Data.Sel (Sel (SelSymbol), SelW, TSel, TSelW, showSelW, showTSelW)

data ProductField =
  ProductField {
    ProductField -> Symbol
name :: Symbol,
    ProductField -> *
tpe :: Type
  }

newtype ConCol (name :: Symbol) (record :: Bool) (fields :: [ProductField]) as =
  ConCol { forall (name :: Symbol) (record :: Bool) (fields :: [ProductField])
       (as :: [*]).
ConCol name record fields as -> NP I as
unConCol :: NP I as }

data ProdType = Reg | Con [Type]

data Comp = Prod ProdType | Sum

data CompInc = Merge | Nest

data Struct =
  Prim
  |
  Comp {
    Struct -> TSel
typeName :: TSel,
    Struct -> Comp
compKind :: Comp,
    Struct -> CompInc
compInc :: CompInc,
    Struct -> [DdK]
sub :: [DdK]
  }

data DdK =
  DdK {
    DdK -> Sel
columnName :: Sel,
    DdK -> [*]
mods :: [Type],
    DdK -> *
hsType :: Type,
    DdK -> Struct
struct :: Struct
  }

type DdSort :: Comp -> Type
data DdSort c where
  DdProd :: DdSort ('Prod 'Reg)
  DdCon :: DdSort ('Prod ('Con as))
  DdSum :: DdSort 'Sum

type MkDdSort :: Comp -> Constraint
class MkDdSort c where ddSort :: DdSort c

instance MkDdSort ('Prod 'Reg) where ddSort :: DdSort ('Prod 'Reg)
ddSort = DdSort ('Prod 'Reg)
DdProd
instance MkDdSort ('Prod ('Con as)) where ddSort :: DdSort ('Prod ('Con as))
ddSort = forall (as :: [*]). DdSort ('Prod ('Con as))
DdCon
instance MkDdSort 'Sum where ddSort :: DdSort 'Sum
ddSort = DdSort 'Sum
DdSum

type DdInc :: CompInc -> Type
data DdInc c where
  DdMerge :: DdInc 'Merge
  DdNest :: DdInc 'Nest

type MkDdInc :: CompInc -> Constraint
class MkDdInc c where ddInc :: DdInc c

instance MkDdInc 'Merge where ddInc :: DdInc 'Merge
ddInc = DdInc 'Merge
DdMerge
instance MkDdInc 'Nest where ddInc :: DdInc 'Nest
ddInc = DdInc 'Nest
DdNest

type DdStruct :: Struct -> Type
data DdStruct s where
  DdPrim :: DdStruct 'Prim
  DdComp :: TSelW sel -> DdSort c -> DdInc i -> NP Dd sub -> DdStruct ('Comp sel c i sub)

-- TODO maybe this could be a data family so that after using the dsl, the index is changed so that all Sels are present
-- also to stuff different metadata in there, like DdlColumn?
type Dd :: DdK -> Type
data Dd s where
  Dd :: SelW sel -> Mods mods -> DdStruct s -> Dd ('DdK sel mods a s)

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

type DdType :: DdK -> Type
type family DdType s where
  DdType ('DdK _ _ a _) = a

type DdTypes :: [DdK] -> [Type]
type family DdTypes s where
  DdTypes '[] = '[]
  DdTypes (s : ss) = DdType s : DdTypes ss

type DdSel :: DdK -> Sel
type family DdSel s where
  DdSel ('DdK sel _ _ _) = sel

type family DdName (s :: DdK) :: Symbol where
  DdName ('DdK ('SelSymbol name) _ _ _) = name
  DdName ('DdK _ _ a _) = TypeError ("This Dd for type " <> a <> " has no name")

type DdTypeSel :: DdK -> TSel
type family DdTypeSel s where
  DdTypeSel ('DdK _ _ _ ('Comp sel _ _ _)) = sel

sel :: Dd s -> SelW (DdSel s)
sel :: forall (s :: DdK). Dd s -> SelW (DdSel s)
sel (Dd SelW sel
s Mods mods
_ DdStruct s
_) = SelW sel
s

typeSel :: Dd ('DdK sel p a ('Comp tsel c i sub)) -> TSelW tsel
typeSel :: forall (sel :: Sel) (p :: [*]) a (tsel :: TSel) (c :: Comp)
       (i :: CompInc) (sub :: [DdK]).
Dd ('DdK sel p a ('Comp tsel c i sub)) -> TSelW tsel
typeSel (Dd SelW sel
_ Mods mods
_ (DdComp TSelW sel
s DdSort c
_ DdInc i
_ NP Dd sub
_)) = TSelW sel
s

showSel :: Dd s -> Text
showSel :: forall (s :: DdK). Dd s -> Text
showSel =
  forall (s :: Sel). SelW s -> Text
showSelW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: DdK). Dd s -> SelW (DdSel s)
sel

showTypeSel :: Dd ('DdK sel p a ('Comp tsel c i sub)) -> Text
showTypeSel :: forall (sel :: Sel) (p :: [*]) a (tsel :: TSel) (c :: Comp)
       (i :: CompInc) (sub :: [DdK]).
Dd ('DdK sel p a ('Comp tsel c i sub)) -> Text
showTypeSel =
  forall (s :: TSel). TSelW s -> Text
showTSelW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (sel :: Sel) (p :: [*]) a (tsel :: TSel) (c :: Comp)
       (i :: CompInc) (sub :: [DdK]).
Dd ('DdK sel p a ('Comp tsel c i sub)) -> TSelW tsel
typeSel

data a :> b = a :> b
infixr 3 :>

class PrettyNP s where
  prettyNP :: NP Dd s -> [Doc ann]

instance PrettyNP '[] where
  prettyNP :: forall ann. NP Dd '[] -> [Doc ann]
prettyNP NP Dd '[]
Nil = forall a. Monoid a => a
mempty

instance (
    Pretty (Dd s),
    PrettyNP ss
  ) => PrettyNP (s : ss) where
  prettyNP :: forall ann. NP Dd (s : ss) -> [Doc ann]
prettyNP (Dd x
dd :* NP Dd xs
dds) =
    forall a ann. Pretty a => a -> Doc ann
pretty Dd x
dd forall a. a -> [a] -> [a]
: forall (s :: [DdK]) ann. PrettyNP s => NP Dd s -> [Doc ann]
prettyNP NP Dd xs
dds

instance Pretty (DdStruct 'Prim) where
  pretty :: forall ann. DdStruct 'Prim -> Doc ann
pretty DdStruct 'Prim
DdPrim = Doc ann
"prim"

instance (
    PrettyNP sub
  ) => Pretty (Dd ('DdK sel p a ('Comp tsel c i sub))) where
  pretty :: forall ann. Dd ('DdK sel p a ('Comp tsel c i sub)) -> Doc ann
pretty (Dd SelW sel
s Mods mods
_ (DdComp TSelW sel
ts DdSort c
c DdInc i
i NP Dd sub
sub)) =
    forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (forall ann. [Doc ann] -> Doc ann
vsep ((Doc ann
var forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty (forall (s :: TSel). TSelW s -> Text
showTSelW TSelW sel
ts)) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall (s :: Sel). SelW s -> Text
showSelW SelW sel
s) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens Doc ann
inc) forall a. a -> [a] -> [a]
: forall (s :: [DdK]) ann. PrettyNP s => NP Dd s -> [Doc ann]
prettyNP NP Dd sub
sub))
    where
      var :: Doc ann
var = case DdSort c
c of
        DdSort c
DdProd -> Doc ann
"prod"
        DdSort c
DdSum -> Doc ann
"sum"
        DdSort c
DdCon -> Doc ann
"con"
      inc :: Doc ann
inc = case DdInc i
i of
        DdInc i
DdNest -> Doc ann
"nest"
        DdInc i
DdMerge -> Doc ann
"merge"

instance (
    Pretty (Mods p)
  ) => Pretty (Dd ('DdK sel p a 'Prim)) where
  pretty :: forall ann. Dd ('DdK sel p a 'Prim) -> Doc ann
pretty (Dd SelW sel
s Mods mods
p DdStruct s
DdPrim) =
    Doc ann
"prim" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall (s :: Sel). SelW s -> Text
showSelW SelW sel
s) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Mods mods
p

type Sqel' :: Sel -> [Type] -> Type -> Struct -> Type
type family Sqel' sel mods a s = r | r -> sel mods a s where
  Sqel' sel mods a s = Dd ('DdK sel mods a s)

type Sqel :: Type -> (Sel, [Type], Struct) -> Type
type family Sqel a p = r | r -> p a where
  Sqel a '(sel, mods, s) = Dd ('DdK sel mods a s)