Skip to content

Instantly share code, notes, and snippets.

View jhickner's full-sized avatar

Jason Hickner jhickner

View GitHub Profile
import Control.Monad
import Control.Applicative
import Control.Proxy
import System.IO
import Prelude hiding (Left, Right)
data Input = Up | Down | Left | Right | Invalid deriving Show
toInput :: Char -> Input
toInput c = case c of
import Data.List
data Dir = N | S | E | W deriving (Eq, Show)
type Coord = (Int, Int)
(|+|) (x,y) (x',y') = (x+x',y+y')
infixl 6 |+|
toDelta d = case d of
N -> (0, -1)
import Data.Array
import Data.Maybe
data Piece = X | O | Empty deriving (Eq)
instance Show Piece where
show X = "X"
show O = "O"
show Empty = " "
import Data.Char
strong = and . sequence conditions
where conditions = [ (>14) . length
, any isUpper
, any isLower
, any isDigit
]
{-
-- http://blog.sigfpe.com/2006/12/evaluating-cellular-automata-is.html
data U x = U [x] x [x]
right (U a b (c:cs)) = U (b:a) c cs
left (U (a:as) b c) = U as a (b:c)
instance Functor U where
fmap f (U a b c) = U (map f a) (f b) (map f c)
import Data.List
check = filter (and . sequence conditions)
where
conditions = map divsBy $ reverse [2..9]
divsBy x = (== 0) . (`rem` x) . fromDigits . take x
fromDigits = foldl' ((+) . (10 *)) 0
solutions = check $ permutations [1..9]
import Data.Binary.Put (runPut)
import Data.Binary.Get (runGet)
import Data.Binary.Bits.Put
import Data.Binary.Bits.Get
-- helper function to create a bytestring from a list of [Int]
toByteString = runPut . runBitPut . mapM_ (putBool . toBool)
where
toBool n = n /= 0 || False
import Data.List (inits, tails, sortBy)
import Data.Ord (comparing)
type Result = ([Int], Int)
cSum :: [Int] -> [Result]
cSum = reverse . sortBy (comparing snd) . map result . cSubs
where
result xs = (xs, sum xs)
cSubs = concatMap (tail . inits) . tails
@jhickner
jhickner / bsonaeson.hs
Created November 17, 2012 00:41
Data.Bson.Value to Aeson.Value
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as AT
import qualified Data.Bson as B
import qualified Data.Attoparsec as AP
import qualified Data.Attoparsec.Number as APN
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as M
import qualified Data.ByteString as BS
@jhickner
jhickner / reload_chrome.sh
Created November 15, 2012 22:37
Reload Chrome then refocus iTerm
#!/bin/sh
exec <"$0" || exit; read v; read v; exec /usr/bin/osascript - "$@"; exit
-- the above is some shell trickery that lets us write the rest of
-- the file in plain applescript
tell application "Google Chrome"
activate
tell application "System Events"
tell process "Google Chrome"