如何将导管缠绕成状态?

时间:2018-02-06 19:41:02

标签: haskell monad-transformers conduit

我有一个代码从stdin获取json数组流并从中计算candlesticks。我已经实现了函数diff,它应该计算State Monad中旧状态和新状态之间的差异,但我不知道如何使用管道。这个想法是每个json数组都是一批数据。对于每个批次,我们在旧状态和新状态之间计算新的状态candlesticksdiff并打印diff

AFAIK我应该以某种方式将导管包裹在StateT内,但monad变形金刚对我来说仍然是新手,对我来说如何做到这一点并不明显。

import Data.Aeson
import Data.Conduit
import Data.Ord
import Control.Monad.State
import qualified Data.Vector as V
import qualified Data.Map.Lazy as Map
import GHC.Exts (groupWith)
import qualified Data.Conduit.Combinators as CC
import Data.Conduit (await, yield, (.|))
import Data.ByteString.Char8 as BC hiding (last, head, maximum, minimum, map)
import qualified Data.Conduit.Binary as CB
import Data.JsonStream.Parser hiding ((.|))
import System.IO (stdin, stdout)
import Control.Lens


jsonParseValue :: Parser a -> Conduit BC.ByteString IO a
jsonParseValue parser = doParse $ runParser parser
    where
        doParse :: ParseOutput a -> Conduit BC.ByteString IO a
        doParse out = case out of
                        ParseYield value newOutput  -> do
                            yield value
                            doParse newOutput
                        ParseNeedData cont ->
                            awaitForever $ doParse . cont
                        ParseDone remaining -> return ()
                        ParseFailed err -> error err

first (_, _, x, _, _, _) = x
second (_, _, _, x, _, _) = x
third (_, _, _, _, x, _) = x
fourth (_, _, _, _, _, x) = x

group' :: (Ord b) => (a -> b) -> [a] -> [(b, [a])]
group' k vs = map (\g -> (k $ head g, g)) $ groupWith k vs

candle :: (Num a, Ord a) => V.Vector (Int, Int, a, a, a, a) -> (a, a, a, a)
candle vs = (V.maximum $ V.map first vs, V.minimum $ V.map second vs, third $ V.head vs, fourth $ V.last vs)

candles :: (Num a, Ord a) => [(Int, Int, a, a, a, a)] -> Map.Map Int (Map.Map Int (a, a, a, a))
candles vs = Map.fromList $ Prelude.map (\(k, g) ->  (k, Map.fromList $ Prelude.map (\(t, gt) -> (t, candle $ V.fromList gt)) $ group' (\(_, x, _, _, _, _) -> x) g)) $ group' (\(x, _, _, _, _, _) -> x) vs

update :: (Ord a) => Map.Map Int (Map.Map Int (a, a, a, a)) -> Map.Map Int (Map.Map Int (a, a, a, a)) -> Map.Map Int (Map.Map Int (a, a, a, a))
update new old = Map.unionWith (Map.unionWith (\(mm1, mn1, o1, c1) (mm2, mn2, o2, c2) -> (max mm1 mm2, min mn1 mn2, o1, max c1 c2))) old new

diff' old new = Map.differenceWith (\ n o -> Just (Map.differenceWith (\ x y -> Just x) n o)) new old

diff cs return Map.empty :: State (Map.Map Int (Map.Map Int (a, a, a, a))) (Map.Map Int (Map.Map Int (a, a, a, a)))
printCandles = forever $ do
    l <- liftIO $ BC.getLine
    let cs = candles $ parseByteString candlesParser l
    old <- get
    let new = update cs old
    put new
    let d = diff new old
    liftIO $ if Map.null d then return () else BL.putStrLn $ encode d

main = runStateT printCandles Map.empty

0 个答案:

没有答案