{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, EmptyDataDecls #-} -- |Author: Thomas DuBuisson -- Copyright: Thomas DuBuisson -- License: BSD3 module Data.GPS.KML ( -- * KML Operations (Open format used by GoogleEarth, among others) KML , trailToKML , pointsToKML , kmlToString ) where import Text.XML.Light import Data.GPS -- |The KML type and operations might be moved into a Data.KML module in the future type KML = Element -- |Converts the KML elements to a string and prepends the proper XML header, -- thus making it the correct format for saving as a file and opening it -- with other programs such as GoogleEarth. kmlToString :: KML -> String kmlToString = (++) xml_header . ppElement kmlTop = Element (QName "kml" Nothing Nothing) [Attr (basicName "xmlns") "http://www.opengis.net/kml/2.2"] [] Nothing addElem :: Element -> Element -> Element addElem top child = top { elContent = Elem child : elContent top } basicName :: String -> QName basicName n = QName n Nothing Nothing basicElem :: String -> Element basicElem n = Element (basicName n) [] [] Nothing filledElem :: String -> String -> Element filledElem name val = Element (basicName name) [] [Text (CData CDataText val Nothing)] Nothing -- |converts a given set of coordinates to a trail in KML format. -- Useful for saving as a file. trailToKML :: Coordinate a => String -> Trail a -> KML trailToKML name ps = addElem kmlTop doc where doc = foldl addElem (basicElem "Document") (nameElem : trailElem : []) nameElem = filledElem "name" name trailName = filledElem "name" (name ++ " trail") trailElem = foldl addElem (basicElem "Placemark") [trailName, pointsElem] pointsElem = addElem (basicElem "LineString") (filledElem "coordinates" points) points :: String points = concatMap packCoordinate ps packCoordinate :: Coordinate a => a -> String packCoordinate x = let (lat, lon) = getDegreeLatLon x in concat [lon, ",", lat, ",0 "] -- |converts a given set of coordinates to points in KML format. -- Useful for saving as a file. pointsToKML :: Coordinate a => String -> [a] -> [String] -> KML pointsToKML name ps pointNames = addElem kmlTop doc where doc = foldl addElem (basicElem "Document") (nameElem : placemarkElems) nameElem = filledElem "name" name placemarkElems = map buildPoint (zip ps pointNames) buildPoint (p,n) = let (t,g) = getDegreeLatLon p in foldl addElem (basicElem "Placemark") [ filledElem "name" n , foldl addElem (basicElem "LookAt") [ filledElem "longitude" g , filledElem "latitude" t , filledElem "altitude" "0" , filledElem "range" "500" ] , addElem (basicElem "Point") (filledElem "coordinates" (g ++ "," ++ t)) ] -- |Gets a pair of lat lon bytestrings (in degrees) getDegreeLatLon :: Coordinate a => a -> (String,String) getDegreeLatLon x = let (lat,lon) = dmsToRadianPair . toDMS $ x f = show . (*) (180 / pi) in (f lat, f lon)