{-# LANGUAGE RankNTypes, ConstraintKinds, FlexibleContexts, TypeFamilies, ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications, TypeOperators, DataKinds, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE GADTs #-}
module Internal.Control.Effects.Basic (module Internal.Control.Effects.Basic, module Control.Effects)
    where

import Internal.Interlude

import Control.Effects
import Database.PostgreSQL.Simple
import qualified Database.PostgreSQL.Simple.Types as PSQL

import Internal.Data.Basic.Types
import Internal.Data.Basic.Sql.Types
import Internal.Data.Basic.Compiler

newtype Basic = RunSql Type

newtype SqlRequest a = SqlRequest { getSqlRequest :: SqlExp } deriving Show

data instance Effect Basic method mr where
    RunSqlMsg :: FromRow a => SqlRequest a -> Effect Basic ('RunSql a) 'Msg
    RunSqlRes :: FromRow a => { getRunSqlRes :: [a] } -> Effect Basic ('RunSql a) 'Res

effectBasic :: (MonadEffect Basic m, FromRow a) => SqlRequest a -> m [a]
effectBasic = fmap getRunSqlRes . effect . RunSqlMsg

handleBasic ::
    Functor m
    => (forall b. FromRow b => SqlRequest b -> m [b])
    -> EffectHandler Basic m a -> m a
handleBasic f = handleEffect (\(RunSqlMsg r) -> RunSqlRes <$> f r)

-- | Handles SQL by querying a PostgreSQL database.
handleBasicPsql :: MonadIO m => Connection -> EffectHandler Basic m a -> m a
handleBasicPsql conn = handleBasic
    (liftIO . runQuerySegment . sqlExpToQuery . getSqlRequest)
  where
    runQuerySegment :: FromRow b => QuerySegment -> IO [b]
    runQuerySegment (QuerySegment q as) = query conn q as

type family AllTables tables where
    AllTables '[x] = x
    AllTables (x ': xs) = x :. AllTables xs

class (FromRow (AllTables ts)) => AllHaveFromRowInstance ts where
    compositeToTuple :: proxy ts -> AllTables ts -> DbResult ts

instance (FromRow a) => AllHaveFromRowInstance '[a] where
    compositeToTuple _ = Entity

instance (FromRow a, FromRow b) => AllHaveFromRowInstance '[a, b] where
    compositeToTuple _ (a :. b) = (Entity a, Entity b)

instance (FromRow a, FromRow b, FromRow c) => AllHaveFromRowInstance '[a, b, c] where
    compositeToTuple _ (a :. b :. c) = (Entity a, Entity b, Entity c)

runDbStatement :: forall ts m f.
            (AllHaveFromRowInstance ts, MonadEffect Basic m)
         => DbStatement f ts -> m [DbResult ts]
runDbStatement = fmap (map (compositeToTuple (Proxy @ts)))
         . effectBasic
         . SqlRequest
         . compileToSql

runAggregateStatement ::
    forall aggr m.
    ( MonadEffect Basic m
    , FromRow (AggregationResult aggr))
    => AggregateStatement aggr 'AM -> m (AggregationResult aggr)
runAggregateStatement =
      fmap unsafeHead
    . effectBasic
    . SqlRequest
    . aggregateStatementToSql

type family WithoutOnly a where
    WithoutOnly (PSQL.Only a) = a
    WithoutOnly a = a
class NoOnly a where
    noOnly :: a -> WithoutOnly a
instance NoOnly (PSQL.Only a) where
    noOnly (PSQL.Only a) = a
instance {-# OVERLAPPABLE #-}
    WithoutOnly a ~ a
    => NoOnly a where
    noOnly = identity

runMapStatement ::
    forall res m f.
    ( MonadEffect Basic m
    , FromRow res
    , NoOnly res )
    => DbStatement f '[res] -> m [WithoutOnly res]
runMapStatement =
      fmap (fmap (noOnly @res))
    . effectBasic
    . SqlRequest
    . compileToSql