{-# LANGUAGE GADTs, ScopedTypeVariables, RankNTypes, DataKinds, AllowAmbiguousTypes, LambdaCase #-}
module Internal.Data.Basic.Compiler where

import Internal.Interlude

import Internal.Data.Basic.Types as Basic
import Internal.Data.Basic.Sql.Types as Sql
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Database.PostgreSQL.Simple.ToField (ToField(..))
import Database.PostgreSQL.Simple.ToRow (ToRow(..))

expToSql :: DbExp k a -> SqlValueExp
expToSql (Field (_ :: proxy name) (Var tab)) = SimpleName (QualifiedField tab (nameText @name))
expToSql (Literal a) = SqlLiteral (toField a)

literalCollectionToSql :: LiteralCollection collection a => collection -> [SqlValueExp]
literalCollectionToSql = fmap (\(SomeDbExp e) -> expToSql e) . getLiteralCollection

boolExpToSql :: ConditionExp -> Condition
boolExpToSql (Compare c f1 f2) =
    SqlOperator c (expToSql f1) (expToSql f2)
boolExpToSql (BoolOp And exp1 exp2) = SqlAnd (boolExpToSql exp1) (boolExpToSql exp2)
boolExpToSql (BoolOp Or exp1 exp2) = SqlOr (boolExpToSql exp1) (boolExpToSql exp2)
boolExpToSql (Basic.IsNull f) = Sql.IsNull (expToSql f)
boolExpToSql (Basic.In val vals) = Sql.In (expToSql val) (literalCollectionToSql vals)

conditionToSql :: forall tables. TableSetVars 'Filtering tables
               => (Variables 'Filtering tables -> ConditionExp) -> Condition
conditionToSql f = boolExpToSql (f (makeVars @'Filtering @tables))

uniqueNames :: [QualifiedTable] -> [QualifiedTable]
uniqueNames = flip evalState 0 . mapM (\(QualifiedTable t _) -> do
    n <- get
    modify' (+ 1)
    return (QualifiedTable t n))

compileTable :: forall name proxy. KnownSymbol name => proxy (name :: Symbol) -> SqlExp
compileTable _ =
    Select SelectEverything Nothing [QualifiedTable (nameText @name) 0] [] (Limit Nothing) (Sql.Grouping [])

updatedExpToSql :: UpdateExp fields table -> ([Text], [SqlValueExp])
updatedExpToSql = \upd -> updatedExpToSql' (varFromUpdateExp upd) upd
    where updatedExpToSql' :: Var 'Updating t -> UpdateExp fields t -> ([Text], [SqlValueExp])
          updatedExpToSql' _ (NoUpdate _) = ([], [])
          updatedExpToSql' v (SetField p upd val) = (toS (symbolVal p) : fs, expToSql val : vs)
              where (fs, vs) = updatedExpToSql' v upd

updateToSql :: forall table fields. (Var 'Updating table -> UpdateExp fields table)
             -> ([Text], [SqlValueExp])
updateToSql f = updatedExpToSql (f (makeVars @'Updating @'[table]))

orderingToSql :: forall tables ord. (Sortable ord, TableSetVars 'Sorting tables)
              => (Variables 'Sorting tables -> ord) -> [(SqlValueExp, SortDirection)]
orderingToSql f = fmap (first (\(SomeDbExp e) -> expToSql e))
                       (getOrdering (f (makeVars @'Sorting @tables)))

mappingToSql ::
    forall tables map.
    ( Mappable map
    , TableSetVars 'Mapping tables )
    => (Variables 'Mapping tables -> map) -> [SqlValueExp]
mappingToSql f = mapToSql (f (makeVars @'Mapping @tables))

mapToSql :: Mappable map => map -> [SqlValueExp]
mapToSql = fmap (\(SomeDbExp e) -> expToSql e) . getMapping

groupMapToSql :: GroupMappable map => map -> [SqlValueExp]
groupMapToSql = fmap (\(af, SomeDbExp e) -> AggregateFunction af (expToSql e)) . getGroupMapping


grouppingToSql ::
    forall tables group.
    ( Groupable group
    , TableSetVars 'Basic.Grouping tables )
    => (Variables 'Basic.Grouping tables -> group) -> [SqlValueExp]
grouppingToSql f =
    fmap (\(SomeDbExp e) -> expToSql e) (getGrouping (f (makeVars @'Basic.Grouping @tables)))

groupStatementToSql :: forall tables group. GroupStatement group tables -> SqlExp
groupStatementToSql (GroupOn f t) =
    Select SelectEverything conditions tables ordering lim (Sql.Grouping (grouppingToSql @tables f))
    where Select SelectEverything conditions tables ordering lim (Sql.Grouping []) = compileToSql t

foldingToSql ::
    forall tables aggr.
    ( Aggregatable aggr
    , TableSetVars 'Folding tables )
    => (Variables 'Folding tables -> aggr) -> [SqlValueExp]
foldingToSql f =
    fmap (\(af, SomeDbExp e) -> AggregateFunction af (expToSql e))
         (getAggregating (f (makeVars @'Folding @tables)))


aggregateStatementToSql :: AggregateStatement aggr 'AM -> SqlExp
aggregateStatementToSql (Aggregate f (t :: DbStatement f tables)) =
    Select (SelectExpressions (foldingToSql @tables f)) conditions tables ordering lim (Sql.Grouping [])
    where Select SelectEverything conditions tables ordering lim (Sql.Grouping []) = compileToSql t

compileToSql :: DbStatement f ts -> SqlExp
compileToSql (Table p) = compileTable p
compileToSql (Filter cond (t :: DbStatement f tables)) =
    Select sel (conditions <> Just newConditions) tables [] (Limit Nothing) (Sql.Grouping [])
    where Select sel conditions tables [] (Limit Nothing) (Sql.Grouping []) = compileToSql t
          newConditions = conditionToSql @tables cond
compileToSql (Join t1 t2) =
    Select SelectEverything Nothing (uniqueNames $ tab1 ++ tab2) [] (Limit Nothing) (Sql.Grouping [])
    where Select SelectEverything Nothing tab1 [] (Limit Nothing) (Sql.Grouping []) = compileToSql t1
          Select SelectEverything Nothing tab2 [] (Limit Nothing) (Sql.Grouping []) = compileToSql t2
compileToSql (Raw q pars) = RawQuery q (toRow pars)
compileToSql (Basic.Insert (a :: Entity entKind table)) =
    Sql.Insert (nameText @(TableName table))
               (mapTypeList (Proxy @KnownSymbol) (toS . symbolVal)
                            (Proxy @(SetFields (MissingFields entKind) table)))
               (mapFields @(TypeSatisfies ToField) @table @(SetFields (MissingFields entKind) table) (const toField) a)
compileToSql (Basic.Delete (t :: DbStatement f '[table])) =
    Sql.Delete table conditions
    where Select SelectEverything conditions [table] [] (Limit Nothing) (Sql.Grouping []) = compileToSql t
compileToSql (Basic.Update update t) = Sql.Update updateFields updateVals conditions table
    where Select SelectEverything conditions [table] [] (Limit Nothing) (Sql.Grouping []) = compileToSql t
          (updateFields, updateVals) = updateToSql update
compileToSql (SortOn selector (t :: DbStatement f tables)) =
    Select sel conditions tables orderings (Limit Nothing) (Sql.Grouping [])
    where Select sel conditions tables [] (Limit Nothing) (Sql.Grouping []) = compileToSql t
          orderings = orderingToSql @tables selector
compileToSql (Take n t) =
    Select sel conditions tables ordering (Limit (Just n)) (Sql.Grouping [])
    where Select sel conditions tables ordering (Limit Nothing) (Sql.Grouping []) = compileToSql t
compileToSql (Map f (t :: DbStatement f tables)) =
    Select (SelectExpressions (mappingToSql @tables f)) conditions tables ordering lim (Sql.Grouping [])
    where Select SelectEverything conditions tables ordering lim (Sql.Grouping []) = compileToSql t
compileToSql (AsGroup t) = compileToSql t
compileToSql (GroupMap f t@(GroupOn gf (gt :: DbStatement f tables))) =
    Select what conditions tables ordering lim grouping
    where Select SelectEverything conditions tables ordering lim grouping = groupStatementToSql t
          g = asAggregate (gf (makeVars @'Basic.Grouping @tables))
          what = SelectExpressions (groupMapToSql (f (g, AsGroup gt)))