{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | TBW
--
module Servant.Machines where

import           Control.Monad.Error.Class
                 (MonadError (..))
import           Control.Monad.IO.Class
                 (MonadIO (..))
import           Data.Machine
import           Servant.API.Stream

instance m ~ IO => ToStreamGenerator (MachineT m k o) o where
    toStreamGenerator (MachineT m) = StreamGenerator $ \f g -> do
        step <- m
        case step of
            Stop      -> return ()
            Yield o m' -> do
                f o
                loop g m'
            Await _ _ m' -> loop g m'
      where
        loop :: (o -> IO ()) -> MachineT m k o -> IO ()
        loop g = go where
            go (MachineT m0) = do
                step <- m0
                case step of
                    Stop         -> return ()
                    Yield o m'   -> g o >> go m'
                    Await _ _ m' -> go m'

instance (MonadIO m, MonadError String m) => BuildFromStream o (MachineT m k o) where
    buildFromStream (ResultStream f) = f mk where
        mk action = return r where
            r = MachineT $ liftIO action >>= \x -> case x of
                Nothing         -> return Stop
                Just (Right y)  -> return (Yield y r)
                Just (Left err) -> throwError err