Haskell State Monad和Binary不会输出所有东西

Question

我一直在玩一些简单的二进制编码，它似乎大部分工作正常，直到我添加了状态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" 

Answer 1

问题是writeSized实际上并没有写入字节串。 return只将Put计算包装到状态monad中而不实际运行它。有可能是解决它更聪明的方式，但明显的是利用这样一个事实Put（实际上PutM）是一个单子，用单子变压器符合国家单子来撰写它：

{-# 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" 

Answer 2

你可以使用一个字节串Builder（编辑：现在利用binary而不是从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），因此您只需支付在当你转换回时结束。