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 :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command "ticker")
{ help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "ticker symbols. Look up quotes for symbols"
, process :: String -> Cmd (ModuleT () LB) ()
process = String -> Cmd (ModuleT () LB) ()
tickerCmd
}
, (String -> Command Identity
command "bid")
{ help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "bid symbols. Sum up the bid and ask prices for symbols."
, process :: String -> Cmd (ModuleT () LB) ()
process = String -> Cmd (ModuleT () LB) ()
bidsCmd
}
]
}
tickerCmd :: String -> Cmd Ticker ()
tickerCmd :: String -> Cmd (ModuleT () LB) ()
tickerCmd [] = String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "Empty ticker."
tickerCmd tickers :: String
tickers = do
[String]
quotes <- String -> Cmd (ModuleT () LB) [String]
forall (m :: * -> *). MonadLB m => String -> m [String]
getPage (String -> Cmd (ModuleT () LB) [String])
-> String -> Cmd (ModuleT () LB) [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 [String
x | Just x :: String
x <- (String -> Maybe String) -> [String] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
extractQuote [String]
quotes] of
[] -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say "No Result Found."
xs :: [String]
xs -> (String -> Cmd (ModuleT () LB) ())
-> [String] -> Cmd (ModuleT () LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say [String]
xs
tickerUrl :: [String] -> String
tickerUrl :: [String] -> String
tickerUrl tickers :: [String]
tickers = "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
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
urlEncode [String]
tickers
extractQuote :: String -> Maybe String
= [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 [sym :: String
sym, price :: String
price, change :: String
change, date :: String
date, time :: 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 "%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
("N/A":_) -> ""
[ch :: String
ch, _, pch :: String
pch] -> String
ch String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pch String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") "
_ -> ""
getQuote _ = Maybe a
forall a. Maybe a
Nothing
bidsCmd :: String -> Cmd Ticker ()
bidsCmd :: String -> Cmd (ModuleT () LB) ()
bidsCmd tickers :: String
tickers =
case String -> [String]
words String
tickers of
[] -> String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> String -> String
forall r. PrintfType r => String -> r
printf "Invalid argument '%s'" String
tickers)
xs :: [String]
xs -> [String] -> Cmd (ModuleT () LB) String
forall (m :: * -> *). MonadLB m => [String] -> m String
calcBids [String]
xs Cmd (ModuleT () LB) String
-> (String -> Cmd (ModuleT () LB) ()) -> Cmd (ModuleT () LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Cmd (ModuleT () LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
bidsUrl :: [String] -> String
bidsUrl :: [String] -> String
bidsUrl tickers :: [String]
tickers = "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
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 :: [String] -> m [Maybe (Float, Float)]
getBidAsks tickers :: [String]
tickers = do
[String]
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
[Maybe (Float, Float)] -> m [Maybe (Float, Float)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe (Float, Float)] -> m [Maybe (Float, Float)])
-> [Maybe (Float, Float)] -> m [Maybe (Float, Float)]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe (Float, Float))
-> [String] -> [Maybe (Float, Float)]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Maybe (Float, Float)
extractPrice([String] -> Maybe (Float, Float))
-> (String -> [String]) -> String -> Maybe (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String]
csv) [String]
xs
where
extractPrice :: [String] -> Maybe (Float, Float)
extractPrice :: [String] -> Maybe (Float, Float)
extractPrice [bid :: String
bid,ask :: String
ask] = (Float -> Float -> (Float, Float))
-> Maybe Float -> Maybe Float -> Maybe (Float, Float)
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 _ = Maybe (Float, Float)
forall a. Maybe a
Nothing
type AccumVal = Either String (Float, Float)
accumOption :: AccumVal -> (String, Maybe (Float, Float)) -> AccumVal
accumOption :: AccumVal -> (String, Maybe (Float, Float)) -> AccumVal
accumOption err :: AccumVal
err@(Left _) _ = AccumVal
err
accumOption (Right _) (ticker :: String
ticker, 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 "Can't find '%s'" String
ticker
accumOption (Right (a :: Float
a,b :: Float
b)) (('-':_), Just (a' :: Float
a',b' :: 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 (a :: Float
a,b :: Float
b)) (_, Just (a' :: Float
a',b' :: 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')
calcBids :: MonadLB m => [String] -> m String
calcBids :: [String] -> m String
calcBids ticks :: [String]
ticks = do
[Maybe (Float, Float)]
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
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ case (AccumVal -> (String, Maybe (Float, Float)) -> AccumVal)
-> AccumVal -> [(String, Maybe (Float, Float))] -> AccumVal
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AccumVal -> (String, Maybe (Float, Float)) -> AccumVal
accumOption ((Float, Float) -> AccumVal
forall a b. b -> Either a b
Right (0,0)) ([String]
-> [Maybe (Float, Float)] -> [(String, Maybe (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ticks [Maybe (Float, Float)]
xs) of
(Left err :: String
err) -> String
err
(Right (bid :: Float
bid,ask :: Float
ask)) -> String -> String -> Float -> Float -> String
forall r. PrintfType r => String -> r
printf "%s: bid $%.02f, ask $%.02f" String
s Float
bid Float
ask
where
s :: String
s = [String] -> String
unwords [String]
ticks
noPrefix :: String -> String
noPrefix ('+':xs :: String
xs) = String
xs
noPrefix ('-':xs :: String
xs) = String
xs
noPrefix xs :: String
xs = String
xs
getPage :: MonadLB m => String -> m [String]
getPage :: String -> m [String]
getPage url :: 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
/= '\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 :: Response String
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 Response String -> ResponseCode
forall a. Response a -> ResponseCode
rspCode Response String
result of
(2,0,0) -> [String] -> BrowserAction (HandleStream String) [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]
cleanup (Response String -> String
forall a. Response a -> a
rspBody Response String
result))
(x :: Int
x,y :: Int
y,z :: Int
z) -> [String] -> BrowserAction (HandleStream String) [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ["Connection error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Int
x,Int
y,Int
z] [Int] -> (Int -> String) -> String
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)]
csv :: String -> [String]
csv :: String -> [String]
csv ('"':xs :: 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
/= '"') String
xs of
(word :: String
word, '"':',':rest :: String
rest) -> String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
csv String
rest
(word :: String
word, '"':[]) -> String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: []
_ -> String -> [String]
forall a. HasCallStack => String -> a
error "invalid CSV"
csv xs :: 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
/= ',') String
xs of
(word :: String
word, ',':rest :: String
rest) -> String
word String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
csv String
rest
([], []) -> []
(word :: String
word, []) -> [String
word]
_ -> String -> [String]
forall a. HasCallStack => String -> a
error "shouldn't happen"
readMaybe :: Read a => String -> Maybe a
readMaybe :: String -> Maybe a
readMaybe x :: String
x = case Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec 0 String
x of
[(y :: a
y,"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
_ -> Maybe a
forall a. Maybe a
Nothing