{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | This module exports 'ToSourceIO' and 'FromSourceIO' for 'MachineT' instances.
module Servant.Machines (
    MachineToSourceIO (..),
    ) where

import           Control.Monad.IO.Class
                 (MonadIO (..))
import           Data.Machine
                 (MachineT (..), Step (..))
import           Servant.API.Stream
import qualified Servant.Types.SourceT  as S

-- | Helper class to implement @'ToSourceIO' 'MachineT'@ instance
-- for various monads.
class MachineToSourceIO m where
    machineToSourceIO :: MachineT m k o -> S.SourceT IO o

instance MachineToSourceIO IO where
    machineToSourceIO :: forall (k :: * -> *) o. MachineT IO k o -> SourceT IO o
machineToSourceIO MachineT IO k o
ma = forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT (forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {k :: * -> *} {a}.
Monad m =>
MachineT m k a -> StepT m a
go MachineT IO k o
ma) where
        go :: MachineT m k a -> StepT m a
go (MachineT m (Step k a (MachineT m k a))
m) = forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect forall a b. (a -> b) -> a -> b
$ do
            Step k a (MachineT m k a)
step <- m (Step k a (MachineT m k a))
m
            case Step k a (MachineT m k a)
step of
                Step k a (MachineT m k a)
Stop         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a. StepT m a
S.Stop
                Yield a
x MachineT m k a
m'   -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield a
x (MachineT m k a -> StepT m a
go MachineT m k a
m'))
                Await t -> MachineT m k a
_ k t
_ MachineT m k a
m' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. StepT m a -> StepT m a
S.Skip (MachineT m k a -> StepT m a
go MachineT m k a
m'))

instance MachineToSourceIO m => ToSourceIO o (MachineT m k o) where
    toSourceIO :: MachineT m k o -> SourceIO o
toSourceIO = forall (m :: * -> *) (k :: * -> *) o.
MachineToSourceIO m =>
MachineT m k o -> SourceT IO o
machineToSourceIO

instance MonadIO m => FromSourceIO o (MachineT m k o) where
    fromSourceIO :: SourceIO o -> IO (MachineT m k o)
fromSourceIO SourceIO o
src = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
SourceT m a -> forall b. (StepT m a -> m b) -> m b
S.unSourceT SourceIO o
src StepT IO o -> IO (Step k o (MachineT m k o))
go
      where
        go :: S.StepT IO o -> IO (Step k o (MachineT m k o))
        go :: StepT IO o -> IO (Step k o (MachineT m k o))
go StepT IO o
S.Stop        = forall (m :: * -> *) a. Monad m => a -> m a
return forall (k :: * -> *) o r. Step k o r
Stop
        go (S.Error String
err) = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
        go (S.Skip StepT IO o
s)    = StepT IO o -> IO (Step k o (MachineT m k o))
go StepT IO o
s
        go (S.Effect IO (StepT IO o)
ms) = IO (StepT IO o)
ms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StepT IO o -> IO (Step k o (MachineT m k o))
go
        go (S.Yield o
x StepT IO o
s) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
x (forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StepT IO o -> IO (Step k o (MachineT m k o))
go StepT IO o
s))))
    {-# SPECIALIZE INLINE fromSourceIO :: SourceIO o -> IO (MachineT IO k o) #-}