    -- | Pull quotes down from yahoo.
    module Lambdabot.Plugin.Reference.Ticker (tickerPlugin) where

    import Lambdabot.Plugin
    import Lambdabot.Util.Browser

    import Control.Applicative
    import Data.List
    import Network.Browser (request)
    import Network.HTTP
    import Text.Printf

    type Ticker = ModuleT () LB

    tickerPlugin :: Module ()
    tickerPlugin :: Module ()
    tickerPlugin = Module ()
    forall st. Module st
    newModule
        { moduleCmds = return
            [ (command "ticker")
                { help = say "ticker symbols.  Look up quotes for symbols"
                , process = tickerCmd
                }
            , (command "bid")
                { help = say "bid symbols.  Sum up the bid and ask prices for symbols."
                , process = bidsCmd
                }
            ]
        }

    ------------------------------------------------------------------------

    -- Fetch several ticker quotes and report them.
    tickerCmd :: String -> Cmd Ticker ()
    tickerCmd :: String -> Cmd Ticker ()
    tickerCmd []        = String -> Cmd Ticker ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "Empty ticker."
    tickerCmd String
    tickers = do
        quotes <- String -> Cmd Ticker [String]
    forall (m :: * -> *). MonadLB m => String -> m [String]
    getPage (String -> Cmd Ticker [String]) -> String -> Cmd Ticker [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    tickerUrl ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    words String
    tickers
        case [x | Just x <- map extractQuote quotes] of
          []       -> String -> Cmd Ticker ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say String
    "No Result Found."
          [String]
    xs       -> (String -> Cmd Ticker ()) -> [String] -> Cmd Ticker ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> Cmd Ticker ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say [String]
    xs

    -- fetch: s symbol, l1 price, c change with percent, d1 date, t1 time.
    tickerUrl :: [String] -> String
    tickerUrl :: [String] -> String
    tickerUrl [String]
    tickers =  String
    "http://download.finance.yahoo.com/d/quotes.csv?f=sl1cd1t1&e=.csv&s=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ts
        where ts :: String
    ts = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "+" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    urlEncode [String]
    tickers

    -- $ curl "http://download.finance.yahoo.com/d/quotes.csv?f=sl1cd1t1&e=.csv&s=C"
    -- "C",23.19,"-0.45 - -1.90%","5/13/2008","1:32pm"
    -- "GBPUSD=X",1.9478,"N/A - N/A","5/13/2008","1:52pm"
    extractQuote :: String -> Maybe String
    extractQuote :: String -> Maybe String
    extractQuote = [String] -> Maybe String
    forall {a}. PrintfType a => [String] -> Maybe a
    getQuote ([String] -> Maybe String)
    -> (String -> [String]) -> String -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    csv
        where
            getQuote :: [String] -> Maybe a
    getQuote [String
    sym, String
    price, String
    change, String
    date, String
    time] =
                a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String -> String -> String -> a
    forall r. PrintfType r => String -> r
    printf String
    "%s: %s %s@ %s %s" String
    sym String
    price String
    change' String
    date String
    time
                where change' :: String
    change' = case String -> [String]
    words String
    change of
                                  (String
    "N/A":[String]
    _)    -> String
    ""
                                  [String
    ch, String
    _, String
    pch] -> String
    ch String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pch String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") "
                                  [String]
    _            -> String
    ""
            getQuote [String]
    _ = Maybe a
    forall a. Maybe a
    Nothing

    -- Fetch quotes for tickers and sum their bid/ask prices.
    bidsCmd :: String -> Cmd Ticker ()
    bidsCmd :: String -> Cmd Ticker ()
    bidsCmd String
    tickers =
        case String -> [String]
    words String
    tickers of
            [] -> String -> Cmd Ticker ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say (String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Invalid argument '%s'" String
    tickers)
            [String]
    xs -> [String] -> Cmd Ticker String
    forall (m :: * -> *). MonadLB m => [String] -> m String
    calcBids [String]
    xs Cmd Ticker String -> (String -> Cmd Ticker ()) -> Cmd Ticker ()
    forall a b. Cmd Ticker a -> (a -> Cmd Ticker b) -> Cmd Ticker b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Cmd Ticker ()
    forall (m :: * -> *). Monad m => String -> Cmd m ()
    say

    -- fetch: b bid, a ask
    bidsUrl :: [String] -> String
    bidsUrl :: [String] -> String
    bidsUrl [String]
    tickers = String
    "http://download.finance.yahoo.com/d/quotes.csv?f=ba&e=.csv&s=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ts
        where ts :: String
    ts = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "+" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    urlEncode [String]
    tickers

    getBidAsks :: MonadLB m => [String] -> m [Maybe (Float, Float)]
    getBidAsks :: forall (m :: * -> *).
    MonadLB m =>
    [String] -> m [Maybe (Float, Float)]
    getBidAsks [String]
    tickers = do
        xs <- String -> m [String]
    forall (m :: * -> *). MonadLB m => String -> m [String]
    getPage (String -> m [String]) -> String -> m [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    bidsUrl [String]
    tickers
        return $ map (extractPrice.csv) xs
        where
            extractPrice :: [String] -> Maybe (Float, Float)
            extractPrice :: [String] -> Maybe (Float, Float)
    extractPrice [String
    bid,String
    ask] = (Float -> Float -> (Float, Float))
    -> Maybe Float -> Maybe Float -> Maybe (Float, Float)
    forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,) (String -> Maybe Float
    forall a. Read a => String -> Maybe a
    readMaybe String
    bid) (String -> Maybe Float
    forall a. Read a => String -> Maybe a
    readMaybe String
    ask)
            extractPrice [String]
    _         = Maybe (Float, Float)
    forall a. Maybe a
    Nothing

    type AccumVal = Either String (Float, Float)

    -- If we have a new bid/ask pair, accumulate it (normally add, but
    -- if the ticker starts with '-' then subtract).  If there is no
    -- value, make a note that it is an error.
    accumOption :: AccumVal -> (String, Maybe (Float, Float)) -> AccumVal
    accumOption :: AccumVal -> (String, Maybe (Float, Float)) -> AccumVal
    accumOption err :: AccumVal
    err@(Left String
    _) (String, Maybe (Float, Float))
    _ = AccumVal
    err
    accumOption (Right (Float, Float)
    _) (String
    ticker, Maybe (Float, Float)
    Nothing) = String -> AccumVal
    forall a b. a -> Either a b
    Left (String -> AccumVal) -> String -> AccumVal
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    forall r. PrintfType r => String -> r
    printf String
    "Can't find '%s'" String
    ticker
    accumOption (Right (Float
    a,Float
    b)) ((Char
    '-':String
    _), Just (Float
    a',Float
    b')) = (Float, Float) -> AccumVal
    forall a b. b -> Either a b
    Right (Float
    aFloat -> Float -> Float
    forall a. Num a => a -> a -> a
    -Float
    b', Float
    bFloat -> Float -> Float
    forall a. Num a => a -> a -> a
    -Float
    a')
    accumOption (Right (Float
    a,Float
    b)) (String
    _, Just (Float
    a',Float
    b')) = (Float, Float) -> AccumVal
    forall a b. b -> Either a b
    Right (Float
    aFloat -> Float -> Float
    forall a. Num a => a -> a -> a
    +Float
    a', Float
    bFloat -> Float -> Float
    forall a. Num a => a -> a -> a
    +Float
    b')

    -- Take a list of tickers which are optionally prefixed with '+' or '-'
    -- and add up (or subtract) the bid/ask prices on the based on the prefix.
    calcBids :: MonadLB m => [String] -> m String
    calcBids :: forall (m :: * -> *). MonadLB m => [String] -> m String
    calcBids [String]
    ticks = do
        xs <- [String] -> m [Maybe (Float, Float)]
    forall (m :: * -> *).
    MonadLB m =>
    [String] -> m [Maybe (Float, Float)]
    getBidAsks ([String] -> m [Maybe (Float, Float)])
    -> [String] -> m [Maybe (Float, Float)]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    noPrefix [String]
    ticks
        return $ case foldl accumOption (Right (0,0)) (zip ticks xs) of
            (Left String
    err)        -> String
    err
            (Right (Float
    bid,Float
    ask)) -> String -> String -> Float -> Float -> String
    forall r. PrintfType r => String -> r
    printf String
    "%s: bid $%.02f, ask $%.02f" String
    s Float
    bid Float
    ask
        where
            s :: String
    s = [String] -> String
    unwords [String]
    ticks
            noPrefix :: String -> String
    noPrefix (Char
    '+':String
    xs) = String
    xs
            noPrefix (Char
    '-':String
    xs) = String
    xs
            noPrefix String
    xs = String
    xs

    -- | Fetch a page via HTTP and return its body as a list of lines.
    getPage :: MonadLB m => String -> m [String]
    getPage :: forall (m :: * -> *). MonadLB m => String -> m [String]
    getPage String
    url = do
        let cleanup :: String -> [String]
    cleanup = ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r'))) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

        BrowserAction (HandleStream String) [String] -> m [String]
    forall (m :: * -> *) conn a.
    MonadLB m =>
    BrowserAction conn a -> m a
    browseLB (BrowserAction (HandleStream String) [String] -> m [String])
    -> BrowserAction (HandleStream String) [String] -> m [String]
    forall a b. (a -> b) -> a -> b
    $ do
            (_, result) <- Request String
    -> BrowserAction (HandleStream String) (URI, Response String)
    forall ty.
    HStream ty =>
    Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
    request (String -> Request String
    getRequest String
    url)
            case rspCode result of
              (Int
    2,Int
    0,Int
    0) -> [String] -> BrowserAction (HandleStream String) [String]
    forall a. a -> BrowserAction (HandleStream String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> [String]
    cleanup (Response String -> String
    forall a. Response a -> a
    rspBody Response String
    result))
              (Int
    x,Int
    y,Int
    z) -> [String] -> BrowserAction (HandleStream String) [String]
    forall a. a -> BrowserAction (HandleStream String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    "Connection error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ([Int
    x,Int
    y,Int
    z] [Int] -> (Int -> String) -> String
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> String
    forall a. Show a => a -> String
    show) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show (Response String -> String
    forall a. Response a -> String
    rspReason Response String
    result)]

    -- | Return a list of comma-separated values.
    -- Quotes allowed in CSV if it's the first character of a field.
    csv :: String -> [String]
    csv :: String -> [String]
    csv (Char
    '"':String
    xs) = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '"') String
    xs of
                      (String
    word, Char
    '"':Char
    ',':String
    rest) -> String
    word String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    csv String
    rest
                      (String
    word, Char
    '"':[])       -> String
    word String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : []
                      (String, String)
    _                    -> String -> [String]
    forall a. HasCallStack => String -> a
    error String
    "invalid CSV"
    csv String
    xs = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ',') String
    xs of
                 (String
    word, Char
    ',':String
    rest) -> String
    word String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    csv String
    rest
                 ([], [])         -> []
                 (String
    word, [])       -> [String
    word]
                 (String, String)
    _                -> String -> [String]
    forall a. HasCallStack => String -> a
    error String
    "shouldn't happen"

    -- | Read a value from a string.
    readMaybe :: Read a => String -> Maybe a
    readMaybe :: forall a. Read a => String -> Maybe a
    readMaybe String
    x = case Int -> ReadS a
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    0 String
    x of
                    [(a
    y,String
    "")] -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    y
                    [(a, String)]
    _        -> Maybe a
    forall a. Maybe a
    Nothing