{- ==== Provide a simple program to consume a web-service. It is a Google geo service to return the coordinate of a given address. The service is a RESTful service. ==== -} module CTy.ExampleRestApp where import Network.HTTP import Network.URI import List import Maybe import System.IO.Unsafe import Text.XML.HaXml --import Text.XML.HaXml.Pretty --import Text.XML.HaXml.Wrappers import Text.XML.HaXml.Util --import Text.XML.HaXml.XmlContent import Text.XML.HaXml.Posn -- import Data.Time.Clock import System.Time -- -- The function to call the service. It will return a list of coordinates -- of a given address. It will return "Nothing" if the service can't -- identify the address. -- -- Example of address: "princetonplein+10+utrecht" -- gg :: String -> IO (Maybe [(Float,Float)]) gg address = do { response <- ggbase address ; xmlResp <- return . docContent (posInNewCxt "debug" Nothing) . xmlParse "debug" $ response ; locs <- return . multi (tag "location") $ xmlResp ; status <- return . tagTextContent . head . Text.XML.HaXml.path [tag "GeocodeResponse", children, tag "status"] $ xmlResp ; if status == "OK" then return (Just (map value locs)) else return Nothing } where lat loc = toFloat . Text.XML.HaXml.path [children, tag "lat"] $ loc long loc = toFloat . Text.XML.HaXml.path [children, tag "lng"] $ loc toFloat = read . tagTextContent . head value loc = (lat loc, long loc) -- -- The underlying call to googleGeo service. This will return XML; this -- will be parsed by the function gg above. -- ggbase address = restRequest googleGeo where googleGeo = "http://maps.googleapis.com/maps/api/geocode/xml?" ++ "address=" ++ address ++ "&sensor=false" -- -- The underlying function to submit a REST request -- restRequest :: String -> IO String restRequest restUrl = do { --putStrLn "Sending request ..." ; rsp <- simpleHTTP . getRequest $ restUrl ; --putStrLn "Getting response ..." ; s <- getResponseBody rsp ; --putStrLn "Printing response ..." ; return s } -- -- gg, wrapped with a specification. The specification compares the result -- with the previous result of the same query. It they are the same then -- they are ok; else not. -- -- This will be the function we call from the test-interface below. -- ggWithSpec address = do { log_ <- readFile $ "./ggdebug.txt" ; log <- return . read $ log_ ; old <- return . findEntry log $ address ; rold <- return . getResult . fromJust $ old ; r <- gg address ; time <- getClockTime >>= toCalendarTime ; putStrLn (show r) ; log2 <- return ((MyLogEntry time address r) : log) ; if isNothing old then do { writeFile "ggdebug.txt" (show log2) ; ok <- return True ; putStrLn (show ok) ; return ok } else do { ok <- return (r == rold) ; putStrLn (show ok) ; return ok } } -- -- Represetation of query results which we will record/log for the -- purpose of checking the specification above. -- type MyLog = [MyLogEntry] data MyLogEntry = MyLogEntry CalendarTime --UTCTime String -- address (Maybe [(Float,Float)]) deriving (Eq,Show,Read) -- just for finding an entry in a log findEntry :: MyLog -> String -> Maybe MyLogEntry findEntry [] address = Nothing findEntry (e@(MyLogEntry _ a _):s) address | a==address = Just e | otherwise = findEntry s address getResult (MyLogEntry _ _ r) = r -- -- For GoogleGeo, "address" is just a single string in which we can -- specify street, nr, city, etc. It seems to have some ability to -- handle different orders of those components, or if some are -- missing or a bit magled. -- -- We will test the service through the following test-interface. -- We will generate various combinations of missing and mangled -- arguments; and check the results according to the previously -- written specification (ggWithSpec). -- ggTI (country,city,street,nr) countryMode cityMode streetMode numberMode order = unsafePerformIO (ggWithSpec address) where co = mangle countryMode country ci = mangle cityMode city st = mangle streetMode street n = mangleNr numberMode (show nr) elements = reOrder order co ci st n address = mkAddressString elements -- -- Different modes to mangle a name. -- data NameMode = Correct -- correct name | Swapped2 -- swapping the last two letters | DropLast -- deleting last letter | Empty -- removing the whole name deriving (Eq,Show) -- -- Different modes to mangle a number. -- data NumberMode = NCorrect | NEmpty deriving (Eq,Show) -- Different address-components' orders -- data OrderCoCiSN = CommonO -- common order = s n ci co | CoCiSN -- increasing order | NSCiCo -- decreasing order | CoNSCi -- wierd order deriving (Eq,Show) reOrder CommonO co ci s n = filter (not . null) [s,n,ci,co] reOrder CoCiSN co ci s n = filter (not . null) [co,ci,s,n] reOrder NSCiCo co ci s n = filter (not . null) [n,s,ci,co] reOrder CoNSCi co ci s n = filter (not . null) [co,n,s,ci] mangle Correct name = name mangle Swapped2 [] = [] mangle Swapped2 [x] = [x] mangle Swapped2 s = reverse (y:x:z) where (x:y:z) = reverse s mangle DropLast [] = [] mangle DropLast s = take (length s - 1) s mangle Empty _ = [] mangleNr NCorrect n = n mangleNr NEmpty _ = "" mkAddressString elements = concat . intersperse "+" $ elements