From 05cbb774f73d53881a591cb2dbb706a30d3809df Mon Sep 17 00:00:00 2001 From: Joel Kaasinen Date: Thu, 27 May 2021 10:32:40 +0300 Subject: [PATCH] lecture 15 --- exercises/Examples/Validation.hs | 109 +++++++ exercises/Mooc/Th.hs | 6 + exercises/Set15.hs | 371 ++++++++++++++++++++++ exercises/Set15Test.hs | 260 ++++++++++++++++ part2.html | 519 ++++++++++++++++++++++++++++++- 5 files changed, 1264 insertions(+), 1 deletion(-) create mode 100644 exercises/Examples/Validation.hs create mode 100644 exercises/Set15.hs create mode 100644 exercises/Set15Test.hs diff --git a/exercises/Examples/Validation.hs b/exercises/Examples/Validation.hs new file mode 100644 index 0000000..cee4b69 --- /dev/null +++ b/exercises/Examples/Validation.hs @@ -0,0 +1,109 @@ +module Examples.Validation (Validation,invalid,check) where + +import Control.Applicative +import Data.Char (isDigit) + +data Validation a = Ok a | Errors [String] + deriving (Show,Eq) + +instance Functor Validation where + fmap f (Ok x) = Ok (f x) + fmap _ (Errors e) = Errors e + +instance Applicative Validation where + pure x = Ok x + liftA2 f (Ok x) (Ok y) = Ok (f x y) + liftA2 f (Errors e1) (Ok y) = Errors e1 + liftA2 f (Ok x) (Errors e2) = Errors e2 + liftA2 f (Errors e1) (Errors e2) = Errors (e1++e2) + +invalid :: String -> Validation a +invalid err = Errors [err] + +check :: Bool -> String -> a -> Validation a +check b err x + | b = pure x + | otherwise = invalid err + +---- +---- Example +---- + +birthday :: String -> Int -> Validation String +birthday name age = liftA2 congratulate checkedName checkedAge + where checkedName = check (length name < 10) "Name too long" name + checkedAge = check (age < 99) "Too old" age + congratulate n a = "Happy "++show a++"th birthday "++n++"!" + +-- birthday "Guy" 31 +-- ==> Ok "Happy 31th birthday Guy!" +-- birthday "Guybrush Threepwood" 31 +-- ==> Errors ["Name too long"] +-- birthday "Yog-sothoth" 10000 +-- ==> Errors ["Name too long","Too old"] + +---- +---- Example: validating lists +---- + +-- via recursion +allPositive :: [Int] -> Validation [Int] +allPositive [] = Ok [] +allPositive (x:xs) = liftA2 (:) checkThis checkRest + where checkThis = check (x>=0) ("Not positive: "++show x) x + checkRest = allPositive xs + +-- allPositive [1,2,3] ==> Ok [1,2,3] +-- allPositive [1,2,3,-4] ==> Errors ["Not positive: -4"] +-- allPositive [1,-2,3,-4] ==> Errors ["Not positive: -2","Not positive: -4"] + +-- via traverse +allPositive' :: [Int] -> Validation [Int] +allPositive' xs = traverse checkNumber xs + where checkNumber x = check (x>=0) ("Not positive: "++show x) x + +--- +--- Alternative instance +--- + +instance Alternative Validation where + empty = Errors [] + Ok x <|> _ = Ok x + Errors e1 <|> Ok y = Ok y + Errors e1 <|> Errors e2 = Errors (e1++e2) + +---- +---- Example: parsing contact information: +---- + +data ContactInfo = Email String | Phone String + deriving Show + +validateEmail :: String -> Validation ContactInfo +validateEmail s = check (elem '@' s) "Not an email: should contain a @" (Email s) + +checkLength :: String -> Validation ContactInfo +checkLength s = check (length s <= 10) "Not a phone number: should be at most 10 digits" (Phone s) + +checkDigits :: String -> Validation ContactInfo +checkDigits s = check (all isDigit s) "Not a phone number: should be all numbers" (Phone s) + +validatePhone :: String -> Validation ContactInfo +validatePhone s = checkDigits s *> checkLength s + +validateContactInfo :: String -> Validation ContactInfo +validateContactInfo s = validateEmail s <|> validatePhone s + +-- validateContactInfo "user@example.com" +-- ==> Ok (Email "user@example.com") +-- validateContactInfo "01234" +-- ==> Ok (Phone "01234") +-- validateContactInfo "01234567890" +-- ==> Errors ["Not an email: should contain a @","Not a phone number: should be at most 10 digits"] +-- validateContactInfo "01234567890x" +-- ==> Errors ["Not an email: should contain a @", +-- "Not a phone number: should be all numbers", +-- "Not a phone number: should be at most 10 digits"] +-- validateContactInfo "x" +-- ==> Errors ["Not an email: should contain a @", +-- "Not a phone number: should be all numbers"] diff --git a/exercises/Mooc/Th.hs b/exercises/Mooc/Th.hs index 9a28689..0dfd8db 100644 --- a/exercises/Mooc/Th.hs +++ b/exercises/Mooc/Th.hs @@ -230,6 +230,11 @@ testing call = do -- TH pprint prints all names as qualified, let's convert the names to unqualified locals unqualifyName (Name n _) = Name n NameS +unqualifyType :: Type -> Type +unqualifyType (AppT f x) = AppT (unqualifyType f) (unqualifyType x) +unqualifyType (ConT n) = ConT (unqualifyName n) +unqualifyType x = error $ "Unsupported: " ++ show x + unqualify :: Exp -> Exp unqualify (VarE n) = VarE (unqualifyName n) unqualify (UnboundVarE n) = UnboundVarE (unqualifyName n) @@ -241,6 +246,7 @@ unqualify (LitE l) = LitE l unqualify (TupE exps) = TupE (map (fmap unqualify) exps) unqualify (ListE exps) = ListE (map unqualify exps) unqualify (ArithSeqE (FromR x)) = ArithSeqE (FromR (unqualify x)) +unqualify (SigE e t) = SigE (unqualify e) (unqualifyType t) unqualify x = error $ "Unsupported: " ++ show x testing' :: Q Exp -> Q Exp diff --git a/exercises/Set15.hs b/exercises/Set15.hs new file mode 100644 index 0000000..bb47657 --- /dev/null +++ b/exercises/Set15.hs @@ -0,0 +1,371 @@ +module Set15 where + +import Mooc.Todo +import Examples.Validation + +import Control.Applicative +import Data.Char +import Text.Read (readMaybe) + +------------------------------------------------------------------------------ +-- Ex 1: Sum two Maybe Int values using Applicative operations (i.e. +-- liftA2 and pure). Don't use pattern matching. +-- +-- Examples: +-- sumTwoMaybes (Just 1) (Just 2) ==> Just 3 +-- sumTwoMaybes (Just 1) Nothing ==> Nothing +-- sumTwoMaybes Nothing Nothing ==> Nothing + +sumTwoMaybes :: Maybe Int -> Maybe Int -> Maybe Int +sumTwoMaybes = todo + +------------------------------------------------------------------------------ +-- Ex 2: Given two lists of words, xs and ys, generate all statements +-- of the form "x is [not] y". Use Applicative +-- operations like liftA2! +-- +-- The order of the results doesn't matter. +-- +-- Examples: +-- statements ["beauty"] ["suffering"] +-- ==> ["beauty is suffering","beauty is not suffering"] +-- statements ["beauty","code"] ["suffering","life"] +-- ==> ["beauty is suffering","beauty is life", +-- "beauty is not suffering","beauty is not life", +-- "code is suffering","code is life", +-- "code is not suffering","code is not life"] + +statements :: [String] -> [String] -> [String] +statements = todo + +------------------------------------------------------------------------------ +-- Ex 3: A simple calculator with error handling. Given an operation +-- (negate or double) and a number, as strings, compute the result. +-- Return Nothing for an unknown operation or invalid number. +-- +-- Use Applicative operations, don't use pattern matching. +-- +-- Hint: remember the function readMaybe +-- +-- Examples: +-- calculator "negate" "3" ==> Just (-3) +-- calculator "double" "7" ==> Just 14 +-- calculator "doubl" "7" ==> Nothing +-- calculator "double" "7x" ==> Nothing + +calculator :: String -> String -> Maybe Int +calculator = todo + +------------------------------------------------------------------------------ +-- Ex 4: Safe division. Implement the function validateDiv that +-- divides two integers, but returns an error ("Division by zero!") if +-- the divisor is zero. +-- +-- NB! The constructors of Validation are not exported, so you can't +-- pattern match on Validation, you must use the Applicative methods +-- and the invalid and check functions. +-- +-- Examples: +-- validateDiv 6 2 ==> Ok 3 +-- validateDiv 6 0 ==> Errors ["Division by zero!"] +-- validateDiv 0 3 ==> Ok 0 + +validateDiv :: Int -> Int -> Validation Int +validateDiv = todo + +------------------------------------------------------------------------------ +-- Ex 5: Validating street addresses. A street address consists of a +-- street name, a street number, and a postcode. +-- +-- Implement the functoin validateAddress which constructs an Address +-- value if the input is valid: +-- +-- * Street length should be at most 20 characters +-- (if not, error "Invalid street name") +-- * Street number should only contain digits +-- (if not, error "Invalid street number") +-- * Postcode should be exactly five digits long +-- (if not, error "Invalid postcode") +-- +-- Examples: +-- validateAddress "Haskell road" "35" "13337" +-- ==> Ok (Address "Haskell road" "35" "13337") +-- validateAddress "Haskell road" "35a" "13337" +-- ==> Errors ["Invalid street number"] +-- validateAddress "Haskell road" "35a" "1333" +-- ==> Errors ["Invalid street number","Invalid postcode"] +-- validateAddress "Haskeller's favourite road" "35a" "1333" +-- ==> Errors ["Invalid street name","Invalid street number","Invalid postcode"] + +data Address = Address String String String + deriving (Show,Eq) + +validateAddress :: String -> String -> String -> Validation Address +validateAddress streetName streetNumber postCode = todo + +------------------------------------------------------------------------------ +-- Ex 6: Given the names, ages and employment statuses of two +-- persons, wrapped in Applicatives, return a list of two Person +-- values, wrapped in an applicative. +-- +-- Examples: +-- twoPersons (Just "Clarice") (Just 35) (Just True) (Just "Hannibal") (Just 50) (Just False) +-- ==> Just [Person "Clarice" 35 True,Person "Hannibal" 50 False] +-- twoPersons (Just "Clarice") (Just 35) (Just True) (Just "Hannibal") Nothing (Just False) +-- ==> Nothing +-- twoPersons ["Clarice"] [25,35] [True] ["Hannibal"] [50] [False] +-- ==> [[Person "Clarice" 25 True,Person "Hannibal" 50 False], +-- [Person "Clarice" 35 True,Person "Hannibal" 50 False]] + +data Person = Person String Int Bool + deriving (Show, Eq) + +twoPersons :: Applicative f => + f String -> f Int -> f Bool -> f String -> f Int -> f Bool + -> f [Person] +twoPersons name1 age1 employed1 name2 age2 employed2 = todo + +------------------------------------------------------------------------------ +-- Ex 7: Validate a String that's either a Bool or an Int. The return +-- type of the function uses Either Bool Int to be able to represent +-- both cases. Use <|> to combine two validators and to produce two +-- errors if the value is not an Int or a Bool. +-- +-- Hint: remember readMaybe +-- +-- Examples: +-- boolOrInt "True" ==> Ok (Left True) +-- boolOrInt "13" ==> Ok (Right 13) +-- boolOrInt "13.2" ==> Errors ["Not a Bool","Not an Int"] +-- boolOrInt "Falseb" ==> Errors ["Not a Bool","Not an Int"] + +boolOrInt :: String -> Validation (Either Bool Int) +boolOrInt = todo + +------------------------------------------------------------------------------ +-- Ex 8: Improved phone number validation. Implement the function +-- normalizePhone that, given a String: +-- +-- * removes all spaces from the string +-- * checks that there are at most 10 remaining characters +-- * checks that all remaining characters are digits, and logs an +-- error for every nonvalid character +-- * returns the string, stripped of whitespace, if no errors +-- +-- Examples: +-- normalizePhone "123 456 78" ==> Ok "12345678" +-- normalizePhone "123 4x6 78" +-- ==> Errors ["Invalid character: x"] +-- normalizePhone "123 4x6 7y" +-- ==> Errors ["Invalid character: x","Invalid character: y"] +-- normalizePhone "123 4x6 7y 999" +-- ==> Errors ["Too long","Invalid character: x","Invalid character: y"] +-- normalizePhone "123 456 78 999" +-- ==> Errors ["Too long"] + +normalizePhone :: String -> Validation String +normalizePhone = todo + +------------------------------------------------------------------------------ +-- Ex 9: Parsing expressions. The Expression type describes an +-- arithmetic expression that has an operator (+ or -) and two +-- arguments that can be either numbers or single-letter variables. +-- The operator and the arguments are always separated by spaces. Here +-- are some examples of expressions like this: 1 + 2, y + 7, z - w +-- +-- Implement the function parseExpression that uses the Validation +-- applicative to convert strings like "y + 7" to Expression values +-- like Plus (Variable 'y') (Number 7). +-- +-- The parser should produce the following errors: +-- * For operators other than + or -: "Unknown operator: %" +-- * For variables that aren't single letters: "Invalid variable: xy" +-- * For arguments that aren't numbers: "Invalid number: 1x" -- +-- * For expressions that don't consist of three words: +-- "Invalid expression: 1 + 2 +" +-- "Invalid expression: 1 -" +-- +-- Hint: The functions `words` and `isAlpha` +-- +-- Hint: If you have problems with the ordering of errors, remember +-- that Validation collects errors left-to-right! +-- +-- Examples: +-- parseExpression "1 + 2" ==> Ok (Plus (Number 1) (Number 2)) +-- parseExpression "z - A" ==> Ok (Minus (Variable 'z') (Variable 'A')) +-- parseExpression "1 * 2" ==> Errors ["Unknown operator: *"] +-- parseExpression "1 + 2x" +-- ==> Errors ["Invalid number: 2x","Invalid variable: 2x"] +-- parseExpression ". % 2x" +-- ==> Errors ["Unknown operator: %", +-- "Invalid number: .","Invalid variable: .", +-- "Invalid number: 2x","Invalid variable: 2x"] + +data Arg = Number Int | Variable Char + deriving (Show, Eq) + +data Expression = Plus Arg Arg | Minus Arg Arg + deriving (Show, Eq) + +parseExpression :: String -> Validation Expression +parseExpression = todo + +------------------------------------------------------------------------------ +-- Ex 10: The Priced T type tracks a value of type T, and a price +-- (represented by an Int). Implement the Functor and Applicative +-- instances for Priced. They should work like this: +-- +-- * Transforming a Priced value with fmap keeps the price the same +-- * pure should create a value with price 0 +-- * liftA2 should sum the prices of the things to be combined +-- +-- Examples: +-- fmap reverse (Priced 3 "abc") +-- ==> Priced 3 "cba" +-- liftA2 (*) (pure 2) (pure 3) :: Priced Int +-- ==> Priced 0 6 +-- liftA2 (+) (Priced 1 3) (Priced 1 5) +-- ==> Priced 2 8 +-- traverse (\x -> Priced (length x) x) ["abc","de","f"] +-- ==> Priced 6 ["abc","de","f"] + +data Priced a = Priced Int a + deriving (Show, Eq) + +instance Functor Priced where + fmap = todo + +instance Applicative Priced where + pure = todo + liftA2 = todo + +------------------------------------------------------------------------------ +-- Ex 11: This and the next exercise will use a copy of the +-- Applicative type class called MyApplicative. MyApplicative lacks +-- the Functor requirement that Applicative has, and also the <*> type +-- class method. You'll get to implement them instead. +-- +-- First you'll reimplement <*> using liftA2. In practical terms, +-- implement the operator <#> that works like <*>, using myPure and +-- myLiftA2. +-- +-- As long as you get the types right, your implementation is pretty +-- much guaranteed to be correct. +-- +-- Examples: +-- Just succ <#> Just 2 ==> Just 3 +-- Nothing <#> Just 2 ==> Nothing +-- [(*2),(+1)] <#> [10,100] ==> [20,200,11,101] + +class MyApplicative f where + myPure :: a -> f a + myLiftA2 :: (a -> b -> c) -> f a -> f b -> f c + +-- Some instances for testing: +instance MyApplicative Maybe where + myPure = pure + myLiftA2 = liftA2 +instance MyApplicative [] where + myPure = pure + myLiftA2 = liftA2 + +(<#>) :: MyApplicative f => f (a -> b) -> f a -> f b +f <#> x = todo + +------------------------------------------------------------------------------ +-- Ex 12: Reimplement fmap using liftA2 and pure. In practical terms, +-- implement the function myFmap below using the methods myPure and +-- myLiftA2 from the type class MyApplicative. +-- +-- As long as you get the types right, your implementation is pretty +-- much guaranteed to be correct. However, this time there are a +-- couple of different possible implementations! +-- +-- Examples: +-- myFmap negate (Just 1) ==> Just (-1) +-- myFmap negate Nothing ==> Nothing +-- myFmap negate [1,2,3] ==> [-1,-2,-3] + +myFmap :: MyApplicative f => (a -> b) -> f a -> f b +myFmap = todo + +------------------------------------------------------------------------------ +-- Ex 13: Given a function that returns an Alternative value, and a +-- list, try the function on all the elements in the list and produce +-- any successes. +-- +-- Hint: traverse won't help you since it succeeds only if all the +-- calls succeed. You need to use <|>. +-- +-- Examples: +-- +-- The Maybe Applicative returns the first success: +-- tryAll (\x -> if x>0 then pure x else empty) [0,3,2] :: Maybe Int +-- ==> Just 3 +-- tryAll (\x -> if x>0 then pure x else empty) [0,-1,0] :: Maybe Int +-- ==> Nothing +-- The list Applicative returns all successes: +-- tryAll (\x -> if x>0 then pure x else empty) [0,3,2] :: [Int] +-- ==> [3,2] +-- The Validation Applicative returns the first success or all errors: +-- tryAll (\x -> if x>0 then pure x else invalid "zero") [0,3,2] +-- ==> Ok 3 +-- tryAll (\x -> if x>0 then pure x else invalid "zero") [0,0,0] +-- ==> Errors ["zero","zero","zero"] + +tryAll :: Alternative f => (a -> f b) -> [a] -> f b +tryAll = todo + +------------------------------------------------------------------------------ +-- Ex 14: Here's the type `Both` that expresses the composition of +-- functors. Here are some example values and types: +-- +-- Both (Just [True]) :: Both Maybe [] Bool +-- Both [Just True, Nothing, Just False] :: Both [] Maybe Bool +-- Both [[True,False],[]] :: Both [] [] Bool +-- +-- Both (Ok (Just "value")) :: Both Validation Maybe String +-- Both (Just (Errors ["wrong"])) :: Both Maybe Validation a +-- +-- Implement a Functor instance for Both f g, given that f and g are +-- both Functors. +-- +-- Examples: +-- fmap not (Both (Just [True])) ==> Both (Just [False]) +-- fmap not (Both [Nothing]) ==> Both [Nothing] +-- fmap (+1) (Both [[1,2,3],[4,5]]) ==> Both [[2,3,4],[5,6]] + +newtype Both f g a = Both (f (g a)) + deriving Show + +instance (Functor f, Functor g) => Functor (Both f g) where + fmap = todo + +------------------------------------------------------------------------------ +-- Ex 15: The composition of two Applicatives is also an Applicative! +-- Implement the instance Applicative (Both f g) (given that f and g +-- are already Applicatives). +-- +-- Again, there's only one way to implement this that gets the types +-- right. +-- +-- Examples: +-- pure 1 :: Both Maybe [] Int +-- ==> Both (Just [1]) +-- liftA2 (+) (Both (Just [10,100])) (Both (Just [1,2])) +-- ==> Both (Just [11,12,101,102]) +-- liftA2 (+) (Both (Just [10,100])) (Both Nothing) +-- ==> Both Nothing +-- liftA2 (&&) (Both (Just (invalid "err"))) (Both (Just (pure True))) +-- ==> Both (Just (Errors ["err"])) +-- liftA2 (&&) (Both (Just (invalid "err"))) (Both (Just (invalid "umm"))) +-- ==> Both (Just (Errors ["err","umm"])) +-- liftA2 (+) (Both [pure 1, invalid "fail 1"]) +-- (Both [pure 10, pure 100, invalid "fail 2"]) +-- ==> Both [Ok 11,Ok 101,Errors ["fail 2"], +-- Errors ["fail 1"],Errors ["fail 1"], +-- Errors ["fail 1","fail 2"]] + +instance (Applicative f, Applicative g) => Applicative (Both f g) where + pure = todo + liftA2 = todo diff --git a/exercises/Set15Test.hs b/exercises/Set15Test.hs new file mode 100644 index 0000000..df93802 --- /dev/null +++ b/exercises/Set15Test.hs @@ -0,0 +1,260 @@ +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, StandaloneDeriving, FlexibleInstances #-} + +module Set15Test where + +import Mooc.Test +import Mooc.Th +import Examples.Validation + +import Control.Applicative + +import Test.QuickCheck hiding (Result,Fun,Failure) + +import Set15 + +main = score tests + +tests = [(1,"sumTwoMaybes",[ex1]) + ,(2,"statements",[ex2_1, ex2_2]) + ,(3,"calculator",[ex3_success, ex3_failure_1, ex3_failure_2]) + ,(4,"validateDiv",[ex4]) + ,(5,"validateAddress",[ex5_ok, ex5_fail]) + ,(6,"twoPersons",[ex6_maybe,ex6_list]) + ,(7,"boolOrInt",[ex7_ok, ex7_fail]) + ,(8,"normalizePhone",[ex8]) + ,(9,"parseExpression",[ex9_ok, ex9_fail]) + ,(10,"Priced",[ex10_fmap, ex10_liftA2]) + ,(11,"<*> via liftA2",[ex11]) + ,(12,"fmap via liftA2",[ex12]) + ,(14,"Functor Both",[ex14_ok, ex14_fail]) + ,(13,"tryAll",[ex13_maybe, ex13_list, ex13_validation]) + ,(15,"Applicative Both",[ex15_pure, ex15_liftA2, ex15_liftA2_2]) + ] + +-- -- -- -- -- + +ex1 = forAll_ $ \i -> + forAll_ $ \j -> + conjoin [$(testing [|sumTwoMaybes (Just i) (Just j)|]) (?==Just (i+j)) + ,$(testing [|sumTwoMaybes (Just i) n|]) (?==Nothing) + ,$(testing [|sumTwoMaybes n (Just j)|]) (?==Nothing) + ,$(testing [|sumTwoMaybes n n|]) (?==Nothing)] + where n = Nothing :: Maybe Int + +ex2_1 = conjoin + [$(testing [|statements ["x"] ["y"]|]) (hasElements ["x is y","x is not y"]) + ,$(testing [|statements ["x"] ["y","w"]|]) (hasElements ["x is y","x is w","x is not y","x is not w"]) + ,$(testing [|statements ["x","z"] ["y","w"]|]) (hasElements ["x is y","x is w","x is not y","x is not w" + ,"z is y","z is w","z is not y","z is not w"]) + ,$(testing [|statements ([]::[String]) ["y","w"]|]) (?== [])] + +word = listOf1 (choose ('a','z')) + +ex2_2 = forAllBlind (resize 8 $ listOf1 word) $ \xs -> + forAllBlind (resize 8 $ listOf1 word) $ \ys -> + forAllBlind (elements xs) $ \x -> + forAllBlind (elements ys) $ \y -> + forAllBlind (elements [" is "," is not "]) $ \i -> + let exp = x ++ i ++ y + in $(testing [|statements xs ys|]) . was $ \out -> + counterexample (" Should contain "++show exp) $ + elem exp out + +ex3_success = forAllBlind (choose (-100,100)) $ \i -> + let s = show i + in conjoin [$(testing [|calculator "negate" s|]) (?==Just (negate i)) + ,$(testing [|calculator "double" s|]) (?==Just (2*i))] + +ex3_failure_1 = forAllBlind word $ \w -> + forAllBlind (choose (-100,100::Int)) $ \i -> + not (elem w ["negate","double"]) ==> $(testing [|calculator w (show i)|]) (?==Nothing) + +ex3_failure_2 = forAll (elements ["negate","double","xyzzy"]) $ \w -> + forAllBlind (choose (-100,100::Int)) $ \i -> + let s = show i + in conjoin [$(testing [|calculator w ""|]) (?==Nothing) + ,$(testing [|calculator w (s++".3")|]) (?==Nothing) + ,forAllBlind (shuffle (s++"z")) $ \s' -> $(testing [|calculator w s'|]) (?==Nothing)] + +ok :: a -> Validation a +ok = pure + +invalids :: [String] -> Validation a +invalids = foldr1 (<|>) . map invalid + +ex4 = forAllBlind (choose (0,100)) $ \i -> + forAllBlind (choose (1,10)) $ \j -> + conjoin [$(testing [|validateDiv i j|]) (?==ok (div i j)) + ,$(testing [|validateDiv i 0|]) (?==invalid "Division by zero!")] + +postCode = vectorOf 5 (choose ('0','9')) +street = listOf1 (elements (' ':['a'..'z'])) `suchThat` ((<=20).length) + +ex5_ok = forAllBlind postCode $ \p -> + forAllBlind street $ \s -> + forAllBlind (fmap show (choose (1,1000::Int))) $ \n -> + $(testing [|validateAddress s n p|]) (?==ok (Address s n p)) + +ex5_fail = forAllBlind postCode $ \p -> + forAllBlind street $ \s -> + forAllBlind (fmap show (choose (1,1000::Int))) $ \n -> + forAllBlind (choose ('a','z')) $ \chaff -> + forAllBlind (vectorOf 20 (choose ('a','z'))) $ \pad -> + forAllBlind (shuffle (chaff:take 4 p)) $ \p' -> + forAllBlind (shuffle (chaff:n)) $ \n' -> + conjoin [$(testing [|validateAddress (s++pad) n p|]) (?==invalid "Invalid street name") + ,$(testing [|validateAddress s n (take 4 p)|]) (?==invalid "Invalid postcode") + ,$(testing [|validateAddress s n p'|]) (?==invalid "Invalid postcode") + ,$(testing [|validateAddress s n' p|]) (?==invalid "Invalid street number") + ,$(testing [|validateAddress (s++pad) n p'|]) (?==invalids ["Invalid street name", "Invalid postcode"]) + ,$(testing [|validateAddress (s++pad) n' (take 4 p)|]) (?==invalids ["Invalid street name", "Invalid street number","Invalid postcode"])] + +ex6_maybe = forAllBlind word $ \name1 -> + forAllBlind word $ \name2 -> + forAllBlind (choose (10,100)) $ \age1 -> + forAllBlind (choose (10,100)) $ \age2 -> + forAll_ $ \(emp1,emp2) -> + conjoin [$(testing [|twoPersons (Just name1) (Just age1) (Just emp1) (Just name2) (Just age2) (Just emp2)|]) + (?==Just [Person name1 age1 emp1, Person name2 age2 emp2]) + ,$(testing [|twoPersons (Just name1) (Nothing::Maybe Int) (Just emp1) (Just name2) (Just age2) (Just emp2)|]) + (?==Nothing) + ,$(testing [|twoPersons (Just name1) (Just age1) (Just emp1) (Just name2) (Just age2) (Nothing::Maybe Bool)|]) + (?==Nothing)] + +ex6_list = forAllBlind word $ \name1 -> + forAllBlind word $ \name2 -> + forAllBlind word $ \name3 -> + forAllBlind (choose (10,100)) $ \age1 -> + forAllBlind (choose (10,100)) $ \age2 -> + forAllBlind (choose (10,100)) $ \age3 -> + forAll_ $ \(emp1,emp2) -> + conjoin [$(testing [|twoPersons [name1] [age1] [emp1] [name2] [age2] [emp2]|]) + (?==[[Person name1 age1 emp1, Person name2 age2 emp2]]) + ,$(testing [|twoPersons [name1,name3] [age1] [emp1] [name2] [age2] [emp2]|]) + (?==[[Person name1 age1 emp1, Person name2 age2 emp2] + ,[Person name3 age1 emp1, Person name2 age2 emp2]]) + ,$(testing [|twoPersons [name1] [age1] [emp1] [name2] [age2,age3] [emp2]|]) + (?==[[Person name1 age1 emp1, Person name2 age2 emp2] + ,[Person name1 age1 emp1, Person name2 age3 emp2]])] + +ex7_ok = forAll_ $ \(i::Int) -> + forAll_ $ \(b::Bool) -> + conjoin [$(testing [|boolOrInt (show i)|]) (?==ok (Right i)) + ,$(testing [|boolOrInt (show b)|]) (?==ok (Left b))] + +sow :: [a] -> [a] -> Gen [a] +sow xs [] = return xs +sow [] ys = return ys +sow (x:xs) (y:ys) = oneof [fmap (x:) $ sow xs (y:ys) + ,fmap (y:) $ sow (x:xs) ys] + +ex7_fail = forAll_ $ \(i::Int) -> + forAllBlind (choose ('a','z')) $ \c -> + forAllBlind (shuffle (c:show i)) $ \ni -> + forAll_ $ \(b::Bool) -> + forAllBlind (sow [c] (show b)) $ \nb -> + conjoin [$(testing [|boolOrInt ni|]) (?==invalids ["Not a Bool","Not an Int"]) + ,$(testing [|boolOrInt nb|]) (?==invalids ["Not a Bool","Not an Int"])] + +digit = choose ('0','9') + +ex8 = forAllBlind (take 10 <$> listOf1 digit) $ \out -> + forAllBlind (listOf1 (return ' ')) $ \spaces -> + forAllBlind word $ \chaff -> + forAllBlind (sow out spaces) $ \inp -> + forAllBlind (sow inp chaff) $ \wrong -> + conjoin [$(testing [|normalizePhone inp|]) (?==ok out) + ,$(testing [|normalizePhone (inp++"9999999999")|]) (?==invalid "Too long") + ,$(testing [|normalizePhone wrong|]) + (?==invalids ((if length out + length chaff > 10 then ["Too long"] else [])++["Invalid character: "++[d] | d <- chaff]))] + +showE (Plus x y) = showA x ++ " + " ++showA y +showE (Minus x y) = showA x ++ " - " ++showA y + +showA (Number i) = show i +showA (Variable v) = [v] + +genA = oneof [Number <$> choose (0,10) + ,Variable <$> choose ('a','z')] + +genE = elements [Plus,Minus] <*> genA <*> genA + +ex9_ok = forAllBlind genE $ \exp -> + let s = showE exp + in $(testing [|parseExpression s|]) (?==ok exp) + +ex9_fail = forAllBlind (showA<$>genA) $ \goodArg -> + forAllBlind (elements ["1z","1.0","xy","."]) $ \badArg -> + forAllBlind (elements ["+","-"]) $ \goodOp -> + forAllBlind (elements ["*","%","x","3"]) $ \badOp -> + let b x op y = x ++ " " ++ op ++ " " ++ y + badExp1 = (goodArg ++ " " ++ goodOp) + badExp2 = b goodArg goodOp goodArg ++ " " ++ goodOp + in conjoin [$(testing [|parseExpression (b goodArg goodOp badArg)|]) + (?==invalids ["Invalid number: "++badArg, "Invalid variable: "++badArg]) + ,$(testing [|parseExpression (b badArg goodOp goodArg)|]) + (?==invalids ["Invalid number: "++badArg, "Invalid variable: "++badArg]) + ,$(testing [|parseExpression (b goodArg badOp goodArg)|]) + (?==invalid ("Unknown operator: "++badOp)) + ,$(testing [|parseExpression badExp1|]) + (?==invalid ("Invalid expression: "++badExp1)) + ,$(testing [|parseExpression badExp2|]) + (?==invalid ("Invalid expression: "++badExp2)) + ,$(testing [|parseExpression (b goodArg badOp badArg)|]) + (?==invalids ["Unknown operator: "++badOp,"Invalid number: "++badArg, "Invalid variable: "++badArg]) + ,$(testing [|parseExpression (b goodArg badOp badArg)|]) + (?==invalids ["Unknown operator: "++badOp,"Invalid number: "++badArg, "Invalid variable: "++badArg])] + +ex10_fmap = conjoin [$(testing' [|fmap reverse (Priced 3 "abc")|]) (?==Priced 3 "cba") + ,$(testing' [|fmap negate (Priced 1 7)|]) (?==Priced 1 (-7))] + +ex10_liftA2 = conjoin [$(testing' [|liftA2 (++) (Priced 3 "abc") (Priced 5 "de")|]) (?==Priced 8 "abcde") + ,$(testing' [|liftA2 (+) (pure 4) (Priced 3 6)|]) (?==Priced 3 10)] + +deriving instance (Eq (f (g a))) => Eq (Both f g a) + +ex11 = conjoin [$(testing' [|Just succ <#> Just 2|]) (?==Just 3) + ,$(testing' [|Nothing <#> Just 2|]) (?==(Nothing :: Maybe Int)) + ,$(testing' [|Just reverse <#> Nothing|]) (?==(Nothing :: Maybe [Bool])) + ,$(testing' [|[reverse,drop 1] <#> ["foo","bar"]|]) (?==["oof","rab","oo","ar"])] + +ex12 = conjoin [$(testing' [|myFmap negate (Just 1)|]) (?==Just (-1)) + ,$(testing' [|myFmap negate Nothing|]) (?==Nothing) + ,$(testing' [|myFmap negate [1,2]|]) (?==[-1,-2]) + ,$(testing' [|myFmap not [True,True,False]|]) (?==[False,False,True]) + ,$(testing' [|myFmap not Nothing|]) (?==Nothing)] + +ex13_maybe = conjoin [$(testing' [|tryAll id [Nothing, Just 1, Just 2]|]) (?==Just 1) + ,$(testing' [|tryAll id [Nothing, Nothing]|]) (?==(Nothing::Maybe Int)) + ,$(testing' [|tryAll id [] :: Maybe Int|]) (?==Nothing)] + +ex13_list = conjoin [$(testing' [|tryAll tail ["abc", "d", "ef"]|]) (?=="bcf") + ,$(testing' [|tryAll tail []|]) (?==([]::String))] + +tA l xs k = counterexample' ("tryAll (\\x -> if x>" ++ show l ++ " then pure x else invalid \"zero\") "++show xs) $ + k $ tryAll (\x -> if x>l then pure x else invalid "zero") xs + +ex13_validation = forAllBlind (choose (0::Int,10)) $ \l -> + forAllBlind (listOf1 (choose (0::Int,10))) $ \xs -> + tA l xs (?==case filter (>l) xs of [] -> invalids (map (const "zero") xs) + (x:_) -> ok x) + +ex14_ok = conjoin [$(testing' [|fmap not (Both (Just [True]))|]) (?== Both (Just [False])) + ,$(testing' [|fmap negate (Both [Just 3, Just 4])|]) (?== Both [Just (-3), Just (-4)]) + ,$(testing' [|fmap negate (Both [[1,2,3],[4,5]])|]) (?== Both [[-1,-2,-3],[-4,-5]])] + +ex14_fail = conjoin [$(testing' [|fmap not (Both [Nothing])|]) (?== Both [Nothing]) + ,$(testing' [|fmap not (Both []) :: Both [] Maybe Bool|]) (?== Both [])] + +ex15_pure = conjoin [$(testing' [|pure 1 :: Both [] Maybe Int|]) (?== Both [Just 1]) + ,$(testing' [|pure "a" :: Both Maybe Validation String|]) (?==Both (Just (ok "a")))] + +ex15_liftA2 = conjoin [$(testing' [|liftA2 (+) (Both (Just [10,100])) (Both (Just [1,2]))|]) (?==Both (Just [11,12,101,102])) + ,$(testing' [|liftA2 (+) (Both (Just [10,100])) (Both Nothing)|]) (?==Both Nothing)] + +ex15_liftA2_2 = conjoin [$(testing' [|liftA2 (&&) (Both (Just (invalid "err"))) (Both (Just (pure True)))|]) (?==Both (Just (invalid "err"))) + ,$(testing' [|liftA2 (&&) (Both (Just (invalid "err"))) (Both (Just (invalid "umm")))|]) (?==Both (Just (invalids ["err","umm"]))) + ,$(testing' [|liftA2 (+) (Both [pure 1, invalid "fail 1"]) (Both [pure 10, pure 100, invalid "fail 2"])|]) + (?== Both [ok 11,ok 101,invalid "fail 2", + invalid "fail 1",invalid "fail 1", + invalids ["fail 1","fail 2"]])] diff --git a/part2.html b/part2.html index 1a3cb0d..a0c222f 100644 --- a/part2.html +++ b/part2.html @@ -158,6 +158,18 @@ code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warni
  • 14.4 Working With a Database: sqlite-simple
  • 14.5 Exercises
    • +
  • 15 Lecture 15: You’re Valid Even Without Monads
    • @@ -1922,7 +1934,7 @@ Prelude> final System.Directory.listDirectory :: FilePath -> IO [FilePath] -- is the given file a directory? System.Directory.doesDirectoryExist :: FilePath -> IO Bool
    -

    And here’s the program itself. You can also find it in the course repository as exercises/Examples/ReadTypes.hs.

    +

    And here’s the program itself. You can also find it in the course repository as exercises/Examples/ReadTypes.hs.

    module Examples.ReadTypes where
 
 import Control.Monad (forM)
@@ -3654,6 +3666,511 @@ bob
 
  • Set14b: HTTP & SQLite
    • 
 
  • Remember to give feedback!
    • 
 
+
    15 Lecture 15: You’re Valid Even Without Monads
    
+
    15.1 Introduction to Applicatives
    
+
    The Applicative type class is a middle ground between Functor (which you can’t do that much with) and Monad (which pretty much allows you to write arbitrary programs). Reasons to use Applicative instead of Monad include:
    
+
      
+
    • Performance: since Applicative allows less operations, it can be optimized better than Monad.
      • 
+
    • Simplicity: an Applicative interface is easier to reason about.
      • 
+
    • Necessity: there just is no way to define a Monad instance for your type, but there is an Applicative instance. This is rare.
      • 
+
    
+
    So what is an Applicative? Let’s look at a definition.
    
+
+
    So an Applicative is a Functor that allows us to build singleton values via pure, and combine two values into one using liftA2. This adds a lot of power compared to a bare functor. Computations using functors are necessarily linear: fmap :: (a -> b) -> f a -> f b takes in one functorial value, and outputs another. By contrast, pure takes in no functorial value and outputs one, and liftA2 takes in two and returns one.
    
+
    Sidenote: the term Applicative comes from the term Applicative Functor, which sounds like it comes from Category Theory, but was actually introduced in a programming paper.
    
+
    That’s enough abstract mumbo jumbo for now. Let’s look at what sort of computations we can express using Applicative operations (and fmap). We’ll start with the Maybe applicative. Here’s a streamlined definition:
    
+
+
+
    You’ll see the definition uses the same type of failure propagation as the Monad Maybe instance. Let’s use this when parsing monetary values:
    
+
+
+
    That worked out nicely. However, if we try to expand on this we soon run into the limits of Applicative. For example, consider this sumMoney function that sums Money values but fails if they are not in the same currency:
    
+
+
    We can’t apply it to two Maybe Money values using Applicative operations. We need the Maybe monad for that:
    
+
+
    If we try to use liftA2, we’re stuck with a Maybe (Maybe Money) type. In addition, we can now get two different types of failures: Nothing and Just Nothing, depending on what level the error happens on. This would be a clear case for switching to a Monad instance.
    
+
    liftA2 sumMoney (parseMoney "123" "e") (parseMoney "45" "€")
+  ==> Just (Just (Money 168 EUR))
+liftA2 sumMoney (parseMoney "123" "e") (parseMoney "45" "$")
+  ==> Just Nothing
+liftA2 sumMoney (parseMoney "123" "e") (parseMoney "xxx" "e")
+  ==> Nothing
    
+
    Sidenote: the name liftA2 sounds a bit cumbersome, but it’s an analogy with the liftM, liftM2 and so on functions for monads. Recall that liftM was just fmap, so perhaps liftA2 should’ve been called fmap2.
    
+
    15.2 The List Applicative
    
+
    Let’s have a look at the applicative instances for another Functor we’ve seen. The Applicative instance for the list functor goes through all possible combinations of values (just like the list monad). Here’s the instance:
    
+
+
    And here’s an example: generating some phrases.
    
+
+
+
+
    15.3 New Operators
    
+
    There are a handful of operators for Applicatives that are quite handy. They are <$>, <*>, <* and *>.
    
+
    Let’s start with <$>, which is just an infix version of fmap:
    
+
+
+
    That’s kinda nice on its own, but it really gets to shine when combined with this Applicative operator:
    
+
+
    The type tells you what <*> does: it’s function application lifted to an applicative. Here are some standalone examples:
    
+
+
    The real magic happens when we combine <$> and <*>: we can then lift functions of arbitrarily many argments to an Applicative!
    
+
+
+
    What’s going on here? Let’s step through the evaluation. The key is that each <*> partially applies one more argument to the function.
    
+
+
    Perhaps looking at the types will make it clearer:
    
+
+
    The next two operators are a bit simpler:
    
+
+
    You can compare the types to a more familiar operator:
    
+
+
    What the operators <* and *> mean is: run both of these operations, but only keep one result. The arrow points to the result that’s kept:
    
+
+
    These operators might seem trivial, but they’re useful when combining checks. For example:
    
+
+
+
    Now that we’ve seen all these operators, we can understand the full definition of Applicative. All the operators have definitions in terms of liftA2, so it’s enought to define liftA2 and pure when implementing an Applicative instance.
    
+
+
    15.4 The Validation Applicative
    
+
    Let’s look at an Applicative that’s a bit more interesting than Maybe or lists. Often in programming we need to validate some inputs from the user. In these cases it’s useful to gather together all the errors that the input might have. The file exercises/Examples/Validation.hs implements the Validation datatype:
    
+
+
    The Applicative instance for Validation works like this:
    
+
+
    Note how in contrast to the Maybe Applicative, we have many different kinds of failures.
    
+
    Here’s a worked example that introduces some helpers and then uses them to congratulate somebody on their birthday:
    
+
+
+
    Oh right, here are the Functor and Applicative instances for Validation:
    
+
+
    The definition of liftA2 for Validation shows that the errors are collected together left-to-right. This can be seen in the example above where the expression liftA2 congratulate checkedName checkedAge outputs the error ("Name too long") from checkedName first, and the error ("Too old") from checkedAge last.
    
+
    PS. The same sort of idea has been implemented in the validation and either libraries.
    
+
+
    15.5 Validating Lists: traverse
    
+
    So far we’ve dealt with fixed-size things and Applicatives: we’ve applied a function of two or three arguments to some things. What if we have an arbitrary amount of inputs? What if we need to validate a list?
    
+
    Let’s look at some ways to implement a function like this:
    
+
+
    As always, when working with lists, pattern matching and recursion are usually the way to go. Here’s a recursive solution:
    
+
+
    It’s a bit of a chore to always spell out a recursion like this. If we were working in a Monad we could just use a helper like mapM:
    
+
+
    The equivalent of mapM for Applicative is called traverse. It’s a member of the type class Traversable:
    
+
+
    That’s one heck of a type signature, so let’s simplify it a bit. Lists are Traversable, so we can specialize this type into:
    
+
+
    That looks like what we need! For Applicatives that are also Monads, traverse is just another name for mapM:
    
+
+
    But for our Validation, which isn’t a Monad, traverse is exactly what we want:
    
+
+
+
    Note how traverse for Validation collects all the errors together, in the order they occur in the original list.
    
+
    PS. In fact, Validation is one of the few examples of an Applicative that can’t be a Monad. Can you figure out why?
    
+
+
    15.6 Sidenote: Traversable
    
+
    So what things are Traversable? Many familiar structures. Here are some examples:
    
+
+
+
    So Traversable is a type class for all sorts of containers, kind of like Foldable. Indeed, if you look at the definition, Traversable is a subclass of Foldable. It also turns out that traverse and mapM are methods of the class!
    
+
+
    It can be hard to keep the types straight here. Let’s go back to the type of traverse:
    
+
+
    Here we have two functors: t and f. The t functor is also a Foldable and a Traversable and the f functor is also an Applicative. The traverse function lets us run f-operations inside a t-container.
    
+
    Don’t worry if that feels abstract. In practice, you pretty much always use traverse on lists.
    
+
    15.7 Dealing with Failure: Alternative
    
+
    If you play around with applicatives a bit you’ll start to notice some limits to their power. For example, when writing parsers like we did in the parseMoney example, it would be nice to be able to try some a couple of different parsers and take any non-failure result. This is easy enough to write for a concrete Applicative like Maybe, as can be seen below.
    
+
+
+
    How could we generalize eitherOf? We can’t give it the type Applicative f => f x -> f x -> f x because then the implementation would need to be effectively something like eitherOf a b = liftA2 something a b, but then eitherOf Nothing (Just x) would be Nothing (since that’s how the instance Applicative instance works)!
    
+
    It turns out we need a new type class: Alternative. An Alternative adds two operations to Applicative: empty means no results, and <|> means combining results.
    
+
+
    Now we can rewrite our parsing code using general operations:
    
+
+
    We can also pick which Alternative we run our parser in to get different behaviours. Maybe gives us only one result, while [] gives us all possible results.
    
+
+
    The Alternative instances for [] and Maybe are unsurprising:
    
+
+
    The Validation type is also an Alternative. The instance collects together all error messages, just like the Applicative instance did.
    
+
+
    Here’s a final example: validating contact information, which is either a phone number or an email address.
    
+
+
+
    Note how here, just like in previous examples, the errors are collected left-to-right: the errors from validateEmail come before the errors from validatePhone. The error from checkDigits comes before the error from checkLength.
    
+
+
    15.8 Sidenote: Monads and Applicatives
    
+
    So what’s the relationship between an Monad and an Applicative? If an Applicative is also a Monad, the following laws hold:
    
+
+
    When working in a Monad, you can freely mix Applicative and Functor with Monad operations. As an example, let’s rewrite mapM until it only uses applicative operations, and thus get an implementation for traverse. This is our starting point:
    
+
+
    GHCi tells us it only works for Monads:
    
+
+
    Let’s apply the pure === return and the liftA2 laws from above:
    
+
+
    Ta-da! Now myMapM works for any Applicative:
    
+
+
    15.9 Quiz
    
+
    What’s the type of x in liftA2 not Nothing x?
    
+
      
+
    1. 
+Applicative f => f Bool
+
      2. 
+
    2. 
+Applicative Bool
+
      3. 
+
    3. 
+Maybe Bool
+
      4. 
+
    
+
    How many elements does liftA2 f xs ys have when xs and ys are lists?
    
+
      
+
    1. 
+length xs + length ys
+
      2. 
+
    2. 
+length xs * length ys
+
      3. 
+
    3. 
+min (length xs) (length ys)
+
      4. 
+
    
+
    Which of these expressions is equivalent to liftA2 f x y? There might be multiple correct answers.
    
+
      
+
    1. 
+f <$> x <*> y
+
      2. 
+
    2. 
+f <*> x <*> y
+
      3. 
+
    3. 
+f <*> x <$> y
+
      4. 
+
    4. 
+fmap f x <*> y
+
      5. 
+
    5. 
+pure f <*> x <*> y
+
      6. 
+
    
+
    If f :: X -> Maybe Y and xs :: [X], which of these expressions has a type different from the others?
    
+
      
+
    1. 
+fmap f xs
+
      2. 
+
    2. 
+traverse f xs
+
      3. 
+
    3. 
+map f xs
+
      4. 
+
    
+
    For which Applicative do the expressions pure x <* pure y and pure x <|> pure y have the different result?
    
+
      
+
    1. 
+Maybe
+
      2. 
+
    2. 
+[]
+
      3. 
+
    3. 
+Validation
+
      4. 
+
    
+
    15.10 Exercises
    
+