{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}

module Language.SQL.SpiderSQL.Syntax where

import Data.Hashable (Hashable)
import Data.Kind (Type)
import GHC.Generics (Generic)

data SpiderTyp
  = TBoolean
  | TNumber
  | TText
  | TOthers
  | TTime
  | TStar
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

data X = UD | TC

data SX :: X -> Type where
  SUD :: SX 'UD
  STC :: SX 'TC

type XSpiderSQL :: X -> Type
type family XSpiderSQL x where
  XSpiderSQL 'UD = ()
  XSpiderSQL 'TC = [SpiderTyp]

type SpiderSQL :: X -> Type
data SpiderSQL x = SpiderSQL
  { spiderSQLX :: XSpiderSQL x,
    spiderSQLSelect :: Select x,
    spiderSQLFrom :: From x,
    spiderSQLWhere :: Maybe (Cond x),
    spiderSQLGroupBy :: [ColUnit x],
    spiderSQLOrderBy :: Maybe (OrderBy x),
    spiderSQLHaving :: Maybe (Cond x),
    spiderSQLLimit :: Maybe Int,
    spiderSQLIntersect :: Maybe (SpiderSQL x),
    spiderSQLExcept :: Maybe (SpiderSQL x),
    spiderSQLUnion :: Maybe (SpiderSQL x)
  }
  deriving stock (Generic)

type SpiderSQLUD = SpiderSQL 'UD

pattern SpiderSQLUD ::
  SelectUD ->
  FromUD ->
  Maybe CondUD ->
  [ColUnitUD] ->
  Maybe OrderByUD ->
  Maybe CondUD ->
  Maybe Int ->
  Maybe SpiderSQLUD ->
  Maybe SpiderSQLUD ->
  Maybe SpiderSQLUD ->
  SpiderSQLUD
pattern SpiderSQLUD sqlSelect sqlFrom sqlWhere sqlGroupBy sqlOrderBy sqlHaving sqlLimit sqlIntersect sqlExcept sqlUnion <-
  SpiderSQL _ sqlSelect sqlFrom sqlWhere sqlGroupBy sqlOrderBy sqlHaving sqlLimit sqlIntersect sqlExcept sqlUnion
  where
    SpiderSQLUD sqlSelect sqlFrom sqlWhere sqlGroupBy sqlOrderBy sqlHaving sqlLimit sqlIntersect sqlExcept sqlUnion =
      SpiderSQL () sqlSelect sqlFrom sqlWhere sqlGroupBy sqlOrderBy sqlHaving sqlLimit sqlIntersect sqlExcept sqlUnion

deriving stock instance Eq SpiderSQLUD

deriving stock instance Show SpiderSQLUD

deriving anyclass instance Hashable SpiderSQLUD

spiderSQLTyp :: SpiderSQL x -> XSpiderSQL x
spiderSQLTyp SpiderSQL {..} = spiderSQLX

type SpiderSQLTC = SpiderSQL 'TC

deriving stock instance Eq SpiderSQLTC

deriving stock instance Show SpiderSQLTC

deriving anyclass instance Hashable SpiderSQLTC

type family XSelect x where
  XSelect 'UD = ()
  XSelect 'TC = [SpiderTyp]

data Select x
  = Select (XSelect x) [Agg x]
  | SelectDistinct (XSelect x) [Agg x]
  deriving stock (Generic)

pattern SelectUD :: [AggUD] -> SelectUD
pattern SelectUD aggs <-
  Select _ aggs
  where
    SelectUD aggs = Select () aggs

pattern SelectDistinctUD :: [AggUD] -> SelectUD
pattern SelectDistinctUD aggs <-
  SelectDistinct _ aggs
  where
    SelectDistinctUD aggs = SelectDistinct () aggs

type SelectUD = Select 'UD

deriving stock instance Eq SelectUD

deriving stock instance Show SelectUD

deriving anyclass instance Hashable SelectUD

selectTyp :: Select x -> XSelect x
selectTyp (Select typ _) = typ
selectTyp (SelectDistinct typ _) = typ

type SelectTC = Select 'TC

deriving stock instance Eq SelectTC

deriving stock instance Show SelectTC

deriving anyclass instance Hashable SelectTC

data From x = From
  { fromTableUnits :: [TableUnit x],
    fromCond :: Maybe (Cond x)
  }
  deriving stock (Generic)

type FromUD = From 'UD

deriving stock instance Eq FromUD

deriving stock instance Show FromUD

deriving anyclass instance Hashable FromUD

type FromTC = From 'TC

deriving stock instance Eq FromTC

deriving stock instance Show FromTC

deriving anyclass instance Hashable FromTC

type Cond :: X -> Type
data Cond x
  = And (Cond x) (Cond x)
  | Or (Cond x) (Cond x)
  | Not (Cond x)
  | Between (ValUnit x) (ValUnit x) (ValUnit x)
  | Eq (ValUnit x) (ValUnit x)
  | Gt (ValUnit x) (ValUnit x)
  | Lt (ValUnit x) (ValUnit x)
  | Ge (ValUnit x) (ValUnit x)
  | Le (ValUnit x) (ValUnit x)
  | Ne (ValUnit x) (ValUnit x)
  | In (ValUnit x) (ValUnit x)
  | Like (ValUnit x) (ValUnit x)
  deriving stock (Generic)

type CondUD = Cond 'UD

deriving stock instance Eq CondUD

deriving stock instance Show CondUD

deriving anyclass instance Hashable CondUD

type CondTC = Cond 'TC

deriving stock instance Eq CondTC

deriving stock instance Show CondTC

deriving anyclass instance Hashable CondTC

type family XValUnit x where
  XValUnit 'UD = ()
  XValUnit 'TC = SpiderTyp

type ValUnit :: X -> Type
data ValUnit x
  = Column (XValUnit x) (Val x)
  | Minus (XValUnit x) (Val x) (Val x)
  | Plus (XValUnit x) (Val x) (Val x)
  | Times (XValUnit x) (Val x) (Val x)
  | Divide (XValUnit x) (Val x) (Val x)
  deriving stock (Generic)

valUnitTyp :: forall x. ValUnit x -> XValUnit x
valUnitTyp (Column typ _) = typ
valUnitTyp (Minus typ _ _) = typ
valUnitTyp (Plus typ _ _) = typ
valUnitTyp (Times typ _ _) = typ
valUnitTyp (Divide typ _ _) = typ

pattern ColumnUD :: ValUD -> ValUnitUD
pattern ColumnUD val <-
  Column _ val
  where
    ColumnUD val = Column () val

type ValUnitUD = ValUnit 'UD

deriving stock instance Eq ValUnitUD

deriving stock instance Show ValUnitUD

deriving anyclass instance Hashable ValUnitUD

type ValUnitTC = ValUnit 'TC

deriving stock instance Eq ValUnitTC

deriving stock instance Show ValUnitTC

deriving anyclass instance Hashable ValUnitTC

type XValColUnit :: X -> Type

type XValColUnit x = XColUnit x

type XValSQL :: X -> Type

type XValSQL x = XSpiderSQL x

type Val :: X -> Type
data Val x
  = ValColUnit {columnX :: XValColUnit x, columnValue :: ColUnit x}
  | Number {numberValue :: Double}
  | ValString {stringValue :: String}
  | ValSQL {sqlValueX :: XValSQL x, sqlValue :: SpiderSQL x}
  deriving stock (Generic)

type ValUD = Val 'UD

deriving stock instance Eq ValUD

deriving stock instance Show ValUD

deriving anyclass instance Hashable ValUD

type ValTC = Val 'TC

deriving stock instance Eq ValTC

deriving stock instance Show ValTC

deriving anyclass instance Hashable ValTC

type XColUnit :: X -> Type
type family XColUnit x where
  XColUnit 'UD = ()
  XColUnit 'TC = SpiderTyp

data ColUnit x
  = ColUnit
      { colUnitX :: XColUnit x,
        colUnitAggId :: Maybe AggType,
        colUnitTable :: Maybe (Either TableId Alias),
        colUnitColId :: ColumnId x
      }
  | DistinctColUnit
      { distinctColUnitX :: XColUnit x,
        distinctColUnitAggId :: Maybe AggType,
        distinctColUnitTable :: Maybe (Either TableId Alias),
        distinctColUnitColdId :: ColumnId x
      }
  deriving stock (Generic)

pattern ColUnitUD :: Maybe AggType -> Maybe (Either TableId Alias) -> ColumnIdUD -> ColUnitUD
pattern ColUnitUD at tidOrAlias cid <-
  ColUnit _ at tidOrAlias cid
  where
    ColUnitUD at tidOrAlias cid = ColUnit () at tidOrAlias cid

pattern DistinctColUnitUD :: Maybe AggType -> Maybe (Either TableId Alias) -> ColumnIdUD -> ColUnitUD
pattern DistinctColUnitUD at tidOrAlias cid <-
  DistinctColUnit _ at tidOrAlias cid
  where
    DistinctColUnitUD at tidOrAlias cid = DistinctColUnit () at tidOrAlias cid

type ColUnitUD = ColUnit 'UD

deriving stock instance Eq ColUnitUD

deriving stock instance Show ColUnitUD

deriving anyclass instance Hashable ColUnitUD

colUnitTyp :: forall x. ColUnit x -> XColUnit x
colUnitTyp ColUnit {..} = colUnitX
colUnitTyp DistinctColUnit {..} = distinctColUnitX

type ColUnitTC = ColUnit 'TC

deriving stock instance Eq ColUnitTC

deriving stock instance Show ColUnitTC

deriving anyclass instance Hashable ColUnitTC

type OrderBy :: X -> Type
newtype OrderBy x = OrderBy [(ValUnit x, OrderByOrder)]
  deriving stock (Generic)

type OrderByUD = OrderBy 'UD

deriving stock instance Eq OrderByUD

deriving stock instance Show OrderByUD

deriving anyclass instance Hashable OrderByUD

type OrderByTC = OrderBy 'TC

deriving stock instance Eq OrderByTC

deriving stock instance Show OrderByTC

deriving anyclass instance Hashable OrderByTC

data OrderByOrder = Asc | Desc
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

type XAgg :: X -> Type
type family XAgg x where
  XAgg 'UD = ()
  XAgg 'TC = SpiderTyp

type Agg :: X -> Type
data Agg x = Agg (XAgg x) (Maybe AggType) (ValUnit x)
  deriving stock (Generic)

pattern AggUD :: Maybe AggType -> ValUnitUD -> AggUD
pattern AggUD aggType vu <-
  Agg _ aggType vu
  where
    AggUD aggType vu = Agg () aggType vu

type AggUD = Agg 'UD

deriving stock instance Eq AggUD

deriving stock instance Show AggUD

deriving anyclass instance Hashable AggUD

type AggTC = Agg 'TC

deriving stock instance Eq AggTC

deriving stock instance Show AggTC

deriving anyclass instance Hashable AggTC

type TableUnit :: X -> Type
data TableUnit x
  = TableUnitSQL (SpiderSQL x) (Maybe Alias)
  | Table TableId (Maybe Alias)
  deriving stock (Generic)

type TableUnitUD = TableUnit 'UD

deriving stock instance Eq TableUnitUD

deriving stock instance Show TableUnitUD

deriving anyclass instance Hashable TableUnitUD

type TableUnitTC = TableUnit 'TC

deriving stock instance Eq TableUnitTC

deriving stock instance Show TableUnitTC

deriving anyclass instance Hashable TableUnitTC

data AggType = Max | Min | Count | Sum | Avg
  deriving stock (Eq, Show, Generic)
  deriving anyclass (Hashable)

type XColumnID :: X -> Type
type family XColumnID x where
  XColumnID 'UD = ()
  XColumnID 'TC = SpiderTyp

data ColumnId x
  = Star
  | ColumnId {columnIdX :: XColumnID x, columnName :: String}
  deriving stock (Generic)

pattern ColumnIdUD :: String -> ColumnIdUD
pattern ColumnIdUD colName <-
  ColumnId _ colName
  where
    ColumnIdUD colName = ColumnId () colName

type ColumnIdUD = ColumnId 'UD

deriving stock instance Eq ColumnIdUD

deriving stock instance Show ColumnIdUD

deriving anyclass instance Hashable ColumnIdUD

type ColumnIdTC = ColumnId 'TC

deriving stock instance Eq ColumnIdTC

deriving stock instance Show ColumnIdTC

deriving anyclass instance Hashable ColumnIdTC

newtype TableId = TableId {tableName :: String}
  deriving stock (Eq, Ord, Show, Generic)
  deriving anyclass (Hashable)

newtype Alias = Alias {aliasName :: String}
  deriving stock (Eq, Ord, Show, Generic)
  deriving anyclass (Hashable)