Spark line

spark.hs

-- Response to https://twitter.com/mfeathers/status/495979138365149184
-- Based on http://git.zx2c4.com/spark/tree/spark.c

import System.IO (hPutStrLn, stderr)
import System.Environment (getArgs)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  args <- getArgs
  case args of
    [] -> getContents >>= run . lines >> putChar '\n'
    "-h":_ -> usage
    "--help":_ -> usage
    _ -> run args >> putChar '\n'
  
usage :: IO ()
usage = hPutStrLn stderr "Usage: blah blah"

-- Note: would not use "read" in real code because it can fail.
run :: [String] -> IO ()
run = mapM_ C.putStr . buildInOnePass . map read

levels :: Double
levels = 8

buildInThreePasses :: [Double] -> [B.ByteString]
buildInThreePasses  values =
  map (\v -> B.pack [ 0xe2,
                      0x96,
                      0x81 +
                      round ((v-m0+1)/difference*(levels-1))
                    ]) values where
    m0 = minimum values
    m1 = maximum values
    difference = max (m1 - m0 + 1) 1

-- "Clever" version using lazy circularity.
buildInOnePass :: [Double] -> [B.ByteString]
buildInOnePass values =
  let (result, m0, m1) = foldr
        (\ v (bytes, m0, m1) ->
          (B.pack [ 0xe2,
                    0x96,
                    0x81 +
                    round ((v-m0+1)/difference*(levels-1))
                  ] : bytes,
           min m0 v,
           max m1 v)
        )
        ([], 1.7976931348623157E+308, 2.2250738585072014E-308)
        values where difference = max (m1 - m0 + 1) 1
  in
    result

BTW, I can implement build in one pass in Haskell, unlike the two-pass C solution. Hang on.

One-pass solution presented for fun, using Richard Bird's classic technique (1984) http://link.springer.com/article/10.1007%2FBF00264249

Uglier and uglier, we can also just use Char, avoid allocating intermediate ByteStrings, and put the IO actions into the loop.

runInOnePass :: [Double] -> IO ()
runInOnePass values =
  let (result, m0, m1) = foldr
        (\ v (actions, m0, m1) -> (
            do
              putChar '\xe2'
              putChar '\x96'
              putChar $ chr $ 0x81 +
                round ((v-m0+1)/difference*(levels-1))
              actions,
            min m0 v,
            max m1 v)
        )
        (putChar '\n', 1.7976931348623157E+308, 2.2250738585072014E-308)
        values where difference = max (m1 - m0 + 1) 1
  in do
    hSetEncoding stdout char8
    result