sayo-hs/heftia
1
1
Fork 0
mirror of https://github.com/sayo-hs/heftia.git synced 2024-11-23 20:09:22 +03:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

[fix] Use 'ForallFunctor' as the standard constraint name that does not depend on the implementation of union datatype.

Browse Source
This commit is contained in:
Yamada Ryo 2024-07-07 05:15:02 +09:00
parent 621a335c2a
commit 9ef6817000
No known key found for this signature in database
GPG Key ID: AAE3C7A542B02DBF
2 changed files with 6 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
heftia-effects/Example/DepParams/Main.hs
View File

@ -10,9 +10,8 @@ module Main where
import Control.Effect (SendIns (sendIns), type (~>))
import Control.Effect.ExtensibleChurch (runEff, type (:!!))
import Control.Effect.Hefty (interposeRec, interpretRec, unkeyEff)
import Data.Effect.HFunctor (HFunctor)
import Data.Effect.TH (makeEffectF)
import Data.Hefty.Extensible (Forall, type (<|), MemberBy)
import Data.Hefty.Extensible (type (<|), MemberBy, ForallHFunctor)
import Data.Effect.Key (type (#>), unKey)
import Data.Function ((&))
import Control.Effect.Key (key, SendInsBy)
@ -23,7 +22,7 @@ data Teletype a where
makeEffectF [''Teletype]
teletypeToIO :: (IO <| r, Forall HFunctor eh) => eh :!! LTeletype ': r ~> eh :!! r
teletypeToIO :: (IO <| r, ForallHFunctor eh) => eh :!! LTeletype ': r ~> eh :!! r
teletypeToIO = interpretRec \case
ReadTTY -> sendIns getLine
WriteTTY msg -> sendIns $ putStrLn msg
@ -35,7 +34,7 @@ echo = do
"" -> pure ()
_ -> writeTTY i & key @"tty1" >> echo
strong :: (MemberBy "tty1" Teletype ef, Forall HFunctor eh) => eh :!! ef ~> eh :!! ef
strong :: (MemberBy "tty1" Teletype ef, ForallHFunctor eh) => eh :!! ef ~> eh :!! ef
strong =
interposeRec @("tty1" #> _) \e -> case unKey e of
ReadTTY -> readTTY & key @"tty1"

7
heftia-effects/Example/Teletype/Main.hs
View File

@ -14,10 +14,9 @@ module Main where
import Control.Effect (SendIns (sendIns), type (<:), type (~>))
import Control.Effect.ExtensibleChurch (runEff, type (:!!))
import Control.Effect.Hefty (interposeRec, interpretRec, untagEff)
import Data.Effect.HFunctor (HFunctor)
import Data.Effect.TH (makeEffectF)
import Data.Effect.Tag (Tag (unTag), type (#))
import Data.Hefty.Extensible (Forall, type (<|))
import Data.Hefty.Extensible (type (<|), ForallHFunctor)
data Teletype a where
ReadTTY :: Teletype String
@ -25,7 +24,7 @@ data Teletype a where
makeEffectF [''Teletype]
teletypeToIO :: (IO <| r, Forall HFunctor eh) => eh :!! LTeletype ': r ~> eh :!! r
teletypeToIO :: (IO <| r, ForallHFunctor eh) => eh :!! LTeletype ': r ~> eh :!! r
teletypeToIO = interpretRec \case
ReadTTY -> sendIns getLine
WriteTTY msg -> sendIns $ putStrLn msg
@ -37,7 +36,7 @@ echo = do
"" -> pure ()
_ -> writeTTY' @"tty1" i >> echo
strong :: (Teletype # "tty1" <| ef, Forall HFunctor eh) => eh :!! ef ~> eh :!! ef
strong :: (Teletype # "tty1" <| ef, ForallHFunctor eh) => eh :!! ef ~> eh :!! ef
strong =
interposeRec @(_ # "tty1") \e -> case unTag e of
ReadTTY -> readTTY' @"tty1"