{-# LANGUAGE MultiParamTypeClasses, DataKinds, FlexibleInstances, TypeFamilies
           , FlexibleContexts, ScopedTypeVariables, ConstraintKinds
           , NoMonomorphismRestriction, TypeOperators, UndecidableSuperClasses, TypeApplications
           , AllowAmbiguousTypes, UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans -Wno-redundant-constraints #-}
-- {-# OPTIONS_GHC -ddump-splices #-}
module Internal.Data.Basic.Common (module Internal.Data.Basic.Common) where

import Internal.Interlude hiding (filter)

import Database.PostgreSQL.Simple (FromRow)
import Database.PostgreSQL.Simple.ToRow (ToRow)

import Overload

import Internal.Data.Basic.Types
import Internal.Data.Basic.TH.Types (Schema(..))
import Internal.Control.Effects.Basic

class LiftedStatement fs t res where
    liftDbExp :: DbStatement fs t -> res
instance (DbStatement fs ~ dbs, ts1 ~ ts2) => LiftedStatement fs ts1 (dbs (ts2 :: [*])) where
    liftDbExp = identity
instance ( res ~ [DbResult ts]
         , AllHaveFromRowInstance ts, MonadEffect Basic m )
         => LiftedStatement fs ts (m (res :: *)) where
    liftDbExp = runDbStatement

djoin :: LiftedStatement 'Unfiltered (tables1 ++ tables2) res
      => DbStatement 'Unfiltered tables1
      -> DbStatement 'Unfiltered tables2 -> res
djoin l r = liftDbExp (Join l r)

dfilter :: ( LiftedStatement 'Filtered tables res
           , TableSetVars 'Filtering tables
           , Selection f )
        => (Variables 'Filtering tables -> ConditionExp) -> DbStatement f tables -> res
dfilter f t = liftDbExp (Filter f t)

ddelete :: (LiftedStatement 'Deleted '[table] res, Selection f, Table table)
        => DbStatement f '[table] -> res
ddelete = liftDbExp . Delete

type AllRows table res = (Table table, LiftedStatement 'Unfiltered '[table] res)

allRows :: forall tableName table res.
        (TableName table ~ tableName, AllRows table res)
        => res
allRows = liftDbExp (Table (Proxy @tableName))

allRowsProxy ::
    forall table res proxy.
    (Table table, LiftedStatement 'Unfiltered '[table] res)
    => proxy table -> res
allRowsProxy _ = allRows @(TableName table)

rawQuery :: forall a r m. (MonadEffect Basic m, FromRow a, ToRow r)
         => Text -> r -> m [Entity ('FromDb 'Live) a]
rawQuery q r = runDbStatement (Raw q r :: DbStatement 'RawQueried '[a])

insert :: (CanInsert entKind table, MonadEffect Basic m, FromRow table)
       => Entity entKind table -> m (Entity ('FromDb 'Live) table)
insert = fmap unsafeHead . runDbStatement . Insert

dupdate :: (MonadEffect Basic m, FromRow table, Selection f)
        => (Var 'Updating table -> UpdateExp fields table) -> DbStatement f '[table]
        -> m [Entity ('FromDb 'Live) table]
dupdate f e = runDbStatement (Update f e)

dsortOn :: ( LiftedStatement 'Sorted tables res
           , TableSetVars 'Sorting tables
           , Sortable ord
           , Selection f )
        => (Variables 'Sorting tables -> ord) -> DbStatement f tables -> res
dsortOn f t = liftDbExp (SortOn f t)

dtake :: ( LiftedStatement 'Limited tables res
         , CanTake f )
      => Int -> DbStatement f tables -> res
dtake n t = liftDbExp (Take n t)

dgroupOn ::
    ( Groupable group
    , TableSetVars 'Grouping tables
    , Internal.Data.Basic.Types.Selection f )
    => (Variables 'Grouping tables -> group) -> DbStatement f tables -> GroupStatement group tables
dgroupOn = GroupOn

dmapAll ::
    (Mappable map, CanMap f, TableSetVars 'Mapping tables)
    => (Variables 'Mapping tables -> map) -> DbStatement f tables
    -> DbStatement 'Mapped '[MapResult map]
dmapAll = Map

dgroupMap ::
    (GroupMappable map, InterpretAsGroupMap map ~ 'True)
    => ((AsAggregate group, DbStatement 'Grouped tables) -> map)
    -> GroupStatement group tables
    -> DbStatement 'Folded '[GroupMapResult map]
dgroupMap = GroupMap

overload "dmap'" ['dmapAll, 'dgroupMap]

class LiftedMapStatement fs t res where
    liftMapStatement :: DbStatement fs '[t] -> res
instance (DbStatement fs ~ dbs, '[ts1] ~ ts2) => LiftedMapStatement fs ts1 (dbs (ts2 :: [*])) where
    liftMapStatement = identity
instance
    ( res ~ [WithoutOnly ts]
    , MonadEffect Basic m
    , FromRow ts
    , NoOnly ts )
    => LiftedMapStatement fs ts (m (res :: *)) where
    liftMapStatement = runMapStatement

dmap :: forall f res a b m (ts :: [*]) t.
    (Dmap' ((a -> b) -> m ts -> DbStatement f '[t]), LiftedMapStatement f t res)
    => (a -> b) -> m ts -> res
dmap f as = liftMapStatement @f @t @res (dmap' f as)

class
    interpretAsGroupMap ~ InterpretAsGroupMap res
    => LiftedAggregation (interpretAsGroupMap :: Bool) aggr res where
    liftAggregation :: AggregateStatement aggr 'AM -> res
instance {-# INCOHERENT #-}
    ( GroupMappableThing (AggregationResult aggr) 'AM ~ aggStat, Aggregatable aggr
    , InterpretAsGroupMap aggStat ~ 'True )
    => LiftedAggregation 'True aggr aggStat where
    liftAggregation = GroupMappableAggr
instance {-# INCOHERENT #-}
    ( GroupMappableThing (AggregationResult aggr) ~ aggStat, m ~ 'AM, Aggregatable aggr
    , InterpretAsGroupMap (aggStat m) ~ i )
    => LiftedAggregation i aggr (aggStat (m :: AM)) where
    liftAggregation = GroupMappableAggr
instance {-# INCOHERENT #-}
    ( res ~ AggregationResult aggr, MonadEffect Basic m, FromRow res
    , InterpretAsGroupMap (m res) ~ i )
    => LiftedAggregation i aggr (m (res :: *)) where
    liftAggregation = runAggregateStatement

dfoldMap :: forall tables aggr f res.
    ( Aggregatable aggr
    , CanAggregate f
    , TableSetVars 'Folding tables
    , LiftedAggregation (InterpretAsGroupMap res) aggr res )
    => (Variables 'Folding tables -> aggr) -> DbStatement f tables
    -> res
dfoldMap f s = liftAggregation (Aggregate f s)

dfoldMapInner ::
    ( AsAggregate group ~ GroupMappableThing t 'AM
    , LiftedMapStatement 'Folded (ListToSimpleTuple (TupleToList t ++ TupleToList (AggregationResult aggr))) res
    , Aggregatable aggr
    , TableSetVars 'Folding tables )
    => (Variables 'Folding tables -> aggr) -> GroupStatement group tables -> res
dfoldMapInner f s = liftMapStatement (dgroupMap (\(g, t) -> (g, GroupMappableAggr (Aggregate f t))) s)

delem :: (LiteralCollection collection a) => DbExp k a -> collection -> ConditionExp
delem = In

disNothing :: DbExp 'FieldExp (Maybe a) -> ConditionExp
disNothing = IsNull

disJust :: DbExp 'FieldExp (Maybe a) -> ConditionExp
disJust = IsNotNull

dtrue :: ConditionExp
dtrue = BoolLit True

dfalse :: ConditionExp
dfalse = BoolLit False

like, ilike :: DbExp 'FieldExp Text -> Text -> ConditionExp
like = Like False
ilike = Like True

executeQuery :: (ToRow r, MonadEffect Basic m) => Text -> r -> m ()
executeQuery q r = executeDbStatement (Execute q r :: DbStatement 'RawQueried '[])

applySchema :: MonadEffect Basic m => Schema -> m ()
applySchema (Schema sch) = void $ executeQuery sch ()