Haskell State Monad и Binary не выводят все

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

Я проверил и запустил все типы, но потом я заметил, что это только записывает последнюю инструкцию в цепочке. Я перешел на использование 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"

haskell monads state-monad
person Compo    schedule 02.11.2013    source источник
comment
Что такое writeSized и откуда его следует импортировать? Этот код у меня не компилируется.   -  person bheklilr    schedule 02.11.2013
comment
Извините, я копировал и вставлял пачками и случайно пропустил - добавил сейчас!   -  person Compo    schedule 02.11.2013

Ответы (2)


arrow_upward
2
arrow_downward

Проблема в том, что writeSized на самом деле не пишет в строку байтов. return только оборачивает вычисление Put в монаду состояния, фактически не запуская его. Могут быть более разумные способы решить эту проблему, но очевидным будет использование того факта, что 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"
person duplode    schedule 02.11.2013

arrow_upward
1
arrow_downward

Вы можете использовать байтовую строку 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), поэтому вы платите только в конце, когда конвертируете обратно в ByteString.

person Fixnum    schedule 02.11.2013
comment
Спасибо, я рассмотрю реализацию этого вместе с приведенным выше кодом состояния. Правильно ли я говорю, что для этого мне понадобится двоичный экземпляр для каждого поля в моем типе данных, чтобы вызов B.encode работал? - person Compo; 02.11.2013
comment
Вам просто нужен способ превратить ваши поля в Builders. Data.Binary дает вам способы сделать это для ByteStrings, Words и Chars. Использование encode — это просто удобство, потому что оно скрывает детали сериализации Int (в которой очень легко ошибиться — у вас есть потенциальная ошибка усечения на 64-битных машинах), но вместо этого вы можете использовать putWordX . fromIntegral, как делали изначально. - person Fixnum; 02.11.2013
comment
Кроме того, создание Binary экземпляров очень просто . - person Fixnum; 02.11.2013
comment
Круто, попробую. Я не делаю ничего особенно интенсивного, но я предпочел бы привыкнуть делать все правильно, пока я еще учусь! - person Compo; 03.11.2013