more samples

.gitignore

@@ -4,3 +4,6 @@
 cabal.sandbox.config
 .cabal-sandbox
 dist/
+*.hi
+*.o
+

arbitrary.hs

@@ -0,0 +1,15 @@
+import Test.QuickCheck
+
+data Color = Red | Green | Blue deriving Show
+
+instance Arbitrary Color where
+  arbitrary = do
+    n <- choose (0,2) :: Gen Int
+    return $ case n of
+      0 -> Red
+      1 -> Green
+      2 -> Blue
+
+example1 :: IO [Color]
+example1 = sample' arbitrary
+-- [Red,Green,Red,Blue,Red,Red,Red,Blue,Green,Red,Red]

bytestring.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import qualified Data.ByteString.Char8 as B
+
+-- From pack
+myBStr1 :: B.ByteString
+myBStr1 = B.pack ("foo" :: String)
+
+-- From overloaded string literal.
+myBStr2 :: B.ByteString
+myBStr2 = "bar"

cereal.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+import Data.Word
+import Data.ByteString
+import Data.Serialize
+
+import GHC.Generics
+
+data Foo = A [Foo] | B [(Foo, Foo)] | C
+  deriving (Generic, Show)
+
+instance Serialize Foo where
+
+encoded :: ByteString
+encoded = encode (A [B [(C, C)]])
+-- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\SOH\NUL\NUL\NUL\NUL\NUL\NUL\NUL\SOH\STX\STX"
+
+bytes :: [Word8]
+bytes = unpack encoded
+-- [0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,2,2]
+
+decoded :: Either String Foo
+decoded = decode encoded

criterion.hs

@@ -0,0 +1,30 @@
+import Criterion.Main
+import Criterion.Config
+
+-- Naive recursion for fibonacci numbers.
+fib :: Int -> Int
+fib 0 = 0
+fib 1 = 1
+fib n = fib (n-1) + fib (n-2)
+
+-- Use the De Moivre closed form for fibonacci numbers.
+fib2 :: Int -> Int
+fib2 x = truncate $ ( 1 / sqrt 5 ) * ( phi ^ x - psi ^ x )
+  where
+      phi = ( 1 + sqrt 5 ) / 2
+      psi = ( 1 - sqrt 5 ) / 2
+
+suite :: [Benchmark]
+suite = [
+    bgroup "naive" [
+      bench "fib 10" $ whnf fib 5
+    , bench "fib 20" $ whnf fib 10
+    ],
+    bgroup "de moivre" [
+      bench "fib 10" $ whnf fib2 5
+    , bench "fib 20" $ whnf fib2 10
+    ]
+  ]
+
+main :: IO ()
+main = defaultMain suite

derive.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.DeriveTH
+import Test.QuickCheck
+
+data Color = Red | Green | Blue deriving Show
+
+$(derive makeArbitrary ''Color)
+
+example1 :: IO [Color]
+example1 = sample' arbitrary
+-- [Red,Green,Blue,Red,Blue,Green,Blue,Red,Blue,Blue,Red]

derive_aeson.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Aeson
+import GHC.Generics
+import qualified Data.ByteString.Lazy.Char8 as BL
+
+data Point = Point { _x :: Double, _y :: Double }
+   deriving (Show, Generic)
+
+instance FromJSON Point
+instance ToJSON Point
+
+example1 :: Maybe Point
+example1 = decode "{\"x\":3.0,\"y\":-1.0}"
+
+example2 :: BL.ByteString
+example2 = encode $ Point 123.4 20

hashable.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+import GHC.Generics (Generic)
+import Data.Hashable
+
+data Color = Red | Green | Blue deriving (Generic, Show)
+
+instance Hashable Color where
+
+example1 :: Int
+example1 = hash Red
+
+example2 :: Int
+example2 = hashWithSalt 0xDEADBEEF Red

lens.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+import Control.Lens
+import Control.Lens.TH
+
+data Record1 a = Record1
+  { _a :: Int
+  , _b :: Maybe a
+  } deriving Show
+
+data Record2 = Record2
+  { _c :: String
+  , _d :: [Int]
+  } deriving Show
+
+$(makeLenses ''Record1)
+$(makeLenses ''Record2)
+
+records = [
+    Record1 {
+      _a = 1,
+      _b = Nothing
+    },
+    Record1 {
+      _a = 2,
+      _b = Just $ Record2 {
+        _c = "Picard",
+        _d = [1,2,3]
+      }
+    },
+    Record1 {
+      _a = 3,
+      _b = Just $ Record2 {
+        _c = "Riker",
+        _d = [1,2,3]
+      }
+    },
+    Record1 {
+      _a = 4,
+      _b = Just $ Record2 {
+        _c = "Data",
+        _d = [1,2,3]
+      }
+    }
+  ]
+
+-- Some abstract traversals.
+ids   = traverse.a
+names = traverse.b._Just.c
+nums  = traverse.b._Just.d
+
+-- Modify/read/extract in terms of generic traversals.
+
+-- Modify to set all ids to 0
+ex1 = set ids 0 records
+
+-- Return a view of the concatenated d fields for all nested records.
+ex2 = view nums records
+
+-- Increment all ids by 1
+ex3 = over ids (+1) records
+
+-- Return a list of all c fields.
+ex4 = toListOf names records

state.hs

@@ -1,26 +1,4 @@
-newtype State s a = State { runState :: s -> (a,s) }
-
-instance Monad (State s) where
-  return a = State $ \s -> (a, s)
-
-  State act >>= k = State $ \s ->
-    let (a, s') = act s
-    in runState (k a) s'
-
-get :: State s s
-get = State $ \s -> (s, s)
-
-put :: s -> State s ()
-put s = State $ \_ -> ((), s)
-
-modify :: (s -> s) -> State s ()
-modify f = get >>= \x -> put (f x)
-
-evalState :: State s a -> s -> a
-evalState act = fst . runState act
-
-execState :: State s a -> s -> s
-execState act = snd . runState act
+import Control.Monad.State
 
 test :: State Int Int
 test = do

state_impl.hs

@@ -0,0 +1,23 @@
+newtype State s a = State { runState :: s -> (a,s) }
+
+instance Monad (State s) where
+  return a = State $ \s -> (a, s)
+
+  State act >>= k = State $ \s ->
+    let (a, s') = act s
+    in runState (k a) s'
+
+get :: State s s
+get = State $ \s -> (s, s)
+
+put :: s -> State s ()
+put s = State $ \_ -> ((), s)
+
+modify :: (s -> s) -> State s ()
+modify f = get >>= \x -> put (f x)
+
+evalState :: State s a -> s -> a
+evalState act = fst . runState act
+
+execState :: State s a -> s -> s
+execState act = snd . runState act

text.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import qualified Data.Text as T
+
+-- From pack
+myTStr1 :: T.Text
+myTStr1 = T.pack ("foo" :: String)
+
+-- From overloaded string literal.
+myTStr2 :: T.Text
+myTStr2 = "bar"