On Github etrepum / why-haskell-2013
General Purpose
Constructors and record accessors become values
Values Named bindings Instances of constructors Functions Control flow-- sum type, 3 possible values
data Choice = Definitely
| Possibly
| NoWay
-- product type, 9 possible values (3 * 3)
data Choices = Choices Choice Choice
-- record syntax defines accessors automatically
data Choices = Choices { fstChoice :: Choice
, sndChoice :: Choice
}
-- Bindings can be annotated success :: a -> Maybe a -- Constructors are functions success = Just -- Constructors can be pattern matched -- _ is a wildcard case success True of Just True -> () _ -> () -- Values can be annotated in-line 2 ^ (1 :: Int)
class Equals a where
isEqual :: a -> a -> Bool
instance Equals Choice where
isEqual Definitely Definitely = True
isEqual Possibly Possibly = True
isEqual NoWay NoWay = True
isEqual _ _ = False
instance (Equals a) => Equals [a] where
isEqual (a:as) (b:bs) = isEqual a b &&
isEqual as bs
isEqual as bs = null as && null bs
greeting :: String greeting = "Hello, " sayHello :: String -> String sayHello name = greeting ++ name -- desugars to: sayHello = \name -> (++) greeting name sayHello name = result where result = greeting ++ name -- desugars to: sayHello = \name -> let result = (++) greeting name in result
-- Unlike Erlang, pattern matching is only on
-- constructors, never variables
isJust (Just _) = True
isJust Nothing = False
-- desugars to:
isJust = \x ->
case x of
(Just _) -> True
Nothing -> False
isNegative :: (Num a) => a -> Bool isNegative x | x < 0 = True | otherwise = False -- desugars to: isNegative = \x -> if (<) x 0 then True else False
-- Symbolic operators can be used -- prefix when in (parentheses) (+) a b -- Named functions can be used -- infix when in `backticks` x `elem` xs -- infixl, infixr define associativity -- and precedence (0 lowest, 9 highest) infixr 5 `append` a `append` b = a ++ b
do m -- desugars to: m do a <- m return a -- desugars to: m >>= \a -> return a do m return () -- desugars to: m >> return ()
$ runhaskell --help
Usage: runghc [runghc flags] [GHC flags] module [program args]
The runghc flags are
-f /path/to/ghc Tell runghc where GHC is
--help Print this usage information
--version Print version number
$ ghci GHCi, version 7.6.3: http://www.haskell.org/ghc/ :? for help Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. h>
h> :t map map :: (a -> b) -> [a] -> [b] h> :t map (+1) map (+1) :: Num b => [b] -> [b] h> :t (>>=) (>>=) :: Monad m => m a -> (a -> m b) -> m b
h> :i Num
class Num a where
(+) :: a -> a -> a
(*) :: a -> a -> a
(-) :: a -> a -> a
negate :: a -> a
abs :: a -> a
signum :: a -> a
fromInteger :: Integer -> a
-- Defined in `GHC.Num'
instance Num Integer -- Defined in `GHC.Num'
instance Num Int -- Defined in `GHC.Num'
instance Num Float -- Defined in `GHC.Float'
instance Num Double -- Defined in `GHC.Float'
h> :info map
map :: (a -> b) -> [a] -> [b]
-- Defined in `GHC.Base'
h> :info (>>=)
class Monad m where
(>>=) :: m a -> (a -> m b) -> m b
...
-- Defined in `GHC.Base'
infixl 1 >>=
h> :info Int data Int = ghc-prim:GHC.Types.I# ghc-prim:GHC.Prim.Int# -- Defined in `ghc-prim:GHC.Types' instance Bounded Int -- Defined in `GHC.Enum' instance Enum Int -- Defined in `GHC.Enum' instance Eq Int -- Defined in `GHC.Classes' instance Integral Int -- Defined in `GHC.Real' instance Num Int -- Defined in `GHC.Num' instance Ord Int -- Defined in `GHC.Classes' instance Read Int -- Defined in `GHC.Read' instance Real Int -- Defined in `GHC.Real' instance Show Int -- Defined in `GHC.Show'
h> :! echo 'hello = print "hello"' > Hello.hs h> :l Hello [1 of 1] Compiling Main ( Hello.hs, interpreted ) Ok, modules loaded: Main. h> hello "hello" h> :! echo 'hello = print "HELLO"' > Hello.hs h> :r [1 of 1] Compiling Main ( Hello.hs, interpreted ) Ok, modules loaded: Main. h> hello "HELLO"
-- MergeSort1.hs module MergeSort1 (mergeSort) where -- | Bottom-up merge sort. mergeSort :: Ord a => [a] -> [a] mergeSort [] = [] mergeSort xs = mergeAll [[x] | x <- xs] mergeAll :: Ord a => [[a]] -> [a] mergeAll [xs] = xs mergeAll xss = mergeAll (mergePairs xss) mergePairs :: Ord a => [[a]] -> [[a]] mergePairs (a:b:xs) = merge a b : mergePairs xs mergePairs xs = xs merge :: Ord a => [a] -> [a] -> [a] merge as@(a:as') bs@(b:bs') | a > b = b : merge as bs' | otherwise = a : merge as' bs merge [] bs = bs merge as [] = as
-- MergeSort2.hs
module MergeSort2 (mergeSort) where
-- | Bottom-up merge sort.
mergeSort :: Ord a => [a] -> [a]
mergeSort = mergeAll . map (:[])
where
mergeAll [] = []
mergeAll [xs] = xs
mergeAll xss = mergeAll (mergePairs xss)
mergePairs (a:b:xs) =
merge a b : mergePairs xs
mergePairs xs = xs
merge as@(a:as') bs@(b:bs')
| a > b = b : merge as bs'
| otherwise = a : merge as' bs
merge [] bs = bs
merge as [] = as
# merge_sort.py
def merge_sort(lst):
if not lst:
return []
lists = [[x] for x in lst]
while len(lists) > 1:
lists = merge_lists(lists)
return lists[0]
def merge_lists(lists):
result = []
for i in range(0, len(lists) // 2):
result.append(merge2(lists[i*2], lists[i*2 + 1]))
if len(lists) % 2:
result.append(lists[-1])
return result
def merge2(xs, ys):
i = 0
j = 0
result = []
while i < len(xs) and j < len(ys):
x = xs[i]
y = ys[j]
if x > y:
result.append(y)
j += 1
else:
result.append(x)
i += 1
result.extend(xs[i:])
result.extend(ys[j:])
return result
-- WordCount1.hs main :: IO () main = do input <- getContents let wordCount = length (words input) print wordCount
-- WordCount2.hs
main :: IO ()
main =
getContents >>= \input ->
let wordCount = length (words input)
in print wordCount
-- WordCount3.hs main :: IO () main = getContents >>= print . length . words
-- Function composition (.) :: (b -> c) -> (a -> b) -> a -> c f . g = \x -> f (g x) -- Function application (with a lower precedence) ($) :: (a -> b) -> a -> b f $ x = f x
{-# RULES
"ByteString specialise break (x==)" forall x.
break ((==) x) = breakByte x
"ByteString specialise break (==x)" forall x.
break (==x) = breakByte x
#-}
-- [1..] is an infinite list, [1, 2, 3, ...] print (head (map (*2) [1..])) -- Outside in, print x = putStrLn (show x) putStrLn (show (head (map (*2) [1..])) -- head (x:_) = x -- map f (x:xs) = f x : map f xs -- desugar [1..] syntax putStrLn (show (head (map (*2) (enumFrom 1)))) -- enumFrom n = n : enumFrom (succ n) putStrLn (show (head (map (*2) (1 : enumFrom (succ 1))))) -- apply map putStrLn (show (head ((1*2) : map (*2) (enumFrom (succ 1))))) -- apply head putStrLn (show (1*2)) -- show pattern matches on its argument putStrLn (show 2) -- apply show putStrLn "2"
if' :: Bool -> a -> a -> a if' cond a b = case cond of True -> a False -> b (&&) :: Bool -> Bool -> Bool a && b = case a of True -> b False -> False const :: a -> b -> a const x = \_ -> x
fib :: [Integer] fib = 0 : 1 : zipWith (+) fib (tail fib) cycle :: [a] -> [a] cycle xs = xs ++ cycle xs iterate :: (a -> a) -> a -> [a] iterate f x = x : iterate f (f x) takeWhile :: (a -> Bool) -> [a] -> [a] takeWhile _ [] = [] takeWhile p (x:xs) | p x = x : takeWhile p xs | otherwise = []
h> let f x = head True
<interactive>:23:16:
Couldn't match expected type `[a0]' with actual type `Bool'
In the first argument of `head', namely `True'
In the expression: head True
In an equation for `f': f x = head True
h> let f x = heads True
<interactive>:24:11:
Not in scope: `heads'
Perhaps you meant one of these:
`reads' (imported from Prelude), `head' (imported from Prelude)
data Maybe a = Just a
| Nothing
data Either a b = Left a
| Right b
parseBit :: Char -> Maybe Int
parseBit '0' = Just 0
parseBit '1' = Just 1
parseBit _ = Nothing
h> let x = x in x -- Infinite recursion, not a fun case to deal with! h> case False of True -> () *** Exception: <interactive>:29:1-24: Non-exhaustive patterns in case h> head [] *** Exception: Prelude.head: empty list h> error "this throws an exception" *** Exception: this throws an exception h> undefined *** Exception: Prelude.undefined
-- Polymorphic and recursive
data List a = Cons a (List a)
| Nil
deriving (Show)
data Tree a = Leaf a
| Branch (Tree a) (Tree a)
deriving (Show)
listMap :: (a -> b) -> List a -> List b
listMap _ Nil = Nil
listMap f (Cons x xs) = Cons (f x) (listMap f xs)
treeToList :: Tree a -> List a
treeToList root = go root Nil
where
-- Note that `go` returns a function!
go (Leaf x) = Cons x
go (Branch l r) = go l . go r
-- (), pronounced "unit" unit :: () unit = () -- Char someChar :: Char someChar = 'x' -- Instances of Num typeclass someDouble :: Double someDouble = 1 -- Instances of Fractional typeclass someRatio :: Rational someRatio = 1.2345
-- [a], type can be written prefix as `[] a` someList, someOtherList :: [Int] someList = [1, 2, 3] someOtherList = (:) 4 (5 : (:) 6 []) -- (a, b), can be written prefix as `(,) a b` someTuple, someOtherTuple :: (Int, Char) someTuple = (10, '4') someOtherTuple = (,) 4 '2' -- [Char], also known as String -- (also see the OverloadedStrings extension) someString :: String someString = "foo"
module List where
data List a = Cons a (List a)
| Nil
instance (Eq a) => Eq (List a) where
(Cons a as) == (Cons b bs) = a == b && as == bs
Nil == Nil = True
_ == _ = False
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
{-# LANGUAGE DeriveFunctor #-}
module List where
data List a = Cons a (List a)
| Nil
deriving (Eq, Functor)
import Data.List (sort)
newtype Down a = Down { unDown :: a }
deriving (Eq)
instance (Ord a) => Ord (Down a) where
compare (Down a) (Down b) = case compare a b of
LT -> GT
EQ -> EQ
GT -> LT
reverseSort :: Ord a => [a] -> [a]
reverseSort = map unDown . sort . map Down
class Monoid a where mempty :: a mappend :: a -> a -> a instance Monoid [a] where mempty = [] mappend = (++) infixr 6 <> (<>) :: (Monoid a) => a -> a -> a (<>) = mappend
class Functor f where fmap :: (a -> b) -> f a -> f b instance Functor [] where fmap = map instance Functor Maybe where fmap f (Just x) = Just (f x) fmap _ Nothing = Nothing infixl 4 <$> (<$>) :: Functor f => (a -> b) -> f a -> f b (<$>) = fmap
class (Functor f) => Applicative f where pure :: a -> f a infixl 4 <*> (<*>) :: f (a -> b) -> f a -> f b instance Applicative [] where pure x = [x] fs <*> xs = concatMap (\f -> map f xs) fs instance Applicative Maybe where pure = Just Just f <*> Just x = Just (f x) _ <*> _ = Nothing
class Monad m where return :: a -> m a (>>=) :: m a -> (a -> m b) -> m b (>>) :: m a -> m b -> m b ma >> mb = ma >>= \_ -> mb instance Monad [] where return = pure m >>= f = concatMap f m instance Monad Maybe where return = pure Just x >>= f = f x Nothing >>= _ = Nothing
{-# LANGUAGE OverloadedStrings #-}
module SJSON where
import Prelude hiding (concat)
import Data.Text (Text, concat)
import Data.Attoparsec.Text
import Control.Applicative
data JSON = JArray [JSON]
| JObject [(Text, JSON)]
| JText Text
deriving (Show)
pJSON :: Parser JSON
pJSON = choice [ pText, pObject, pArray ]
where
pString = concat <$> "\"" .*> many pStringChunk <*. "\""
pStringChunk = choice [ "\\\"" .*> pure "\""
, takeWhile1 (not . (`elem` "\\\""))
, "\\" ]
pText = JText <$> pString
pPair = (,) <$> pString <*. ":" <*> pJSON
pObject = JObject <$> "{" .*> (pPair `sepBy` ",") <*. "}"
pArray = JArray <$> "[" .*> (pJSON `sepBy` ",") <*. "]"
{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign.C.Types
import Control.Monad
foreign import ccall unsafe "stdlib.h rand"
c_rand :: IO CUInt
main :: IO ()
main = replicateM_ 20 (c_rand >>= print)
-- FlipImage.hs
import System.Environment
import Data.Word
import Data.Array.Repa hiding ((++))
import Data.Array.Repa.IO.DevIL
import Data.Array.Repa.Repr.ForeignPtr
main :: IO ()
main = do
[f] <- getArgs
(RGB v) <- runIL $ readImage f
rotated <- (computeP $ rot180 v) :: IO (Array F DIM3 Word8)
runIL $ writeImage ("flip-"++f) (RGB rotated)
rot180 :: (Source r e) => Array r DIM3 e -> Array D DIM3 e
rot180 g = backpermute e flop g
where
e@(Z :. x :. y :. _) = extent g
flop (Z :. i :. j :. k) =
(Z :. x - i - 1 :. y - j - 1 :. k)
RAM footprint per unit of concurrency (approx)
1.3KB
import Control.Concurrent
import Network.HTTP
getHTTP :: String -> IO String
getHTTP url = simpleHTTP (getRequest url) >>= getResponseBody
urls :: [String]
urls = map ("http://ifconfig.me/"++) ["ip", "host"]
startRequest :: String -> IO (MVar ())
startRequest url = do
v <- newEmptyMVar
forkIO (getHTTP url >>= putStr >> putMVar v ())
return v
main :: IO ()
main = do
mvars <- mapM startRequest urls
mapM_ takeMVar mvars
A monad is just a monoid in the category of endofunctors, what's the problem?
Terminology from category theory can be intimidating (at first)!
return probably doesn't mean what you think it means.
function main() {
var foo = {bar: 1, baz: 20};
while (foo.baz > foo.bar) {
foo.bar += 1;
}
console.log(foo);
}
import Control.Concurrent
data Foo = Foo {bar :: Int, baz :: Int}
deriving (Show)
main :: IO ()
main = do
fooVar <- newMVar (Foo { bar = 1, baz = 20 })
let whileLoop = do
foo <- takeMVar fooVar
if baz foo > bar foo
then do
putMVar fooVar (foo { bar = 1 + bar foo })
whileLoop
else
putMVar fooVar foo
whileLoop
withMVar fooVar print
sum :: Num a => [a] -> a sum [] = 0 sum (x:xs) = x + sum xs
sum :: Num [a] => [a] -> a
sum = go 0
where
go acc (x:xs) = go (acc + x) (go xs)
go acc [] = acc
sum :: Num [a] => [a] -> a
sum = go 0
where
go acc _
| seq acc False = undefined
go acc (x:xs) = go (acc + x) (go xs)
go acc [] = acc
{-# LANGUAGE BangPatterns #-}
sum :: Num [a] => [a] -> a
sum = go 0
where
go !acc (x:xs) = go (acc + x) (go xs)
go acc [] = acc
Slides
http://bob.ippoli.to/why-haskell-2013/
Source
github.com/etrepum/why-haskell-2013
bob@redivi.com