试图实现“迭代器模式的本质”

时间:2018-10-31 21:33:21

标签: haskell applicative

我碰到了论文“ https://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf”,其中有非常抽象的伪haskell语法的代码示例。

我正在努力实现6.2节中的示例。在真正的haskell中。 这是我走了多远:

module Iterator where
import Data.Functor.Const               -- for Const
import Data.Monoid (Sum (..), getSum)   -- for Sum
import Control.Monad.State.Lazy         -- for State
import Control.Applicative              -- for WrappedMonad


data Prod m n a = Prod {pfst:: m a, psnd:: n a} deriving (Show)

instance (Functor m, Functor n) => Functor (Prod m n) where    
fmap f (Prod m n) = Prod (fmap f m) (fmap f n)

instance (Applicative m, Applicative n) => Applicative (Prod m n) where
    pure x = Prod (pure x) (pure x)
    mf <*> mx = Prod (pfst mf <*> pfst mx) (psnd mf <*> psnd mx)

-- Functor Product
x :: (Functor m, Functor n) => (a -> m b) -> (a -> n b) -> (a -> Prod m n b)
(f `x` g) y = Prod (f y) (g y) 


type Count = Const (Sum Integer)
count :: a -> Count b
count _ = Const 1

cciBody :: Char -> Count a
cciBody = count

cci :: String -> Count [a]
cci = traverse cciBody

lciBody :: Char -> Count a
lciBody c = Const (Sum $ test (c == '\n'))

test :: Bool -> Integer
test b = if b then 1 else 0

lci :: String -> Count [a]
lci = traverse lciBody

clci :: String -> Prod Count Count [a]
clci = traverse (cciBody `x` lciBody)
-- up to here the code is working

-- can't get this to compile:
wciBody :: Char -> (WrappedMonad (Prod (State Bool) Count)) a
wciBody c =  pure $ state (updateState c) where
    updateState :: Char -> Bool -> (Integer, Bool)
    updateState c w = let s = c /= ' ' in (test (not(w && s)), s)

wci :: String -> (WrappedMonad (Prod (State Bool) Count)) [a]
wci = traverse wciBody

clwci :: String -> (Prod (Prod Count Count) (WrappedMonad (Prod (State Bool) Count))) [a]
clwci = traverse (cciBody `x` lciBody `x` wciBody)

str :: [Char]
str = "hello \n nice \t and \n busy world"

iteratorDemo = do
    print $ clci str
    print $ clwci str

有问题的地方是wciBody,在这里我不知道如何实现本文中的⇑函数。 有什么想法吗?

2 个答案:

答案 0 :(得分:10)

我认为您可能会在本文中使用的中缀类型运算符与定义中的前缀类型构造函数之间进行错误转换。我之所以这样说,是因为论文包含

wciBody :: Char → ( (State Bool) ⊡ Count) a

您已将其翻译为

wciBody :: Char -> (WrappedMonad (Prod (State Bool) Count)) a

我认为这没有道理:Prod x y没有Monad实例,因此将其包装在WrapMonad中是没有意义的。相反,您打算将⊡字符读为将其整个左半部分( (State Bool)与其右半部分(Count)分开,类似于Haskell中的值级运算符如何解析:

wciBody :: Char -> Prod (WrappedMonad (State Bool)) Count a

这更有意义,不是吗? Prod现在接受三个参数,其中前两个参数均为* -> *类型,并且WrappedMonad的参数显然是monad。这样的变化会让您重回正轨吗?

答案 1 :(得分:1)

感谢amalloy的提示,我终于使示例代码正常工作。

这是我想出的:

module Iterator where
import Data.Functor.Product             -- Product of Functors
import Data.Functor.Compose             -- Composition of Functors
import Data.Functor.Const               -- Const Functor
import Data.Functor.Identity            -- Identity Functor (needed for coercion)
import Data.Monoid (Sum (..), getSum)   -- Sum Monoid for Integers
import Control.Monad.State.Lazy         -- State Monad
import Control.Applicative              -- WrappedMonad
import Data.Coerce (coerce)             -- Coercion magic

-- Functor Product
(<#>) :: (Functor m, Functor n) => (a -> m b) -> (a -> n b) -> (a -> Product m n b)
(f <#> g) y = Pair (f y) (g y) 

-- Functor composition
(<.>) :: (Functor m, Functor n) => (b -> n c) -> (a -> m b) -> (a -> (Compose m n) c)
f <.> g = Compose . fmap f . g

type Count = Const (Sum Integer)

count :: a -> Count b
count _ = Const 1

cciBody :: Char -> Count a
cciBody = count

cci :: String -> Count [a]
cci = traverse cciBody

lciBody :: Char -> Count a
lciBody c = Const $ test (c == '\n')

test :: Bool -> Sum Integer
test b = Sum $ if b then 1 else 0

lci :: String -> Count [a]
lci = traverse lciBody

clci :: String -> Product Count Count [a]
clci = traverse (cciBody <#> lciBody)

wciBody :: Char -> Compose (WrappedMonad (State Bool)) Count a
wciBody c =  coerce (updateState c) where
    updateState :: Char -> Bool -> (Sum Integer, Bool)
    updateState c w = let s = not(isSpace c) in (test (not w && s), s)
    isSpace :: Char -> Bool
    isSpace c = c == ' ' || c == '\n' || c == '\t'

wci :: String -> Compose (WrappedMonad (State Bool)) Count [a]
wci = traverse wciBody

clwci :: String -> (Product (Product Count Count) (Compose (WrappedMonad (State Bool)) Count)) [a]
clwci = traverse (cciBody <#> lciBody <#> wciBody)

-- | the actual wordcount implementation. 
--   for any String a triple of linecount, wordcount, charactercount is returned
wc :: String -> (Integer, Integer, Integer)
wc str = 
    let raw = clwci str
        cc  = coerce $ pfst (pfst raw)
        lc  = coerce $ psnd (pfst raw)
        wc  = coerce $ evalState (unwrapMonad (getCompose (psnd raw))) False
    in (lc,wc,cc)

pfst :: Product f g a -> f a
pfst (Pair fst _) = fst
psnd :: Product f g a -> g a
psnd (Pair _ snd) = snd

main = do
    putStrLn "computing three counters in one go"
    print $ wc "hello \n world"