Почему упаковка монады Data.Binary.Put создает утечку памяти? (Часть 2)

Как и в моем предыдущем вопросе , я пытаюсь обернуть монаду Data.Binary.Put в другую монаду, чтобы позже я мог задавать ей вопросы типа «сколько байтов он будет писать «или», какова текущая позиция в файле.

Раньше я думал, что понимание того, почему происходит утечка памяти при использовании тривиальной (IdentityT?) оболочки, приведет меня к решению моей проблемы. Но даже если вы ребята помогли мне решить проблему с тривиальной оболочкой, обернув ее чем-то полезным, например StateT или WriterT, по-прежнему потребляет слишком много памяти (и обычно дает сбой).

Например, это один из способов, которым я пытаюсь обернуть его и что приводит к утечке памяти для больших входных данных:

type Out = StateT Integer P.PutM ()

writeToFile :: String -> Out -> IO ()
writeToFile path out = BL.writeFile path $ P.runPut $ do runStateT out 0
                                                         return ()

Здесь - более полный пример кода, демонстрирующий проблему.

Я хотел бы знать, что это s:

1. Что происходит внутри программы, вызывающей утечку памяти?
2. Что я могу сделать, чтобы это исправить?

Что касается моего второго вопроса, я думаю, мне следует более подробно объяснить, что я собираюсь искать в данных на диске: это в основном древовидная структура, в которой каждый узел дерева представлен в виде таблицы смещений для своих дочерних элементов (плюс некоторые дополнительные данные).Итак, чтобы вычислить смещение n-ых дочерних элементов в таблице смещений, мне нужно знать размеры дочерних элементов от 0 до n-1 плюс текущее смещение (для упрощения предположим, что каждый узел имеет фиксированное количество дочерних элементов).

Спасибо, что посмотрели.

ОБНОВЛЕНИЕ: Благодаря nominolo я теперь могу создать монаду, которая обертывает Data.Binary.Put, отслеживает текущее смещение и почти не использует память. Это достигается путем отказа от использования преобразователя StateT в пользу другого механизма потоковой передачи состояний, который использует Continuations.

Примерно так:

type Offset = Int

newtype MyPut a = MyPut
  { unS :: forall r . (Offset -> a -> P.PutM r) -> Offset -> P.PutM r }

instance Monad MyPut where
  return a = MyPut $ \f s -> f s a
  ma >>= f = MyPut $ \fb s -> unS ma (\s' a -> unS (f a) fb s') s

writeToFile :: String -> MyPut () -> IO ()
writeToFile path put =
  BL.writeFile path $ P.runPut $ peal put >> return ()
  where peal myput = unS myput (\o -> return) 0

getCurrentOffset :: MyPut Int
getCurrentOffset = MyPut $ \f o -> f o o

lift' n ma = MyPut $ \f s -> ma >>= f (s+n)

Однако у меня все еще есть проблема с отслеживанием того, сколько байтов MyPut собирается записать на диск. В частности, мне нужна функция с такой сигнатурой:

getSize :: MyPut a -> MyPut Int

getSize :: MyPut a -> Int

Мой подход заключался в том, чтобы обернуть монаду MyPut внутри преобразователя WriterT (что-то вроде this ). Но это снова начало потреблять слишком много памяти. Как упоминает sclv в комментариях под ответом nominolos, WriterT каким-то образом нейтрализует эффект продолжений. Он также упоминает, что получение размера должно быть возможно непосредственно из монады MyPut, которая у меня уже есть, но все мои попытки сделать это закончились некомпилируемым кодом или бесконечным циклом: - |.

Не могли бы вы помочь дальше?