Skip to content

Instantly share code, notes, and snippets.

@danielkeller
Created February 20, 2016 12:05
Show Gist options
  • Save danielkeller/c19a740fc2b0df861343 to your computer and use it in GitHub Desktop.
Save danielkeller/c19a740fc2b0df861343 to your computer and use it in GitHub Desktop.
Test setup for SO question

Test1.hs:

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
import System.IO
import Control.Monad
import Data.Binary

main = do
    handle <- openBinaryFile "testfile" WriteMode
    mapM_ (B.hPut handle . encode) dat
    print (length dat)
    hClose handle

dat :: [T.Text]
dat = [ {- lorem ipsum clipped -} ]

and then I

$ runhaskell Test1.hs
37
$ ls -hl testfile 
-rw-r--r-- 1 dan 18K Feb 20 12:09 testfile

Test1.hs:

import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T
import System.IO
import Data.Binary

main = do
    handle <- openBinaryFile "testfile" ReadMode
    initSize <- hFileSize handle
    str <- B.hGet handle (fromInteger initSize)
    hClose handle
    let (_, msgs) = decodeMany str
    --here we fool the GC into retaining the thunks in msgs
    chr <- readLn
    print $ map (max chr) $ map (T.foldl1 max) msgs
    --now we let it collect them
    num1 <- readLn
    print (num1 + 1)

decodeMany s = help s []
    where help str acc = case decodeOrFail str of
              Right (str', _, v) -> help str' (v:acc)
              Left _ -> (toInteger (B.length str), acc)

and for Test1.hs (-threaded is to enable the idle GC)

$ ghc -rtsopts -threaded Test2.hs 
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment