module Geography.Directions.Google where
import Geography.Geocoding.Google.Get
import qualified Text.HJson as J
import qualified Data.Map as M
import Network.URI (parseURI)
import Network.HTTP (urlEncodeVars)
import Data.Maybe (fromMaybe)
import Text.Printf (printf)
import Data.List (intersperse)
type DirectionsError = String
data TravelMode = Driving | Walking | Bicycling deriving (Eq)
instance Show TravelMode where show Driving = "driving"; show Walking = "walking"; show Bicycling = "bicycling"
data Avoid = Tolls | Highways deriving (Eq)
instance Show Avoid where show Tolls = "tolls"; show Highways = "highways"
data UnitSystem = Metric | Imperial deriving (Eq)
instance Show UnitSystem where show Metric = "metric"; show Imperial = "imperial"
data DirOptions = DirOptions { travelMode :: TravelMode
, avoid :: Maybe Avoid
, waypoints :: [String]
, alternatives :: Bool
, units :: Maybe UnitSystem
, regionCode :: Maybe String
, sensor :: Bool }
deriving Show
defaultDirOptions = DirOptions Driving Nothing [] False Nothing Nothing False
getDirections :: String -> String -> DirOptions -> IO (Either DirectionsError J.Json)
getDirections orig dest opts = do
case parseURI (mkDirectionsURL orig dest opts) of
Nothing -> return (Left "URL encoding error")
Just uri -> do
jstring <- fromMaybe "" `fmap` maybeGet uri
case J.fromString jstring of
Left e -> return $ Left (show e)
Right js
| getStatus js /= "OK" -> return . Left $ getStatus js
| otherwise -> return $ fromMaybe (Left "Malformed JSON") (Just (Right js))
directionsURLFormat = "http://maps.googleapis.com/maps/api/directions/json?%s"
mkDirectionsURL :: String -> String -> DirOptions -> String
mkDirectionsURL orig dest opts =
printf directionsURLFormat $
urlEncodeVars ([ ("origin", orig)
, ("destination", dest)
, ("sensor", showBool (sensor opts))
, ("alternatives", showBool (alternatives opts)) ] ++
(case avoid opts of Just av -> [("avoid", show av)] ; _ -> []) ++
(case units opts of Just us -> [("units", show us)] ; _ -> []) ++
(case regionCode opts of Just rc -> [("regionCode", show rc)]; _ -> []) ++
(case waypoints opts of [] -> []; wp -> [("waypoints", wp2s wp)])
)
where wp2s = concat . intersperse "|"
showBool True = "true"; showBool False = "false"
getStatus :: J.Json -> String
getStatus (J.JObject top) = fromMaybe "Parse error" $ do
J.JString s <- M.lookup "status" top
return s