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 = forall st. Module st
newModule
{ moduleCmds :: ModuleT () LB [Command Ticker]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command String
"ticker")
{ help :: Cmd Ticker ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"ticker symbols. Look up quotes for symbols"
, process :: String -> Cmd Ticker ()
process = String -> Cmd Ticker ()
tickerCmd
}
, (String -> Command Identity
command String
"bid")
{ help :: Cmd Ticker ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"bid symbols. Sum up the bid and ask prices for symbols."
, process :: String -> Cmd Ticker ()
process = String -> Cmd Ticker ()
bidsCmd
}
]
}
tickerCmd :: String -> Cmd Ticker ()
tickerCmd :: String -> Cmd Ticker ()
tickerCmd [] = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Empty ticker."
tickerCmd String
tickers = do
[String]
quotes <- forall (m :: * -> *). MonadLB m => String -> m [String]
getPage forall a b. (a -> b) -> a -> b
$ [String] -> String
tickerUrl forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
tickers
case [String
x | Just String
x <- forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe String
extractQuote [String]
quotes] of
[] -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"No Result Found."
[String]
xs -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say [String]
xs
tickerUrl :: [String] -> String
tickerUrl :: [String] -> String
tickerUrl [String]
tickers = String
"http://download.finance.yahoo.com/d/quotes.csv?f=sl1cd1t1&e=.csv&s=" forall a. [a] -> [a] -> [a]
++ String
ts
where ts :: String
ts = forall a. [a] -> [[a]] -> [a]
intercalate String
"+" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> String
urlEncode [String]
tickers
extractQuote :: String -> Maybe String
= forall {a}. PrintfType a => [String] -> Maybe a
getQuote 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] =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
pch forall a. [a] -> [a] -> [a]
++ String
") "
[String]
_ -> String
""
getQuote [String]
_ = forall a. Maybe a
Nothing
bidsCmd :: String -> Cmd Ticker ()
bidsCmd :: String -> Cmd Ticker ()
bidsCmd String
tickers =
case String -> [String]
words String
tickers of
[] -> forall (m :: * -> *). Monad m => String -> Cmd m ()
say (forall r. PrintfType r => String -> r
printf String
"Invalid argument '%s'" String
tickers)
[String]
xs -> forall (m :: * -> *). MonadLB m => [String] -> m String
calcBids [String]
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). Monad m => String -> Cmd m ()
say
bidsUrl :: [String] -> String
bidsUrl :: [String] -> String
bidsUrl [String]
tickers = String
"http://download.finance.yahoo.com/d/quotes.csv?f=ba&e=.csv&s=" forall a. [a] -> [a] -> [a]
++ String
ts
where ts :: String
ts = forall a. [a] -> [[a]] -> [a]
intercalate String
"+" forall a b. (a -> b) -> a -> b
$ 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
[String]
xs <- forall (m :: * -> *). MonadLB m => String -> m [String]
getPage forall a b. (a -> b) -> a -> b
$ [String] -> String
bidsUrl [String]
tickers
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Maybe (Float, Float)
extractPriceforall 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 [String
bid,String
ask] = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (forall a. Read a => String -> Maybe a
readMaybe String
bid) (forall a. Read a => String -> Maybe a
readMaybe String
ask)
extractPrice [String]
_ = 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 String
_) (String, Maybe (Float, Float))
_ = AccumVal
err
accumOption (Right (Float, Float)
_) (String
ticker, Maybe (Float, Float)
Nothing) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ 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')) = forall a b. b -> Either a b
Right (Float
aforall a. Num a => a -> a -> a
-Float
b', Float
bforall a. Num a => a -> a -> a
-Float
a')
accumOption (Right (Float
a,Float
b)) (String
_, Just (Float
a',Float
b')) = forall a b. b -> Either a b
Right (Float
aforall a. Num a => a -> a -> a
+Float
a', Float
bforall a. Num a => a -> a -> a
+Float
b')
calcBids :: MonadLB m => [String] -> m String
calcBids :: forall (m :: * -> *). MonadLB m => [String] -> m String
calcBids [String]
ticks = do
[Maybe (Float, Float)]
xs <- forall (m :: * -> *).
MonadLB m =>
[String] -> m [Maybe (Float, Float)]
getBidAsks forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> String
noPrefix [String]
ticks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl AccumVal -> (String, Maybe (Float, Float)) -> AccumVal
accumOption (forall a b. b -> Either a b
Right (Float
0,Float
0)) (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ticks [Maybe (Float, Float)]
xs) of
(Left String
err) -> String
err
(Right (Float
bid,Float
ask)) -> 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
getPage :: MonadLB m => String -> m [String]
getPage :: forall (m :: * -> *). MonadLB m => String -> m [String]
getPage String
url = do
let cleanup :: String -> [String]
cleanup = (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r'))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
forall (m :: * -> *) conn a.
MonadLB m =>
BrowserAction conn a -> m a
browseLB forall a b. (a -> b) -> a -> b
$ do
(URI
_, Response String
result) <- forall ty.
HStream ty =>
Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
request (String -> Request_String
getRequest String
url)
case forall a. Response a -> ResponseCode
rspCode Response String
result of
(Int
2,Int
0,Int
0) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]
cleanup (forall a. Response a -> a
rspBody Response String
result))
(Int
x,Int
y,Int
z) -> forall (m :: * -> *) a. Monad m => a -> m a
return [String
"Connection error: " forall a. [a] -> [a] -> [a]
++ ([Int
x,Int
y,Int
z] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Show a => a -> String
show) forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Response a -> String
rspReason Response String
result)]
csv :: String -> [String]
csv :: String -> [String]
csv (Char
'"':String
xs) = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'"') String
xs of
(String
word, Char
'"':Char
',':String
rest) -> String
word forall a. a -> [a] -> [a]
: String -> [String]
csv String
rest
(String
word, Char
'"':[]) -> String
word forall a. a -> [a] -> [a]
: []
(String, String)
_ -> forall a. HasCallStack => String -> a
error String
"invalid CSV"
csv String
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
',') String
xs of
(String
word, Char
',':String
rest) -> String
word forall a. a -> [a] -> [a]
: String -> [String]
csv String
rest
([], []) -> []
(String
word, []) -> [String
word]
(String, String)
_ -> forall a. HasCallStack => String -> a
error String
"shouldn't happen"
readMaybe :: Read a => String -> Maybe a
readMaybe :: forall a. Read a => String -> Maybe a
readMaybe String
x = case forall a. Read a => Int -> ReadS a
readsPrec Int
0 String
x of
[(a
y,String
"")] -> forall a. a -> Maybe a
Just a
y
[(a, String)]
_ -> forall a. Maybe a
Nothing