From c2d12f72b82b87b88c57592405395bf2fc7dd648 Mon Sep 17 00:00:00 2001 From: Yamada Ryo Date: Tue, 9 Jul 2024 00:52:13 +0900 Subject: [PATCH] [fix] Use 'liftIO' instead of 'sendIns' in the examples. --- README.md | 4 ++-- heftia-effects/Example/Continuation/Main.hs | 9 +++++---- heftia-effects/Example/Continuation2/Main.hs | 10 +++++----- heftia-effects/Example/KeyedEffects/Main.hs | 9 +++++---- heftia-effects/Example/Logging/Main.hs | 17 +++++++++-------- heftia-effects/Example/Teletype/Main.hs | 9 +++++---- heftia-effects/Example/Writer/Main.hs | 7 ++++--- 7 files changed, 35 insertions(+), 30 deletions(-) diff --git a/README.md b/README.md index 11004a3..b404469 100644 --- a/README.md +++ b/README.md @@ -75,8 +75,8 @@ are some examples: . interpretH (elaborateWriterPost @String) $ censorHello - sendIns $ putStrLn $ "Pre-applying: " <> sPre - sendIns $ putStrLn $ "Post-applying: " <> sPost + liftIO $ putStrLn $ "Pre-applying: " <> sPre + liftIO $ putStrLn $ "Post-applying: " <> sPost ``` Using the `elaborateWriterPre` elaborator, you'll get "Goodbye world!", whereas with the `elaborateWriterPost` elaborator, you'll get "Hello world!!". diff --git a/heftia-effects/Example/Continuation/Main.hs b/heftia-effects/Example/Continuation/Main.hs index 9892c72..c67147f 100644 --- a/heftia-effects/Example/Continuation/Main.hs +++ b/heftia-effects/Example/Continuation/Main.hs @@ -7,9 +7,10 @@ module Main where -import Control.Effect (SendIns (sendIns), type (~>)) +import Control.Effect (type (~>)) import Control.Effect.ExtensibleChurch (runEff, type (:!!)) import Control.Effect.Hefty (interposeK, interpretH, interpretRec) +import Control.Monad.IO.Class (liftIO) import Data.Effect.TH (makeEffectF, makeEffectH) import Data.Function ((&)) import Data.Hefty.Extensible (ForallHFunctor, type (<|)) @@ -39,13 +40,13 @@ main = . runForkSingle . interpretH (applyResetFork 4) $ do - sendIns . putStrLn . (("[out of scope] " ++) . show) =<< fork + liftIO . putStrLn . (("[out of scope] " ++) . show) =<< fork s <- resetFork do fid1 <- fork fid2 <- fork - sendIns $ putStrLn $ "[delimited continuation of `fork`] Fork ID: " ++ show (fid1, fid2) + liftIO $ putStrLn $ "[delimited continuation of `fork`] Fork ID: " ++ show (fid1, fid2) pure $ show (fid1, fid2) - sendIns $ putStrLn $ "scope exited. result: " ++ s + liftIO $ putStrLn $ "scope exited. result: " ++ s {- [out of scope] 0 diff --git a/heftia-effects/Example/Continuation2/Main.hs b/heftia-effects/Example/Continuation2/Main.hs index d7161ec..a513687 100644 --- a/heftia-effects/Example/Continuation2/Main.hs +++ b/heftia-effects/Example/Continuation2/Main.hs @@ -4,13 +4,13 @@ module Main where -import Control.Effect (sendIns) import Control.Effect.ExtensibleChurch (runEff, type (!!)) import Control.Effect.Handler.Heftia.Reader (elaborateLocal, interpretAsk) import Control.Effect.Handler.Heftia.ShiftReset (Shift, Shift_, getCC, getCC_, runShift, runShift_) import Control.Effect.Handler.Heftia.State (evalState) import Control.Effect.Hefty (interpretH, send1, type ($)) import Control.Monad.Extra (whenM) +import Control.Monad.IO.Class (liftIO) import Data.Effect.HFunctor ((:+:)) import Data.Effect.Reader (Ask, Local, ask, local) import Data.Effect.State (State, get, modify) @@ -72,12 +72,12 @@ elaborateLocalThenShift = prog = do k <- send1 getCC env <- ask @Double - send1 $ sendIns $ putStrLn $ "[local scope outer] env = " ++ show env + send1 $ liftIO $ putStrLn $ "[local scope outer] env = " ++ show env local @Double (* 2) do whenM (send1 (get @Int) <&> (< 5)) do send1 $ modify @Int (+ 1) env' <- ask @Double - send1 $ sendIns $ putStrLn $ "[local scope inner] env = " ++ show env' + send1 $ liftIO $ putStrLn $ "[local scope inner] env = " ++ show env' send1 k elaborateShiftThenLocal :: IO () @@ -93,10 +93,10 @@ elaborateShiftThenLocal = do prog = do k <- getCC_ env <- ask @Double - sendIns $ putStrLn $ "[local scope outer] env = " ++ show env + liftIO $ putStrLn $ "[local scope outer] env = " ++ show env local @Double (* 2) do whenM (get @Int <&> (< 5)) do modify @Int (+ 1) env' <- ask @Double - sendIns $ putStrLn $ "[local scope inner] env = " ++ show env' + liftIO $ putStrLn $ "[local scope inner] env = " ++ show env' k diff --git a/heftia-effects/Example/KeyedEffects/Main.hs b/heftia-effects/Example/KeyedEffects/Main.hs index fc2afe6..c18a1d0 100644 --- a/heftia-effects/Example/KeyedEffects/Main.hs +++ b/heftia-effects/Example/KeyedEffects/Main.hs @@ -7,10 +7,11 @@ module Main where -import Control.Effect (SendIns (sendIns), type (~>)) +import Control.Effect (type (~>)) import Control.Effect.ExtensibleChurch (runEff, type (:!!)) import Control.Effect.Hefty (interposeRec, interpretRec, unkeyEff) import Control.Effect.Key (SendInsBy) +import Control.Monad.IO.Class (liftIO) import Data.Effect.Key (unKey, type (#>)) import Data.Effect.TH (makeEffectF) import Data.Hefty.Extensible (ForallHFunctor, MemberBy, type (<|)) @@ -23,8 +24,8 @@ makeEffectF [''Teletype] teletypeToIO :: (IO <| r, ForallHFunctor eh) => eh :!! LTeletype ': r ~> eh :!! r teletypeToIO = interpretRec \case - ReadTTY -> sendIns getLine - WriteTTY msg -> sendIns $ putStrLn msg + ReadTTY -> liftIO getLine + WriteTTY msg -> liftIO $ putStrLn msg echo :: (SendInsBy "tty1" Teletype m, Monad m) => m () echo = do @@ -41,5 +42,5 @@ strong = main :: IO () main = runEff do - sendIns $ putStrLn "Please enter something..." + liftIO $ putStrLn "Please enter something..." teletypeToIO . unkeyEff @"tty1" . strong . strong $ echo diff --git a/heftia-effects/Example/Logging/Main.hs b/heftia-effects/Example/Logging/Main.hs index 82e49ad..9812e7d 100644 --- a/heftia-effects/Example/Logging/Main.hs +++ b/heftia-effects/Example/Logging/Main.hs @@ -9,12 +9,13 @@ module Main where import Control.Arrow ((>>>)) -import Control.Effect (sendIns, type (<:), type (<<:), type (~>)) +import Control.Effect (type (<:), type (<<:), type (~>)) import Control.Effect.ExtensibleChurch (runEff, type (:!!)) import Control.Effect.Handler.Heftia.Reader (interpretReader) import Control.Effect.Handler.Heftia.State (evalState) import Control.Effect.Hefty (interposeRec, interposeRecH, interpretRec, interpretRecH, raise, raiseH) import Control.Monad (when) +import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Effect.Reader (ask, local) import Data.Effect.State (get, modify) import Data.Effect.TH (makeEffectF, makeEffectH) @@ -33,7 +34,7 @@ data Log a where makeEffectF [''Log] logToIO :: (IO <| r, ForallHFunctor eh) => eh :!! LLog ': r ~> eh :!! r -logToIO = interpretRec \(Logging msg) -> sendIns $ T.putStrLn msg +logToIO = interpretRec \(Logging msg) -> liftIO $ T.putStrLn msg data Time a where CurrentTime :: Time UTCTime @@ -41,7 +42,7 @@ data Time a where makeEffectF [''Time] timeToIO :: (IO <| r, ForallHFunctor eh) => eh :!! LTime ': r ~> eh :!! r -timeToIO = interpretRec \CurrentTime -> sendIns getCurrentTime +timeToIO = interpretRec \CurrentTime -> liftIO getCurrentTime logWithTime :: (Log <| ef, Time <| ef, ForallHFunctor eh) => eh :!! ef ~> eh :!! ef logWithTime = interposeRec \(Logging msg) -> do @@ -88,9 +89,9 @@ makeEffectF [''FileSystem] runDummyFS :: (IO <| r, ForallHFunctor eh) => eh :!! LFileSystem ': r ~> eh :!! r runDummyFS = interpretRec \case Mkdir path -> - sendIns $ putStrLn $ " mkdir " <> path + liftIO $ putStrLn $ " mkdir " <> path WriteToFile path content -> - sendIns $ putStrLn $ " writeToFile " <> path <> " : " <> content + liftIO $ putStrLn $ " writeToFile " <> path <> " : " <> content -- | Create directories according to the log-chunk structure and save one log in one file. saveLogChunk :: @@ -112,7 +113,7 @@ saveLogChunk = ) >>> interpretReader @FilePath "./log/" -logExample :: (LogChunk <<: m, Log <: m, IO <: m, Monad m) => m () +logExample :: (LogChunk <<: m, Log <: m, MonadIO m) => m () logExample = logChunk "scope1" do logging "foo" @@ -120,7 +121,7 @@ logExample = logging "baz" logging "qux" - sendIns $ putStrLn "------" + liftIO $ putStrLn "------" logChunk "scope2" do logging "hoge" @@ -128,7 +129,7 @@ logExample = logging "fuga" logging "hogera" - sendIns $ putStrLn "------" + liftIO $ putStrLn "------" logging "quux" logging "foobar" diff --git a/heftia-effects/Example/Teletype/Main.hs b/heftia-effects/Example/Teletype/Main.hs index 5011f7a..ed8247f 100644 --- a/heftia-effects/Example/Teletype/Main.hs +++ b/heftia-effects/Example/Teletype/Main.hs @@ -11,9 +11,10 @@ The original of this example can be found at polysemy. -} module Main where -import Control.Effect (SendIns (sendIns), type (<:), type (~>)) +import Control.Effect (type (<:), type (~>)) import Control.Effect.ExtensibleChurch (runEff, type (:!!)) import Control.Effect.Hefty (interposeRec, interpretRec, untagEff) +import Control.Monad.IO.Class (liftIO) import Data.Effect.TH (makeEffectF) import Data.Effect.Tag (Tag (unTag), type (#)) import Data.Hefty.Extensible (ForallHFunctor, type (<|)) @@ -26,8 +27,8 @@ makeEffectF [''Teletype] teletypeToIO :: (IO <| r, ForallHFunctor eh) => eh :!! LTeletype ': r ~> eh :!! r teletypeToIO = interpretRec \case - ReadTTY -> sendIns getLine - WriteTTY msg -> sendIns $ putStrLn msg + ReadTTY -> liftIO getLine + WriteTTY msg -> liftIO $ putStrLn msg echo :: (Teletype # "tty1" <: m, Monad m) => m () echo = do @@ -44,5 +45,5 @@ strong = main :: IO () main = runEff do - sendIns $ putStrLn "Please enter something..." + liftIO $ putStrLn "Please enter something..." teletypeToIO . untagEff @"tty1" . strong . strong $ echo diff --git a/heftia-effects/Example/Writer/Main.hs b/heftia-effects/Example/Writer/Main.hs index 2d00530..050fe3b 100644 --- a/heftia-effects/Example/Writer/Main.hs +++ b/heftia-effects/Example/Writer/Main.hs @@ -4,10 +4,11 @@ module Main where -import Control.Effect (sendIns, type (<:), type (<<:)) +import Control.Effect (type (<:), type (<<:)) import Control.Effect.ExtensibleChurch (runEff) import Control.Effect.Handler.Heftia.Writer (elaborateWriterPost, elaborateWriterPre, interpretTell) import Control.Effect.Hefty (interpretH) +import Control.Monad.IO.Class (liftIO) import Data.Effect.Writer (Tell, WriterH, censor, tell) hello :: (Tell String <: m, Monad m) => m () @@ -40,8 +41,8 @@ main = runEff do . interpretH (elaborateWriterPost @String) $ censorHello - sendIns $ putStrLn $ "Pre-applying: " <> sPre - sendIns $ putStrLn $ "Post-applying: " <> sPost + liftIO $ putStrLn $ "Pre-applying: " <> sPre + liftIO $ putStrLn $ "Post-applying: " <> sPost {- Pre-applying: Goodbye world!