-- Connexion au service Web de Velib' pour afficher le nombre de velos disponibles
-- et le nombr d'emplacements libres.

-- Compiler avec, par exemple :
--    ghc -o get-station --make get-station.hs

import Network.HTTP
import Network.URI

import Text.XML.HaXml  -- http://www.cs.york.ac.uk/fp/HaXml/

import Text.Printf (printf)

import Data.Maybe
import Data.Either

import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)

baseURI = "http://www.velib.paris.fr/service/stationdetails/"

fatal :: String -> IO a
fatal msg = do 
	  hPutStrLn stderr msg
	  exitFailure

fromRight (Right a) = a
fromRight e = error ("Not a left value: " ++ (show e))

-- Quelques fonctions auxiliaires pour XML. On pourrait certainement faire mieux 
-- avec les combinateurs de HaXML. TODO.
rootOf :: Document -> Element
rootOf (Document _ _ r _) = r

nameOf :: Element -> Name
nameOf (Elem n _ _) = n

contentOf :: Element -> [Content]
contentOf (Elem _ _ cs) = cs

textOf :: Element -> String
textOf (Elem _ _ cs) = concat (map show cs)

instance Show Content where 
   show (CString _ value) = value 
   show (CElem e) = nameOf e
   show _ = "Undefined"

showVal :: Content -> String
showVal (CElem e)= textOf e

firstChild :: Name -> Content -> Content
firstChild tagname item = head (concat (map (tag tagname) (children item)))

valueOf :: String -> Element -> Either String String
valueOf tagname tree =
  let elements = concat (map (tag tagname) (contentOf tree)) in
  if (length elements /= 1) then
      Left ("valueOf: XML document must have one and only one <" ++ 
             tagname ++ "> element")
  else
      let element = elements !! 0 in
      Right (show ((children element) !! 0))

readInteger :: String -> Integer
readInteger s =
   (read s)::Integer

integerValueOf :: String -> Element -> Either String Integer
integerValueOf tagname tree =
  let stringvalue = valueOf tagname tree in
  either (Left) 
         (Right . readInteger)
         stringvalue

-- Fin des fonctions XML

get :: URI -> IO (Result Response)
get uri = do
    result <- simpleHTTP (request uri)
    return result

request :: URI -> Request
request uri = Request{ rqURI = uri,
                       rqMethod = GET,
                       rqHeaders = [Header HdrUserAgent "get-station/0.0 (Bortzmeyer's get-station.hs; Haskell; http://www.bortzmeyer.org/velib-rest.html)"],
                       rqBody = "" }

handle (Left e) station = do
           hPutStrLn stderr "Network error" -- TODO: display it
           exitFailure
handle (Right r) station = do
           -- putStrLn (show (rspCode r)) -- TODO: do something if there is an error, 
           -- for instance 404
           let xmltree = rootOf (xmlParse "Velib Web resource" (rspBody r))          
           if nameOf xmltree /= "station" then
               error ("Wrong root element <" ++ nameOf xmltree ++ ">")
            else
               putStr ""
           let availableBikes = integerValueOf "available" xmltree
           let freeSlots = integerValueOf "free" xmltree
           let totalSlots = integerValueOf "total" xmltree
           if (fromRight totalSlots) == 0 then
              error ("No slots at all at station " ++ station ++ " Does it really exist?")
            else
              putStr ""
           printf "Available bikes - Free slots - Total slots  at station %s\n" station
           printf "           %4u         %4u          %4u\n" (fromRight availableBikes)
                 (fromRight freeSlots) (fromRight totalSlots)
 
main = 
    do
    args <- getArgs
    case args of 
	[station] -> do
                   let uri = parseURI (baseURI ++ station)
                   result <- get (fromJust uri)
                   handle result station
	_ -> fatal "Usage: get-station station-number"