Skip to content

Instantly share code, notes, and snippets.

View BasicPost.hs
basicPost = do
r <- post "http://httpbin.org/post" (binary "wibble") >>= json
let body = r^.responseBody :: Value
assertEqual "POST succeeds" status200 (r ^. responseStatus)
assertEqual "POST echoes input" (Just "wibble") (body ^? key "data")
assertEqual "POST is binary" (Just "application/octet-stream")
(body ^? key "headers" . key "Content-Type")
@bos
bos / AesonPlayground.hs
Last active Oct 18, 2016
A proof-of-concept of a new approach to encoding JSON values for aeson.
View AesonPlayground.hs
{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances,
OverloadedStrings #-}
import Data.Monoid (Monoid(..), (<>))
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder, singleton)
import qualified Data.Text.Lazy.Builder as Bld
import qualified Data.Text.Lazy.Builder.Int as Bld
@bos
bos / index.patch
Created Mar 14, 2012
incremental parsing for mercurial index
View index.patch
# HG changeset patch
# User Bryan O'Sullivan <bos@serpentine.com>
# Date 1331763158 25200
# Branch stable
# Node ID 268ae4d69a012f47cb1ef2bf65a8a96f561ce672
# Parent ca5cc2976574d820dad5774afd8c7b3c39ec11cd
[WIP] lazy index file parser
Only parse entries in a revlog index file when they are actually needed.
@bos
bos / pygit2.patch
Created Mar 14, 2012
5x to 8x speedup in "hg convert"
View pygit2.patch
# HG changeset patch
# User Bryan O'Sullivan <bos@serpentine.com>
# Date 1331697209 25200
# Branch stable
# Node ID 9c15f20c0418fbad1da202f72dc894372538beba
# Parent 6344043924497cd06d781d9014c66802285072e4
imported patch libgit2.patch
diff -r 634404392449 -r 9c15f20c0418 hgext/convert/git.py
--- a/hgext/convert/git.py Sun Jan 01 13:37:30 2012 -0600
@bos
bos / Wordy.hs
Created Aug 8, 2011
C++ and Haskell versions of code
View Wordy.hs
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
module Main (main) where
import Data.Monoid (mappend, mempty)
import GHC.Base (Int(..), chr, quotInt#, remInt#)
import Prelude hiding ((!!))
import System.Environment (getArgs)
import qualified Data.ByteString.Char8 as B
@bos
bos / SparseZip.hs
Created Apr 13, 2011
Sparse vector addition
View SparseZip.hs
-- Assumption: indices are sorted in ascending order.
type Sparse a = [(Int,a)]
zipWithS :: (Num a) => (a -> a -> a) -> Sparse a -> Sparse a -> Sparse a
zipWithS f as0 bs0 = filter ((/=0) . snd) $ go as0 bs0
where go ias@(ia@(i,a):as) jbs@(jb@(j,b):bs) =
case compare i j of
LT -> ia : go as jbs
EQ -> (i,f a b) : go as bs
@bos
bos / CRS.f
Created Apr 7, 2011
Sparse matrix-vector multiplication in Haskell and Fortran 77
View CRS.f
! From http://netlib.org/linalg/html_templates/node98.html
!
! val: non-zero values from the matrix
! col_ind: indices into val at which columns start in successive rows
! row_ptr: indices into val at which successive rows start
for i = 1, n
y(i) = 0
for j = row_ptr(i), row_ptr(i+1) - 1
y(i) = y(i) + val(j) * x(col_ind(j))
@bos
bos / DebugRTS.hs
Created Nov 27, 2010
A quick hack for debugging the GHC RTS
View DebugRTS.hs
import Foreign.C.String
import Foreign.Ptr
import System.Posix.Internals
debug :: String -> IO ()
debug s = do
withCStringLen (s++"\n") $ \(ptr,len) ->
c_safe_write 2 (castPtr ptr) (fromIntegral len)
return ()
View snap-core 0.3 build failure
src/Snap/Internal/Http/Parser.hs:126:4:
Couldn't match expected type `Iteratee IO a'
against inferred type `(a1, b)'
In the pattern: (out, _)
In a stmt of a 'do' expression:
(out, _) <- unsafeBufferIterateeWithBuffer
buf (ignoreEOF $ wrap killwrap it)
In the expression:
do { killwrap <- newIORef False;
(out, _) <- unsafeBufferIterateeWithBuffer
View gist:558062
import Control.Concurrent
import Control.Monad
import qualified Data.ByteString as B
import Network.Format.LLSD
import System.Environment
main = do
[path, threads, reads] <- getArgs
let nthreads = read threads
qs <- newQSem 0