initial commit

BloomFilter/Easy.hs

@@ -0,0 +1,48 @@
+-- file: BloomFilter/Easy.hs
+suggestSizing
+    :: Integer       -- expected maximum capacity
+    -> Double        -- desired false positive rate
+    -> Either String (Word32,Int) -- (filter size, number of hashes)
+suggestSizing capacity errRate
+    | capacity <= 0                = Left "capacity too small"
+    | errRate <= 0 || errRate >= 1 = Left "invalid error rate"
+    | null saneSizes               = Left "capacity too large"
+    | otherwise                    = Right (minimum saneSizes)
+  where saneSizes = catMaybes . map sanitize $ sizings capacity errRate
+        sanitize (bits,hashes)
+          | bits > maxWord32 - 1 = Nothing
+          | otherwise            = Just (ceiling bits, truncate hashes)
+          where maxWord32 = fromIntegral (maxBound :: Word32)
+
+sizings :: Integer -> Double -> [(Double, Double)]
+sizings capacity errRate =
+    [(((-k) * cap / log (1 - (errRate ** (1 / k)))), k) | k <- [1..50]]
+  where cap = fromIntegral capacity-- file: BloomFilter/Easy.hs
+module BloomFilter.Easy
+    (
+      suggestSizing
+    , sizings
+    , easyList
+
+    -- re-export useful names from BloomFilter
+    , B.Bloom
+    , B.length
+    , B.elem
+    , B.notElem
+    ) where
+
+import BloomFilter.Hash (Hashable, doubleHash)
+import Data.List (genericLength)
+import Data.Maybe (catMaybes)
+import Data.Word (Word32)
+import qualified BloomFilter as B
+
+easyList errRate values =
+    case suggestSizing (genericLength values) errRate of
+      Left err            -> Left err
+      Right (bits,hashes) -> Right filt
+        where filt = B.fromList (doubleHash hashes) bits values-- file: BloomFilter/Easy.hs
+easyList :: (Hashable a)
+         => Double        -- false positive rate (between 0 and 1)
+         -> [a]           -- values to populate the filter with
+         -> Either String (B.Bloom a)

BloomFilter/Hash.hs

@@ -0,0 +1,112 @@
+-- file: BloomFilter/Hash.hs
+doubleHash :: Hashable a => Int -> a -> [Word32]
+doubleHash numHashes value = go 0
+    where go n | n == num  = []
+               | otherwise = h1 + h2 * n : go (n + 1)
+
+          !h1 = fromIntegral (h `shiftR` 32) .&. maxBound
+          !h2 = fromIntegral h
+
+          h   = hashSalt 0x9150a946c4a8966e value
+          num = fromIntegral numHashes-- file: BloomFilter/Hash.hs
+doubleHash :: Hashable a => Int -> a -> [Word32]
+doubleHash numHashes value = [h1 + h2 * i | i <- [0..num]]
+    where h   = hashSalt 0x9150a946c4a8966e value
+          h1  = fromIntegral (h `shiftR` 32) .&. maxBound
+          h2  = fromIntegral h
+          num = fromIntegral numHashes-- file: BloomFilter/Hash.hs
+doubleHash :: Hashable a => Int -> a -> [Word32]
+doubleHash numHashes value = [h1 + h2 * i | i <- [0..num]]
+    where h   = hashSalt 0x9150a946c4a8966e value
+          h1  = fromIntegral (h `shiftR` 32) .&. maxBound
+          h2  = fromIntegral h
+          num = fromIntegral numHashes-- file: BloomFilter/Hash.hs
+hashByteString :: Word64 -> Strict.ByteString -> IO Word64
+hashByteString salt bs = Strict.useAsCStringLen bs $ \(ptr, len) ->
+                         hashIO ptr (fromIntegral len) salt
+
+instance Hashable Strict.ByteString where
+    hashSalt salt bs = unsafePerformIO $ hashByteString salt bs
+
+rechunk :: Lazy.ByteString -> [Strict.ByteString]
+rechunk s
+    | Lazy.null s = []
+    | otherwise   = let (pre,suf) = Lazy.splitAt chunkSize s
+                    in  repack pre : rechunk suf
+    where repack    = Strict.concat . Lazy.toChunks
+          chunkSize = 64 * 1024
+
+instance Hashable Lazy.ByteString where
+    hashSalt salt bs = unsafePerformIO $
+                       foldM hashByteString salt (rechunk bs)-- file: BloomFilter/Hash.hs
+hash2 :: (Hashable a) => a -> Word64 -> Word64
+hash2 k salt = hashSalt salt k
+
+instance (Hashable a, Hashable b) => Hashable (a,b) where
+    hashSalt salt (a,b) = hash2 b . hash2 a $ salt
+
+instance (Hashable a, Hashable b, Hashable c) => Hashable (a,b,c) where
+    hashSalt salt (a,b,c) = hash2 c . hash2 b . hash2 a $ salt-- file: BloomFilter/Hash.hs
+hashList :: (Storable a) => Word64 -> [a] -> IO Word64
+hashList salt xs =
+    withArrayLen xs $ \len ptr ->
+      hashIO ptr (fromIntegral (len * sizeOf x)) salt
+  where x = head xs
+
+instance (Storable a) => Hashable [a] where
+    hashSalt salt xs = unsafePerformIO $ hashList salt xs-- file: BloomFilter/Hash.hs
+instance Storable a => Hashable a where
+    hashSalt = hashStorable-- file: BloomFilter/Hash.hs
+hashStorable :: Storable a => Word64 -> a -> Word64
+hashStorable salt k = unsafePerformIO . with k $ \ptr ->
+                      hashIO ptr (fromIntegral (sizeOf k)) salt
+
+instance Hashable Char   where hashSalt = hashStorable
+instance Hashable Int    where hashSalt = hashStorable
+instance Hashable Double where hashSalt = hashStorable-- file: BloomFilter/Hash.hs
+class Hashable a where
+    hashSalt :: Word64        -- ^ salt
+             -> a             -- ^ value to hash
+             -> Word64
+
+hash :: Hashable a => a -> Word64
+hash = hashSalt 0x106fc397cf62f64d3-- file: BloomFilter/Hash.hs
+hashIO :: Ptr a    -- value to hash
+       -> CSize    -- number of bytes
+       -> Word64   -- salt
+       -> IO Word64
+hashIO ptr bytes salt =
+    with (fromIntegral salt) $ \sp -> do
+      let p1 = castPtr sp
+          p2 = castPtr sp `plusPtr` 4
+      go p1 p2
+      peek sp
+  where go p1 p2
+          | bytes .&. 3 == 0 = hashWord2 (castPtr ptr) words p1 p2
+          | otherwise        = hashLittle2 ptr bytes p1 p2
+        words = bytes `div` 4-- file: BloomFilter/Hash.hs
+{-# LANGUAGE BangPatterns, ForeignFunctionInterface #-}
+module BloomFilter.Hash
+    (
+      Hashable(..)
+    , hash
+    , doubleHash
+    ) where
+
+import Data.Bits ((.&.), shiftR)
+import Foreign.Marshal.Array (withArrayLen)
+import Control.Monad (foldM)
+import Data.Word (Word32, Word64)
+import Foreign.C.Types (CSize)
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr (Ptr, castPtr, plusPtr)
+import Foreign.Storable (Storable, peek, sizeOf)
+import qualified Data.ByteString as Strict
+import qualified Data.ByteString.Lazy as Lazy
+import System.IO.Unsafe (unsafePerformIO)
+
+foreign import ccall unsafe "lookup3.h hashword2" hashWord2
+    :: Ptr Word32 -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()
+
+foreign import ccall unsafe "lookup3.h hashlittle2" hashLittle2
+    :: Ptr a -> CSize -> Ptr Word32 -> Ptr Word32 -> IO ()

BloomFilter/Internal.hs

@@ -0,0 +1,19 @@
+-- file: BloomFilter/Internal.hs
+data MutBloom s a = MB {
+      mutHash :: (a -> [Word32])
+    , mutArray :: STUArray s Word32 Bool
+    }-- file: BloomFilter/Internal.hs
+module BloomFilter.Internal
+    (
+      Bloom(..)
+    , MutBloom(..)
+    ) where
+
+import Data.Array.ST (STUArray)
+import Data.Array.Unboxed (UArray)
+import Data.Word (Word32)
+
+data Bloom a = B {
+      blmHash  :: (a -> [Word32])
+    , blmArray :: UArray Word32 Bool
+    }

BloomFilter/Mutable.hs

@@ -0,0 +1,43 @@
+-- file: BloomFilter/Mutable.hs
+allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
+allM p (x:xs) = do
+  ok <- p x
+  if ok
+    then allM p xs
+    else return False
+allM _ [] = return True-- file: BloomFilter/Mutable.hs
+elem, notElem :: a -> MutBloom s a -> ST s Bool
+
+elem elt filt = indices filt elt >>=
+                allM (readArray (mutArray filt))
+
+notElem elt filt = not `liftM` elem elt filt-- file: BloomFilter/Mutable.hs
+insert :: MutBloom s a -> a -> ST s ()
+insert filt elt = indices filt elt >>=
+                  mapM_ (\bit -> writeArray (mutArray filt) bit True)
+
+indices :: MutBloom s a -> a -> ST s [Word32]
+indices filt elt = do
+  modulus <- length filt
+  return $ map (`mod` modulus) (mutHash filt elt)-- file: BloomFilter/Mutable.hs
+length :: MutBloom s a -> ST s Word32
+length filt = (succ . snd) `liftM` getBounds (mutArray filt)-- file: BloomFilter/Mutable.hs
+new :: (a -> [Word32]) -> Word32 -> ST s (MutBloom s a)
+new hash numBits = MB hash `liftM` newArray (0,numBits-1) False-- file: BloomFilter/Mutable.hs
+module BloomFilter.Mutable
+    (
+      MutBloom
+    , elem
+    , notElem
+    , insert
+    , length
+    , new
+    ) where
+
+import Control.Monad (liftM)
+import Control.Monad.ST (ST)
+import Data.Array.MArray (getBounds, newArray, readArray, writeArray)
+import Data.Word (Word32)
+import Prelude hiding (elem, length, notElem)
+
+import BloomFilter.Internal (MutBloom(..))

README.md

@@ -1,4 +1,14 @@
 real-world-haskell
 ==================
 
-parser for code samples from the book "real world haskell" (http://book.realworldhaskell.org/read/)
+Parser for code samples from the book "real world haskell" (http://book.realworldhaskell.org/read/).
+
+It's written (of course) in haskell.
+
+Code samples aren't complete for different reasons. For example: sometimes parts of the file are given not in ascending order. The goal of this repo is to allow easy access / reduce copy/pasting for the code written in the book.
+
+files
+=====
+
+  * parse-code.hs - download/parser of pages/program listings
+  * else - parsed program listings

ch00/KMinima.hs

@@ -0,0 +1,4 @@
+-- file: ch00/KMinima.hs
+-- lines beginning with "--" are comments.
+
+minima k xs = take k (sort xs)

ch01/WC.hs

@@ -0,0 +1,5 @@
+-- file: ch01/WC.hs
+-- lines beginning with "--" are comments.
+
+main = interact wordCount
+    where wordCount input = show (length (lines input)) ++ "\n"

ch02/Assign.hs

@@ -0,0 +1,3 @@
+-- file: ch02/Assign.hs
+x = 10
+x = 11

ch02/RoundToEven.hs

@@ -0,0 +1,2 @@
+-- file: ch02/RoundToEven.hs
+isOdd n = mod n 2 == 1

ch02/Take.hs

@@ -0,0 +1,2 @@
+-- file: ch02/Take.hs
+take :: Int -> ([a] -> [a])

ch02/myDrop.hs

@@ -0,0 +1,7 @@
+-- file: ch02/myDrop.hs
+niceDrop n xs | n <= 0 = xs
+niceDrop _ []          = []
+niceDrop n (_:xs)      = niceDrop (n - 1) xs-- file: ch02/myDrop.hs
+myDrop n xs = if n <= 0 || null xs
+              then xs
+              else myDrop (n - 1) (tail xs)

ch02/shortCircuit.hs

@@ -0,0 +1,2 @@
+-- file: ch02/shortCircuit.hs
+newOr a b = if a then a else b

ch03/AlgebraicVector.hs

@@ -0,0 +1,8 @@
+-- file: ch03/AlgebraicVector.hs
+-- x and y coordinates or lengths.
+data Cartesian2D = Cartesian2D Double Double
+                   deriving (Eq, Show)
+
+-- Angle and distance (magnitude).
+data Polar2D = Polar2D Double Double
+               deriving (Eq, Show)

ch03/AltCustomer.hs

@@ -0,0 +1,12 @@
+-- file: ch03/AltCustomer.hs
+data Customer = Customer Int String [String]
+                deriving (Show)
+
+customerID :: Customer -> Int
+customerID (Customer id _ _) = id
+
+customerName :: Customer -> String
+customerName (Customer _ name _) = name
+
+customerAddress :: Customer -> [String]
+customerAddress (Customer _ _ address) = address

ch03/BadIndent.hs

@@ -0,0 +1,8 @@
+-- file: ch03/BadIndent.hs
+-- This is the leftmost column.
+
+    -- Our first declaration is in column 4.
+    firstBadIndentation = 1
+
+  -- Our second is left of the first, which is illegal!
+  secondBadIndentation = 2

ch03/BadPattern.hs

@@ -0,0 +1,4 @@
+-- file: ch03/BadPattern.hs
+goodExample (x:xs) = x + goodExample xs
+goodExample _      = 0-- file: ch03/BadPattern.hs
+badExample (x:xs) = x + badExample xs

ch03/BadTree.hs

@@ -0,0 +1,6 @@
+-- file: ch03/BadTree.hs
+nodesAreSame (Node a _ _) (Node b _ _)
+    | a == b     = Just a
+nodesAreSame _ _ = Nothing-- file: ch03/BadTree.hs
+bad_nodesAreSame (Node a _ _) (Node a _ _) = Just a
+bad_nodesAreSame _            _            = Nothing

ch03/BogusPattern.hs

@@ -0,0 +1,17 @@
+-- file: ch03/BogusPattern.hs
+betterFruit f = case f of
+                  "apple"  -> Apple
+                  "orange" -> Orange-- file: ch03/BogusPattern.hs
+equational apple = Apple
+equational orange = Orange-- file: ch03/BogusPattern.hs
+data Fruit = Apple | Orange
+
+apple = "apple"
+
+orange = "orange"        
+
+whichFruit :: String -> Fruit
+
+whichFruit f = case f of
+                 apple  -> Apple
+                 orange -> Orange

ch03/BookStore.hs

@@ -0,0 +1,50 @@
+-- file: ch03/BookStore.hs
+customer2 = Customer {
+              customerID = 271828
+            , customerAddress = ["1048576 Disk Drive",
+                                 "Milpitas, CA 95134",
+                                 "USA"]
+            , customerName = "Jane Q. Citizen"
+            }-- file: ch03/BookStore.hs
+customer1 = Customer 271828 "J.R. Hacker"
+            ["255 Syntax Ct",
+             "Milpitas, CA 95134",
+             "USA"]-- file: ch03/BookStore.hs
+data Customer = Customer {
+      customerID      :: CustomerID
+    , customerName    :: String
+    , customerAddress :: Address
+    } deriving (Show)-- file: ch03/BookStore.hs
+nicerID      (Book id _     _      ) = id
+nicerTitle   (Book _  title _      ) = title
+nicerAuthors (Book _  _     authors) = authors-- file: ch03/BookStore.hs
+nicerID      (Book id _     _      ) = id
+nicerTitle   (Book _  title _      ) = title
+nicerAuthors (Book _  _     authors) = authors-- file: ch03/BookStore.hs
+bookID      (Book id title authors) = id
+bookTitle   (Book id title authors) = title
+bookAuthors (Book id title authors) = authors-- file: ch03/BookStore.hs
+data BookInfo = Book Int String [String]
+                deriving (Show)-- file: ch03/BookStore.hs
+type CardHolder = String
+type CardNumber = String
+type Address = [String]
+
+data BillingInfo = CreditCard CardNumber CardHolder Address
+                 | CashOnDelivery
+                 | Invoice CustomerID
+                   deriving (Show)-- file: ch03/BookStore.hs
+type BookRecord = (BookInfo, BookReview)-- file: ch03/BookStore.hs
+type CustomerID = Int
+type ReviewBody = String
+
+data BetterReview = BetterReview BookInfo CustomerID ReviewBody-- file: ch03/BookStore.hs
+-- We will introduce the CustomerID type shortly.
+
+data BookReview = BookReview BookInfo CustomerID String-- file: ch03/BookStore.hs
+myInfo = Book 9780135072455 "Algebra of Programming"
+         ["Richard Bird", "Oege de Moor"]-- file: ch03/BookStore.hs
+data MagazineInfo = Magazine Int String [String]
+                    deriving (Show)-- file: ch03/BookStore.hs
+data BookInfo = Book Int String [String]
+                deriving (Show)

ch03/Bool.hs

@@ -0,0 +1,2 @@
+-- file: ch03/Bool.hs
+data Bool = False | True

ch03/Braces.hs

@@ -0,0 +1,9 @@
+-- file: ch03/Braces.hs
+bar = let a = 1
+          b = 2
+          c = 3
+      in a + b + c
+
+foo = let { a = 1;  b = 2;
+        c = 3 }
+      in a + b + c