mirror of
https://github.com/lexi-lambda/freer-simple.git
synced 2024-12-25 15:14:29 +03:00
Capitalization effect example
Purpose of this effect is to create very simple example that would be easy to compose in a very obvious way.
This commit is contained in:
parent
2affe8b612
commit
fd1d406dbe
22
examples/src/Capitalize.hs
Normal file
22
examples/src/Capitalize.hs
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
module Capitalize where
|
||||||
|
|
||||||
|
import Data.Char (toUpper)
|
||||||
|
|
||||||
|
import Control.Monad.Freer
|
||||||
|
import Control.Monad.Freer.Internal
|
||||||
|
|
||||||
|
data Capitalize v where
|
||||||
|
Capitalize :: String -> Capitalize String
|
||||||
|
|
||||||
|
capitalize :: Member Capitalize r => String -> Eff r String
|
||||||
|
capitalize = send . Capitalize
|
||||||
|
|
||||||
|
runCapitalizeM :: Eff (Capitalize ': r) w -> Eff r w
|
||||||
|
runCapitalizeM (Val x) = return x
|
||||||
|
runCapitalizeM (E u q) = case decomp u of
|
||||||
|
Right (Capitalize s) -> runCapitalizeM (qApp q (map toUpper s))
|
||||||
|
Left u' -> E u' (tsingleton (\s -> runCapitalizeM (qApp q s)))
|
@ -88,7 +88,8 @@ executable freer-examples
|
|||||||
hs-source-dirs: examples/src
|
hs-source-dirs: examples/src
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
Common
|
Capitalize
|
||||||
|
, Common
|
||||||
, Coroutine
|
, Coroutine
|
||||||
, Cut
|
, Cut
|
||||||
, Fresh
|
, Fresh
|
||||||
|
Loading…
Reference in New Issue
Block a user