`fused-effects` example

Main.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Main where

import Prelude hiding (read)

-- `isEOF` should be on `Prelude`.
import System.IO

import Control.Algebra
import Control.Applicative
import Control.Effect.State
-- Why is `guard` not in `Control.Applicative`?
import Control.Monad
import Control.Monad.IO.Class
import Data.Kind

cat :: Has (State String) sig m => m ()
cat = modify @String id >> cat

newtype ConsoleC m a = ConsoleC { runConsoleC :: m a }
  deriving (Applicative, Alternative, Functor, Monad, MonadIO)

instance (MonadIO m, Alternative m, Algebra sig m) => Algebra (State String :+: sig) (ConsoleC m) where
  alg hdl sig ctx = case sig of
    L Get -> do
      guard . not =<< liftIO isEOF
      text <- liftIO getLine
      return $ text <$ ctx
    L (Put s) -> do
      liftIO $ putStrLn s
      return ctx
    R other -> ConsoleC $ alg (runConsoleC . hdl) other ctx

main :: IO ()
main = runConsoleC cat <|> return ()