gpx-conduit (empty) → 0.1
raw patch · 4 files changed
+210/−0 lines, 4 filesdep +attoparsecdep +basedep +conduitsetup-changed
Dependencies added: attoparsec, base, conduit, filepath, monad-control, old-locale, text, time, void, xml-conduit, xml-types
Files
- Geo/GPX/Conduit.hs +146/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- gpx-conduit.cabal +32/−0
+ Geo/GPX/Conduit.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, FlexibleContexts #-}+{-| This is a partial parsing of the GPX 1.0 and 1.0 exchange types.+ -}+module Geo.GPX.Conduit+ ( Track(..), GPX(..), Segment(..), Point(..)+ , readGPXFile, pt+ ) where++import Control.Monad.Trans.Control+import Control.Monad+import Data.Conduit+import Data.Conduit.Text+import Data.Conduit.List as L+import Data.Void (Void)+import Data.Time.Format+import Data.Text (Text)+import qualified Data.Text as T+import System.Locale+import System.FilePath+import Data.String+import Data.Maybe (fromMaybe)+import Data.Time (UTCTime, buildTime, parseTime)+import Data.XML.Types+import Text.XML hiding (parseText)+import Text.XML.Stream.Parse+import qualified Data.Attoparsec.Text as AT++import Debug.Trace+++-- |A GPX file usually is a single track (but can be many)+-- with one or more segments and many points in each segment.+data GPX = GPX { -- waypoints :: [Waypoint]+ -- , routes :: [Route]+ tracks :: [Track] }+ deriving (Eq, Ord, Show, Read)+data Track = Track + { trkName :: Maybe Text+ , trkDescription :: Maybe Text+ , segments :: [Segment]+ }+ deriving (Eq, Ord, Show, Read)++-- |A GPX segments is just a bundle of points.+data Segment = Segment { points :: [Point] }+ deriving (Eq, Ord, Show, Read)++type Latitude = Double+type Longitude = Double++-- |Track point is a full-fledged representation of all the data+-- available in most GPS loggers. It is possible you don't want+-- all this data and can just made do with coordinates (via 'Pnt')+-- or a custom derivative.+data Point = Point+ { pntLat :: Latitude+ , pntLon :: Longitude+ , pntEle :: Maybe Double -- ^ In meters+ , pntTime :: Maybe UTCTime+ -- , pntSpeed :: Maybe Double -- ^ Non-standard. Usually in meters/second.+ }+ deriving (Eq, Ord, Show, Read)++pt :: Latitude -> Longitude -> Maybe Double -> Maybe UTCTime -> Point+pt t g e m = Point t g e m++zeroPoint = Point 0 0 Nothing Nothing++readGPXFile :: FilePath -> IO (Maybe GPX)+readGPXFile fp = runResourceT (parseFile def (fromString fp) $$ conduitGPX)++parseGPX :: (MonadThrow m, MonadBaseControl IO m) => Text -> m (Maybe GPX)+parseGPX t = runResourceT (yield t =$= mapOutput snd (parseText def) + $$ conduitGPX)++conduitGPX :: MonadThrow m => Sink Event m (Maybe GPX)+conduitGPX =+ tagPredicate ((== "gpx") . nameLocalName)+ ignoreAttrs+ (\_ -> do+ skipTagAndContents "metadata" + ts <- many conduitTrack+ return $ GPX ts)++skipTagAndContents :: (MonadThrow m) => Text -> Pipe Event Event Void () m ()+skipTagAndContents n = do+ tagPredicate ((== n) . nameLocalName) ignoreAttrs+ (const $ L.sinkNull)+ return ()+++conduitTrack :: MonadThrow m => Sink Event m (Maybe Track)+conduitTrack = do+ tagPredicate ((== "trk") . nameLocalName) ignoreAttrs $ \_ -> do+ n <- join `fmap` tagPredicate (("name" ==) . nameLocalName) ignoreAttrs (const contentMaybe)+ d <- join `fmap` tagPredicate (("desc" ==) . nameLocalName) ignoreAttrs (const contentMaybe)+ segs <- many conduitSegment+ return (Track n d segs)++conduitSegment :: MonadThrow m => Sink Event m (Maybe Segment)+conduitSegment = do + tagPredicate ((== "trkseg") . nameLocalName) ignoreAttrs $ \_ -> do+ pnts <- (many conduitPoint)+ return (Segment pnts)++conduitPoint :: MonadThrow m => Sink Event m (Maybe Point)+conduitPoint =+ tagPredicate ((== "trkpt") . nameLocalName )+ (do l <- parseDouble `fmap` requireAttr "lat"+ g <- parseDouble `fmap` requireAttr "lon"+ return $ zeroPoint { pntLon = g, pntLat = l })+ parseETS++-- Parse elevation, time, and speed tags+parseETS :: MonadThrow m => Point -> Sink Event m Point+parseETS pnt = do+ let nameParse :: Name -> Maybe (Point -> Text -> Point)+ nameParse n =+ case nameLocalName n of+ "ele" -> Just (\p t -> p { pntEle = Just (parseDouble t) })+ "time" -> Just (\p t -> p { pntTime = (parseUTC t) })+ "speed" -> Just (\p _ -> p ) -- We ignore 'speed'+ _ -> Nothing+ handleName :: (MonadThrow m) => pnt -> (pnt -> Text -> pnt) -> Sink Event m pnt+ handleName p op = fmap (op p) content+ skipTagAndContents "extensions"+ pnt' <- tag nameParse return (handleName pnt)+ case pnt' of+ Nothing -> return pnt+ Just p -> parseETS p++parseDouble :: Text -> Double+parseDouble l = either (const 0) id (AT.parseOnly AT.double l)++parseUTC :: Text -> Maybe UTCTime+parseUTC = either (const Nothing) id . AT.parseOnly (do + yearMonthDay <- AT.manyTill AT.anyChar (AT.char 'T')+ hourMinSec <- AT.manyTill AT.anyChar (AT.choice [AT.char '.', AT.char 'Z'])+ fraction <- AT.choice [AT.manyTill AT.anyChar (AT.char 'Z'), return ""]+ -- The Time package version 1.4 does not handle F T and Q property for+ -- buildTime.+ -- return (buildTime defaultTimeLocale + -- [('F', yearMonthDay), ('T', hourMinSec), ('Q', fraction)]))+ return (parseTime defaultTimeLocale "%F %T %Q"+ (unwords [yearMonthDay,hourMinSec,'.':fraction]))+ )
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Thomas M. DuBuisson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Thomas M. DuBuisson nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gpx-conduit.cabal view
@@ -0,0 +1,32 @@+-- gpx-conduit.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+Name: gpx-conduit+Version: 0.1+Synopsis: Read GPX files using conduits+Description: Read GPX files into simple Point types.+License: BSD3+License-file: LICENSE+Author: Thomas M. DuBuisson+Maintainer: Thomas.DuBuisson@gmail.com+Copyright: Thomas M. DuBuisson (2012)+Category: Data+Build-type: Simple+-- Extra-source-files: +Cabal-version: >=1.6++Library+ Exposed-modules: Geo.GPX.Conduit+ Build-depends: base == 4.*+ , xml-conduit == 1.0.*+ , conduit == 0.5.*+ , attoparsec == 0.10.*+ , time == 1.4.*+ , text == 0.11.*+ , xml-types == 0.3.*+ , old-locale == 1.0.*+ , filepath == 1.3.*+ , monad-control == 0.3.*+ , void == 0.5.*+ -- Other-modules: + -- Build-tools: