{-# LANGUAGE RankNTypes, ConstraintKinds, FlexibleContexts, TypeFamilies, ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications, TypeOperators, DataKinds, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE TypeFamilyDependencies #-}
module Internal.Control.Effects.Basic 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

data Basic

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

type instance EffectMsg1 Basic = SqlRequest
type instance EffectRes1 Basic = []
type instance EffectCon1 Basic a = FromRow a

handleBasic :: (forall b. FromRow b => SqlRequest b -> m [b])
            -> EffectHandler1 Basic m a -> m a
handleBasic = handleEffect1

-- | Handles SQL by querying a PostgreSQL database.
handleBasicPsql :: MonadIO m => Connection -> EffectHandler1 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, MonadEffect1 Basic m)
         => DbStatement f ts -> m [DbResult ts]
runDbStatement = fmap (map (compositeToTuple (Proxy @ts)))
         . effect1 (Proxy :: Proxy Basic)
         . SqlRequest
         . compileToSql

runAggregateStatement ::
    forall aggr m.
    ( MonadEffect1 Basic m
    , FromRow (AggregationResult aggr))
    => AggregateStatement aggr 'AM -> m (AggregationResult aggr)
runAggregateStatement =
      fmap unsafeHead
    . effect1 (Proxy :: Proxy Basic)
    . 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.
    ( MonadEffect1 Basic m
    , FromRow res
    , NoOnly res )
    => DbStatement f '[res] -> m [WithoutOnly res]
runMapStatement =
      fmap (fmap (noOnly @res))
    . effect1 (Proxy :: Proxy Basic)
    . SqlRequest
    . compileToSql

type MonadEffectBasic m = MonadEffect1 Basic m