computation model, 1930s, Alonzo Church, formalizing a method, Turing machines
expression combination, first class function, purity, referential transparency, abstraction and composability
relation -> input & output,
input set = domain, output = codomain, output <- input = range,
lambda calculus -> three lambda terms: expressions, variables, abstractions
expression: variable name, abstraction, combination of those things.
abstraction: anonymous function 𝜆𝑥.𝑥 = function = head (𝜆 lambda + parameter name) + body (expression) <- argument (input value)
𝜆𝑥.𝑥 = 𝜆𝑑.𝑑 = 𝜆𝑧.𝑧
(𝜆𝑥.𝑥)(𝜆𝑦.𝑦) => [𝑥 ∶= (𝜆𝑦.𝑦)] => 𝜆𝑦.𝑦
𝜆𝑥.𝑥𝑦 <= y
currying: 1920s Moses Schönfinke -> Haskell Curry
𝜆𝑥𝑦.𝑥𝑦 -> 𝜆𝑥.(𝜆𝑦.𝑥𝑦)
beta normal form: cannot reduce further
combinator: a lambda term with no free variables:
- 𝜆𝑥.𝑥 2. 𝜆𝑥𝑦.𝑥 3. 𝜆𝑥𝑦𝑧.𝑥𝑧(𝑦𝑧)
not combinator, free variable: 1. 𝜆𝑦.𝑥 2. 𝜆𝑥.𝑥𝑧
Divergence: reduction process never terminates:
(𝜆𝑥.𝑥𝑥)(𝜆𝑥.𝑥𝑥) => ([𝑥 ∶= (𝜆𝑥.𝑥𝑥)]𝑥𝑥) => (𝜆𝑥.𝑥𝑥)(𝜆𝑥.𝑥𝑥)
- FP: expression composition
- function: head, body <= apply, reduce, evaluate
- function declaration: bound variable
- one argument => function => one result
- function: same input => same output
Haskell: typed lambda calculus
- 𝜆𝑥.𝑥𝑥𝑥
- 𝜆𝑥𝑦𝑧.𝑥𝑦(𝑧𝑥)
- 𝜆𝑥𝑦𝑧.𝑥𝑦(𝑧𝑥𝑦)
- 𝜆𝑥.𝑥𝑥𝑥 => normal
- (𝜆𝑧.𝑧𝑧)(𝜆𝑦.𝑦𝑦) => diverge
- (𝜆𝑥.𝑥𝑥𝑥)𝑧 => nomal
- (𝜆𝑎𝑏𝑐.𝑐𝑏𝑎)𝑧𝑧(𝜆𝑤𝑣.𝑤) => z
- (𝜆𝑥.𝜆𝑦.𝑥𝑦𝑦)(𝜆𝑎.𝑎)𝑏 => bb
- (𝜆𝑦.𝑦)(𝜆𝑥.𝑥𝑥)(𝜆𝑧.𝑧𝑞) => qq
- (𝜆𝑧.𝑧)(𝜆𝑧.𝑧𝑧)(𝜆𝑧.𝑧𝑦) => yy
- (𝜆𝑥.𝜆𝑦.𝑥𝑦𝑦)(𝜆𝑦.𝑦)𝑦 => yy
- (𝜆𝑎.𝑎𝑎)(𝜆𝑏.𝑏𝑎)𝑐 => aac
- (𝜆𝑥𝑦𝑧.𝑥𝑧(𝑦𝑧))(𝜆𝑥.𝑧)(𝜆𝑥.𝑎) => 𝜆𝑧'.𝑧𝑎
- normal order: left associative
-
Raul Rojas. A Tutorial Introduction to the Lambda Calculus
-
Henk Barendregt; Erik Barendsen. Introduction to Lambda Calculus
-
Jean-Yves Girard; P. Taylor; Yves Lafon. Proofs and Types
install tools
command:
- :quit / :q
- :info / : i
- :load / :l
- :reload / :r
- :module / :m #unload module
- :type /:t
- :browse #browse module
redexes: reducible expressions
normalizing = executing = evaluating = reducing
triple x = x * 3
𝑓′ : "eff-prime"
- half x = x / 2 => add 'let' to run in REPL
- f r = 3.14 * r * r
default: prefix syntax
:info (*)
> infixl 7 *
infixl: infix operator, left associative infixr: infix operator, right associative 7: precedence on a scale of 0-9, indicated by higher number
Below are some pairs of functions that are alike except for parenthe- sization. Read them carefully and decide if the parentheses change the results of the function. Check your work in GHCi.
- a) 8 + 7 * 9 b) (8 + 7) * 9
- a) perimeter x y = (x * 2) + (y * 2) b) perimeter x y = x * 2 + y * 2
- a) f x = x / 2 + 9 b) f x = x / (2 + 9)
module Learn where
x = 10 * 5 + y
myResult = x * 5
y = 10
spacing:
let
x = 3
y = 4
-- or
let x = 3
y = 4
foo x =
let y = x * 2
z = x ^ 2
in 2 * y * z
let area x = 3. 14 * (x * x) -- 3.14
let double x = b * 2 -- b is free
x = 7
y = 10
f = x + y -- spacing
operator: + - * / div mod quot rem
mod & rem: ```haskell mod (-12) 7 -- 5 rem (-12) 7 -- -2
### 2.8 Negative numbers
syntactic sugar: unary - => negate
```haskell
2000 + (-1234)
2000 + (negate 1234)
1 + 1
(+) 1 1
(+ 1) 1 -- sectioning
(quot x y)*y + (rem x y) == x
(div x y)*y + (mod x y) == x
-- FunctionWithWhere.hs
module FunctionWithWhere where
printInc n = print plusTwo
where plusTwo = n + 2
printInc 1 -- 3
printInc2 n = let plusTwo = n + 2 in print plusTwo
-- turns into
printInc2 n = (\plusTwo -> print plusTwo)(n + 2)
let x = 5 in x -- 5
let x = 5 in x * x -- 25
let x = 5; y = 6 in x * y -- 30
let x = 3; y = 1000 in x + 3 -- 6
λx.x => \x -> x
let a = b in c
-- equivalent to
(\a -> c) b
let x = 10 in x + 9001
-- equivalent to
(\x -> x + 9001) 10
c where a = b
-- equivalent to
(\a -> c) b
x + 9001 where x = 10
-- equivalent to
(\x -> x + 9001) 10
let x = 3; y = 1000 in x * 3 + y
v = x * 3 + y where x = 3; y = 100
let y = 10; x = 10 * 5 + y in x * 5
v = x * 5 where y = 10; x = 10 * 5 + y
let x = 7; y = negate x; z = y * 10 in z / x + y
v = z / x + y where x = 7; y = negate x; z = y * 10
:info ($)
> ($) :: (a -> b) -> a -> b
> infixr 0 $
(2^) $ 2 + 2 -- 16
(2^) (2 + 2) -- 16
(2^) 2 + 2 -- 6
(2^) $ (+2) $ 3 * 2 -- 256
1 + 1 -- 2
10 ^ 2 -- 10 + 9 * 10
400 - 37 -- not (-) 37 400
100 `div` 3 -- 100 / 3
2 * 5 + 18 -- not 2 * (5 + 18)
- argument & parameter:
f x = x + 2
f 1
parameter 𝑥, argument 1
- expression: combination of constants, variables, and functions.
- redex: reducible expression.
- value: expression that cannot be reduced or evaluated.
- function: a list -> inputs => outputs
- Infix notation
- Operators: infix functions
- Syntactic sugar
- Haskell wiki article on Let vs. Where
- [How to desugar Haskell code](http://www.haskellforall.com/2014/10/how-to-desugar-haskell-code. html); Gabriel Gonzalez
[Char] === String
-- :type "Hello"
"Hello" :: [Char]
:: type signature
-- print1.hs
module Print1 where main :: IO ()
main = do
putStrLn "Count to four for me:"
putStr "one, two"
putStr ", three, and"
putStrLn " four!"
main
++
-- :t concat
concat :: Foldable t => t [a] -> [a]
'c' : "hris"
head "Papuchon"
tail "Papuchon" -- "apuchon"
take 6 "Papuchon" -- "Papuch"
drop 1 "Papuchon" -- "apuchon"
"Papu" ++ "chon" -- "Papuchon"
"Papuchon" !! 0 -- 'p'
- String: [Char]
- type / datatype: value classification
- concatenation
- scope: visibility
- local binding: let where
- global: top level bindings
- data structure
type: classifying, organizing, delimiting data
datatypes, type constructors, data constructors, type signatures, typeclasses
Data declarations: datatype
data Bool = False | True
Type constructor: type name, capitalized (Bool)
Data constructor: value (False | True)
- Int: fixed-precision integer
- Integer: arbitrarily large numbers
- Float: single-precision floating point number.
- Double: double-precision floating point number.twice bits of Float.
- Rational: ratio of two Integers
- Scientific: almost-arbitrary precision scientific number type
typeclass Num: numeric datatype
Typeclass: reuse functionality across type.
Integral number: Int & Integer: no fraction: 1 2 3
infinite data constructor, how represent?
import GHC.Int
127 :: Int8
128 :: Int8 -- warning
--typeclass Bounded
minBound :: Int8 -- -128
maxBound :: Int8 -- 128
Float, Double, Rational, Scientific
-- :t (/)
(/) :: Fractional a => a -> a -> a
type variable a implement Fractional typeclass
Num is superclass of Fractional. function from Num can be used with Fractional function from Fractional cannot .. Fractional
['a', 'b'] > ['b', 'a'] -- false
[1, 2] > [2, 1] -- false
data Mood = Blah | Woot deriving Show
[Blah, Woot] > [Woot, Blah] -- error
Term-level: code <= running
type-level: type variables, type constructors, and typeclasses <= static analysis & verification
module
if True then "Truthin" else "Falsin"
greetIfCool :: String -> IO ()
greetIfCool coolness =
if cool coolness
then putStrLn "eyyyyy. What's shakin'?"
else
putStrLn "pshhhh."
where cool v = v == "downright frosty yo"
multiple values within a single value
tuple's arity: set in type and immutable
pair: two-tuple
triple: three-tuple
fst :: (x, xs) -> a
snd :: (x, xs) -> xs
different types in tuple:
let myTup = (1 :: Integer, "blah")
import Data.Tuple
swap myTup -- ("blah", 1)
let awesome = ["Papuchon", "curry", ":)"]
-- :t awesome
awesome :: [[Char]]
awesome = ["Papuchon", "curry", ":)"]
alsoAwesome = ["Quake", "The Simons"]
allAwesome = [awesome, alsoAwesome]
- type signature of length:
-- :t length
length :: Foldable t => t a -> Int
length allAwesome -- 3
length (concat allAwesome) -- 5
6 / length [1, 2, 3] -- error
-- this works
6 / (fromIntegral (length [1, 2, 3]))
- palindrome
isPalindrome :: Eq a => [a] -> Bool
isPalindrome x = reverse x == x
myAbs :: Integer -> Integer
myAbs n = if n < 0 then (-n) else n
f :: (a, b) -> (c, d) -> ((b, d), (a, c))
f (a, b) (c, d) = ((b, d), (a, c))
- tuple: no singleton tuple, but zero tuple/unit ()
- typeclass:
- data constructor: constant value(nullary) or take arguments like function, Cat Dog
type Name = String
data Pet = Cat | Dog Name
-- :t Cat
Cat :: Pet
-- :t Dog
Dog :: Name -> Pet
- type constructor: not value, Pet
- data declaration: create new type constructor + data constructor
- type alias: alternate name
type Nam
- arity: arguments number
- polymorphism: parametric or constrained
-- parametric
id :: a -> a
id x = x
-- constrained
isEqual :: Eq a => a -> a -> Bool
isEqual x y = x == y
type: Bool tuple
type class: Num Eq
-- :i (->)
data (->) t1 t2
-- :i (,)
data (,) a b = (,) a b
-- fst is a value of type (a, b) -> a
fst :: (a, b) -> a
:type length
-- before GHC 7.10 length :: [a] -> Int
Foldable t => t a -> Int
typeclass-constrained polymorphic type variable
let fifteen = 15
-- :t fifteen
fifteen :: Num a => a
fifteen is constrained by typeclass Num, but dont know its concrete type. its type can be a Num instance (Float, Int, Integer...).
-- :info 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
{-# MINIMAL (+), (*), abs, signum, fromInteger, (negate | (-)) #-}
-- Defined in ‘GHC.Num’
instance Num Word -- 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’
multiple typeclass constraints:
(Num a, Num b) => a -> b -> b -- or
(Ord a, Num a) => a -> Ordering
not :: Bool -> Bool
length :: Foldable t => t a -> Int
concat :: Foldable t => t [a] -> [a]
head :: [a] -> a
(<) :: Ord a => a -> a -> Bool
partial application
• Uncurried functions: One function, many arguments • Curried functions: Many functions, one argument apiece
let curry f a b = f (a, b)
-- :t curry
curry :: ((t1, t2) -> t) -> t1 -> t2 -> t
-- :t fst
fst :: (a, b) -> a
-- :t curry fst
curry fst :: t -> b -> t
fst (1, 2) -- 1
curry fst 1 2 --1
let uncurry f (a, b) = f a b
-- :t uncurry
uncurry :: (t1 -> t2 -> t) -> (t1, t2) -> t
-- :t (+)
(+) :: Num a => a -> a -> a
(+) 1 2 -- 3
uncurry (+) (1, 2) -- 3
type signatures types: concrete, constrained polymorphic, or parametrically polymorphic.
polymorphism: parametric polymorphism, constrained polymorphism.
-
constrained, ad-hoc polymorphism(overload): puts typeclass constraints on the variable. capitalized name in type signature.
-
Parametric polymorphism: type variables, or parameters. fully polymorphic. unconstrained by typeclass, lowercase name in type signature.
more type flexibility, less method; vice versa.
-
type: a set of possible values
-
type variable: a set of types, constrained by type class
-
polymorphic function: type signature has variables which represent more than one type.
- given function type signature: a -> a. make a function other than id.
-- impossible
- type signature: a -> a -> a, find two and only two functions
f :: a -> a -> a
f a b = a
f :: a -> a -> a
f a b = b
- type signature: a -> b -> b
f a b = b
1 + 0.1
-- 1.1
-- :t 1 + 0.1
1 + 0.1 :: Fractional a => a
-- :t 1
1 :: Num t => t
-- :t 0.1
0.1 :: Fractional t => t
type of 0.1 polymorphic
6 / (length [1, 2, 3]) -- error
6 / fromIntegral (length [1, 2, 3])
Damas-Hindley-Milner type system
-- type signature locally, uncommon
triple x = tripleIt x
where tripleIt :: Integer -> Integer
tripleIt y = y * 3
(* 9) 6 :: Num a => a
head [(0,"doge"),(1,"kitteh")] :: Num t => (t,[Char])
head [(0 :: Integer ,"doge"),(1,"kitteh")] :: (Integer,[Char])
if False then True else False :: Bool
length [1, 2, 3, 4, 5] :: Int
(length [1, 2, 3, 4]) > (length "TACOCAT") :: Bool
x = 5
y = x + 5
w = y * 10 :: Num
x = 5
y = x + 5
z y = y * 10
z :: Num a => a -> a
x = 5
y = x + 5
f = 4 / y
f :: Fractional a => a
x = "Julie"
y = " <3 "
z = "Haskell"
f = x ++ y ++ z
f :: [Char]
f :: Num a => a -> b -> Int -> Int
- constrained polymorphic: a
- fully polymorphic: b
- concrete: Int
functionH :: [t] -> t
functionH (x : _) = x
functionC :: Ord a => a -> a -> Bool
functionC x y = if (x > y)
then True
else False
functionS :: (t, t1) -> t1
functionS (x, y) = y
i :: a -> a
i = id
c :: a -> b -> a
c a _ = a
r :: [a] -> [a]
r a = tail a
-- ... others
co :: (b -> c) -> (a -> b) -> (a -> c)
co = (.) -- function composition
a :: (a -> c) -> a -> a
a f x = x -- ???
a' :: (a -> b) -> a -> b
-- a' f x = f x
a' = ($)
module Arith3Broken where
main :: IO ()
main = do
print $ 1 + 2
putStrLn $ show 10
print (negate -1)
print ((+) 0 blah)
where blah = negate 1
f :: Int -> String
f = undefined
g :: String -> Char
g = undefined
h :: Int -> Char
h = g . f
data A
data B
data C
q :: A -> B
q = undefined
w :: B -> C
w = undefined
e :: A -> C
e = w . q
data X
data Y
data Z
xz :: X -> Z
xz = undefined
yz :: Y -> Z
yz = undefined
xform :: (X, Y) -> (Z, Z)
xform (a, b) = (xz a, xz b)
munge :: (x -> y) -> (y -> (w, z)) -> x -> w
munge f1 f2 x = fst $ f2 $ f1 x
munge f1 f2 = fst . f2 . f1
- Polymorphism: parametric / ad-hoc
- principal type: generic type which still typechecks
a
Num a => a
Int
-- The principal type here is the
-- parametrically polymorphic 'a'
- Type inference
- Type variable: unspecified type or set of types
- typeclass
- Parametricity
- Ad-hoc polymorphism: constrained polymorphism, apply typeclass constraints
- Luis Damas; Robin Milner. Principal type-schemes for func- tional programs
- Christopher Strachey. Fundamental Concepts in Programming Languages
Popular origin of the parametric/ad-hoc polymorphism distinction.
- typeclass Eq, Num, Ord, Enum, Show
- type-defaulting typeclass, typeclass inheritance
- implicit function that create side effect
typeclass and type are opposite
- type declaration: how type is created
- typeclass declaration: how type is consumed
typeclass - interface: ad-hoc polymorphism, generalize over a set of types to define and execute a standard set of features. eg, typeclass Eq -> type data comparation
-- :info Bool
-- data declaration
data Bool = False | True
-- typeclass that Bool implements.
instance Bounded Bool -- upper and lower bound
instance Enum Bool -- can be enumerated
instance Eq Bool -- equation
instance Ord Bool -- can be put into a sequential order
instance Read Bool -- parse string into thing. DONT USE.
instance Show Bool -- render thing into string
- Ord <- Eq: be compared for equality before ordering.
- Enum <- Ord: be orderd before put into enumerated list.
:info Eq
class Eq a where
(==) :: a -> a -> Bool
(/=) :: a -> a -> Bool
-- List of some Eq instances
instance Eq a => Eq [a]
instance Eq Ordering
instance Eq Int
instance Eq Float
instance Eq Double
instance Eq Char
instance Eq Bool
instance (Eq a, Eq b) => Eq (a, b)
instance Eq ()
instance Eq a => Eq (Maybe a)
instance Eq Integer
data (,) a b = (,) a b
instance (Eq a, Eq b) => Eq (a, b)
instance (Ord a, Ord b) => Ord (a, b)
instance (Read a, Read b) => Read (a, b)
instance (Show a, Show b) => Show (a, b)
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
instance Num Integer
instance Num Int
instance Num Float
instance Num Double
class (Real a, Enum a) => Integral a where
quot :: a -> a -> a
rem :: a -> a -> a
div :: a -> a -> a
mod :: a -> a -> a
quotRem :: a -> a -> (a, a) divMod :: a -> a -> (a, a)
toInteger :: a -> Integer
class (Num a) => Fractional a where
(/) :: a -> a -> a
recip :: a -> a
fromRational :: Rational -> a
divideThenAdd :: Fractional a => a -> a -> a
divideThenAdd x y = (x / y) + 1
divideThenAdd :: Num a => a -> a -> a -- error
divideThenAdd x y = (x / y) + 1
Haskell Report:
default Num Integer
default Real Integer
default Enum Integer
default Integral Integer
default Fractional Double
default RealFrac Double
default Floating Double
default RealFloat Double
-- :info Ord
-- Ord is constrained by Eq
class Eq a => Ord a where
compare :: a -> a -> Ordering
(<) :: a -> a -> Bool
(>=) :: a -> a -> Bool
(>) :: a -> a -> Bool
(<=) :: a -> a -> Bool
max :: a -> a -> a
min :: a -> a -> a
instance Ord a => Ord (Maybe a)
instance (Ord a, Ord b) => Ord (Either a b)
instance Ord Integer
instance Ord a => Ord [a]
instance Ord Ordering
instance Ord Int
instance Ord Float
instance Ord Double
instance Ord Char
instance Ord Bool
-- :info Enum
class Enum a where
succ :: a -> a
pred :: a -> a
toEnum :: Int -> a
fromEnum :: a -> Int
enumFrom :: a -> [a]
enumFromThen :: a -> a -> [a]
enumFromTo :: a -> a -> [a]
enumFromThenTo :: a -> a -> a -> [a]
instance Enum Ordering
instance Enum Integer
instance Enum Int
instance Enum Char
instance Enum Bool
instance Enum ()
instance Enum Float
instance Enum Double
succ 4 -- 5
pred 'd' -- c
succ 4.5 -- 5.5
enumFormTo 3 8 -- [3, 4, 5, 6, 7, 8]
enumFromTo 'a' 'f' -- "abcdef"
enumFromThenTo 1 10 100 ---[1,10,19,28,37,46,55,64,73,82,91,100]
not for serialization, but for human redability.
class Show a where
showsPrec :: Int -> a -> ShowS
show :: a -> String
showList :: [a] -> ShowS
instance Show a => Show [a]
instance Show Ordering
instance Show a => Show (Maybe a)
instance Show Integer
instance Show Int instance Show Char
instance Show Bool instance Show ()
instance Show Float instance Show Double
-- :t print
print :: Show a => a -> IO ()
main function => side effect
() : empty tuple / unit: represents nothing
expression must have return value. () represents the end of IO action.
IO String: a means of producing a String, which perform side effects before get the value.
minimal implementation: implement show / showPrec
data Mood = Blah
instance Show Mood where
show _ = "blah"
-- Blah => blah
data Mood = Blah deriving Show
-- Blah -> Blah
Typeclass instances we can magically derive are Eq, Ord, Enum, Bounded, Read, and Show.
-- :t read
read :: Read a => String -> a
avoid using it:
read "1234567" :: Integer
-- 1234567
read "BLAH" :: Integer
-- *** Exception: Prelude.read: no parse
-
a typeclass defines a set of functions and/or values
-
types have instances of that typeclass
-
the instances specify the ways that type uses the functions of the typeclass
class Numberish a where
fromNumber :: Integer -> a
toNumber :: a -> Integer
-- pretend newtype is data for now
newtype Age =
Age Integer
deriving (Eq, Show)
instance Numberish Age where
fromNumber n = Age n
toNumber (Age n) = n
newtype Year =
Year Integer
deriving (Eq, Show)
instance Numberish Year where
fromNumber n = Year n
toNumber (Year n) = n
usage:
sumNumberish :: Numberish a => a -> a -> a
sumNumberish a a' = fromNumber summed where
integerOfA = toNumber a
integerOfAPrime = toNumber a'
summed = integerOfA + integerOfAPrime
sumNumberish (Age 10) (Age 10)
-- Age 20
-- This is even worse than the last one.
-- Don't use typeclasses to define default values.
-- Seriously. Haskell Ninjas will find you
-- and replace your toothpaste with muddy chalk.
class Numberish a where
fromNumber :: Integer -> a
toNumber :: a -> Integer
defaultNumber :: a
instance Numberish Age where
fromNumber n = Age n
toNumber (Age n) = n
defaultNumber = Age 65
instance Numberish Year where
fromNumber n = Year n
toNumber (Year n) = n
defaultNumber = Year 1988
defaultNumber -- error
defaultNumber :: Age -- Age 65
defaultNumber :: Year -- Year 1988
see Monoid chapter
Minimal complete definition: either == or /=.
data Trivial = Trivial
Trivial == Trivial -- error, no instance
data Trivial = Trivial'
-- instance TYPECLASS TYPE where
instance Eq Trivial where
-- (DATA CONSTRUCTOR == DATA CONSTRUCTOR) = BOOL
Trivial' == Trivial' = True
-- (==) Trivial' Trivial' = True -- prefix notation
Trivial' == Trivial' -- True
another example:
data DayOfWeek =
Mon | Tue | Weds | Thu | Fri | Sat | Sun
-- day of week and numerical day of month
data Date =
Date DayOfWeek Int
instance Eq DayOfWeek where
(==) Mon Mon = True
(==) Tue Tue = True
(==) Weds Weds = True
(==) Thu Thu = True
(==) Fri Fri = True
(==) Sat Sat = True
(==) Sun Sun = True
(==) _ _ = False
instance Eq Date where
(==) (Date weekday dayOfMonth)
(Date weekday' dayOfMonth') =
weekday == weekday' && dayOfMonth == dayOfMonth'
Date Thu 10 == Date Thu 10
-- True
Date Thu 10 == Date Thu 11
-- False
Date Thu 10 == Date Weds 10
-- False
f :: Int -> Bool
f 1 = True
f 1 -- True
f 2 -- error
-- using a unconditional case
f :: Int -> Bool
f 1 = True
f _ = False
data Identity a = Identity a
-- error
instance Eq (Identity a) where
(==) (Identity v) (Identity v') = v == v'
-- okay, ensure a to have an instance of Eq
instance Eq a => Eq (Identity a) where
(==) (Identity v) (Identity v') = v == v'
-- 1
data TisAnInteger = TisAn Integer
instance Eq TisAnInteger where
(==) (Tis a) (Tis b) = a == b
-- 2
data TwoIntegers = Two Integer Integer
instance Eq TwoIntegers where
(==) (Two a b) (Two a' b') = a' == a' && b == b'
-- 3
data StringOrInt = TisAnInt Int | TisAString String
instance Eq StringOrInt where
(==) (TisAnInt a) (TisAnInt b) = a == b
(==) (TisAString a) (TisAString b) = a == b
(==) _ _ = False
-- 4
data Pair a = Pair a a
instance Eq a => Eq (Pair a) where
(==) (Pair a b) (Pair a' b) = a' == a' && b == b'
-- 5
data Tuple a b = Tuple a b
instance (Eq a, Eq b) => Eq (Tuple a b) where
(==) (Tuple a b) (Tuple a' b) = a' == a' && b == b'
-- 6
data Which a = ThisOne a | ThatOne a
instance Eq a => Eq Which a where
(==) (ThisOne a) (ThisOne b) = a == b
(==) (ThatOne a) (ThatOne b) = a == b
(==) _ _ = False
-- 7
data EitherOr a b = Hello a | Goodbye b
instance (Eq a, Eq b) => Eq (EitherOr a b) where
(==) (Hello a) (Hello b) = a == b
(==) (Goodbye a) (Goodbye b) = a == b
(==) _ _ = False
data DayOfWeek =
Mon | Tue | Weds | Thu | Fri | Sat | Sun
deriving (Ord, Show)
-- default Eq, left value smaller
Mon > Tue -- False
Sun > Mon -- True
compare Tue Weds -- LT
-- custom instance
instance Ord DayOfWeek where
compare Fri Fri = EQ
compare Fri _ = GT
compare _ Fri = LT
compare _ _ = EQ
compare Fri Sat -- GT
compare Sat Mon -- EQ
compare Fri Mon -- GT
compare Sat Fri -- LT
Mon > Fri -- False
Fri > Sat -- True
-- error
add :: a -> a -> a
add x y = x + y
-- okay
add :: Num a => a -> a -> a
add x y = x + y
-- error
addWeird :: Num a => a -> a -> a
addWeird x y =
if x > 1
then x + y
else x
-- okay
addWeird :: (Num a, Ord a) => a -> a -> a
addWeird x y =
if x > 1
then x + y
else x
-- error
check' :: a -> a -> Bool
check' a a' = a == a'
-- okay
check' :: Ord a => a -> a -> Bool
check' a a' = a == a'
add :: Int -> Int -> Int
add x y = x + y
addWeird :: Int -> Int -> Int
addWeird x y =
if x > 1
then x + y
else x
check' :: Int -> Int -> Bool
check' a a' = a == a'
-- 1
data Person = Person Bool deriving Show
printPerson :: Person -> IO ()
printPerson person = putStrLn (show person)
-- 2
data Mood = Blah | Woot deriving (Show, Eq)
settleDown x = if x == Woot
then Blah
else x
data Rocks = Rocks String deriving (Eq, Show)
data Yeah = Yeah Bool deriving (Eq, Show)
data Papu = Papu Rocks Yeah deriving (Eq, Show)
-- 1 fixed
phew = Papu (Rocks "chases") (Yeah True)
-- 2
truth = Papu (Rocks "chomskydoz")
(Yeah True)
-- 3
equalityForall :: Papu -> Papu -> Bool
equalityForall p p' = p == p'
-- 4 error no instance Ord
comparePapus :: Papu -> Papu -> Bool
comparePapus p p' = p > p'
-- 1
chk :: Eq b => (a -> b) -> a -> b -> Bool
chk f a b = (f a) == b
-- 2
-- Hint: use some arithmetic operation to
-- combine values of type 'b'. Pick one.
arith :: Num b => (a -> b) -> Integer -> a -> b
arith f i a = (f a) + (fromInteger i)
- typeclass inheritance: superclass => typeclass
class Num a => Fractional a where
(/) :: a -> a -> a
recip :: a -> a
fromRational :: Rational -> a
-
Side effects:
-
IO:
-
instance: typeclass => type
-
derived instance: deriving ..
Eq => Ord => Real
Num => Real / Fractional
Real, Enum => Integral
- P. Wadler and S. Blott. [How to make ad-hoc polymorphism less ad hoc.](http://www.cse.iitk.ac.in/users/karkare/courses/2010/ cs653/Papers/ad-hoc-polymorphism.pdf)
- Cordelia V. Hall, Kevin Hammond, Simon L. Peyton Jones, and Philip L. Wadler. Typeclasses in Haskell.
function:
- as values in expressions, lists, or tuples;
- as arguments in function;
- as returned result from function;
- make use of syntactic patterns.
bindExp :: Integer -> String
bindExp x = let y = 5 in
"the integer was: " ++ show x
++ " and y was: " ++ show y
shadowing:
bindExp :: Integer -> String
-- x is shadowed
bindExp x = let x = 10; y = 5 in
"the integer was: " ++ show x
++ " and y was: " ++ show y
pattern => value === data constructor
order matters
module RegisteredUser where
newtype Username = Username String
newtype AccountNumber = AccountNumber Integer
data User = UnregisteredUser
| RegisteredUser Username AccountNumber
-- RegisteredUser :: Username -> AccountNumber -> User
-- Username :: String -> Username
-- AccountNumber :: Integer -> AccountNumber
printUser :: User -> IO ()
printUser UnregisteredUser = putStrLn "UnregisteredUser"
printUser (RegisteredUser (Username name)
(AccountNumber acctNum))
= putStrLn $ name ++ " " ++ show acctNum
-- usage:
printUser UnregisteredUser -- "UnregisteredUser"
let myUser = (Username "callen")
let myAcct = (AccountNumber 10456)
printUser $ RegisteredUser myUser myAcct
unpack data constructor:
data WherePenguinsLive = Galapagos
| Antarctica
| Australia
| SouthAfrica
| SouthAmerica deriving (Eq, Show)
data Penguin = Peng WherePenguinsLive deriving (Eq, Show)
isSouthAfrica' :: WherePenguinsLive -> Bool
isSouthAfrica' SouthAfrica = True
isSouthAfrica' _ = False
gimmeWhereTheyLive :: Penguin -> WherePenguinsLive gimmeWhereTheyLive (Peng whereitlives) = whereitlives
humboldt = Peng SouthAmerica
gentoo = Peng Antarctica
macaroni = Peng Antarctica
little = Peng Australia
galapagos = Peng Galapagos
galapagosPenguin :: Penguin -> Bool
galapagosPenguin (Peng Galapagos) = True
galapagosPenguin _ = False
antarcticPenguin :: Penguin -> Bool
antarcticPenguin (Peng Antarctica) = True
antarcticPenguin _ = False
-- in this final function, the || operator
-- is an `or` function, which will return True
-- if either value is True
antarcticOrGalapagos :: Penguin -> Bool
antarcticOrGalapagos p = (galapagosPenguin p)
|| (antarcticPenguin p)
f :: (a, b, c) -> (d, e, f) -> ((a, d), (c, f))
f (a, b, c) (d, e, f) = ((a, d), (c, f))
f x = if x + 1 == 1 then "AWESOME" else "wut"
-- using case
funcZ x = case x + 1 == 1 of
True -> "AWESOME"
False -> "wut"
pal' xs = case y of
True -> "yes"
False -> "no"
where y = xs == reverse xs
functionC x y = if (x > y) then x else y
-- using case
functionC x y = case x > y of
True -> x
False -> y
ifEvenAdd2 n = if even n then (n+2) else n
-- using case
ifEvenAdd2 n = case even n of
True -> n + 2
False -> n
nums x = case compare x 0 of
LT -> -1
GT -> 1
EQ -> 0
-- :t flip
flip :: (a -> b -> c) -> b -> a -> c
flip f x y = f y x
myAbs :: Integer -> Integer
myAbs x
| x < 0 = (-x)
| otherwise = x
(.) :: (b -> c) -> (a -> b) -> a -> c
(f . g) x = f (g x)
-- why using $ ?
negate . sum $ [1, 2, 3, 4, 5] -- -15
-- :i (.)
(.) :: (b -> c) -> (a -> b) -> a -> c
infixr 9 .
-- composition precedence 9, function application 10
-- wrong
negate . sum [1, 2, 3, 4, 5]
negate . 15 -- error
take 5 . reverse $ [1..10]
-- [10,9,8,7,6]
take 5 . enumFrom $ 3
-- [3,4,5,6,7]
take 5 . filter odd . enumFrom $ 3
-- [3,5,7,9,11]
point: argument
print: the composition of show and putStrLn
pusStr :: String -> IO()
putStrLn :: String -> IO()
show :: Show a => a -> String
print :: Show a => a -> IO ()
print :: Show a => a -> IO ()
print = putStrLn . show
tensDigit :: Integral a => a -> a
tensDigit x = d
where xLast = x `div` 10
d = xLast `mod` 10
-- using divMod
tensDigit :: Integral a => a -> a
tensDigit x = d
where xLast = fst $ divMod x 10
d = lst $ divMod xLast 10
foldBool :: a -> a -> Bool -> a
-- using case
foldBool x y b = case b of
True -> x
False -> y
-- using guard
foldBool x y b =
| b = x
| otherwise = y
-- using pattern matching
foldBool3 :: a -> a -> Bool -> a
foldBool3 x y True = x
foldBool3 x y False = y
g :: (a -> b) -> (a, c) -> (b, c)
g f (a, c) = (f a, c)
read :: Read a => String -> a
show :: Show a => a -> String
roundTrip :: (Show a, Read a) => a -> a
roundTrip a = read (show a)
main = do
print (roundTrip 4)
print (id 4)
-- using point free
roundTrip :: (Show a, Read a) => a -> a
roundTrip = read . show
-- force to Int
main = do
print (roundTrip 4 :: Int)
print (id 4)
- Binding or bound
- anonymousfunction
- Currying
- Pattern matching: Pattern matching is about your data.
- Bottom: non-value, lazy
- Higher-order functions
- Composition
- Pointfree
-
Paul Hudak; John Peterson; Joseph Fasel. A Gentle Introduction to Haskell, chapter on case expressions and pattern matching.
-
Simon Peyton Jones. The Implementation of Functional Programming Languages, pages 53-103.
-
Christopher Strachey. Fundamental Concepts in Programming Languages, page 11 for explanation of currying.
-
J.N. Oliveira. An introduction to pointfree programming.
-
Manuel Alcino Pereira da Cunha. Point-free Program Calculation.
fact :: Int -> Int
fact 1 = 1
fact i = i * fact (i-1)
Any programming language, such as Haskell, that is built purely on lambda calculus has only one verb: apply a function to an argument.
⊥ or bottom: computations that do not successfully result in a value.
f :: Bool -> Int
f False = 0
f _ = error $ "*** Exception: "
++ "Non-exhaustive"
++ "patterns in function f"
partial function / total function
data Maybe a = Nothing | Just a
f :: Bool -> Maybe Int
f False = Just 0
f _ = Nothing
- Consider the types
fibonacci :: Integer -> Integer
-- or
fibonacci :: Integral a => a -> a
- Consider the base case
fibonacci :: Integral a => a -> a
fibonacci 0 = 0 fibonacci 1 = 1
- Consider the arguments
fibonacci :: Integral a => a -> a
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci x = (x - 1) (x - 2)
-- note: this doesn't work quite yet.
- Consider the recursion
fibonacci :: Integral a => a -> a
fibonacci 0 = 0
fibonacci 1 = 1
fibonacci x = fibonacci (x - 1) + fibonacci (x - 2)
dividedBy :: Integer -> Integer -> Integer
dividedBy = div
-- type synonyms, changes to
type Numerator = Integer
type Denominator = Integer
type Quotient = Integer
dividedBy :: Numerator -> Denominator -> Quotient
dividedBy = div
dividedBy :: Integral a => a -> a -> (a, a)
dividedBy num denom = go num denom 0
where go n d count
| n < d = (count, n)
| otherwise = go (n - d) d (count + 1)
-- :t
[[True, False], [True, True], [False, True]] -- [[Bool]]
dividedBy :: Integral a => a -> a -> (a, a)
dividedBy num denom = go num denom 0
where go n d count
| n < d = (count, n)
| otherwise = go (n-d) d (count+1)
recSum :: (Eq a, Num a) => a -> a
recSum n = go n 0
where go n acc
| n < 0 = acc
| otherwise = go (n-1) (acc+n)
recMul :: (Integral a) => a -> a -> a
recMul a b = go a b 0
where go a b acc
| a == 0 = acc
| otherwise = go (a-1) b (acc+b)
mc91 :: Int -> Int
mc91 n
| n > 100 = n - 10
| otherwise = mc91 . mc91 $ n + 11
map mc91 [95..110]
-- [91,91,91,91,91,91,91,92,93,94,95,96,97,98,99,100]
module WordNumber where
import Data.List (intersperse)
digitToWord :: Int -> String
digitToWord n = case n of
0 -> "zero"
1 -> "one"
2 -> "two"
3 -> "three"
4 -> "four"
5 -> "five"
6 -> "six"
7 -> "seven"
8 -> "eight"
9 -> "nine"
digits :: Int -> [Int]
digits n = go n []
where go n acc
| n > 9 = go (div n 10) ((mod n 10) : acc)
| otherwise = n : acc
wordNumber :: Int -> String
wordNumber n = concat . intersperse '-' . map digitToWord . digits
- Recursion
-- data TYPE-CONSTRUCTOR ARGS =
-- DATA CONSTRUCTOR or
-- DATA CONSTRUCTOR and MORE LIST
data [] a = [] | a : [a]
(:) : cons / construct
myHead [] = []
myHead (x : _) = x
-- fall safe
myTail [] = []
myTail (_: xs) = xs
data Maybe a = Nothing | Just a
safeTail :: [a] -> Maybe [a]
safeTail [] = Nothing
safeTail (_ : []) = Nothing
safeTail (_ : xs) = Just xs
[1, 2, 3] ++ [4]
-- equals to
1 : 2 : 3 : [] ++ 4 : []
[1..10]
-- equals to
enumFromTo 1 10
[1, 2..10]
class Enum a where
succ :: a -> a
pred :: a -> a
toEnum :: Int -> a
fromEnum :: a -> Int
enumFrom :: a -> [a]
enumFromThen :: a -> a -> [a]
enumFromTo :: a -> a -> [a]
enumFromThenTo :: a -> a -> a -> [a]
myEnumFromTo :: Enum a => a -> a -> [a]
myEnumFromTo x y
| xi > yi = []
| otherwise = x : myEnumFromToi (succ xi) yi
where xi = fromEnum x
yi = fromEnum y
myEnumFromToi a b
| a > b = []
| otherwise = (toEnum a) : myEnumFromToi (succ a) b
take :: Int -> [a] -> [a]
drop :: Int -> [a] -> [a]
splitAt :: Int -> [a] -> ([a], [a])
takeWhile :: (a -> Bool) -> [a] -> [a]
dropWhile :: (a -> Bool) -> [a] -> [a]
- reverse using
dropWhile
andtakeWhile
myWords :: [Char] -> [[Char]]
myWords [] = []
myWords a@(x:xs)
| x == ' ' = myWords xs
| otherwise = takeWhile (/=' ') a : (myWords . dropWhile (/=' ') $ a)
-- using case
myWords :: [Char] -> [[Char]]
myWords [] = []
myWords a =
case dropWhile (==' ') a of
[] -> []
xs -> takeWhile (/=' ') xs
: myWords (dropWhile (/=' ') xs)
-- using break
myWords :: [Char] -> [[Char]]
myWords [] = []
myWords a =
case dropWhile (==' ') a of
[] -> []
az -> w : rest
where (w, rest) = break (==' ') az
myWords :: String -> [String]
myWords [] = []
myWords (' ':xs) = myWords xs
myWords xs = takeWhile (/= ' ') xs : myWords (dropWhile (/= ' ') xs)
module PoemLines where
firstSen = "Tyger Tyger, burning bright\n"
secondSen = "In the forests of the night\n"
thirdSen = "What immortal hand or eye\n"
fourthSen = "Could frame thy fearful symmetry?"
sentences = firstSen ++ secondSen
++ thirdSen ++ fourthSen
-- putStrLn sentences
-- should print
-- Tyger Tyger, burning bright
-- In the forests of the night
-- What immortal hand or eye
-- Could frame thy fearful symmetry?
-- Implement this
myLines :: String -> [String]
myLines [] = []
myLines xs = case dropWhile (== '\n') xs of
[] -> []
az -> w : myLines rest
where (w, rest) = break (== '\n') az
-- What we want 'myLines sentences' to equal
shouldEqual =
[ "Tyger Tyger, burning bright"
, "In the forests of the night"
, "What immortal hand or eye"
, "Could frame thy fearful symmetry?"
]
-- The main function here is a small test
-- to ensure you've written your function
-- correctly.
main :: IO ()
main =
print $ "Are they equal? "
++ show (myLines sentences == shouldEqual)
separate :: Char -> [Char] -> [[Char]]
separate _ [] = []
separate sep xs = case dropWhile (== sep) xs of
[] -> []
az -> w : separate sep rest
where (w, rest) = break (== sep) az
-- using purely takeWhile and dropWhile
separate' :: Char -> [Char] -> [[Char]]
separate' _ [] = []
separate' sep xs = w : separate' sep ws
where w = takeWhile (/= sep) xs
ws = dropWhile (== sep) (drop (length w) xs)
myWords :: [Char] -> [[Char]]
myWords = separate ' '
myLines :: String -> [String]
myLines = separate '\n'
-- :t elem
elem :: Eq a => a -> [a] -> Bool
[(x, y) | x <- mySqr, y <- myCube]
[(x, y) | x <- mySqr, y <- myCube, x < 50, y < 50]
spine (:) => shape of tree, It is also possible to evaluate only part of the spine of a list and not the rest of it.
spine-strict: length
spine-lazt: map
non-strictness
:spring
l = ['a'..'z'] -- WHNF
-- :sprint
l = _
take 5 l
-- :sprint
l = 'a' : 'b' : 'c' : 'd' : 'e' : _
weak head normal form: evaluated to reach data constructor
normal form: fully evaluated
(1, 2) -- WHNF & NF
(1, _ + _)
-- WHNF, but not NF. The (+) and its
-- unknown arguments could be evaluated
(1, 1 + 1)
-- WHNF, but not NF.
-- The 1 + 1 could be evaluated.
\x -> x * 10 -- WHNF & NF
"Papu" ++ "chon" -- Neither WHNF nor NF
only evaluating spine, so wont crash
x = [1, undefined, 3]
length x -- 3
-- like this
length :: [a] -> Integer
length [] = 0
length (_:xs) = 1 + length xs
map lazy
take 1 . map (+1) $ [1, 2, undefined] -- [2]
lazy in the spine, strict in the leaves
filter :: (a -> Bool) -> [a] -> [a]
filter _ [] = []
filter pred (x:xs)
| pred x = x : filter pred xs
| otherwise = filter pred xs
filter (\x -> rem x 3 == 0) [1..30]
length . filter (\x -> rem x 3 == 0) $ [1..30]
filter \x -> not $ elem x ["the", "a", "an"] . words $ "the brown dog was a goof"
filter (not . flip elem ["the", "a", "an"]) . words $ "the brown dog was a goof"
-- :t zip
zip :: [a] -> [b] -> [(a, b)]
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
zip' :: [a] -> [b] -> [(a, b)]
zip' (a: az) (b: bz) = (a, b) : zip' az bz
zip' _ _ = []
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f (a:az) (b:bz) = f a b : zipWith' az bz
zipWith' _ _ _ = []
import Data.Char
fUp = filter isUpper
capFisrt :: [Char] -> [Char]
capFisrt (x:xs) = toUpper x : xs
capFisrt _ = ""
capAll :: [Char] -> [Char]
capAll (x:xs) = toUpper x : capAll xs
capAll _ = ""
fstCap :: [Char] -> Char
fstCap xs = toUpper $ head xs
myOr :: [Bool] -> Bool
myOr (x:xs) = if x then True else myOr xs
myOr [] = False
myOr' [] = False
myOr' (x:xs)
| x = x
| otherwise = myOr xs
myAny :: (a -> Bool) -> [a] -> Bool
myAny f (x:xs) = if f x then True else myAny f xs
myAny _ _ = False
myElem :: Eq a => a -> [a] -> Bool
myElem a (x:xs) = if a == x then True else myElem a xs
myElem _ _ = False
myReverse :: [a] -> [a]
myReverse (x:xs) = myReverse xs ++ [x]
myReverse _ = []
myReverse' a = go a []
where go (x:xs) acc = go xs (x:acc)
go _ acc = acc
squish :: [[a]] -> [a]
squish (x:xs) = x ++ squish xs
squish _ = []
squishMap :: (a -> [b]) -> [a] -> [b]
squishMap f (x:xs) = f x ++ squishMap f xs
squishMap _ _ = []
myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
myMaximumBy f (acc:xs) = go f acc xs
where go f acc (x:xs)
| f acc x == GT = go f acc xs
| otherwise = go f x xs
go _ acc _ = acc
myMaximumBy _ _ = undefined
-
Product type: tuples or data constructors with more than one argument.
-
Sum type: using the pipe, |
-
Cons:
-
Cons cell:
-
spine
Catamorphism: https://en.wikipedia.org/wiki/Catamorphism
foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f acc [] = acc
foldr f acc (x:xs) = f x (foldr f acc xs)
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f acc xs = case xs of
[] -> acc
(x:xs) -> f x (foldr f acc xs)
stage: traversal and folding
used with infinite list
foldr (\_ _ -> 9001) 0 [1..5]
-- 9001
foldr (\_ _ -> 9001) 0 [1, 2, 3, undefined]
-- 9001
foldr (\_ _ -> 9001) 0 ([1, 2, 3] ++ undefined)
-- 9001
foldr (\_ _ -> 9001) 0 [1..]
-- 9001
const x _ = x
foldr const 0 [1..]
-- 1
foldl :: (b -> a -> b) -> b -> [a] -> b
foldl f acc [] = acc
foldl f acc (x:xs) = foldl f (f acc x) xs
f = (\x y -> concat ["(",x,"+",y,")"])
foldl f "0" (map show [1..5])
"(((((0+1)+2)+3)+4)+5)"
foldr f "0" (map show [1..5])
"(1+(2+(3+(4+(5+0)))))"
foldr (+) 0 [1..5] -- 15
scanr (+) 0 [1..5] -- [15,14,12,9,5,0]
foldl (+) 0 [1..5] -- 15
scanl (+) 0 [1..5] -- [0,1,3,6,10,15]
last (scanl f z xs) = foldl f z xs
head (scanr f z xs) = foldr f z xs
foldr (:) [] [1..3] -- [1,2,3]
foldl (flip (:)) [] [1..3] -- [3,2,1]
foldl: forced spine evaluation => finite list
foldl'
foldr f acc a = foldl (flip f) acc (reverse a)
foldl only works for finite list
foldr:
-
foldr ::
(a -> b -> b) -> b -> [a] -> b
; b in-> b ->
is the rest of the fold -
associate to the right
-
infinite list, lazy evaluation
foldl:
-
produce value after reaching the end
-
associate to the right
-
finite list
-
nearly useless; prefer foldl'
foldr :: (a -> b -> b) -> b -> [a] -> b
scanr :: (a -> b -> b) -> b -> [a] -> [b]
foldl :: (b -> a -> b) -> b -> [a] -> b
scanl :: (b -> a -> b) -> b -> [a] -> [b]
scanl :: (a -> b -> a) -> a -> [b] -> [a]
scanl f q ls =
q : (case ls of
[] -> []
x:xs -> scanl f (f q x) xs)
bang bang operator:
(!!) :: [a] -> Int -> a
fibs = 1 : scanl (+) 1 fibs -- infinite list
fibsN x = fibs !! x
stops = "pbtdkg"
vowels = "aeiou"
svs :: [Char] -> [Char] -> [(Char, Char, Char)]
svs stops vowels = [(s, v, s2) | s <- stops, v <- vowels, s2 <- stops]
svs :: [Char] -> [Char] -> [(Char, Char, Char)]
svs stops vowels = [(s, v, s2) | s <- stops, v <- vowels, s2 <- stops, p == 'p']
seekritFunc x =
div (sum (map length (words x)))
(length (words x))
-- rewrite
seekritFunc :: Fractional a => String -> a
seekritFunc x = fromIntegral (sum (map length (words x)))
/ fromIntegral (length (words x))
myOr :: [Bool] -> Bool
myOr = foldr || False
myAny :: (a -> Bool) -> [a] -> Bool
myAny f = foldr (\a acc -> f a || acc) False
myElem :: Eq a => a -> [a] -> Bool
myElem x = foldr (\a acc -> x == a || acc) False
myReverse :: [a] -> [a]
myReverse = foldl (flip :) []
myMap :: (a -> b) -> [a] -> [b]
myMap f = foldr (\a acc -> f a : acc) []
myMap' f = foldr ((:) . f) [] -- nicer
myFilter :: (a -> Bool) -> [a] -> [a]
myFilter f = foldr (\a acc -> if f a then a : acc else acc) []
myFilter' f = foldr g []
where g a acc
| f a = a : acc
| otherwise = acc
squish :: [[a]] -> [a]
squish = foldr (++) []
squishMap :: (a -> [b]) -> [a] -> [b]
squishMap f = foldr (\a acc -> f a ++ acc) []
squishMap' f = foldr ((++) . f) [] -- nicer
myMaximumBy :: (a -> a -> Ordering) -> [a] -> a
myMaximumBy f (x:xs) = foldr (\a acc -> if f a acc == GT
then a
else acc)
x
xs
myMaximumBy _ [x] = x
myMaximumBy _ [] = undefined
myMaximumBy' f (x:xs) = foldr g x xs
where g a b
| g a b == GT = a
|otherwise b
myMaximumBy' _ [x] = x
myMaximumBy' _ [] = undefined
-
Fold:
-
Catamorphism: breaking down structure
-
tail call: final result of a function
-
Tail recursion: a function whose tail calls are recursive invo- cations of itself
-
Haskell Wiki. Fold.
-
Richard Bird. Sections 4.5 and 4.6 of Introduction to Functional Programming using Haskell (1998).
-
Antoni Diller. Introduction to Haskell
-
Graham Hutton. A tutorial on the universality and expressive- ness of fold.
pattern matching, type checking, and inference
A type can be thought of as an enumeration of constructors that have zero or more arguments.
sum types, product types: record syntax, type aliases (String = [Char]), newtype
This chapter will:
algebra
in algebraic datatypes- data constructors
- custom datatypes
- type synonyms / newtype;
- kinds
-- data TYPE-CONSTRUCTOR (ARGS) = DATA-CONSTRUCTOR (ARGS) or ..
-- enumeration of two possible constructors
data Bool = False | True
data [] a = [] | a:[a]
type constructors: type level, in type signatures and typeclass declarations and instances. Types are static and resolve at compile time.
data constructors: construct the values at term level, values you can interact with at runtime.
constants: Type and data constructors that take no arguments. They can only store a fixed type and amount of data. eg, Bool - type constant;. It enumerates two values that are also constants, True and False, because they take no arguments.
-- type constants, value constants
data Trivial = Trivial'
-- type constructor, data constructor
data UnaryTypeCon a = UnaryValueCon a
kind:
-- :k Bool
Bool :: *
-- :k [Int]
[Int] :: *
-- :k []
[] :: * -> *
data constructors:
constant values:
-- type constant, constant value
data PugType = PugData
-- phantom a, constant value
data HuskyType a = HuskyData
--
data DogueDeBordeaux doge = DogueDeBordeaux doge
query :t
of the data, not the type
type constructors - compile-time
----> phase separation --->
data constructors - runtime
Arity: number of arguments a function or constructor takes.
nullary: takes no arguments
-- nullary
data Example0 =
Example0 deriving (Eq, Show)
-- unary
data Example1 =
Example1 Int deriving (Eq, Show)
-- product of Int and String
data Example2 =
Example2 Int String deriving (Eq, Show)
cardinality
it has cardinality same as the type they contain
no runtime overhead
newType Goats = Goats Int deriving (Eq, Show)
newType Cows = Cows Int deriving (Eq, Show)
tooManyGoats :: Goats -> Bool
tooManyGoats (Goats n) = n > 42
class TooMany a where
tooMany :: a -> Bool
instance TooMany Int where
tooMany n = n > 42
newtype Goats = Goats Int deriving Show
instance TooMany Goats where
tooMany (Goats n) = n > 43
newtype Goats = Goats Int deriving (Eq, Show)
instance TooMany Goats where
tooMany (Goats n) = tooMany n
GeneralizedNewtypeDeriving:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
class TooMany a where
tooMany :: a -> Bool
instance TooMany Int where
tooMany n = n > 42
newtype Goats = Goats Int deriving (Eq, Show, TooMany)
-- add pragma, so do not need instance
{-# FlexibleInstances #-}
class TooMany a where
tooMany :: a -> Bool
instance TooMany (Int, String) where
tooMany (n, s) = n > 42
-- with newtype
newtype Goats = Goats (Int, String) deriving Show
instance TooMany Goats where
tooMany (Goats (n, s)) = n > 42
class TooMany a where
tooMany :: a -> Bool
newtype Goats = Goats (Int, Int) deriving Show
instance TooMany Goats where
tooMany (Goats (a, b)) = (a + b) > 42
{-# LANGUAGE FlexibleInstances #-}
class TooMany a where
tooMany :: a -> Bool
instance TooMany Int where
tooMany n = n > 42
instance (Num a, TooMany a) => TooMany (a, a) where
tooMany (n, n') = tooMany (n + n')
record: product types with additional syntax to access fields
data Person = MkPerson String Int deriving (Eq, Show)
-- these are just sample data
jm = MkPerson "julie" 108
ca = MkPerson "chris" 16
namae :: Person -> String
namae (MkPerson s _) = s
-- uaing record
data Person = Person { name :: String
, age :: Int }
deriving (Eq, Show)
-- :t name
name :: Person -> String
-- :t age
age :: Person -> Int
Person "Papu" 5
-- Person {name = "Papu", age = 5}
papu = Person "Papu" 5
age papu -- 5
name papu -- "Papu"
module Jammin where
data Fruit = Peach
| Plum
| Apple
| Blackberry deriving (Eq, Show)
data JamJars = Jam Fruit Int deriving (Eq, Show)
-- using record syntax
data JamJars = Jam {fruit :: Fruit
,jars :: Int} deriving (Eq, Show, Ord)
rowJars :: [JamJars] -> [Int]
rowJars = map jars
jarsCount :: [JamJars] -> Int
jarsCount = sum . rowJars
mostRow :: [JamJars] -> JamJars
mostRow = maximumBy (\j1 j2 -> compare (jars j1) (jars j2))
compareKind (Jam k _) (Jam k' _) = compare k k'
sortJams :: [JamJars] -> [JamJars]
sortJams = sortBy compareKind
groupJam :: [JamJars] -> [JamJars]
groupJam = groupBy (\j1 j2 -> fruit j1 == fruit j2) . sortJams
distributive property: a * (b + c) -> (a * b) + (a * c)
Product types distribute over sum types
normal form: sum of products
data Expr = Number Int
| Add Expr Expr
| Minus Expr
| Mult Expr Expr
| Divide Expr Expr
type Number = Int
type Add = (Expr, Expr)
type Minus = Expr
type Mult = (Expr, Expr)
type Divide = (Expr, Expr)
type Expr = Either Number
(Either Add
(Either Minus
(Either Mult Divide)))
data OperatingSystem = GnuPlusLinux
| OpenBSDPlusNevermindJustBSDStill
| Mac
| Windows deriving (Eq, Show)
data ProgrammingLanguage = Haskell
| Agda
| Idris
| PureScript deriving (Eq, Show)
data Programmer =
Programmer {os :: OperatingSystem
,lang :: ProgrammingLanguage} deriving (Eq, Show)
allOperatingSystems :: [OperatingSystem]
allOperatingSystems = [ GnuPlusLinux
, OpenBSDPlusNevermindJustBSDStill
, Mac
, Windows ]
allLanguages :: [ProgrammingLanguage]
allLanguages = [Haskell, Agda, Idris, PureScript]
allProgrammers :: [Programmer]
allProgrammers = [ Programmer { os = o
, lang = l}
| o <- allOperatingSystems
, l <- allLanguages ]
-- partially apply record
partialAf = Programmer {os = GnuPlusLinux}
partialAf -- error
newtype Name = Name String deriving Show
newtype Acres = Acres Int deriving Show
data FarmerType = DairyFarmer
| WheatFarmer
| SoybeanFarmer deriving Show
data Farmer = Farmer Name Acres FarmerType deriving Show
-- destructing
isDairyFarmer :: Farmer -> Bool
isDairyFarmer (Farmer _ _ DairyFarmer) = True
isDairyFarmer _ = False
data Farmer = Farmer { name :: Name
, acres :: Acres
, farmerType :: FarmerType } deriving Show
-- destruct record
isDairyFarmer :: Farmer -> Bool
isDairyFarmer farmer = farmerType farmer == DairyFarmer
a -> b
: b ^ a
a -> b -> c
: (c ^ b) ^ a = c ^ (b * a)
-- Identical to (a, b, c, d)
-- :kind (,,,)
(,,,) :: * -> * -> * -> * -> *
Any operator that starts with a colon (:) must be an infix type or data constructor.
data Product a b = a :&: b deriving (Eq, Show)
1 :&: 2 :: (Num a, Num b) => Product a b
dataList a = Nil | Cons a (List a)
oneItem = (Cons "woohoo!" Nil)
data BinaryTree a =
Leaf | Node (BinaryTree a) a (BinaryTree a)
deriving (Eq, Ord, Show)
insert' :: Ord a => a -> BinaryTree a -> BinaryTree a
insert' b Leaf = Node Leaf b Leaf
insert' b (Node left a right)
| b == a = Node left a right
| b < a = Node (insert' b left) a right
| b > a = Node left a (insert' b right)
-- try it
t1 = insert' 0 Leaf -- Node Leaf 0 Leaf
t2 = insert' 1 t1 -- Node Leaf 0 (Node Leaf 1 Leaf)
t3 = insert' 2 t2 -- Node Leaf 0 (Node Leaf 1 (Node Leaf 3 Leaf))
mapTree :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree _ Leaf = Leaf
mapTree f (Node left a right) = Node (mapTree left f) (f a) (mapTree right f)
preorder :: BinaryTree a -> [a]
preorder Leaf = []
preorder (Node left a right) = a : (preorder left) ++ (preorder right)
inorder :: BinaryTree a -> [a]
inorder Leaf = []
inorder = (inorder left) ++ [a] ++ (inorder right)
postorder :: BinaryTree a -> [a]
postorder Leaf = []
postorder = (postorder left) ++ (postorder right) ++ [a]
-- 3 parameter
foldTree :: (a -> b -> b -> b) -> b -> BinaryTree a -> b
foldTree _ acc Leaf = acc
foldTree f acc (Node left a right) = f a
(foldTree f acc left)
(foldTree f acc right)
-- 2 parameter
foldTree :: (a -> b -> b) -> b -> BinaryTree a -> b
foldTree _ acc Leaf = acc
foldTree f acc bt = foldr f acc (flattenIn bt [])
flattenIn :: BinaryTree a -> [a] -> [a]
flattenIn Leaf l = l
flattenIn (Node left a right) l = flattenIn left (a : (flattenIn right l))
-- 3 parameter, ok
data BinaryTree a = Leaf
| Node (BinaryTree a) a (BinaryTree a)
deriving (Eq, Ord, Show)
foldTree :: (a -> b -> b -> b) -> b -> BinaryTree a -> b
foldTree _ acc Leaf = acc
foldTree f acc (Node left a right) = f a (foldTree f acc left) (foldTree f acc right)
mapTree' :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree' f bt = foldTree mk Leaf bt
where mk a l r = Node l (f a) r
-- 2 parameter failed, structure ruined
mapTree' :: (a -> b) -> BinaryTree a -> BinaryTree b
mapTree' f bt = foldTree f Leaf bt
Vigenère cipher
import Data.Char
vigenere :: String -> String -> String
vigenere xs ys = vigenere' xs (cycle ys)
vigenere' [] _ = ""
vigenere' (' ':xs) cyp = ' ' : vigenere' xs cyp
vigenere' (x:xs) cyp@(y:ys) = docyp x y : vigenere' xs ys
where base = ord 'A'
r = 26
dist c = ord c - base
docyp x y = chr $ (dist x + dist y) `mod` r + base
main = print $ vigenere "MEET AT DAWN" "ALLY" == "MPPR AE OYWY"
isSubsequenceOf :: (Eq a) => [a] -> [a] -> Bool
isSubsequenceOf [] [] = True
isSubsequenceOf [] ys = True
isSubsequenceOf _ [] = False
isSubsequenceOf sa@(a:az) (b:bz)
| a == b = isSubsequenceOf az bz
| otherwise isSubsequenceOf sa bz
capitalizeWords :: String -> [(String, String)]
capitalizeWords = map f . words
where f wd@(x:xs) = (wd, toUpper x : xs)
import Data.Char (toUpper)
import Data.List (groupBy)
import Data.Function (on)
capitalizeWord :: String -> String
capitalizeWord [] = ""
capitalizeWord (x:xs)
| x == ' ' = x : capitalizeWord xs
| otherwise = toUpper x : xs
capitalizeParagraph :: String -> String
capitalizeParagraph =
concatMap capitalizeWord . groupBy ((==) `on` (=='.'))
data Expr = Lit Integer
| Add Expr Expr
eval :: Expr -> Integer
eval (Lit x) = x
eval (Add exp1 exp2) = eval exp1 + eval exp2
printExpr :: Expr -> String
printExpr (Lit x) = show x
printExpr (Add exp1 exp2) = printExpr exp1 ++ " + " ++ printExp3 exp2
- Nothing, or Just Maybe
- Either left or right, but not both
- higher-kindedness
- anamorphisms, but not animorphs.
data Name = String
data Age = Integer
data Person = Person Name Age deriving Show
mkPerson :: String -> Integer -> Maybe Person
mkPerson name age
| name \= "" && age > 0 = Just $ Person name age
| otherwise = Nothing
data Either a b = Left a | Right b
data PersonInvalid = NameEmpty
| AgeTooLow deriving (Eq, Show)
-- Compiles fine without Eq
toString :: PersonInvalid -> String
toString NameEmpty = "NameEmpty"
toString AgeTooLow = "AgeTooLow"
instance Show PersonInvalid where
show = toString
mkPerson :: Name -> Age -> Either PersonInvalid Person
mkPerson name age
| name \= "" && age > 0 = Right $ Person name age
| name = "" = Left NameEmpty
| age <= 0 = Left AgeTooLow
-- can not catch the AgeTooLow fault
mkPerson "" (-1) -- Left NameEmpty
type Name = String
type Age = Integer
type ValidatePerson a = Either [PersonInvalid] a
data Person = Person Name Age deriving Show
data PersonInvalid = NameEmpty
| AgeTooLow deriving (Eq, Show)
ageOkay :: Age -> Either [PersonInvalid] Age
ageOkay age = case age >= 0 of
True -> Right age
False -> Left [AgeTooLow]
nameOkay :: Name -> Either [PersonInvalid] Name
nameOkay name = case name /= "" of
True -> Right name
False -> Left [NameEmpty]
mkPerson :: Name -> Age -> ValidatePerson Person
mkPerson name age = mkPerson' (nameOkay name) (ageOkay age)
mkPerson' :: ValidatePerson Name
-> ValidatePerson Age
-> ValidatePerson Person
mkPerson' (Right nameOk) (Right ageOk) =
Right (Person nameOk ageOk)
mkPerson' (Left badName) (Left badAge) =
Left (badName ++ badAge)
mkPerson' (Left badName) _ = Left badName
mkPerson' _ (Left badAge) = Left badAge
Kinds are types one level up.
kind: type of type constructor
type: type constructor(higher-kinded type) / type constant
-- :kind Int
Int :: *
-- :k Bool
Bool :: *
-- :k Char
Char :: *
data Example a = Blah | RoofGoats | Woot a
-- :k Example
Example :: * -> *
-- :k (,)
(,) :: * -> * -> *
-- :k Maybe
Maybe :: * -> *
-- :k Either
Either :: * -> * -> *
lifted type: (->), bottom, polymorphism
unlifed type: no bottom, native machine types and raw pointers, newtype
data Unary a = Unary a
instance Show a => Show (Unary a)
Unary id -- ??
import Data.List (intercalate)
notThe :: String -> Maybe String
notThe str
| str == "the" = Nothing
| otherwise = Just str
replaceThe :: String -> String
replaceThe = intercalate " " . map athe . fmap notThe . words
where athe Nothing = "a"
athe (Just x) = x
isVowel :: String -> Bool
isVowel (x:xs) = elem x "aeiou"
countTheBeforeVowel :: String -> Integer
countTheBeforeVowel = f 0 . words
f :: Integer -> [String] -> Integer
f acc (x:y:xs)
| x == "the" && isVowel y = f (acc+1) xs
| otherwise = f acc (y:xs)
f acc _ = acc
isVowel :: Char -> Bool
isVowel = flip elem "aeiou"
countVowels :: String -> Integer
countVowels = f 0
f :: Integer -> String -> Integer
f acc (x:xs)
| isVowel x = f (acc+1) xs
| otherwise = f acc xs
f acc _ = acc
newtype Word' =
Word' String deriving (Eq, Show)
mkWord :: String -> Maybe Word'
mkWord str
| count str > 2 * countVowels str = Just (Word' str)
| otherwise = Nothing
data Nat = Zero | Succ Nat deriving (Eq, Show)
natToInteger :: Nat -> Integer
natToInteger = f 0
where f acc Zero = acc
f acc (Succ Nat) = f (acc+1) Nat
-- >>> natToInteger Zero
-- 0
-- >>> natToInteger (Succ Zero)
-- 1
-- >>> natToInteger (Succ (Succ Zero))
-- 2
integerToNat :: Integer -> Maybe Nat
integerToNat n
| n < 0 = Nothing
| otherwise = Just (f Zero n)
where f acc n
| n == 0 = acc
| otherwise = f (Succ acc) (n-1)
-- >>> integerToNat 0
-- Just Zero
-- >>> integerToNat 1
-- Just (Succ Zero)
-- >>> integerToNat 2
-- Just (Succ (Succ Zero))
-- >>> integerToNat (-1)
-- Nothing
-- >>> isJust (Just 1)
-- True
-- >>> isJust Nothing
-- False
isJust :: Maybe a -> Bool
isJust Nothing = False
isJust _ = True
-- >>> isNothing (Just 1)
-- False
-- >>> isNothing Nothing
-- True
isNothing :: Maybe a -> Bool
isNothing Nothing = True
isNothing _ = False
-- >>> mayybee 0 (+1) Nothing
-- 0
-- >>> mayybee 0 (+1) (Just 1)
-- 2
mayybee :: b -> (a -> b) -> Maybe a -> b
mayybee _ f (Just a) = f a
mayybee d _ Nothing = d
-- >>> fromMaybe 0 Nothing
-- 0
-- >>> fromMaybe 0 (Just 1)
-- 1
fromMaybe :: a -> Maybe a -> a
fromMaybe d v = mayybee d id v
-- >>> listToMaybe [1, 2, 3]
-- Just 1
-- >>> listToMaybe []
-- Nothing
listToMaybe :: [a] -> Maybe a
listToMaybe (x:_) = Just x
listToMaybe [] = Nothing
-- >>> maybeToList (Just 1)
-- [1]
-- >>> maybeToList Nothing
-- []
maybeToList :: Maybe a -> [a]
maybeToList (Just a) = [a]
maybeToList Nothing = []
-- >>> catMaybes [Just 1, Nothing, Just 2]
-- [1, 2]
-- >>> catMaybes [Nothing, Nothing, Nothing]
-- []
catMaybes :: [Maybe a] -> [a]
catMaybes = map g . filter f
where g (Just v) = v
f = (/= Nothing)
-- foldr
catMaybes' :: [Maybe a] -> [a]
catMaybes' [] = []
catMaybes' xs = foldr f [] xs
where f Nothing xs' = xs'
f (Just a) xs' = a : xs'
-- >>> flipMaybe [Just 1, Just 2, Just 3]
-- Just [1, 2, 3]
-- >>> flipMaybe [Just 1, Nothing, Just 3]
-- Nothing
flipMaybe :: [Maybe a] -> Maybe [a]
flipMaybe = f []
where f acc ((Just a):xs) = f (a:acc) xs
f acc [] = acc
f _ (Nothing:xs) = Nothing
-- using foldr
flipMaybe [] = Just []
flipMaybe xs = foldr f (Just []) xs
where f _ Nothing = Nothing
f Nothing _ = Nothing
f (Just a) (Just b) = Just (a:b)
lefts' :: [Either a b] -> [a]
lefts' = foldr f []
where f (Left a) acc = a : acc
f _ acc = acc
rights' :: [Either a b] -> [b]
lefts' = foldr f []
where f (Right a) acc = a : acc
f _ acc = acc
partitionEithers' :: [Either a b] -> ([a], [b])
partitionEithers' = foldr f ([], [])
where f (Left a) (az, bz) = (a:az, bz)
f (Right b) (az, bz) = (az, b:bz)
eitherMaybe' :: (b -> c) -> Either a b -> Maybe c
eitherMaybe' f (Right b) = Just (f b)
eitherMaybe' _ (Left a) = Nothing
either' :: (a -> c) -> (b -> c) -> Either a b -> c
either' f _ (Left a) = f a
either' _ f (Right b) = f b
eitherMaybe'' :: (b -> c) -> Either a b -> Maybe c
eitherMaybe'' f = either' f1 f2
f1 _ = Nothing
f2 = Just . f
anamorphisms - catamorphisms
unfoldr
take 10 $ iterate (+1) 0
-- [0,1,2,3,4,5,6,7,8,9]
-- :t unfoldr
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
take 10 $ unfoldr (\b -> Just (b, b+1)) 0
-- [0,1,2,3,4,5,6,7,8,9]
import Data.List
mehSum :: Num a => [a] -> a
mehSum xs = go 0 xs
where go :: Num a => a -> [a] -> a
go n [] = n
go n (x:xs) = (go (n+x) xs)
niceSum :: Num a => [a] -> a
niceSum = foldl' (+) 0
mehProduct :: Num a => [a] -> a
mehProduct xs = go 1 xs
where go :: Num a => a -> [a] -> a
go n [] = n
go n (x:xs) = (go (n*x) xs)
niceProduct :: Num a => [a] -> a
niceProduct = foldl' (*) 1
mehConcat :: [[a]] -> [a]
mehConcat xs = go [] xs
where go :: [a] -> [[a]] -> [a]
go xs' [] = xs'
go xs' (x:xs) = (go (xs' ++ x) xs)
niceConcat :: [[a]] -> [a]
niceConcat = foldr (++) []
myIterate :: (a -> a) -> a -> [a]
myIterate f a = a : myIterate f (f a)
unfoldr (\b -> Just (b, b+1)) 0
myUnfoldr :: (b -> Maybe (a, b)) -> b -> [a]
myUnfoldr f b = g $ f b
where g (Just (a, b)) = a : myUnfoldr f b
g _ = []
betterIterate :: (a -> a) -> a -> [a]
betterIterate f = myUnfoldr g
where g b = Just (b, f b)
data BinaryTree a = Leaf
| Node (BinaryTree a) a (BinaryTree a)
deriving (Eq, Ord, Show)
unfold :: (a -> Maybe (a,b,a)) -> a -> BinaryTree b
unfold f b = case f b of
Nothing -> Leaf
Just (x, y, z) -> Node (unfold f x) y (unfold f z)
treeBuild :: Integer -> BinaryTree Integer
treeBuild n = go n Leaf
where go 0 acc = acc
go n acc = go (n-1) (Node acc (n-1) acc)
-- using unfold
treeBuild :: Integer -> BinaryTree Integer
treeBuild n = unfold f 0
where f m
| m == n = Nothing
| otherwise = Just (m + 1, m, m + 1)
- higher kinded type:
Maybe :: * -> *
[] :: * -> *
Either :: * -> * -> *
(->) :: * -> * -> *
-- The following are not:
Int :: *
Char :: *
String :: *
[Char] :: *
- Algebras!
- Laws!
- Monoids!
- Semigroups!
Algebra: mathematical symbols and the rules, operation <= implemented with typeclass,
monoid: binary associative operation with an identity
monoid: function that takes two arguments and follows two laws: associativity and identity
-- [] = mempty, or the identity
-- mappend is the binary operation
-- to append, or join, two arguments
mappend [1..5] [] = [1..5]
mappend [] [1..5] = [1..5]
-- or, more generally
mappend x mempty = x
mappend mempty x = x
class Monoid m where
mempty :: m
mappend :: m -> m -> m
mconcat :: [m] -> m
mconcat = foldr mappend mempty
instance Monoid [a] where
mempty = []
mappend = (++)
-- usage:
mappend [1, 2, 3] [4, 5, 6]
-- [1,2,3,4,5,6]
mconcat [[1..3], [4..6]]
-- [1,2,3,4,5,6]
mappend "Trout" " goes well with garlic"
-- "Trout goes well with garlic"
(++) [1, 2, 3] [4, 5, 6]
-- [1,2,3,4,5,6]
(++) "Trout" " goes well with garlic"
-- "Trout goes well with garlic"
foldr (++) [] [[1..3], [4..6]]
-- [1,2,3,4,5,6]
foldr mappend mempty [[1..3], [4..6]]
-- [1,2,3,4,5,6]
Both summation, multiplication are monoidal (binary, associative, having an identity value), but each type should only have one unique instance for a given typeclass, not two (one instance for a sum, one for a product).
solution: wrap the value with Sum, Product newtype
mappend (Sum 1) (Sum 5)
-- Sum {getSum = 6}
mappend (Product 5) (Product 5)
-- Product {getProduct = 25}
mappend (Sum 4.5) (Sum 3.4)
-- Sum {getSum = 7.9}
data Server = Server String
newtype Server' = Server' String
newtype: unary data constructor, no additional runtime overhead(identical to what it wraps)
import Data.Monoid
-- :info Sum
newtype Sum a = Sum {getSum :: a}
-- .. other instances
instance Num a => Monoid (Sum a)
-- :info Product
newtype Product a = Product {getProduct :: a}
-- .. other instances
instance Num a => Monoid (Product a)
-- :t (<>)
(<>) :: Monoid m => m -> m -> m
mappend (Sum 8) (Sum 9)
(Sum 8) <> (Sum 9)
-- Sum {getSum = 17}
mappend mempty Sum 9
mempty <> Sum 9
-- Sum {getSum = 9}
-- error
-- mappend (Sum 1) (Sum 2) (Sum 3)
mappend (Sum 1) (mappend (Sum 2) (Sum 3))
(Sum 1) `mappend` (Sum 2) `mappend` (Sum 3)
(Sum 1) <> (Sum 2) <> (Sum 3)
-- Sum {getSum = 6}
mconcat [(Sum 8), (Sum 9), (Sum 10)]
-- Sum {getSum = 27}
A common use of monoids is to structure and describe common modes of processing data. Sometimes this is to describe an API for incrementally processing a large dataset, sometimes to describe guar- antees needed to roll up aggregations (think summation) in a parallel, concurrent, or distributed processing framework.
foldr mappend mempty ([2, 4, 6] :: [Product Int])
-- Product {getProduct = 48}
foldr mappend mempty ([2, 4, 6] :: [Sum Int])
-- Sum {getSum = 12}
foldr mappend mempty ["blah", "woot"]
-- "blahwoot"
law - algebra
-- left identity
mappend mempty x = x
-- right identity
mappend x mempty = x
-- associativity
mappend x (mappend y z) = mappend (mappend x y) z
mconcat = foldr mappend mempty
Bool wrapper:
import Data.Monoid
All True <> All True
-- All {getAll = True}
All True <> All False
-- All {getAll = False}
Any True <> Any False
-- Any {getAny = True}
Any False <> Any False
-- Any {getAny = False}
Maybe wrapper:
First (Just 1) `mappend` First (Just 2)
-- First {getFirst = Just 1}
Last (Just 1) `mappend` Last (Just 2)
-- Last {getLast = Just 2}
Last Nothing `mappend` Last (Just 2)
-- Last {getLast = Just 2}
First Nothing `mappend` First (Just 2)
-- First {getFirst = Just 2}
instance Monoid b => Monoid (a -> b)
instance (Monoid a, Monoid b) => Monoid (a, b)
instance (Monoid a, Monoid b, Monoid c) => Monoid (a, b, c)
data Optional a = Nada | Only a deriving (Eq, Show)
instance Monoid a => Monoid (Optional a) where
mempty = Nada
mappend Nada (Only a) = Only a
mappend (Only a) Nada = Only a
mappend Nada Nada = Nada
mappend (Only a) (Only b) = Only (mappend a b)
-- usage:
Only (Sum 1) `mappend` Only (Sum 1)
-- Only (Sum {getSum = 2})
Only (Product 4) `mappend` Only (Product 2)
-- Only (Product {getProduct = 8})
Only (Sum 1) `mappend` Nada
-- Only (Sum {getSum = 1})
Only [1] `mappend` Nada
-- Only [1]
Nada `mappend` Only (Sum 1)
-- Only (Sum {getSum = 1})
monoid is not necessarily commutative
Commutative: reorder the arguments, not just reassociate the parentheses, and still get the same result.
commutative: (+) (*)
not commutative: (-) (++)
identity:
identity value:
problem:
module Listy where
newtype Listy a =
Listy [a] deriving (Eq, Show)
module ListyInstances where
import Data.Monoid
import Listy
instance Monoid (Listy a) where
mempty = Listy []
mappend (Listy l) (Listy l') = Listy $ mappend l l'
solution:
-
You defined the type but not the typeclass? Put the instance in the same module as the type so that the type cannot be imported without its instances.
-
You defined the typeclass but not the type? Put the instance in the same module as the typeclass definition so that the typeclass cannot be imported without its instances.
-
Neither the type nor the typeclass are yours? Define your own newtype wrapping the original type and now you’ve got a type that “belongs” to you for which you can rightly define typeclass instances.
import Data.Monoid
type Verb = String
type Adjective = String
type Adverb = String
type Noun = String
type Exclamation = String
madlibbinBetter' :: Exclamation
-> Adverb
-> Noun
-> Adjective
-> String
madlibbinBetter' e adv noun adj = mconcat [e, "! he said ", adv, " as he jumped into his car ", noun, " and drove off with this ", adj, " wife."]
import Data.Monoid
import Test.QuickCheck
monoidAssoc :: (Eq m, Monoid m) => m -> m -> m -> Bool
monoidAssoc a b c = (a <> (b <> c)) == ((a <> b) <> c)
monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity a = (mempty <> a) == a
monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity a = (a <> mempty) == a
quickCheck (monoidLeftIdentity :: String -> Bool)
-- +++ OK, passed 100 tests.
quickCheck (monoidRightIdentity :: String -> Bool)
-- +++ OK, passed 100 tests.
newtype First' a =
First' { getFirst' :: Optional a } deriving (Eq, Show)
instance Monoid (First' a) where
mempty = First' Nada
mappend (First' (Only x)) _ = First' (Only x)
mappend (First' Nada) (First' (Only x)) = First' (Only x)
mappend _ _ = First' Nada
firstMappend :: First' a -> First' a -> First' a
firstMappend = mappend
type FirstMappend =
First' String
-> First' String
-> First' String
-> Bool
main :: IO () main = do
quickCheck (monoidAssoc :: FirstMappend)
quickCheck (monoidLeftIdentity :: First' String -> Bool)
quickCheck (monoidRightIdentity :: First' String -> Bool)
class Semigroup a where
(<>) :: a -> a -> a
(a <> b) <> c = a <> (b <> c)
-- :| is the data constructor, the product of a and [a]
data NonEmpty a = a :| [a]
deriving (Eq, Ord, Show)
-- or like this
newtype NonEmpty a = NonEmpty (a, [a])
deriving (Eq, Ord, Show)
ok with binary associative operation, but not with identity.
so, with semigroup:
-- you need to have `semigroups` installed
import Data.List.NonEmpty as N
import Data.Semigroup as S
1 :| [2, 3]
-- 1 :| [2,3]
:t 1 :| [2, 3]
-- 1 :| [2, 3] :: Num a => NonEmpty a
:t (<>)
-- (<>) :: Semigroup a => a -> a -> a
xs = 1 :| [2, 3]
ys = 4 :| [5, 6]
xs <> ys
-- 1 :| [2,3,4,5,6]
N.head xs
-- 1
N.length (xs <> ys)
-- 6
class Semigroup a => Monoid a where
...
the inverse relationship: operations permitted over a type and the number of types that can satisfy.
id :: a -> a
-
Number of types: Infinite
-
Number of operations: one
inc :: Num a => a -> a
- Number of types: anything that implements Num. Zero to many.
- Number of operations: 7 methods in Num
somethingInt :: Int -> Int
- Number of types: one — just Int.
- Number of operations: considerably more than 7. In addition to Num, Int has instances of Bounded, Enum, Eq, Integral, Ord, Read, Real, and Show. On top of that, you can write arbitrary functions that pattern match on concrete types and return arbitrary values in that same type as the result. Polymorphism isn’t only useful for reusing code; it’s also useful for expressing intent through parametricity so that people reading the code know what we meant to accomplish.
data Trivial = Trivial deriving (Eq, Show)
instance Semigroup Trivial where
(<>) = Trivial
instance Monoid Trivial where
mempty = Trivial
mappend = (<>)
type TrivialAssoc = Trivial -> Trivial -> Trivial -> Bool
main :: IO () main = do
quickCheck (semigroupAssoc :: TrivialAssoc)
quickCheck (monoidLeftIdentity :: Trivial -> Bool)
quickCheck (monoidRightIdentity :: Trivial -> Bool)
-
monoid
-
semigroup
-
Law
-
algebra: informal notion of operations over a type and its laws, such as with semigroups, monoids, groups, semirings, and rings.
-
Algebraic structure; Simple English Wikipedia;
-
Algebraic structure; English Wikipedia
functor: Rudolf Carnap in the 1930s.
- the return of the higher-kinded types;
- fmaps;
- typeclasses and constructor classes;
class Functor f where
fmap :: (a -> b) -> f a -> f b
-- Functor f =>
fmap :: (a -> b) -> f a -> f b
:: (a -> b) -> [] a -> [] b
:: (a -> b) -> Maybe a -> Maybe n
:: (a -> b) -> Either e a -> Either e b
:: (a -> b) -> (e,) a -> (e,) b
:: (a -> b) -> Identity a -> Identity b
:: (a -> b) -> Constant e a -> Constant e b
(->) :: * -> * -> *
fmap :: Functorf => (a -> b) -> f a -> f b
(<$>) :: Functorf => (a -> b) -> f a -> f b
($) :: (a->b) -> a -> b
data FixMePls a = FixMe | Pls a deriving (Eq, Show)
instance Functor FixMePls where
fmap _ FixMe = FixMe
fmap f (Pls a) = Pls (f a)
fmap id == id
fmap (f . g) == fmap f . fmap g
data WhoCares a = ItDoesnt
| Matter a
| WhatThisIsCalled deriving (Eq, Show)
instance Functor WhoCares where
fmap _ ItDoesnt = ItDoesnt
fmap _ WhatThisIsCalled = WhatThisIsCalled
fmap f (Matter a) = Matter (f a)
lms = [Just "Ave", Nothing, Just "woohoo"]
replaceWithP = const 'p'
(fmap . fmap) replaceWithP lms
-- [Just 'p', Nothing, Just 'p']
(.) :: (b -> c) -> (a -> b) -> a -> c
fmap :: Functor f => (m -> n) -> f m -> f n
fmap :: Functor g => (x -> y) -> g x -> g y
fmap . fmap = ((m -> n) -> (f m -> f n))
-> ((x -> y) -> (g x -> g y))
= (x -> y) -> (f g x -> f g y)
= (x -> y) -> f g x -> f g y
a = fmap (+1) (read "[1]" :: [Int])
b = (fmap . fmap) (++ "lol") (Just ["Hi,", "Hello"])
c = (*2) . (\x -> x -2)
d = ((return '1' ++) . show) . (\x -> [x, 1..3])
data Two a b = Two a b deriving (Eq, Show)
data Or a b = First a | Second b deriving (Eq, Show)
-- error
instance Functor Two where fmap = undefined
instance Functor Or where fmap = undefined
-- ok
instance Functor (Two a) where
fmap f (Two a b) = Two a (f b)
instance Functor (Or a) where
fmap _ (First a) = First a
fmap f (Second b) = Second (f b)
newtype Identity a = Identity a
instance Functor Identity where
fmap f (Identity a) = Identity (f a)
data Pair a = Pair a a
instance Functor Pair where
fmap f (Pair a b) = Pair (f a) (f b)
data Two a b = Two a b
instance Functor (Two a) where
fmap f (Two a b) = Two a (f b)
data Three a b c = Three a b c
instance Functor (Three a b) where
fmap f (Three a b c) = Three a b (f c)
data Three' a b = Three' a b b
instance Functor (Three' a) where
fmap f (Three' a b c) = Two a (f b) (f c)
data Four a b c d = Four a b c d
instance Functor (Four a b c) where
fmap f (Four a b c d) = Two a b c (f d)
data Four' a b = Four' a a a b
instance Functor (Four' a) where
fmap f (Four' a b c d) = Two a b c (f d)
data Possibly a = LolNope | Yeppers a deriving (Eq, Show)
instance Functor Possibly where
fmap _ LolNope = LolNope
fmap f (Yeppers a) = Yeppers (f a)
data Sum a b = First a | Second b deriving (Eq, Show)
instance Functor (Sum a) where
fmap _ (First a) = First a
fmap f (Second a) = Second (f a)
data Wrap f a = Wrap (f a) deriving (Eq, Show)
instance Functor (Wrap f) where
fmap f (Wrap fa) = Wrap (f fa)
instance Functor (Wrap f) where
fmap f (Wrap fa) = Wrap (fmap f fa)
instance Functor f => Functor (Wrap f) where
fmap f (Wrap fa) = Wrap (fmap f fa)
getLine :: IO String
read :: Read a => String -> a
getInt :: IO Int
getInt = fmap read getLine
addOne = fmap (+1) getInt
-- or
meTooIsm :: IO String
meTooIsm = do
input <- getLine
return (input + 1)
natural transformations: transform the structure, but not the arguments
nat :: (f -> g) -> f a -> g a
{-# LANGUAGE RankNTypes #-}
type Nat f g = forall a. f a -> g a
-- This'll work
maybeToList :: Nat Maybe []
maybeToList Nothing = []
maybeToList (Just a) = [a]
-- This will not work, not allowed.
degenerateMtl :: Nat Maybe []
degenerateMtl Nothing = []
degenerateMtl (Just a) = [a+1]
data Quant a b = Finance | Desk a | Bloor b
instance Functor (Quant a) where
fmap f (Bloor b) = Bloor (f b)
fmap _ (Desk a) = Desk a
fmap _ Finance = Finance
data K a b = K a
instance Functor (K a) where
fmap _ (K a) = K a
{-# LANGUAGE FlexibleInstances #-}
newtype Flip f a b = Flip (f b a) deriving (Eq, Show)
newtype K a b = K a
instance Functor (Flip K a) where
fmap f (Flip (K a)) = Flip (K (f b))
data EvilGoateeConst a b = GoatyConst b
instance Functor (EvilGoateeConst a) where
fmap f (GoatyConst b) = GoatyConst (f b)
data LiftItOut f a = LiftItOut (f a)
instance Functor f => Functor (LiftItOut f) where
fmap f (LiftItOut fa) = LiftItOut (fmap f fa)
data Parappa f g a = DaWrappa (f a) (g a)
instance (Functor f, Functor g) => Functor (Parappa f g) where
fmap f (DaWrappa fa ga) = DaWrappa (fmap f fa) (fmap f ga)
data IgnoreOne f g a b = IgnoringSomething (f a) (g b)
instance Functor g => Functor (IgnoreOne f g a) where
fmap f (IgnoringSomething fa gb) = IgnoringSomething fa (fmap f gb)
data Notorious g o a t = Notorious (g o) (g a) (g t)
instance Functor g => Functor (Notorious g o a) where
fmap f (Notorious go ga gt) = Notorious go ga (fmap f gt)
data List a = Nil | Cons a (List a)
instance List where
fmap f (Cons a (List a)) = Cons (f a) (List (f a))
fmap _ Nil = Nil
data GoatLord a = NoGoat
| OneGoat a
| MoreGoats (GoatLord a) (GoatLord a) (GoatLord a)
instance Functor GoatLoard where
fmap _ NoGoat = NoGoat
fmap f (OneGoat a) = OneGoat (f a)
fmap f MoreGoats ga1
ga2
ga3 = MoreGoats (fmap f ga1)
(fmap f ga2)
(fmap f ga3)
data TalkToMe a = Halt
| Print String a
| Read (String -> a)
instance Functor TalkToMe where
fmap _ Halt = Halt
fmap f (Print s a) = Print s (f a)
fmap f (Read g) = Read (fmap f g)
-
Higher-kinded polymorphism
-
Functor
-
lifting
-
George Clinton
-
Haskell Wikibook; The Functor class.
-
Mark P. Jones; A system of constructor classes: overloading and implicit higher-order polymorphism.
-
Gabriel Gonzalez; The functor design pattern.
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
-- Could call <*> tie-fighter or "ap" (short for apply)
every type that can have an Applicative instance must also have a Functor instance.
pure: like identity
, embed sth into f
<*>: ap,
(<$>) :: Functor f => (a -> b) -> f a -> f b
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
fmap :: (a -> b) -> f a -> f b
(<*>) :: f (a -> b) -> f a -> f b
fmap f x = pure f <*> x
fmap (+1) [1, 2, 3] -- [2, 3, 4]
pure (+1) <*> [1, 2, 3] -- [2, 3, 4]
pure
embed the value into the structure
pure 1 :: [Int] -- [1]
pure 1 :: Maybe Int -- Just 1
pure 1 :: Either a Int -- Right 1
pure 1 :: ([a], Int) -- ([],1)
fmap (+1) (4, 5)
($) :: (a->b)-> a-> b
(<$>) :: (a -> b) -> f a -> f b
(<*>) :: f (a -> b) -> f a -> f b
mappend :: Monoid a => a -> a -> a
mappend :: f f f
$ :: (a -> b) a b
(<*>) :: f (a -> b) -> f a -> f b
[(*2), (*3)] <*> [4, 5]
-- [8, 10, 12, 15]
Just (*2) <*> Just 2 = Just 4
Just (*2) <*> Nothing = Nothing
Nothing <*> Just 2 = Nothing
Nothing <*> Nothing = Nothing
:info (,)
data (,) a b = (,) a b -- Defined in ‘GHC.Tuple’
...
instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’
...
instance (Monoid a, Monoid b) => Monoid (a, b)
-- functor
fmap (+1) ("blah", 0)
-- ("blah",1)
-- ap
("Woo", (+1)) <*> (" Hoo!", 0)
-- ("Woo Hoo!", 1)
((Sum 2), (+1)) <*> ((Sum 0), 0)
-- (Sum {getSum = 2}, 1)
((Product 3), (+9)) <*> ((Product 2), 8)
-- (Product {getProduct = 6}, 17)
((All True), (+1)) <*> ((All False), 0)
-- (All {getAll = False}, 1)
instance (Monoid a, Monoid b) => Monoid (a,b) where
mempty = (mempty, mempty)
(a, b) `mappend` (a', b') = (a `mappend` a', b `mappend` b')
instance Monoid a => Applicative ((,) a) where
pure x = (mempty, x)
(u, f) <*> (v, x) = (u `mappend` v, f x)
instance Monoid a => Monoid (Maybe a) where
mempty = Nothing
mappend m Nothing = m
mappend Nothing m = m
mappend (Just a) (Just a') = Just (mappend a a')
instance Applicative Maybe where
pure = Just
Nothing <*> _ = Nothing
_ <*> Nothing = Nothing
Just f <*> Just a = Just (f a)
-- f ~ []
(<*>) :: f (a -> b) -> f a -> f b
(<*>) :: [] (a -> b) -> [] a -> [] b
-- more syntactically typical
(<*>) :: [(a -> b)] -> [a] -> [b]
pure :: a -> f a
pure :: a -> [] a
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
-- f ~ []
listApply :: [(a -> b)] -> [a] -> [b]
listFmap :: (a -> b) -> [a] -> [b]
functor: a function to a plurality of values:
fmap (2^) [1, 2, 3]
-- [2,4,8]
fmap (^2) [1, 2, 3]
-- [1,4,9]
ap: a plurality of function to a plurality of values:
[(+1), (*2)] <*> [2, 4]
-- [3,5,4,8]
(,) <$> [1, 2] <*> [3, 4]
-- [(1,3),(1,4),(2,3),(2,4)]
added :: Maybe Integer
added = (+3) <$> (lookup 3 $ zip [1, 2, 3] [4, 5, 6])
y :: Maybe Integer
y = lookup 3 $ zip [1, 2, 3] [4, 5, 6]
z :: Maybe Integer
z = lookup 2 $ zip [1, 2, 3] [4, 5, 6]
tupled :: Maybe (Integer, Integer)
tupled = (,) <$> y <*> z
import Data.List (elemIndex)
x :: Maybe Int
x = elemIndex 3 [1, 2, 3, 4, 5]
y :: Maybe Int
y = elemIndex 4 [1, 2, 3, 4, 5]
max' :: Int -> Int -> Int
max' = max
maxed :: Maybe Int
maxed = max' <$> x <*> y
newtype Identity a = Identity a deriving (Eq, Ord, Show)
instance Functor Identity where
fmap f (Identity a)= Identity (f a)
instance Applicative Identity where
pure = Identity
(<*>) (Identity f) (Identity b)= Identity (f b)
-- f ~ Constant e
(<*>) :: f (a -> b) -> f a -> f b
(<*>) :: Constant e (a -> b) -> Constant e a -> Constant e b
pure :: a -> f a
pure :: a -> Constant e a
newtype Constant a b = Constant { getConstant :: a } deriving (Eq, Ord, Show)
instance Functor (Constant a) where
fmap _ (Constant a) = Constant a
instance Monoid a => Applicative (Constant a) where
pure = Constant
(<*>) (Constant a) (Constant b) = Constant (a b)
-- f ~ Maybe
(<*>) :: f (a -> b) -> f a -> f b
(<*>) :: Maybe (a -> b) -> Maybe a -> Maybe b
pure :: a -> f a
pure :: a -> Maybe a
validateLength :: Int -> String -> Maybe String
validateLength maxLen s = if (length s) > maxLen
then Nothing
else Just s
newtype Name = Name String deriving (Eq, Show)
newtype Address = Address String deriving (Eq, Show)
mkName :: String -> Maybe Name
mkName s = fmap Name $ validateLength 25 s
mkAddress :: String -> Maybe Address
mkAddress a = fmap Address $ validateLength 100 a
data Person = Person Name Address deriving (Eq, Show)
mkPerson :: String -> String -> Maybe Person
mkPerson n a = case mkName n of
Nothing -> Nothing
Just n' -> case mkAddress a of
Nothing -> Nothing
Just a' -> Just $ Person n' a'
--usage:
Person <$> (mkName "Babe") <*> (mkAddress 1)
instance Functor Maybe where
fmap _ Nothing = Nothing
fmap f (Just a) = Just (f a)
instance Applicative Maybe where
pure = Just
Nothing <*> _ = Nothing
_ <*> Nothing = Nothing
Just f <*> Just a = Just (f a)
const <$> Just "Hello" <*> pure "World"
(,,,) <$> Just 90 <*> Just 10 <*> Just "Tierness" <*> pure [1, 2, 3]
id v = v
fmap id v = v
pure id <*> v = v
pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
pure f <*> pure x = pure (f x)
u <*> pure y = pure ($ y) <*> u
($ 1) (*1) = 1
Sum 1 `mappend` ??? -> Sum 1
instance Monoid a => Monoid (ZipList a) where
mempty = pure mempty
mappend = liftA2 mappend
data List a = Nil | Cons a (List a) deriving (Eq, Show)
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons a az) = Cons (f a) (fmap f az)
instance Applicative List where
pure a = Cons a Nil
(<*>) Nil _ = Nil
(<*>) _ Nil = Nil
(<*>) (Cons f a) bz = fmap f bz <> (a <*> bz)
-- usage:
functions = Cons (+1) (Cons (*2) Nil)
values = Cons 1 (Cons 2 Nil)
functions <*> values
-- Cons 2 (Cons 3 (Cons 2 (Cons 4 Nil)))
append :: List a -> List a -> List a
append Nil ys = ys
append (Cons x xs) ys = Cons x $ xs `append` ys
fold :: (a -> b -> b) -> b -> List a -> b
fold _ b Nil = b
fold f b (Cons h t) = f h (fold f b t)
concat' :: List (List a) -> List a
concat' = fold append Nil
-- write this one in terms of concat' and fmap
flatMap :: (a -> List b) -> List a -> List b
flatMap f (a:as) = f a ++ (flatMap f as)
flatMap _ [] = []
data List a = Nil | Cons a (List a) deriving (Eq, Show)
take' :: Int -> List a -> List a
take' 0 _ = Nil
take' _ Nil = Nil
take' n (Cons a az) = Cons a (take' (n-1) az)
instance Monoid (List a) where
mempty = Nil
mappend Nil a = a
mappend a Nil = a
mappend (Cons x xs) ys = Cons x (mappend xs ys)
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons a az) = Cons (f a) (fmap f az)
instance Applicative List where
pure a = Cons a Nil
(<*>) Nil _ = Nil
(<*>) _ Nil = Nil
(<*>) (Cons x xs) ys = fmap x ys <> (xs <*> ys)
newtype ZipList' a = ZipList' (List a) deriving (Eq, Show)
instance Eq a => EqProp (ZipList' a) where
xs =-= ys = xs' `eq` ys'
where xs' = let (ZipList' l) = xs
in take' 3000 l
ys' = let (ZipList' l) = ys
in take' 3000 l
instance Functor ZipList' where
fmap f (ZipList' xs) = ZipList' $ fmap f xs
repeatList :: a -> (List a)
repeatList x = xs
where xs = Cons x xs
zipListWith :: (a -> b -> c) -> (List a) -> (List b) -> (List c)
zipListWith _ Nil _ = Nil
zipListWith _ _ Nil = Nil
zipListWith f (Cons a as) (Cons b bs) = Cons (f a b) (zipListWith f as bs)
instance Applicative ZipList' where
pure = ZipList' . repeatList
(<*>) (ZipList' fs ) (ZipList' xs) = ZipList' (zipListWith id fs xs)
-- f ~ Either e
(<*>) :: f (a -> b) -> f a -> f b
(<*>) :: Either e (a -> b) -> Either e a -> Either e b
pure :: a -> f a
pure :: a -> Either e a
pure 1 :: Either e Int
-- Right 1
Right (+1) <*> Right 1
-- Right 2
Right (+1) <*> Left ":("
-- Left ":("
data Validation e a = Error e
| Success a deriving (Eq, Show)
instance Functor (Sum a) where
fmap _ (First a) = First a
fmap f (Second b) = Second b
instance Applicative (Sum a) where
pure = Second
(<*>) (First a) _ = First a
(<*>) _ (First a) = First a
(<*>) (Second b) (Second c) = Second (b c)
instance Functor (Validation e) where
fmap _ (Error e) = Error e
fmap f (Success a) = Success a
instance Monoid e => Applicative (Validation e) where
pure = Success
(<*>) (Error e) (Error e') = Error (e <> e')
(<*>) _ (Error e) = Error e
(<*>) (Error e) _ = Error e
(<*>) (Success f) (Success b) = Success (f b)
newtype Identity a = Identity a deriving Show
instance Applicative Identity where
pure = Identity
(<*>) (Identity f) (Identity a) = Identity (f a)
data Pair a = Pair a a deriving Show
instance Applicative Pair where
pure a = Pair a a
(<*>) (Pair f f') (Pair a a') = Pair (f a) (f' a')
data Two a b = Two a b
instance Monoid a => Applicative (Two a) where
pure x = Two mempty x
(<*>) (Two a f) (Two a' b) = Two (a <> a') (f b)
data Three a b c = Three a b c
instance (Monoid a, Monoid b) => Applicative (Three a b) where
pure x = Three mempty mempty x
(<*>) (Three a b f) (Three a' b' c) = Three (a <> a')
(b <> b')
(f c)
data Three' a b = Three' a b b
instance Monoid a => Applicative (Three' a) where
pure x = Three' mempty x x
(<*>) (Three' a f g) (Three' a' b b') = Three' (a <> a')
(f b)
(g b')
data Four a b c d = Four a b c d
instance (Monoid a,
Monoid b,
Monoid c) => Applicative (Four a b c) where
pure x = Four mempty mempty mempty x
(<*>) (Four a b c f) (Four a' b' c' d) = Four (a <> a')
(b <> b')
(c <> c')
(f d)
data Four' a b = Four' a a a b
instance Monoid a => Applicative (Four' a) where
pure x = Four' mempty mempty mempty x
(<*>) (Four' a b c f) (Four' a' b' c' d) = Four' (a <> a')
(b <> b')
(c <> c')
(f d)
- Applicative
-
Tony Morris; Nick Partridge; Validation library
-
Conor McBride; Ross Paterson; Applicative Programming with Effects
-
Jeremy Gibbons; Bruno C. d. S. Oliveira; Essence of the Iterator Pattern
-
Ross Paterson; Constructing Applicative Functors
-
Sam Lindley; Philip Wadler; Jeremy Yallop; Idioms are oblivious, arrows are meticulous, monads are promiscuous.
monad: applicative functor
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
(>>) :: m a -> m b -> m b
return :: a -> m a
fmap f xs = xs >>= return . f
fmap :: Functor f => (a -> b) -> f a -> f b
<*> :: Applicative f => f (a -> b) -> f a -> f b
>>= :: Monad f => f a ->(a -> f b) -> f b
monad is a generalization of concat
fmap :: Functor f => (a -> f b) -> f a -> f (f b)
concat :: Foldable t => t [a] -> [a]
import Control.Monad (join)
join :: Monad m => m (m a) -> m a
bind :: Monad m => (a -> m b) -> m a -> m b
bind = join . fmap
Monad is not:
- Impure
- for imperative programming
- value
- About strictness
(*>) :: Applicative f => f a -> f b -> f b
(>>) :: Monad m => m a -> m b -> m b
getLine :: IO String
putStrLn :: String -> IO ()
binding :: IO ()
binding = do
name <- getLine
putStrLn name
binding' :: IO ()
binding' = getLine >>= putStrLn
getLine <$> putStrLn :: IO (IO ())
join $ getLine <$> putStrLn :: IO ()
with and without do
syntax:
bindingAndSequencing :: IO ()
bindingAndSequencing = do
putStrLn "name pls:"
name <- getLine
putStrLn ("y helo thar: " ++ name)
bindingAndSequencing' :: IO ()
bindingAndSequencing' =
putStrLn "name pls:" >>
getLine >>=
\name -> putStrLn ("y helo thar: " ++ name)
(>>=) :: Monad m => m a -> (a -> m b) -> m b
(>>=) :: [a] -> (a -> [b]) -> [b]
return :: Monad m => a -> m a
return :: a -> [a]
twiceWhenEven :: [Integer] -> [Integer]
twiceWhenEven xs = do
x <- xs
if even x
then [x * x, x * x]
else [x * x]
twiceWhenEven [1..3] -- [1,4,4,9]
twiceWhenEven :: [Integer] -> [Integer]
twiceWhenEven xs = do
x <- xs
if even x
then [x*x, x*x]
else []
-- m ~ Maybe
(>>=) :: Monad m => m a -> (a -> m b) -> m b
(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b
-- same as pure
return :: Monad m => a -> m a
return :: a -> Maybe a
instance Monad Maybe where
return x = Just x
(Just x) >>= k = k x
Nothing >>= _ = Nothing
bottom:
Nothing >>= undefined
-- Nothing
-- m ~ Either e
(>>=) :: Monad m => m a -> (a -> m b) -> m b
(>>=) :: Either e a -> (a -> Either e b) -> Either e b
-- same as pure
return :: Monad m => a -> m a
return :: a -> Either e a
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
ap :: Monad m => m (a -> b) -> m a -> m b
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap m m' = do
x <- m
x' <- m'
return (x x')
data Sum a b = First a
| Second b deriving (Eq, Show)
instance Functor (Sum a) where
fmap _ (First a)= First a
fmap f (Second b) = Second (f b)
instance Applicative (Sum a) where
pure = Second
(<*>) (First a) _ = First a
(<*>) _ (First a) = First a
(<*>) (Second f) (Second b) = Second (f b)
instance Monad (Sum a) where
return = pure
(>>=) (First a) _ = First a
(>>=) (Second b) f = f b
-- right identity
m >>= return = m
-- left identity
return x >>= f = f x
(m >>= f) >>= g = m >>= (\x -> f x >>= g)
mcomp :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
mcomp f g a = join (f <$> (g a))
-- or with monad
mcomp'' f g a = g a >>= f
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
flip (.) :: (a -> b) -> (b -> c) -> a -> c
data Nope a = NopeDotJpg
instance Monad Nope where
return = pure
(>>=) NopeDotJpg _ = NopeDotJpg
data PhhhbbtttEither b a = Left a | Right b
instance Monad (PhhhbbtttEither b) where
return = pure
(>>=) (Right b) _ = Right b
(>>=) (Left a) f = f a
newtype Identity a = Identity a deriving (Eq, Ord, Show)
instance Functor Identity where
fmap f (Identity a) = Identity (f a)
instance Applicative Identity where
pure = Identity
(<*>) (Identity f) (Identity a)= Identity (f a)
instance Monad Identity where
return = pure
(>>=) (Identity a) f = f a
data List a = Nil | Cons a (List a)
instance Monad List where
return a = pure
(>>=) Nil _ = Nil
(>>=) (Cons a l) f = f a <> (l >>= f)
j :: Monad m => m (m a) -> m a
j = join
j [[1, 2], [], [3]]
-- [1,2,3]
j (Just (Just 1))
-- Just 1
j (Just Nothing)
-- Nothing
j Nothing
-- Nothing
l1 :: Monad m => (a -> b) -> m a -> m b
l1 = liftM
l2 :: Monad m => (a -> b -> c) -> m a -> m b -> m c
l2 = liftM2
a :: Monad m => m a -> m (a -> b) -> m b
a = flip ap
meh :: Monad m => [a] -> (a -> m b) -> m [b]
meh [] _ = return []
meh (x:xs) f = (meh xs f) >>= (\xs -> fmap (:xs) (f x))
-- or
meh (x:xs) f = (fmap (\a -> (a:)) $ f x) <*> (meh xs f)
-- or
meh (x:xs) f = (++) <$> (fmap (\a -> [a]) $ f x) <*> (meh xs f)
flipType :: (Monad m) => [m a] -> m [a]
flipType [] = return []
flipType (x:xs) = (:) <$> x <*> (flipType xs)
-
monad
-
monadic function:
a -> m b
-
bind
-- lifting (a -> b) over f in f a
fmap :: (a -> b) -> f a -> f b
-- binding (a -> m b) over m in m a
(>>=) :: m a -> (a -> m b) -> m b
- What a Monad is not
- Gabriel Gonzalez; How to desugar Haskell code
- Stephen Diehl; What I wish I knew when Learning Haskell
- Stephen Diehl; Monads Made Difficult
- Brent Yorgey; Typeclassopedia
- the Foldable class and its core operations;
- the monoidal nature of folding;
- standard operations derived from folding.
class Foldable (t :: * -> *) where
fold :: Data.Monoid.Monoid m => t m -> m
foldMap :: Data.Monoid.Monoid m => (a -> m) -> t a -> m
fold
does not have a Monoid specified:
fold [1, 2, 3, 4, 5]
-- ok
fold [Sum 1, Sum 2, Sum 3, Sum 4, Sum 5]
-- Sum {getSum = 15}
-- or this
fold [1, 2, 3, 4, 5 :: Sum Integer]
-- Sum {getSum = 15}
foldMap (*5) [1, 2, 3 :: Product Integer]
-- Product {getProduct = 750}
-- 5 * 10 * 15 = 750
foldMap (*5) [1, 2, 3 :: Sum Integer]
-- Sum {getSum = 30}
-- 5 + 10 + 15 = 30
foldMap (*5) Nothing :: Sum Integer
-- Sum {getSum = 0}
foldMap (*5) Nothing :: Product Integer
-- Product {getProduct = 1}
data Identity a = Identity a
instance Foldable Identity where
foldr f z (Identity x) = f x z
foldl f z (Identity x) = f z x
foldMap f (Identity x) = f x
instance Foldable Optional where
foldr _ z Nada = z
foldr f z (Yep x) = f x z
foldl _ z Nada = z
foldl f z (Yep x) = f z x
foldMap _ Nada = mempty
foldMap f (Yep a) = f a
-- error
foldMap (+1) Nada
-- ok
foldMap (+1) Nada :: Sum Int
-- Sum {getSum = 0}
sum :: (Foldable t, Num a) => t a -> a
sum = getSum . foldMap Sum
product :: (Foldable t, Num a) => t a -> a
product = getProduct . foldMap Product
elem :: (Foldable t, Eq a) => a -> t a -> Bool
elem el = getAny . foldMap (Any . (el==))
newtype Min a = Min {getMin :: Maybe a}
instance Ord a => Monoid (Min a) where
mempty = Min Nothing
m `mappend` Min Nothing = m
Min Nothing `mappend` n = n
(Min m@(Just x)) `mappend` (Min n@(Just y))
| x <= y = Min m
| otherwise = Min n
minimum :: (Foldable t, Ord a) => t a -> Maybe a
minimum = getMin . foldMap (\a -> Min {getMin = Just a})
null :: (Foldable t) => t a -> Bool
null = (==0) . length
-- or
null = foldr (\_ _ -> False) True
length :: (Foldable t) => t a -> Int
length = foldr (\_ acc -> acc + 1) 0
toList :: (Foldable t) => t a -> [a]
toList = foldr (:) []
fold :: (Foldable t, Monoid m) => t m -> m
fold = foldMap id
foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
foldMap f = foldr (\a acc -> f a <> acc) mempty
data Constant a b = Constant a
instance Foldable (Constant a) where
foldMap _ _ = mempty
data Two a b = Two a b
instance Foldable (Two a) where
foldMap f (Two a b) = f b
data Three a b c = Three a b c
instance Foldable (Three a b) where
foldMap f (Three a b c) = f c
data Three' a b = Three' a b b
instance Foldable (Three' a) where
foldMap f (Three' a b c) = f b <> f c
data Four' a b = Four' a b b b
instance Foldable (Four' a) where
foldMap f (Four' a b c d) = f b <> f c <> f d
filterF f = foldMap fb
where fb x
| f x = pure x
| otherwise = mempty
- Jakub Arnold, Foldable and Traversable
class (Functor t, Foldable t) => Traversable t where
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
traverse f = sequenceA . fmap f
sequenceA :: Applicative f => t (f a) -> f (t a)
sequenceA = traverse id
fmap :: (a -> b) ->fa->fb
(=<<) :: (a -> m b) -> m a -> m b -- flip bind
traverse :: (a -> f b) -> t a -> f (t b)
traverse = sequenceA . fmap
traverse is more generic:
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
-- contrast with
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
sequence :: Monad m => [m a] -> m [a]
-- contrast with
sequenceA :: (Applicative f, Traversable t) => t (f a)
-> f (t a)
-- we want this
(sequence .) . fmap = \ f xs -> sequence (fmap f xs)
-- not this
sequence . fmap = \ f -> sequence (fmap f)
traverse morseToChar (morse "julie")
-- Just "julie"
data Query = Query
data SomeObj = SomeObj
data IoOnlyObj = IoOnlyObj
data Err = Err
decodeFn :: String -> Either Err SomeObj
decodeFn = undefined
fetchFn :: Query -> IO [String]
fetchFn = undefined
makeIoOnlyObj :: [SomeObj] -> IO [(SomeObj, IoOnlyObj)] makeIoOnlyObj = undefined
-- before
pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn query = do
a <- fetchFn query
case sequence (map decodeFn a) of
(Left err) -> return $ Left $ err
(Right res) -> do
a <- makeIoOnlyObj res
return $ Right a
-- after
pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn query = do
a <- fetchFn query
traverse makeIoOnlyObj (mapM decodeFn a)
-- or
pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn = (traverse makeIoOnlyObj . mapM decodeFn =<<) . fetchFn
-- or mapM = traverse
pipelineFn :: Query -> IO (Either Err [(SomeObj, IoOnlyObj)])
pipelineFn =
(traverse makeIoOnlyObj . traverse decodeFn =<<) . fetchFn
data Either a b = Left a
| Right b deriving (Eq, Ord, Show)
instance Functor (Either a) where
fmap _ (Left x) = Left x
fmap f (Right y) = Right (f y)
instance Applicative (Either e) where
pure = Right
Left e <*> _ = Left e
Right f <*> r = fmap f r
instance Foldable (Either a) where
foldMap _ (Left _) = mempty
foldMap f (Right y) = f y
foldr _ z (Left _) = z
foldr f z (Right y) = f y z
instance Traversable (Either a) where
traverse _ (Left x) = pure (Left x)
traverse f (Right y) = fmap Right $ f y
instance Functor ((,) a) where
fmap f (x,y) = (x, f y)
instance Monoid a => Applicative ((,) a) where
pure x = (mempty, x)
(u, f) <*> (v, x) = (u `mappend` v, f x)
instance Foldable ((,) a) where
foldMap f (_, y) = f y
foldr f z (_, y) = f y z
instance Traversable ((,) a) where
traverse f (x, y) = (,) x <$> f y
- Naturality
t . traverse f = traverse (t . f)
-- ???
traverse :: (a -> f b) -> t a -> f (t b)
t . f = a -> f b
f = a -> g c
t = g c -> f b
traverse (t . f) = t a -> f (t b)
traverse f = t a -> g (t c)
t = g c -> f b = g (t c) -> f (t b) -- ??
t . traverse f = t a -> f (t b)
- Identity
traverse Identity = Identity
- Composition
traverse (Compose . fmap g . f) =
Compose . fmap (traverse g) . traverse f
- Naturality
t . sequenceA = sequenceA . fmap t
- Identity
sequenceA . fmap Identity = Identity
- Composition
sequenceA . fmap Compose =
Compose . fmap sequenceA . sequenceA
newtype Identity a = Identity a deriving (Eq, Ord, Show)
instance Traversable Identity where
traverse f (Identity a) = Identity <$> f a
newtype Constant a b = Constant { getConstant :: a }
instance Traversable (Constant a) where
traverse _ (Constant a) = pure $ Constant a
data Optional a = Nada | Yep a
instance Traversable Optional where
traverse _ Nada = pure $ Nada
traverse f (Yep a) = Yep <$> f a
data List a = Nil | Cons a (List a)
instance Traversable List where
traverse _ Nil = pure $ Nil
traverse f (Cons a l) = Cons <$> f a <*> traverse f l
data Three a b c = Three a b c
instance Traversable (Three a b) where
traverse f (Three a b c) = Three a b <$> f c
data Three' a b = Three' a b b
instance Traversable (Three' a) where
traverse f (Three' a b c) = Three' a <$> f b <*> f c
data S n a = S (n a) a
instance Traversable n => Traversable (S n) where
traverse f (S na a) = S <$> traverse f na <*> f a
data Tree a = Empty
| Leaf a
| Node (Tree a) a (Tree a) deriving (Eq, Show)
instance Functor Tree where
fmap _ Empty = Empty
fmap f (Leaf a) = Leaf (f a)
fmap f (Node t1 a t2) = Node (fmap f t1)
(f a)
(fmap f t2)
instance Foldable Tree where
foldMap _ Empty = mempty
foldMap f (Leaf a) = f a
foldMap f (Node t1 a t2) = (foldMap f tl)
<> (f a)
<> (foldMap f tr)
instance Traversable Tree where
traverse _ Empty = pure Empty
traverse f (Leaf a) = Leaf <$> f a
traverse f (Node t1 a t2) = Node <$> (traverse f t1)
<*> f a
<$> (traverse f t2)
-
Jakub Arnold, Foldable and Traversable
-
The Essence of the Iterator Pattern; Jeremy Gibbons and Bruno Oliveira.
-
Applicative Programming with Effects; Conor McBride and Ross Paterson.
import Control.Applicative
hurr = (*2)
durr = (+10)
m :: Integer -> Integer
m = hurr . durr
m' :: Integer -> Integer
m' = fmap hurr durr
fmap hurr durr x == (*2) ((+10) x)
-- lift partially-applied function
g = b -> c
f = a -> b
fmap g f = (a ->) (g b) = (a ->) c =
g . f = fmap g f
m3 :: Integer -> Integer
m3 = liftA2 (+) hurr durr
m2 :: Integer -> Integer
m2 = (+) <$> hurr <*> durr
m2 = (+) <$> (*2) <*> (+10)
m2 3 -- 19
--------
<*> = f (a -> b) -> f a -> f b
(+) <$> hurr = (+) . hurr
(+) <$> hurr <*> durr = \x -> (+ hurr x) <*> durr
= \x -> durr x + hurr x
idea of Reader: stringing functions together, awaiting one input from a shared environment.
import Data.Char
cap :: [Char] -> [Char]
cap xs = map toUpper xs
rev :: [Char] -> [Char]
rev xs = reverse xs
composed :: [Char] -> [Char]
composed = rev . cap
fmapped :: [Char] -> [Char]
fmapped = rev <$> cap
tupled :: [Char] -> ([Char], [Char])
tupled = (,) <$> cap <*> rev
tupled' :: [Char] -> ([Char], [Char])
tupled' = liftA2 (,) cap rev
tupled_do :: [Char] -> ([Char], [Char])
tupled_do = do
a <- rev
b <- cap
return (a, b)
tupled_bind :: [Char] -> ([Char], [Char])
tupled_bind = rev >>= \x1 -> cap >>= \x2 -> return (x1, x2)
(>>=) :: Monad m => m a -> (a -> m b) -> m b
instance Functor ((->) r) where
fmap = (.)
(.) :: (b -> c) -> (a -> b) -> (a -> c)
fmap :: Functor f => (a -> b) -> f a -> f b
:: (b -> c) -> (a -> b) -> (a -> c)
:: (a -> b) -> f a -> f b
:: (b -> c) -> (-> a) b -> (-> a) c
:: (b -> c) -> f b -> f c
newtype Reader r a =
Reader { runReader :: r -> a }
instance Functor (Reader r) where
fmap :: (a -> b) -> Reader r a -> Reader r b
fmap f (Reader ra) = Reader $ f . ra
-- same as (.)
compose :: (b -> c) -> (a -> b) -> (a -> c)
compose f g = \x -> f (g x)
-- see it?
\r -> f (ra r)
\x -> f (g x)
ask :: Reader a a
ask = Reader id
pure :: a -> f a
pure :: a -> (r -> a)
(<*>) :: f (a -> b) -> f a -> f b
(<*>) :: (r -> a -> b) -> (r -> a) -> (r -> b)
myLiftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
myLiftA2 f a b= f <$> a <*> b
asks :: (r -> a) -> Reader r a
asks f = Reader f
{-# LANGUAGE InstanceSigs #-}
instance Applicative (Reader r) where
pure :: a -> Reader r a
pure a = Reader $ \r -> a
(<*>) :: Reader r (a -> b) ->
Reader r a ->
Reader r b
(Reader rab) <*> (Reader ra) = Reader $ \r -> rab r (ra r)
getDogR :: Reader Person Dog
getDogR = Reader $ liftA2 Dog dogName address
(>>=) :: Monad m => m a -> (a -> m b) -> m b
(>>=) :: (->) r a -> (a -> (->) r b) -> (->) r b
(>>=) :: (r -> a) -> (a -> r -> b) -> r -> b
return :: Monad m => a -> ma
return :: a -> (->) r a
return :: a -> r -> a
instance Monad (Reader r) where
return = pure
(>>=) :: Reader r a
-> (a -> Reader r b)
-> Reader r b
(Reader ra) >>= aRb =
Reader $ \r -> runReader (aRb $ ra r) $ r
-
Reader Monad; All About Monads
-
Reader Monad; Programming with Monads; Real World Haskell
state: originates in the circuit and automata theory.
sg = mkStdGen 0
newSg = snd $ next sg
newSg2 = snd $ next newSg2
...
-- specify the range
-- randomR
randomR (0, 3) newSg
newtype State s a = State { runState :: s -> (a, s) }
newtype Reader r a = Reader { runReader :: r -> a }
isomorphic
type Iso a b = (a -> b, b -> a)
newtype Sum a = Sum { getSum :: a }
sumIsIsomorphicWithItsContents :: Iso a (Sum a) sumIsIsomorphicWithItsContents = (Sum, getSum)
State :: (s -> (a, s)) -> State s a
runState :: State s a -> s -> (a, s)
randomR :: (...) => (a, a) -> g -> (a, g)
State { runState :: s -> (a, s) }
module RandomExample where
import System.Random
-- Six-sided die
data Die =
DieOne
| DieTwo
| DieThree
| DieFour
| DieFive
| DieSix
deriving (Eq, Show)
intToDie :: Int -> Die
intToDie n =
case n of
1 -> DieOne
2 -> DieTwo
3 -> DieThree
4 -> DieFour
5 -> DieFive
6 -> DieSix
-- Use this tactic _extremely_ sparingly.
x -> error $ "intToDie got non 1-6 integer: " ++ show x
rollDieThreeTimes :: (Die, Die, Die)
rollDieThreeTimes = do
let s = mkStdGen 0
(d1, s1) = randomR (1, 6) s
(d2, s2) = randomR (1, 6) s1
(d3, _) = randomR (1, 6) s2
(intToDie d1, intToDie d2, intToDie d3)
rollDie :: State StdGen Die
rollDie = state $ do
(n, s) <- randomR (1, 6)
return (intToDie n, s)
state :: Monad m => (s -> (a, s)) -> StateT s m a
rollDie' :: State StdGen Die
rollDie' = intToDie <$> state (randomR (1, 6))
rollsToGetN :: Int -> StdGen -> Int
rollsToGetN n g = go 0 0 g
where go :: Int -> Int -> StdGen -> Int
go sum count gen
| sum >= n = count
| otherwise =
let (die, nextGen) = randomR (1, 6) gen
in go (sum + die) (count + 1) nextGen
rollsCountLogged :: Int -> StdGen -> (Int, [Die])
rollsCountLogged n g = go 0 (0, []) g
where go :: Int -> (Int, [Die]) -> StdGen -> (Int, [Die])
go sum acc@(count, xs) gen
| sum >= n = acc
| otherwise =
let (die, nextGen) = randomR (1, 6) gen
in go (sum + die) (count + 1, (intToDie die):acc)
newtype Moi s a = Moi { runMoi :: s -> (a, s) }
instance Functor (Moi s) where
fmap :: (a -> b) -> Moi s a -> Moi s b
fmap f (Moi g) = Moi $ \s -> let (a, b) = g s
in (f a, b)
runMoi ((+1) <$> (Moi $ \s -> (0, s))) 0
-- (1,0)
instance Applicative (Moi s) where
pure :: a -> Moi s a
pure a = Moi $ \s -> (a, s)
(<*>) :: Moi s (a -> b) -> Moi s a -> Moi s b
(Moi f) <*> (Moi g) = Moi $ \s -> let fab = fst $ f s
(a, b) = g s
in (fab a, b)
instance Monad (Moi s) where
return = pure
(>>=) :: Moi s a -> (a -> Moi s b) -> Moi s b
(Moi f) >>= g = Moi $ \s -> let a = fst $ f s
ms = runMoi $ g a
in ms s
-
Understanding Monads; Haskell Wikibook
monad transformer: type constructor that takes a monad as an argument.
newtype Identity a = Identity { runIdentity :: a }
one structure wrapped around another:
newtype Compose f g a =
Compose { getCompose :: f (g a) }
deriving (Eq, Show)
Compose [Just (1 :: Int), Nothing]
lifting both f & g, using fmap . fmap
:
instance (Functor f, Functor g) => Functor (Compose f g) where
fmap f (Compose fga) = Compose $ (fmap . fmap) f fga
{-# LANGUAGE InstanceSigs #-}
instance (Applicative f, Applicative g) => Applicative (Compose f g) where
pure :: a -> Compose f g a
pure = Compose $ pure . pure
(<*>) :: Compose f g (a -> b)
-> Compose f g a
-> Compose f g b
(Compose f) <*> (Compose a) = Compose $ ((<*>) <$> f) <*> a
--
(<*>) <$> f g a <*> f g b
= f ((<*>) g a) <*> f g b
= f (g a <*> g b)
= f g (a b)
composing monad impossible:
instance (Foldable f, Foldable g) => Foldable (Compose f g) where
foldMap f (Compose fga) = (foldMap . foldMap) f fga
instance (Traversable f, Traversable g) => Traversable (Compose f g) where
traverse f (Compose fga) = Compose <$> (traverse . traverse) f fga
class Bifunctor p where
{-# MINIMAL bimap | first, second #-}
bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
bimap f g = first f . second g
first :: (a -> b) -> p a c -> p b c
first f = bimap f id
second :: (b -> c) -> p a b -> p a c
second = bimap id
--
data Deux a b = Deux a b
instance Bifunctor Deux where
bimap f g (Deux a b) = Deux (f a) (g b)
first f (Deux a b) = bimap f id (Deux a b) = Deux (f a) b
second f (Deux a b) = bimap id f (Deux a b) = Deux a (f b)
--
data Const a b = Const a
instance Bifunctor Const where
bimap f _ (Const a) = Const (f a)
--
data Drei a b c = Drei a b c
instance Bifunctor (Drei a) where
bimap f g (Drei a b c) = Drei a (f b) (g c)
--
data SuperDrei a b c = SuperDrei a b
instance Bifunctor (SuperDrei a) where
bimap f _ (SuperDrei a b) = SuperDrei a (f b)
--
data SemiDrei a b c = SemiDrei a
instance Bifunctor (SemiDrei a) where
bimap f g (SemiDrei a) = SemiDrei a
--
data Quadriceps a b c d = Quadzzz a b c d
instance Bifunctor (Quadriceps a b) where
bimap f g (Quadzzz a b c d) = Quadzzz a b (f c) (g d)
--
data Either a b = Left a | Right b
instance Bifunctor Either where
bimap f _ (Left a) = Left (f a)
bimap _ g (Right b) = Right (g b)
newtype Identity a = Identity { runIdentity :: a } deriving (Eq, Show)
newtype IdentityT f a = IdentityT { runIdentityT :: f a } deriving (Eq, Show)
instance Functor Identity where
fmap f (Identity a) = Identity (f a)
instance (Functor m) => Functor (IdentityT m) where
fmap f (IdentityT fa) = IdentityT (fmap f fa)
instance Applicative Identity where
pure = Identity
(Identity f) <*> (Identity a) = Identity (f a)
instance (Applicative m) => Applicative (IdentityT m) where
pure x = IdentityT (pure x)
(IdentityT fab) <*> (IdentityT fa) = IdentityT (fab <*> fa)
instance Monad Identity where return = pure
(Identity a) >>= f = f a
instance (Monad m) => Monad (IdentityT m) where
return = pure
(IdentityT ma) >>= f = IdentityT $ ma >>= runIdentityT . f
--
f :: a -> IdentityT m b
runIdentityT :: IdentityT f a -> f a
runIdentityT . f :: a -> f a
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
instance (Functor m) => Functor (MaybeT m) where
fmap f (MaybeT ma) = MaybeT $ (fmap . fmap) f ma
instance (Applicative m) => Applicative (MaybeT m) where
pure x = MaybeT (pure (pure x))
(MaybeT fab) <*> (MaybeT mma) = MaybeT $ (<*>) <$> fab <*> mma
--
(<*>) <$> mMf <*> mMa = m (Mf <*>) <*> mMa
= m (Maybe (f a))
instance (Monad m) => Monad (MaybeT m) where
return = pure
(>>=) :: MaybeT m a
-> (a -> MaybeT m b)
-> MaybeT m b
(MaybeT ma) >>= f =
MaybeT $ do
v <- ma
case v of
Nothing -> return Nothing
Just y -> returnMaybeT (f y)
newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }
instance Functor m => Functor (EitherT e m) where
fmap f (EitherT mea) = EitherT $ (fmap . fmap) f mea
instance Applicative m => Applicative (EitherT e m) where
pure = EitherT $ pure . pure
(EitherT fab) <*> (EitherT mma) =
EitherT $ (<*>) <$> fab <*> mma
instance Monad m => Monad (EitherT e m) where
return = pure
(>>=) :: EitherT e m a
-> (a -> EitherT e m b)
-> EitherT e m b
(EitherT ma) >>= f =
EitherT $ do
v <- ma
case ma of
Left e -> return $ Left e
Right a -> runEitherT $ f a
swapEitherT :: (Functor m) => EitherT e m a -> EitherT a m e swapEitherT (EitherT x) = EitherT $ swapEitherT <$> x
either' :: (a -> c) -> (b -> c) -> Either a b -> c
either' fe _ (Left e) = fe e
either' _ fa (Right a) = fa a
eitherT :: Monad m =>
(a -> m c)
-> (b -> m c)
-> EitherT a m b
-> m c
eitherT fa fb (EitherT x) = x >>= either' fa fb
newtype RWST r w s m a = RWST { runRWST :: r -> s -> m (a, s, w) }
seq :: a -> b -> b
seq bottom b = bottom
seq literallyAnythingNotBottom b = b
Hey when implementing the Constatnt applicative instance you made a mistake
At least the tie fighter should be this:
Your
pure
implementation is also not compiling but i don't know the correct solution.