Skip to content

Instantly share code, notes, and snippets.

View ahammar's full-sized avatar

Andreas Hammar ahammar

View GitHub Profile
@ahammar
ahammar / Array.hs
Created February 14, 2014 08:48
Mutually recursive modules using a .hs-boot file
module Array where
import qualified Data.IntMap as M
import {-# SOURCE #-} Object
data Array = Array
{ _map :: M.IntMap Value
}
a ! i {- | i >= baseLength ai -} = maybe vnil id $ M.lookup i (_map a)
@ahammar
ahammar / Shuffle.hs
Created February 17, 2014 23:20
Fisher-Yates shuffle
{-# LANGUAGE BangPatterns #-}
import System.Random
shuffle :: [a] -> Int -> IO [a]
shuffle xs 1 = return xs
shuffle !xs !k = do
i <- getStdRandom (randomR (0 , k - 1))
shuffle (sswap i k xs) (k - 1)
@ahammar
ahammar / Model.hs
Created April 13, 2014 16:48
Generic sort options in persistent
{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies #-}
{-# LANGUAGE OverloadedStrings, GADTs #-}
import Data.Text (Text)
import Data.Time (UTCTime)
import Database.Persist
import Database.Persist.Sqlite (runSqlite, runMigration)
import Database.Persist.TH (mkPersist, persistLowerCase, sqlSettings)
mkPersist sqlSettings [persistLowerCase|
@ahammar
ahammar / Birthday.hs
Last active August 29, 2015 14:08
Birthday guesser for nonuniform birthday distributions
import System.IO (hFlush, stdout)
-- Should have 366 entries with probability of being born on each day, but here's a smaller example
-- with just 7 days (let's say they're the probability of being born on each day of the week)
distribution :: [Double]
distribution = [0.1, 0.1, 0.2, 0.0, 0.3, 0.1, 0.2]
medianIndex :: [Double] -> Int
medianIndex xs = length . takeWhile (< half) $ scanl1 (+) xs
where half = sum xs / 2
@ahammar
ahammar / .bashrc
Created January 17, 2015 14:43
Custom Bash prompt showing current Git branch and exit code for failed commands
# put this in your .bashrc
PROMPT_COMMAND=__prompt_command
__prompt_command() {
local LAST_EXIT="$?"
PS1=""
local RED='\[\e[31m\]'
local GREEN='\[\e[01;32m\]'
local BLUE='\[\e[01;34m\]'
@ahammar
ahammar / gist:1019376
Created June 10, 2011 18:01
Constrained associated type
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
class Xyzzy a where
xyzzy :: a -> Int
class Foo a where
type Bar a :: *
foo :: Xyzzy (Bar a) => a -> Bar a
baz :: (Foo a, Xyzzy (Bar a)) => a -> Int
@ahammar
ahammar / gist:1020043
Created June 10, 2011 23:54
Number of comparisons in build_heap
def parent(i):
return i/2
def left(i):
return 2*i
def right(i):
return 2*i+1
def heapify_cost(n, i):
@ahammar
ahammar / Church.hs
Created August 20, 2011 15:37
Church booleans, pairs and lists
{-# LANGUAGE Rank2Types #-}
module Church where
import Prelude (error)
type Bool = forall a. a -> a -> a
true, false :: Bool
true x _ = x
@ahammar
ahammar / Main.hs
Created January 4, 2012 00:28
CodeGolf.SE #4486 test script
import Control.Monad
import Data.Char
import System.Directory
import System.Exit
import System.IO
import System.Process
program = "main=print$(\\xx@2012->xx)2012\n"
alphabet = [chr 32 .. chr 126]
@ahammar
ahammar / DesugarDo.hs
Created November 5, 2011 13:37
Naive do-notation desugarer
import Data.Generics
import Language.Haskell.Parser
import Language.Haskell.Pretty
import Language.Haskell.Syntax
main = do
input <- getContents
case parseModule input of
ParseOk mod -> putStrLn $ prettyPrint $ everywhere (mkT desugarExp) mod
ParseFailed loc msg -> failed loc msg