2

我一直在玩一些简单的二进制编码，它似乎在大多数情况下都能正常工作，直到我添加了 state monad。计划是使用状态来保存到目前为止我已写入字节串的内容的查找表，然后将偏移量写入字符串的先前实例而不是复制它们。

我检查并运行了所有类型，但后来我注意到它只是写出链中的最后一条指令。我改为使用 Control.Monad.State.Strict 但这没有任何区别，所以我怀疑我在其他地方犯了一个基本错误，但我不确定在哪里 - 我已经将代码缩减为基本功能. 另外，有没有更惯用的方式来做到这一点？

{-# LANGUAGE OverloadedStrings #-}


import           Control.Applicative
import qualified Control.Monad.State.Strict as S
import           Data.Binary.Put
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as BL

data SState = SState {
   wsPosition :: Int
   -- plus whatever else
}

initialState = SState 0
type StatePut = S.State SState Put

class StateBinary a where
   sput :: a -> StatePut

incPos :: Int -> S.State SState ()
incPos amnt = do
   (SState p) <- S.get
   S.put $ SState (p + amnt)

writeSized :: Int -> (a -> Put) -> a -> StatePut
writeSized n f x = do
                    incPos n
                    return (f x)

writeInt32 :: Int -> StatePut
writeInt32 = writeSized 32 putWord32be . fromIntegral

writeBS :: BS.ByteString -> StatePut
writeBS b = writeSized (BS.length b) putByteString b

data SomeData = SomeData {
    sdName :: BS.ByteString
  , sdAge  :: Int
  , sdN    :: Int
} deriving (Show, Eq)

instance StateBinary SomeData where
    sput (SomeData nm a n) = do
           writeBS nm
           writeInt32 a
           writeInt32 n

testData = SomeData "TestName" 30 100

runSPut :: StateBinary a => a -> BL.ByteString
runSPut a = runPut $ S.evalState (sput a) initialState

-- runSPut testData returns "\NUL\NUL\NULd"
4

2 回答 2

2

问题是writeSized实际上并没有写入字节串。return仅将计算包装Put到 state monad 中而不实际运行它。可能有更聪明的方法来解决它，但显而易见的方法是利用Put（实际上PutM）是一个 monad 的事实并使用 monad 转换器将它与 state monad 组合：

{-# LANGUAGE OverloadedStrings #-}


import           Control.Applicative
import qualified Control.Monad.State.Strict as S
import           Data.Binary.Put
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as BL

data SState = SState {
   wsPosition :: Int
   -- plus whatever else
}

initialState = SState 0
-- S.StateT SState PutM is a composed monad, with a state layer above PutM.
type StatePut = S.StateT SState PutM ()

class StateBinary a where
   sput :: a -> StatePut

incPos :: Int -> StatePut
incPos amnt = do
   (SState p) <- S.get
   S.put $ SState (p + amnt)

writeSized :: Int -> (a -> Put) -> a -> StatePut
writeSized n f x = do
                    incPos n
                    -- lift runs a computation in the underlying monad.
                    S.lift (f x)

writeInt32 :: Int -> StatePut
writeInt32 = writeSized 32 putWord32be . fromIntegral

writeBS :: BS.ByteString -> StatePut
writeBS b = writeSized (BS.length b) putByteString b

data SomeData = SomeData {
    sdName :: BS.ByteString
  , sdAge  :: Int
  , sdN    :: Int
} deriving (Show, Eq)

instance StateBinary SomeData where
    sput (SomeData nm a n) = do
           writeBS nm
           writeInt32 a
           writeInt32 n

testData = SomeData "TestName" 30 100

runSPut :: StateBinary a => a -> BL.ByteString
runSPut a = runPut $ S.evalStateT (sput a) initialState

-- *Main> runSPut testData
-- "TestName\NUL\NUL\NUL\RS\NUL\NUL\NULd"
于 2013-11-02T15:23:08.063 回答
1

您可以使用字节串Builder（编辑：现在使用 frombinary而不是 from bytestring）：

{-# LANGUAGE OverloadedStrings #-}

import           Data.Monoid
import qualified Data.Binary                as B
import qualified Data.Binary.Builder        as BU
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy       as BL

data SomeData = SomeData {
    sdName :: BS.ByteString
  , sdAge  :: Int
  , sdN    :: Int
} deriving (Show, Eq)

testData :: SomeData
testData  = SomeData "TestName" 30 100

renderData :: SomeData -> BU.Builder
renderData (SomeData n a i) = mconcat $
  BU.fromByteString n : map (BU.fromLazyByteString . B.encode) [a,i]

test :: BL.ByteString
test = BU.toLazyByteString . renderData $ testData

这个想法是引入 ( BU.fromX) 和附加操作是 O(1)，因此您只需在最后转换回 a 时付费ByteString。

于 2013-11-02T15:46:01.853 回答