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），因此您只需支付在當你轉換回時結束。