main = print "hello world"
main :: IO ()
main = putStrLn "hello world"
You'll need a local Haskell interpreter for this due to input. You can replace getLine
with return "some input"
to try here.
Run with runhaskell WOPR.hs
.
-- WOPR.hs
main :: IO ()
main = do
putStrLn "WHAT GAME WOULD YOU LIKE TO PLAY?"
game <- getLine
if game == "GLOBAL THERMONUCLEAR WAR"
then putStrLn "WOULDN'T YOU PREFER A NICE GAME OF CHESS?"
else putStrLn "GOOD CHOICE."
circleArea :: Float -> Float
circleArea r = pi * r ^ 2
main :: IO ()
main = print (circleArea 10)
circleArea :: Float -> Float
circleArea = \r -> pi * r ^ 2
main :: IO ()
main = print (circleArea 10)
rectangleArea :: Float -> Float -> Float
rectangleArea w h = w * h
main :: IO ()
main = print (rectangleArea 10 40)
rectangleArea :: Float -> Float -> Float
rectangleArea = \w -> \h -> w * h
main :: IO ()
main = print (rectangleArea 10 40)
myAnd :: Bool -> Bool -> Bool
myAnd True b = b
myAnd _ _ = False
main :: IO ()
main = print (myAnd (10 > 5) (100 * 2 == 200))
myAnd :: Bool -> Bool -> Bool
myAnd = \a ->
case a of
True -> \b -> b
False -> \_ -> False
main :: IO ()
main = print (myAnd (10 > 5) (100 * 2 == 200))
myXor :: Bool -> Bool -> Bool
myXor a b = undefined
main :: IO ()
main = do
-- these should all print True
print (myXor True True == False)
print (myXor True False == True)
print (myXor False True == True)
print (myXor False False == False)
fac :: Integer -> Integer
fac n
| n > 1 = n * fac (n - 1)
| otherwise = n
main :: IO ()
main = print (fac 26)
(.^) :: Bool -> Bool -> Bool
True .^ True = False
x .^ y = x || y
main :: IO ()
main = print (True .^ True)
(.^) :: Bool -> Bool -> Bool
(.^) True True = False
(.^) x y = x || y
main :: IO ()
main = print (True .^ True)
(.^) :: Bool -> Bool -> Bool
True .^ True = False
x .^ y = x || y
main :: IO ()
main = print ((.^) True True)
xor :: Bool -> Bool -> Bool
True `xor` True = False
x `xor` y = x || y
main :: IO ()
main = print (xor True True)
(.^) :: Bool -> Bool -> Bool
xor True True = False
xor x y = x || y
main :: IO ()
main = print (True `xor` True)
General Purpose
Constructors and record accessors become values
-- 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
}
data Move = Rock
| Paper
| Scissors
deriving (Show, Eq)
data Outcome = Lose
| Draw
| Win
deriving (Show, Eq)
score :: Move -> Move -> Outcome
score a b = undefined
main :: IO ()
main = do
print (score Rock Paper)
print (score Rock Scissors)
data Shape = Circle Float
| Rectangle Float Float
deriving (Show, Eq)
shapeArea :: Shape -> Float
shapeArea _ = undefined
main :: IO ()
main = do
print (shapeArea (Circle 10) == pi * 100)
print (shapeArea (Rectangle 2 12) == 24)
-- 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>
:t
shows type information
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
:i
shows typeclass info
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'
:i
shows value info
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 >>=
:i
shows type info
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'
:l
load a module
:r
to reload
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
>>=
?
do
is just syntax sugar for the >>=
(bind) operator.main
, the Haskell runtime will interpret these actions
-- 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
map f (map g xs) = map (f . g) xs
{-# 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)
NULL
, wrap the value in a sum type such as Maybe
or Either
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 |
Haskell ThreadId + MVar (GHC 7.6.3, 64-bit)
|
2.6 KB |
Erlang process (64-bit)
|
8.0 KB |
Go goroutine
|
64.0 KB |
Java thread stack (minimum)
|
64.0 KB |
C pthread stack (minimum)
|
1 MB |
Java thread stack (default)
|
8 MB |
C pthread stack (default, 64-bit Mac OS X)
|
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
Course |
|
Slides |
|
Source |
|
bob@redivi.com |
|