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.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
Course
Slides
http://bob.ippoli.to/why-haskell-2013/
Source
github.com/etrepum/why-haskell-2013
bob@redivi.com