20-CS-4003-001 Organization of Programming Languages Fall 2017
Functors

Lambda calculus, Type theory, Formal semantics, Program analysis

Prev     Next     All lectures           Code

Applicative Functors

import Data.Map as M
import Data.Maybe
import Control.Monad
import Data.List

{- So far, when we were mapping functions over functors, we usually mapped 
   functions that take only one parameter. But what happens when we map a 
   function like *, which takes two parameters, over a functor? 

   Functions below are mapped inside of Maybe or [] (another Functor)
-}
x1 = fmap (*) (Just 3)                  {- x1 :: Maybe (Integer -> Integer) -}
x2 = fmap (++) (Just "Hello")           {- x2 :: Maybe ([Char] -> [Char]) -}
x3 = fmap (\x y z -> (x+y)/z) [3,4,5,6] {- x3 :: [Double -> Double -> Double] -}

{- f we map compare, which has a type of (Ord a) => a -> a -> Ordering 
   over a list of characters, we get a list of functions of type 
   Char -> Ordering, because the function compare gets partially applied 
   with the characters in the list. It's not a list of 
   (Ord a) => a -> Ordering function, because the first a that got applied 
   was a Char and so the second a has to decide to be of type Char. -}
x4 = fmap compare "Hello"   {- x4 :: [Char -> Ordering] -}

x5 = fmap (\f -> (f 4)) x1
x6 = fmap (\f -> (f " World")) x2
x7 = fmap (\f -> (f 2 3)) x3
x8 = fmap (\f -> (f 'e')) x4

{- But what if we have a functor value of Just (3 *) and a functor value 
   of Just 5 and we want to take out the function from Just (3 *) and 
   map it over Just 5? With normal functors, we're out of luck, because 
   all they support is just mapping normal functions over existing functors. 

   x5 = fmap (\f -> (f (Just 5))) x1
-}
class (Functor f) => Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b

{-  if we want to make a type constructor part of the Applicative typeclass, 
    it has to be in Functor first. Thus we can use fmap 

    pure puts a value in a default context

    <*> from within the functor context f, applies a function (a -> b) to 
    argument of type a to get an object of type b wrapped inside the 
    functor context f.

    <*> changes a function inside the functor to a function over values of 
    the functor. 

    This is just syntactic sugar for covering the use of fmap 

    In the following use Maybe instead of Maybe a since Applicative 
    is a type over a concrete type parameter -}
instance Applicative Maybe where  
    pure = Just  
    Nothing <*> _ = Nothing  
    (Just f) <*> something = fmap f something  

{- examples -}
x9 = (Just (*3)) <*> (Just 4)   {- no can do: x9 = fmap (Just (*3)) (Just 3) -}
x10 = (pure (*3)) <*> (Just 4)
x11 = (Just (*3)) <*> (pure 4)
x12 = (pure (++ " World")) <*> (Just "Hello")
{- what does work:
   fmap (*3) (Just 3)
   fmap (++ " World") (Just "Hello")
-}

{- f1 is a function of four arguments not in a context, can be applied
   to objects also not in a context using the applicative functor <*> -}
f1 = (\x y z w -> (x+y+z+w))
x13 = (pure f1) <*> (Just 3) <*> (Just 4) <*> (Just 5) <*> (Just 6)

{- Note: pure f <*> x <*> y <*> z same as fmap f x <*> y <*> z -}

{- More syntactic sugar - use a normal function on Applicative functors
class (Functor f) => Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b
  (<$>) :: (Functor f) => (a -> b) -> f a -> f b
-}
(<$>) :: (Functor f) => (a -> b) -> f a -> f b  
f <$> x = fmap f x  

x14 = (++) <$> Just "Hello" <*> Just " World"  

{- List constructors are Applicative functors -}
instance Applicative [] where  
  pure x = [x]  
  fs <*> xs = [f x | f <- fs, x <- xs]  

x15 = pure 1::[Int]
x16 = pure "Hello"::[[Char]]
x17 = pure "Hello"::Maybe [Char]
x18 = [(*0),(+100),(^2)] <*> [1,2,3]  {- cross product? -}
{- [(+),(*)] <*> [1,2] -> [(1+),(2+),(1*),(2*)] comp first in the following -}
x19 = [(+),(*)] <*> [1,2] <*> [3,4]   {- [4,5,5,6,3,4,6,8] -}
{- same as -}
x20 = [ f x y | f <- [(+),(*)], x <- [1,2], y <- [3,4]]

{- do syntax is about taking several I/O actions and gluing them into one, 
   which is exactly what we do here. -}
instance Applicative IO where  
  pure = return  
  a <*> b = do  
    f <- a  
    x <- b  
    return (f x)  

{- The following takes two inputs and glues them together -}
inpAct1 :: IO String  
inpAct1 = do  
  a <- getLine  
  b <- getLine  
  return $ a ++ b  

{- Alternative expression of the above -}
inpAct2 :: IO String  
inpAct2 = (++) <$> getLine <*> getLine 

inpAct3 = do
  a <- getLine    {- a is a String -}
  b <- getLine    {- b is a String -}
  let c = a ++ b  {- c is a String -}
  putStrLn $ "Result: " ++ c

inpAct3a = do
  a <- getLine    {- a is a String -}
  b <- getLine    {- b is a String -}
  putStrLn $ "Result: " ++ a ++ b

inpAct4 = do
  a <- (++) <$> getLine <*> getLine {- a is a String -}
  putStrLn $ "Result: " ++ a

liftA2 :: (Applicative f) => (a -> b -> c) -> f a -> f b -> f c  
liftA2 f a b = f <$> a <*> b  

x21 = liftA2 (++) ["Hello"] ["There"]
x22 = liftA2 (:) (Just 3) (Just [4]) 

sequenceA :: (Applicative f) => [f a] -> f [a]  
sequenceA [] = pure []  
sequenceA (x:xs) = (:) <$> x <*> sequenceA xs

x23 = sequenceA [(Just 1),(Just 2),(Just 3)]

x24 = sequenceA [getLine, getLine, getLine]

{- Applicative functors allow combining different computations, such as 
   I/O computations, non-deterministic computations, computations that 
   might have failed, etc. by using the applicative style. Just by using 
   <$> and <*> we can use normal functions to uniformly operate on any 
   number of applicative functors and take advantage of the semantics 
   of each one. -}

{- The following is taken from
http://debasishg.blogspot.com/2010/10/domain-modeling-in-haskell-follow-types.html http://debasishg.blogspot.com/2010/10/domain-modeling-in-haskell-combinators.html http://debasishg.blogspot.com/2010/11/domain-modeling-in-haskell-applicative.html -}
type Instrument = String type Account = String type NetAmount = Double data TaxFeeId = TradeTax | Commission | VAT deriving (Show, Eq, Ord) data Market = HongKong | Singapore | NewYork | Tokyo | Any deriving (Show, Eq, Read) data Trade = Trade { account :: Account ,instrument :: Instrument ,market :: Market ,ref_no :: String ,unit_price :: Double ,quantity :: Double } deriving (Show) principal :: Trade -> Double principal trade = (unit_price trade) * (quantity trade) forTrade :: Trade -> (Trade, [TaxFeeId]) forTrade trade = (trade, [TradeTax, Commission, VAT]) valueAs :: Trade -> TaxFeeId -> Double valueAs trade TradeTax = 0.2 * (principal trade) valueAs trade Commission = 0.15 * (principal trade) valueAs trade VAT = 0.1 * (principal trade) taxFees :: (Trade, [TaxFeeId]) -> (Trade, [(TaxFeeId, Double)]) taxFees (trade, taxfeeids) = (trade, zip taxfeeids (Prelude.map (valueAs trade) taxfeeids)) type TaxFeeMap = M.Map TaxFeeId Double data RichTrade = RichTrade { trade :: Trade ,taxFeeMap :: TaxFeeMap } deriving (Show) enrichWith :: (Trade, [(TaxFeeId, Double)]) -> RichTrade enrichWith (trade, taxfees) = RichTrade trade (Prelude.foldl(\map (k, v) -> M.insert k v map) M.empty taxfees) netAmount :: RichTrade -> NetAmount netAmount rtrade = let t = trade rtrade p = principal t m = taxFeeMap rtrade in M.fold (\v a -> a + v) p m t1 = Trade { account="me", instrument="him", market=Singapore, ref_no="122", unit_price=3.4, quantity=34.0 } w0 = netAmount $ enrichWith $ taxFees $ forTrade t1 {- continued on next slide -}