Skip to content

Instantly share code, notes, and snippets.

@UnkindPartition
UnkindPartition / gist:1392285
Created November 24, 2011 21:04
Filtering GHC profile with awk
# Show the cost-centres with at least 2% accumulated time
% awk '$7 > 2' benchmark.prof
Thu Nov 24 22:56 2011 Time and Allocation Profiling Report (Final)
total time = 9.24 secs (462 ticks @ 20 ms)
total alloc = 6,124,320,224 bytes (excludes profiling overheads)
MAIN MAIN 1 0 0.0 0.0 100.0 100.0
main Main 322 1 0.0 0.0 100.0 100.0
=~ Text.Regex.Applicative.Interface 323 1 0.0 0.0 100.0 100.0
match Text.Regex.Applicative.Interface 324 1 0.0 0.0 100.0 100.0
step Text.Regex.Applicative.Object 339 800 9.5 4.2 52.4 9.2
@UnkindPartition
UnkindPartition / map.scm
Created December 2, 2011 00:48
Map in Scheme (CPS)
; In reply to https://gist.github.com/1405389
(define (map f lst)
(letrec
((go (lambda (lst k)
(if (null? lst)
(k '())
(go (cdr lst)
(lambda (rest)
(k (cons (f (car lst)) rest))))))))
(go lst (lambda (x) x))))
@UnkindPartition
UnkindPartition / jars.hs
Created March 4, 2012 19:49
Functional programming contest
-- http://users.livejournal.com/_darkus_/641529.html
-- Usage: runghc jars.hs 5 8 2
import Control.Category
import Control.Applicative
import Control.Monad.Logic
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State
import Data.List
@UnkindPartition
UnkindPartition / parsec.scm
Created October 17, 2012 07:58
Simple parser combinators in Scheme
(define (return v) (lambda (s ks kf) (ks v s)))
(define fail (lambda (s ks kf) (kf)))
; >>=
(define (bind a f)
(lambda (s ks kf)
(a s
(lambda (av s1) ((f av) s1 ks kf))
kf)))
@UnkindPartition
UnkindPartition / MyException.hs
Created December 4, 2012 09:10
Exception secrecy
-- In response to http://existentialtype.wordpress.com/2012/12/03/exceptions-are-shared-secrets/
{-# LANGUAGE DeriveDataTypeable #-}
module MyException
( Secret
, MyException
, throwMyException
, handleMyException
) where
@UnkindPartition
UnkindPartition / ArrowMatcher.hs
Last active December 16, 2015 08:58
Arrow-based matchers
-- Arrowized version of https://github.com/tcrayford/rematch
{-# LANGUAGE RankNTypes, Arrows, FlexibleInstances, MultiParamTypeClasses #-}
module ArrowMatcher where
import Prelude hiding ((.), id)
import Control.Applicative
import Control.Category
import Control.Arrow
import Control.Arrow.Transformer
@UnkindPartition
UnkindPartition / aeson.hs
Created May 18, 2013 15:53
aeson's parser non-deterministic behaviour
{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
import Data.Aeson
import Data.Aeson.TH
import qualified Data.ByteString.Lazy as BS
import Control.Applicative
import Control.Monad
instance FromJSON GName where
parseJSON (Object v) =
GName <$>
@UnkindPartition
UnkindPartition / gadt.hs
Created May 29, 2013 05:43
SYB traversal for GADT
{-# LANGUAGE GADTs, EmptyDataDecls, MultiParamTypeClasses, TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
import Data.Generics
import Data.Typeable
import Data.Data
data HasHoles
data Complete
deriving instance Typeable HasHoles
@UnkindPartition
UnkindPartition / test.hs
Created December 14, 2013 17:05
Fine-grained run-time control of SmallCheck depth with Tasty
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, DeriveDataTypeable #-}
import Test.Tasty
import Test.Tasty.Providers
import Test.Tasty.Options
import Test.Tasty.SmallCheck
import Test.Tasty.Runners
import Test.SmallCheck.Series
import Control.Applicative
import Data.Tagged
get_db() {
if [ -z "$CABAL_SANDBOX_CONFIG" ]
then
db=""
else
db=$(sed -nr -e 's/^package-db: (.*)/\1/p' "$CABAL_SANDBOX_CONFIG")
if [ $? -ne 0 ]; then exit 1; fi
fi
}
db_cmd() (