Attempt at polymorphic interpreter for Polysemy

readevents.hs

#! /usr/bin/env nix-shell
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (p: [p.aeson p.polysemy p.polysemy-plugin])"

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}

import Data.Aeson (FromJSON, decode)
import Data.ByteString.Lazy (ByteString)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Polysemy

data ReadEvents e m a where
  ReadEvents :: StreamId -> s -> (s -> e -> s) -> ReadEvents e m s

data StreamId = MainStream | NamedStream Text

makeSem ''ReadEvents

-- * Fake event store
getStream :: StreamId -> [ByteString]
getStream MainStream = ["1", "2", "3"]
getStream (NamedStream "foo") = ["\"a\"", "\"b\"", "\"c\""]

runFakeEventStore :: (FromJSON e) => Sem (ReadEvents e ': r) a -> Sem r a
runFakeEventStore = interpret \case
  ReadEvents stream init fold ->
    pure $ foldl fold init $ mapMaybe decode $ getStream stream

addAll :: (Member (ReadEvents Int) r) => Sem r String
addAll = show <$> readEvents MainStream 0 (+)

dashes :: (Member (ReadEvents Char) r) => Sem r String
dashes = readEvents (NamedStream "foo") "" \str char -> str <> ['-', char]

main :: IO ()
main = do
  putStrLn $
    run $
      runFakeEventStore @Int $
        runFakeEventStore @Char do
          str1 <- addAll
          str2 <- dashes
          pure $ str1 <> str2