In this third part of the series of entries about publishing nike runs we will actually fetch the Nike+ xml, parse it and feed it to the charting function defined in the second part.
First let's define the NikeRun data:
data NikeRun = NikeRun {
extendedData :: [Double],
calories :: Double
} deriving (Eq,Show)
Later we will add more fields to the definition of NikeRun. Let's also change the charting function chartRun to take a NikeRun instead of [Double]:
chartRun :: Int -> Int -> NikeRun -> String
chartRun w h NikeRun {extendedData = xs, calories = c} =
suffix "&chg=25.0,25.0,3,2" $
chartURL $
setAxisLabelPositions [[0, 25, 50, 75, 100], [50], [0, 25, 50, 75, 100], [50]] $
setAxisLabels [(yLabels 4 ylxs), ["pace (min/km)"],
(xLabels 4 xs), ["time (min)"]] $
setAxisTypes [AxisLeft, AxisLeft, AxisBottom, AxisBottom] $
setSize w h $
setData (encodeRunData txs) $
newLineChart
where
ylxs = transformAndAverageRunData xs
txs = transformAndSmoothRunData xs
Now it's time to fetch the xml and parse it which means using Arrows and the IO monad. We will steal most of the following code from this example.
The utility function nikeRunURL returns the URL of a run given the user ID and the run ID:
nikeRunURL :: Int -> Int -> String nikeRunURL userId runId = "http://nikeplus.nike.com/nikeplus/" ++ "v1/services/widget/get_public_run.jsp?userID=" ++ (show userId) ++ "&id=" ++ (show runId)
and the helper function get does an http get and returns the body of the response as a string. This is an IO operation so the return type is IO String:
get :: URI -> IO String
get uri = do
eresp <- simpleHTTP (Request uri GET [] "")
case eresp of
Left _ -> ioError . userError $ "Failed to get " ++ show uri
Right res -> return $ rspBody res
Armed with these two helper functions we define retrieveNikeRun:
retrieveNikeRun :: Int -> Int -> IO String
retrieveNikeRun userId runId = do
case parseURI (nikeRunURL userId runId) of
Nothing -> ioError . userError $ "Invalid URL"
Just uri -> get uri
At this point the fetched data is still in the form of a string. We know we will need a helper function that given a string of comma-separated numbers returns a list of doubles:
readDoubles :: String -> [Double] readDoubles s = map (\y -> read y::Double) (splitRegex (mkRegex ",") s)
A couple more helpers for dealing with xml:
atTag tag = deep (isElem >>> hasName tag) text = getChildren >>> getText textAtTag tag = atTag tag >>> text parseXML doc = readString [(a_validate,v_0)] doc
The next code section uses the {-# LANGUAGE Arrows, NoMonomorphismRestriction #-} extensions:
parseNikeRun = atTag "sportsData" >>>
proc x -> do
cs <- textAtTag "calories" -< x
exds <- textAtTag "extendedData" -< x
returnA -< NikeRun {
extendedData = readDoubles exds,
calories = read cs }
It builds NikeRun data out of xml using the proc and -< syntax sugar.
Finally we collect all this in the getNikeRun function:
getNikeRun :: Int -> Int -> IO NikeRun
getNikeRun userId runId = do
doc <- retrieveNikeRun userId runId
let xml = parseXML doc
nikeRuns <- runX (xml >>> parseNikeRun)
case nikeRuns of
[] -> ioError . userError $ "Failed to parse nike run " ++ show runId
nr:_ -> return nr
Let's try it out in ghci:
do {
nr <- getNikeRun 617307368 1947965371;
return $ chartRun 600 200 nr}
Yeah, it works. In the next part we will read more fields from xml and play with string templates. In the meantime here's the modified module NikeRuns from today:
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
module Codemanic.NikeRuns
(
chartRun,
NikeRun,
getNikeRun
)
where
import Codemanic.NumericLists
import Graphics.Google.Chart
import Data.Time.Clock
import Data.Time.Format
import System.Locale
import Text.Printf
import Text.Regex
import Text.XML.HXT.Arrow
import Network.HTTP
import Network.URI
transformAndSmoothRunData :: [Double] -> [Double]
transformAndSmoothRunData =
flipInRange .
(convolve (gaussianKernel 5)) .
(correlate (movingAverageKernel 6)) .
(map (\x -> (1.0 / (6.0 * x)))) .
(filter (/=0)) .
diff
transformAndAverageRunData :: [Double] -> [Double]
transformAndAverageRunData =
flipInRange .
(correlate (movingAverageKernel 6)) .
(map (\x -> (1.0 / (6.0 * x)))) .
(filter (/=0)) .
diff
scaler :: [Double] -> Double -> (Double -> Double)
scaler xs y = (\x -> (x - minV) * y / d)
where
minV = minInList xs
maxV = maxInList xs
d = maxV - minV
encodeRunData :: [Double] -> ChartData
encodeRunData xs = encodeDataExtended [xs']
where
sc = scaler xs (fromIntegral 4095)
xs' = map (round . sc) xs :: [Int]
sampler :: Int -> Double -> Double -> [Double]
sampler n minV maxV =
[(minV + d * (fromIntegral x) / (fromIntegral n)) | x <- [0..n]]
where
d = maxV - minV
yLabels :: Int -> [Double] -> [String]
yLabels n xs =
map (\x -> printf "%.2f" x) (reverse (sampler n (minInList xs) (maxInList xs)))
xLabels :: Int -> [Double] -> [String]
xLabels n xs = map (\x -> printf "%.1f" x) (sampler n 0.0 duration)
where
duration = (fromIntegral $ length xs) / 6.0
suffix :: String -> (String -> String)
suffix s = (\x -> x ++ s)
data NikeRun = NikeRun {
extendedData :: [Double],
calories :: Double
} deriving (Eq,Show)
chartRun :: Int -> Int -> NikeRun -> String
chartRun w h NikeRun {extendedData = xs, calories = c} =
suffix "&chg=25.0,25.0,3,2" $
chartURL $
setAxisLabelPositions [[0, 25, 50, 75, 100], [50], [0, 25, 50, 75, 100], [50]] $
setAxisLabels [(yLabels 4 ylxs), ["pace (min/km)"],
(xLabels 4 xs), ["time (min)"]] $
setAxisTypes [AxisLeft, AxisLeft, AxisBottom, AxisBottom] $
setSize w h $
setData (encodeRunData txs) $
newLineChart
where
ylxs = transformAndAverageRunData xs
txs = transformAndSmoothRunData xs
nikeRunURL :: Int -> Int -> String
nikeRunURL userId runId =
"http://nikeplus.nike.com/nikeplus/" ++
"v1/services/widget/get_public_run.jsp?userID=" ++ (show userId) ++
"&id=" ++ (show runId)
get :: URI -> IO String
get uri = do
eresp <- simpleHTTP (Request uri GET [] "")
case eresp of
Left _ -> ioError . userError $ "Failed to get " ++ show uri
Right res -> return $ rspBody res
retrieveNikeRun :: Int -> Int -> IO String
retrieveNikeRun userId runId = do
case parseURI (nikeRunURL userId runId) of
Nothing -> ioError . userError $ "Invalid URL"
Just uri -> get uri
readDoubles :: String -> [Double]
readDoubles s = map (\y -> read y::Double) (splitRegex (mkRegex ",") s)
atTag tag = deep (isElem >>> hasName tag)
text = getChildren >>> getText
textAtTag tag = atTag tag >>> text
parseXML doc = readString [(a_validate,v_0)] doc
parseNikeRun = atTag "sportsData" >>>
proc x -> do
cs <- textAtTag "calories" -< x
exds <- textAtTag "extendedData" -< x
returnA -< NikeRun {
extendedData = readDoubles exds,
calories = read cs }
getNikeRun :: Int -> Int -> IO NikeRun
getNikeRun userId runId = do
doc <- retrieveNikeRun userId runId
let xml = parseXML doc
nikeRuns <- runX (xml >>> parseNikeRun)
case nikeRuns of
[] -> ioError . userError $ "Failed to parse nike run " ++ show runId
nr:_ -> return nr
Leave a comment