From de1c7e6052782777e38efb8be39cb3a73c4022f4 Mon Sep 17 00:00:00 2001
From: Yamada Ryo <ymdfield@outlook.jp>
Date: Sat, 16 Sep 2023 15:23:52 +0900
Subject: [PATCH] [add] the entire code to the example 3.

---
 docs-ja/examples/01 First-order.md            |  2 +
 docs-ja/examples/03 Delimited Continuation.md | 51 +++++++++++++++++++
 2 files changed, 53 insertions(+)

diff --git a/docs-ja/examples/01 First-order.md b/docs-ja/examples/01 First-order.md
index 39107e7..0611d73 100644
--- a/docs-ja/examples/01 First-order.md	
+++ b/docs-ja/examples/01 First-order.md	
@@ -203,6 +203,8 @@ main = runFreerEffects $ do
 
 さらに、ハンドル時はタグを外して素の`TeletypeI`に戻すために、`untag @TTY1`を使用している。
 
+将来のclassy-effectsのバージョンでは、例えば`readTTY & tag @TTY1`を`readTTY' @TTY1`のように短く書けるようになる予定である。
+
 ## コード全体
 
 コードの全体は以下のようになる。暗黙的に有効になっているGHC拡張が多いことに注意せよ。
diff --git a/docs-ja/examples/03 Delimited Continuation.md b/docs-ja/examples/03 Delimited Continuation.md
index e99cd14..6fc8b6f 100644
--- a/docs-ja/examples/03 Delimited Continuation.md	
+++ b/docs-ja/examples/03 Delimited Continuation.md	
@@ -118,3 +118,54 @@ Haskell上でEffect Systemを実現するライブラリは数多くあるが、
 有名な「Algebraic Effects and Handlers」で可能なこと（例えば限定継続の取り出しとそれを用いたモジュラーなエフェクトのハンドリング）をほぼフルでエミュレートできるのは、
 筆者の知る限りではいまのところHefty Algebrasに基づくこの方式のみのはずである。
 
+## コード全体
+
+```hs
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import Control.Effect.Class (sendIns, type (~>))
+import Control.Effect.Class.Machinery.TH (makeEffectF, makeEffectH)
+import Control.Effect.Freer (Fre, interposeK, interpret, runFreerEffects, type (<|))
+import Control.Effect.Heftia (Elaborator, runElaborate)
+import Control.Monad.Trans.Heftia.Church (HeftiaChurchT)
+import Data.Function ((&))
+import Data.Hefty.Sum (SumUnionH)
+import Data.Hefty.Union (UnionH (absurdUnionH, (|+:)))
+
+type ForkID = Int
+
+class Fork f where
+    fork :: f ForkID
+
+makeEffectF ''Fork
+
+runForkSingle :: Monad m => Fre (ForkI ': r) m ~> Fre r m
+runForkSingle = interpret \Fork -> pure 0
+
+class DelimitFork f where
+    delimitFork :: Monoid w => f w -> f w
+
+makeEffectH ''DelimitFork
+
+applyDelimitFork :: (ForkI <| es, Monad m) => Int -> Elaborator DelimitForkS (Fre es m)
+applyDelimitFork numberOfFork (DelimitFork m) =
+    m & interposeK pure \k Fork -> do
+        r <- mapM k [1 .. numberOfFork]
+        pure $ mconcat r
+
+main :: IO ()
+main =
+    runFreerEffects
+        . runForkSingle
+        . runElaborate @_ @HeftiaChurchT @SumUnionH (applyDelimitFork 4 |+: absurdUnionH)
+        $ do
+            sendIns . putStrLn . (("[out of scope] " ++) . show) =<< fork
+            s <- delimitFork do
+                fid1 <- fork
+                fid2 <- fork
+                sendIns $ putStrLn $ "[delimited continuation of `fork`] Fork ID: " ++ show (fid1, fid2)
+                pure $ show (fid1, fid2)
+            sendIns $ putStrLn $ "scope exited. result: " ++ s
+```