-
Notifications
You must be signed in to change notification settings - Fork 0
/
eremitfx.hs
210 lines (186 loc) · 6.63 KB
/
eremitfx.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
import Control.Applicative
import Data.Accessor
import Data.Attoparsec.Text
import Data.Char
import Data.Colour
import Data.Colour.Names
import Data.Colour.SRGB
import Data.Either
import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Text.Lazy (toStrict)
import Data.Time
import Graphics.Rendering.Chart
import System.Locale
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Hamlet (shamlet)
import Text.Printf
import qualified Text.Blaze.Html5 as H
data Currency = BDT | IDR | INR | LKR | PHP deriving (Eq,Ord,Show)
data Rate = Rate {timestamp :: UTCTime
,currency :: Currency
,amount :: Double} deriving (Eq,Ord,Show)
tzMYT = TimeZone { timeZoneMinutes = 480
, timeZoneSummerOnly = False
, timeZoneName = "MYT"
}
currencyParser = string "BDT" *> pure BDT
<|> string "IDR" *> pure IDR
<|> string "INR" *> pure INR
<|> string "LKR" *> pure LKR
<|> string "PHP" *> pure PHP
instance H.ToMarkup UTCTime where
toMarkup = H.toHtml . formatTime defaultTimeLocale dayTimeFormat . utcToLocalTime tzMYT
instance H.ToMarkup Currency where
toMarkup = H.toHtml . show
instance H.ToMarkup Rate where
toMarkup = H.toHtml . show
dayTimeFormat :: String
dayTimeFormat = "%b %e %Y %I:%M %p"
dayFormat :: String
dayFormat = "%b %e" -- %Y"
timeFormat :: String
timeFormat = "%I:%M %p"
fxLine :: Parser Rate
fxLine = do
char '['
time <- takeTill (== ']')
char ']'
skipSpace
currency' <- currencyParser
char ':'
skipSpace
amount' <- double
let time' = fromJust $ parseTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" (T.unpack time)
return $ Rate time' currency' amount'
readRates f = fmap (rights . map (parseOnly fxLine) . T.lines) (T.readFile f)
datadir = "/home/eremit/"
eremitlog = datadir ++ "eremit_rates.txt"
yahoolog = datadir ++ "yahoo_myrphp_rates.txt"
colorBlue = sRGB24read "#7aa6da"
colorOrange = sRGB24read "#e78c45"
getTripleCurrency ((((rate:_),_,_):_)) = Just $ currency rate
getTripleCurrency _ = Nothing
main = do
elogs <-readRates eremitlog
ylogs <-readRates yahoolog
let groupedCurrencies = (groupByCurrency . sortByCurrency) elogs
groupByCurrency = groupBy (\x y -> currency x == currency y)
sortByCurrency = sortBy (\x y -> compare (currency x) (currency y))
yahooChartData = (ylogs,"yahoo",colorOrange)
eremitChartData = (map (\rates -> [(rates,"eremit",colorBlue)]) groupedCurrencies)
allChartData = map (\cdata -> cdata ++ (auxData cdata)) eremitChartData
auxData x = case (getTripleCurrency x) of
Just PHP -> [yahooChartData]
_ -> []
T.writeFile (datadir ++ "eremitfx.html") $ toStrict $ renderHtml $ htmlPage groupedCurrencies
mapM_ renderChart allChartData
htmlPage xs = [shamlet|
<html>
<head>
<link rel="stylesheet" href="eremitfx.css" type="text/css" />
<body>
<div>
$if null xs
error: null invalid in htmlPage
$else
$forall x <- xs
#{chartTable x}
|]
chartTable rates = [shamlet|
$if null rates
error: null invalid in htmlPage
$else
<table>
#{pair2Html True headrate updatetime}
$forall rate <- restrates
#{pair2Html False rate updatetime}
<br>
|]
where
(headrate:restrates) = (reverse . list2Pairs . concatMap dedup . groupByAmount) rates
groupByAmount = groupBy (\x y -> amount x == amount y)
dedup (x:[]) = [x]
dedup xs = [minimum xs] -- add ", maximum xs" for graphing
updatetime = timestamp $ last rates
renderChart rates = do
let plots = map (\(rates,name,color) -> plotRates rates name color) rates
case (getTripleCurrency rates) of
(Just curr') -> renderableToSVGFile (chart plots) 1280 300 ( datadir ++ show curr' ++ ".svg")
_ -> putStrLn "invalid data in renderChart"
list2Pairs list = if length list == 1
then []
else go list
where
go (x1:x2:[]) = [(x1,x2)]
go (x1:x2:xs) = [(x1,x2)] ++ go (x2:xs)
go _ = []
pair2Html :: Bool -> (Rate,Rate) -> UTCTime -> H.Html
pair2Html isFirst (prev,curr) updatetime = [shamlet|$newline never
$if isFirst
<tr>
<td colspan=4>
<div class="currprice">
<strong>MYR = #{displayCurrency}
#{amount curr}
$if positive
<div class="big-arrow-up">
$else
<div class="big-arrow-down">
<div class="#{color}"> #{text}
<div>
<small>since #{timestamp curr} • updated #{updatetime}
<div><img class="chart" src="#{displayCurrency}.svg">
$else
<tr>
<td><strong>#{displayCurrency} #{val}
<td>
$if positive
<div class="arrow-up">
$else
<div class="arrow-down">
<div class="#{color}"> #{text}
<td>#{day}
<td>#{time}
|]
where
displayCurrency = currency prev
positive = delta' > 0
val :: String
val = printf "%.2f" (amount curr)
text :: String
text = printf "%.2f (%.2f%s)" delta deltapct pctsign
delta = abs delta'
delta' = amount curr - amount prev
deltapct = abs (delta' / amount curr) * 100
color :: String
color=if positive then "green" else "red"
showTime format = formatTime defaultTimeLocale format . utcToLocalTime tzMYT
day = showTime dayFormat (timestamp curr)
time = showTime timeFormat (timestamp curr)
pctsign = [chr 37]
chart :: [Plot LocalTime Double] -> Renderable ()
chart plots = toRenderable layout
where
bg = transparent
fg = opaque white
fg1 = opaque black
layout = layout1_background ^= solidFillStyle bg
$ updateAllAxesStyles (axis_grid_style ^= solidLine 1 fg1)
$ layout1_bottom_axis ^: laxis_override ^= axisGridHide
$ layout1_plots ^= [ Left x | x <- plots]
$ layout1_grid_last ^= False
$ setLayout1Foreground fg
$ defaultLayout1
lineStyle c = line_width ^= 2
$ line_color ^= c
$ defaultPlotLines ^. plot_lines_style
plotRates rates label color
= toPlot $ plot_lines_style ^= lineStyle (opaque color)
$ plot_lines_values ^= [[ (utcToLocalTime tzMYT u, a) | Rate u _ a <- rates]]
$ plot_lines_title ^= label
$ defaultPlotLines