{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
module Data.Morpheus.Types.Resolver
  ( Pure
  , Resolver
  , MutResolver
  , SubResolver
  , ResolveT
  , SubResolveT
  , MutResolveT
  , SubRootRes
  , Event(..)
  , GQLRootResolver(..)
  , resolver
  , mutResolver
  , toMutResolver
  ) where
import           Control.Monad.Trans.Except              (ExceptT (..), runExceptT)
import           Data.Morpheus.Types.Internal.Stream     (Event (..), PublishStream, StreamState (..), StreamT (..),
                                                          SubscribeStream)
import           Data.Morpheus.Types.Internal.Validation (ResolveT)
type MutResolveT m e c a = ResolveT (PublishStream m e c) a
type Resolver = ExceptT String
type MutResolver m e c = Resolver (PublishStream m e c)
type SubResolver m e c a = Event e (Event e c -> Resolver m a)
type SubResolveT m e c a
   = ResolveT (SubscribeStream m e) (Event e c -> ResolveT m a)
type SubRootRes m e sub = Resolver (SubscribeStream m e) sub
type Pure = Either String
resolver :: m (Either String a) -> Resolver m a
resolver = ExceptT
toMutResolver :: Monad m => [Event e c] -> Resolver m a -> MutResolver m e c a
toMutResolver channels =
  ExceptT . StreamT . fmap (StreamState channels) . runExceptT
mutResolver ::
     Monad m
  => [Event e c]
  -> (StreamT m (Event e c)) (Either String a)
  -> MutResolver m e c a
mutResolver channels = ExceptT . StreamT . fmap effectPlus . runStreamT
  where
    effectPlus state = state {streamEvents = channels ++ streamEvents state}
data GQLRootResolver m e c query mut sub =
  GQLRootResolver
    { queryResolver        :: Resolver m query
    , mutationResolver     :: Resolver (PublishStream m e c) mut
    , subscriptionResolver :: SubRootRes m e sub
    }