ログイン
i-mobile
記事の一覧
4.<■ | extensible-effectsで...>6.

2014-04-27

extensible-effectsと 23:33 Add Star

extensible-effectsとdata types a la carteに出てきたものが似てるという感じの話です。

extensible-effects

http://hackage.haskell.org/package/extensible-effects

http://okmij.org/ftp/Haskell/extensible/

http://konn-san.com/prog/haskell/extensible-effects.html


data types a la carte

http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf

https://github.com/pepeiborra/alacarte/blob/master/example.hs

http://eed3si9n.com/learning-scalaz/ja/Coproducts.html


似てるところなど

extensible-effectsの方は:>で、data types a la carteは:+:で機能を組み合わせてく感じが似てます。

Memberと:<:が似てる気がします。


違うところはextensible-effectsの方はCPSを使ってるとか、評価の方法が違う感じがします。


data types a la carteでは実際に値を評価するときは下のような型クラスを作って、必要なインスタンスを定義してという感じで評価していきます。


class Functor f => Eval f where
    evalAlgebra :: f a -> a

ただこれだとrunStateみたいなものを書こうとするとStateの初期値をインスタンス定義のところに直に書く感じで

使い回ししづらいかもしれません。


extensible-effectsでは下の感じで:>で積み重ねたEffectを一つずつ左から外していく感じで評価していきます。

このときにrunReaderとかrunStateを使います。

ただ自分でEffectを作った時にこのrunなんとかの関数を書くのが少し難しそうという気がします。

それと構造をEffectごとに走査していく感じで、あまり効率がよくなさそうなんですが実際はどうなんだろう。

eff :: Eff (A :> B :> C :> ()) a
runA eff :: Eff (B :> C :> ()) a
runB . runA $ eff :: Eff (C :> ()) a
runC . runB . runA $ eff :: Eff () a
run . runC . runB . runA $ eff :: a

実験コード

下はdata types a la carteに出てきた部品でEffっぽく書いてみたものです。

一応同じようなことができそうな感じはしますが、Effの方をあまり詳しく見てないので不可能なこととかもあるかもしれません。

Liftは多分FreeTを使えば同じことができそうな気がします。

{-# LANGUAGE TypeOperators, MultiParamTypeClasses, OverlappingInstances, FlexibleInstances, FlexibleContexts, ScopedTypeVariables #-}

import Control.Monad.Free (Free(..))
import Control.Monad.Identity (Identity(..))

import Test.Hspec
import Test.Hspec.QuickCheck



-- coproduct, 余積
data (f :+: g) e = Inl (f e) | Inr (g e)
infixr 6 :+:

class (Functor sub, Functor sup) => sub :<: sup where
    inject :: sub a -> sup a

instance (Functor f, Functor g) => Functor (f :+: g) where
    fmap f (Inl e1)  = Inl (fmap f e1)
    fmap f (Inr e2)  = Inr (fmap f e2)

instance Functor f => f :<: f where
    inject = id

instance (Functor f, Functor g) => f :<: (f :+: g) where
    inject = Inl

instance (Functor f, Functor g, Functor h, f :<: g) => f :<: (h :+: g) where
    inject = Inr . inject



-- Reader
newtype Reader e a = Reader { unReader :: e -> a }

instance Functor (Reader e) where
    fmap f (Reader g) = Reader (f. g)

ask :: (Reader r :<: f) => Free f r
ask = Free . inject . Reader $ Pure

runReader :: (Functor g) => r -> Free (Reader r :+: g) a -> Free g a
runReader r (Free (Inl a)) = runReader r (unReader a r)
runReader r (Free (Inr a)) = Free $ fmap (runReader r) a
runReader _ (Pure a) = Pure a



-- State
newtype State s a = State { unState :: s -> (a, s) }

get :: (State s :<: f) => Free f s
get = Free . inject . State $ \s -> (Pure s, s)

put :: (State s :<: f) => s -> Free f ()
put s = Free . inject . State $ \_ -> (Pure (), s)

modify :: (State s :<: f) => (s -> s) -> Free f ()
modify f = get >>= put . f

instance Functor (State s) where
    fmap f (State g) = State $ \s -> let (a, r) = g s
                                     in (f a, r)

runState :: (Functor g) => s -> Free (State s :+: g) a -> Free g (a, s)
runState s (Free (Inl (State g)))= let (a, s') = g s
                                   in runState s' a
runState s (Free (Inr a)) = Free $ fmap (runState s) a
runState s (Pure a) = Pure (a, s)



-- Eff
type Eff f a = Free f a

run :: Eff Identity a -> a
run (Free a) = run (runIdentity a)
run (Pure a) = a



-- spec
main :: IO ()
main = hspec $ readerSpec >> stateSpec

readerSpec :: Spec
readerSpec = do
    prop "Reader一つ" $
        \a ->
            let reader :: Eff (Reader Int :+: Identity) Int
                reader = ask >>= return
            in (run . runReader a $ reader) == a

    prop "Reader二つ" $
        \(a, b) ->
            let reader :: Eff (Reader Int :+: Reader String :+: Identity) (Int, String)
                reader = do { x <- ask; y <- ask; return (x, y) }
            in (run . runReader b . runReader a $ reader) == (a, b)



stateSpec :: Spec
stateSpec = do
    prop "足し算" $
        \xs ->
            let state :: Eff (State Int :+: Identity) ()
                state = mapM_ (\x -> modify (x+)) xs
            in (run . runState 0 $ state) == ((), sum xs)

    prop "State二つ" $
        \(xs) ->
            let f x = modify (+x) >> modify (++ show x)
                state :: Eff (State Int :+: State String :+: Identity) ()
                state = mapM_ f xs
            in (run . runState "" . runState 0 $ state) == (((), sum xs), concat . map show $ xs)
4.<■ | extensible-effectsで...>6.
●ウェブ検索●