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.List
import Data.Maybe
import Control.Applicative
import Control.Monad
import Data.Map as M

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)

taxFeeForMarket = [(Any, [TradeTax, Commission]), 
                   (Singapore, [TradeTax, Commission, VAT])]

principal :: Trade -> Double
principal trade = (unit_price trade) * (quantity trade)

rates = [(TradeTax, 0.2), (Commission, 0.15), (VAT, 0.1)]

valueAs :: Trade -> TaxFeeId -> Double
valueAs trade taxFeeId = 
    (principal trade) * (fromMaybe 0 (Data.List.lookup taxFeeId rates))

forTrade :: Trade -> (Trade, Maybe [TaxFeeId])
forTrade trade =
  let list = Data.List.lookup (market trade) taxFeeForMarket
  in (trade, list)

taxFees :: (Trade, Maybe [TaxFeeId]) -> (Trade, [(TaxFeeId, Double)])
taxFees (trade, Nothing) = (trade, [])
taxFees (trade, Just taxfeeids) =
    (trade, zip taxfeeids (Data.List.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 $ M.fromList taxfees

netAmount :: RichTrade -> NetAmount
netAmount rtrade = 
    let t = trade rtrade
        p = principal t
        m = taxFeeMap rtrade
    in M.fold (+) p m

s1 = rates
{- increase rates by 10% - can be done with fmap because [] is a functor -}
s2 = fmap (\(x,y) -> (x,y*1.1)) rates
s3 = (\(x,y) -> (x,y*1.1)) <$> rates

t1 = Trade { market = Singapore, account="me", instrument="him", ref_no="122", 
             unit_price=3.4, quantity=34.0 }

{- lookup1 :: Ord k => k -> Map k (Maybe [t]) -> Maybe [t] -}
lookup1 key alist = case Data.List.lookup key alist of
                      Just (Just s@(_:_)) -> Just s
                      _ -> Nothing

lst1 = [("quantity", (Just "1.2")), ("unit_price", (Just "34.5")), 
        ("ref_no", (Just "223")), ("market", (Just "Singapore")), 
        ("instrument", (Just "Flakes")), ("account", (Just "Jim"))]

lst2 = [("quantity", (Just "1.2")), ("unit_price", (Just "34.5")), 
        ("ref_no", Nothing), ("market", (Just "Singapore")), 
        ("instrument", (Just "Flakes")), ("account", (Just "Jim"))]

lst3 = [("quantity", (Just "1.2")), ("unit_price", (Just "34.5")), 
        ("market", (Just "Singapore")), ("instrument", (Just "Flakes")), 
        ("account", (Just "Jim"))]

{- To make a trade all fields of a trade must be present with values -}
makeTrade alist = 
  Trade <$> 
    (lookup1 "account" alist) <*>
    (lookup1 "instrument" alist) <*>
    (read <$> (lookup1 "market" alist)::(Maybe Market)) <*>
    (lookup1 "ref_no" alist) <*>
    (read <$> (lookup1 "unit_price" alist)::(Maybe Double)) <*>
    (read <$> (lookup1 "quantity" alist)::(Maybe Double))

{- Try 'runit lst1'  'runit lst2'  'runit lst3' -}
runit trade = netAmount <$> enrichWith <$> taxFees <$> forTrade <$> makeTrade trade

{- (lookup1 "market" lst1) :: (Maybe [Char]) 
   (lookup1 "market" lst1) = Just "Singapore"
   read (lookup1 "market" lst1) :: (Maybe [Char]) does not work read::String -> a
   fmap read (lookup1 "market" lst1) = ambiguous -> does not know what out type will be
   fmap read (lookup1 "market" lst1)::(Maybe Market) -> Just Singapore
 -}