On Github etrepum / eh-01-preview-intro-haskell
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
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 }
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>
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.3KBimport 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
http://bob.ippoli.to/why-haskell-2013/
Source
github.com/etrepum/why-haskell-2013
bob@redivi.com