LINUX.ORG.RU
Форум — Development  

conduits: выбор вариантов

 


0

5

Здравствуйте.

Есть такой код:

{-# LANGUAGE OverloadedStrings #-}

import Data.Conduit
import Conduit
import Control.Concurrent.Async
import Data.Conduit.Network
import Data.Conduit.Binary as DCB
import Data.Conduit.List as DCL
import Data.ByteString.Char8 as B

hostnameListen = "127.0.0.1"

main :: IO ()
main = 
  runTCPServer (serverSettings 4003 hostnameListen) $ \server ->
    appSource server $= DCB.lines $= condToInt $= condToBS $$ appSink server

condToInt :: Conduit ByteString IO Int
condToInt = awaitForever $ \bs -> do
  let res = B.readInt bs
  case res of
    Nothing -> yield 0
    Just (x, _) -> yield x

condToBS :: Conduit Int IO ByteString
condToBS = awaitForever $ \i -> do
  let result = B.pack . show $ i
  yield result

condMultiplN :: Int -> Conduit Int IO Int
condMultiplN m = awaitForever $ \i ->
  yield $ i * m

Ломаю голову над следующим: как сделать так, чтобы в 

appSource server $= DCB.lines $= condToInt $= condToBS $$ appSink server
после condToInt, в зависимости от чётности числа (к примеру), вышедшего из этого кондуита, зависело то, какой кондуит дальше будет его обрабатывать.

Поясню подробнее.

main :: IO ()
main = 
  runTCPServer (serverSettings 4003 hostnameListen) $ \server -> do
    (resum1, res) <- appSource server $= DCB.lines $$+ condToInt 
    case (odd res) of
      True -> resum1 $$+- condMultiplN 2 =$ condToBS $$ appSink server
      otherwise -> resum1 $$+- condMultiplN 3 =$ condToBS $$ appSink server

Я знаю, что показанный код нерабочий, ибо 

($$+) :: Monad m => Source m a -> Sink a m b -> m (ResumableSource m a, b)
но мне кажется, что мою мысль передать получилось: взять что-то, проверить и пустить по одному из направлений, взять следующее что-то, опять проверить и пустить по одному из направлений, повторить.

Вопрос: как этого добиться?

★
← Ядерная отладка
Два дерева и кнопка →
Ответ на: комментарий от anonymous

Да, то, что надо:

{-# LANGUAGE OverloadedStrings #-}

import Data.Conduit
import Conduit
import Data.Conduit.Network
import Data.Conduit.Binary as DCB
import Data.Conduit.List as DCL

import Control.Applicative


import Data.ByteString.Char8 as B

hostnameListen = "127.0.0.1"

main :: IO ()
main = 
  runTCPServer (serverSettings 4003 hostnameListen) $ \server ->
    appSource server $= DCB.lines $= condToInt $= condTransf $$ appSink server

condToInt :: Monad m => Conduit ByteString m Int
condToInt = awaitForever $ \bs -> do
  let res = B.readInt bs
  case res of
    Nothing -> yield 0
    Just (x, _) -> yield x

condToBS :: Monad m => Conduit Int m ByteString
condToBS = awaitForever $ \i -> do
  let result = B.pack . show $ i
  yield result

condMultiplN :: Monad m => Int -> Conduit Int m Int
condMultiplN m = awaitForever $ \i ->
  yield $ i * m

-- объединяем для удобства в один кондуит
condTransf :: Monad m => Conduit Int m ByteString
condTransf = condSplit =$= condConct =$= condToBS

-- разделяем поток на 2 части
condSplit :: Monad m => Conduit Int m (Either Int Int)
condSplit = DCL.map $ \i ->
  if odd i then Left i else Right i

-- сливаем поток из 2-х частей в один поток
condConct :: Monad m => Conduit (Either Int Int) m Int
condConct = getZipConduit $ 
  ZipConduit condEven *>
    ZipConduit condOdd

-- нечётные числа умножить на 3
condOdd :: Monad m => Conduit (Either Int Int) m Int
condOdd = DCL.mapMaybe (either Just (const Nothing)) =$= condMultiplN 3

-- чётные числа умножить на 2
condEven :: Monad m => Conduit (Either Int Int) m Int
condEven = DCL.mapMaybe (either (const Nothing) Just) =$= condMultiplN 2

По идее, если задача будет требовать разделения на большее количество отдельных потоков, то надо будет определить такой тип данных, который будет расширением Either до нужного числа вариантов.

Всем спасибо за помощь!

HolyBoy ★
() автор топика
Ответ на: комментарий от HolyBoy

Раз местами и так однострочники, то можно вот так:

condToInt :: Monad m => Conduit ByteString m Int
condToInt = awaitForever $ yield . maybe 0 fst . B.readInt

condToBS :: Monad m => Conduit Int m ByteString
condToBS = awaitForever $ yield . B.pack . show

condMultiplN :: Monad m => Int -> Conduit Int m Int
condMultiplN m = awaitForever $ yield . (* m)
quasimoto ★★★★
()
Вы не можете добавлять комментарии в эту тему: топик перемещен в архив.
← Ядерная отладка
Development
Два дерева и кнопка →