diff --git a/GPX.cabal b/GPX.cabal --- a/GPX.cabal +++ b/GPX.cabal @@ -1,5 +1,5 @@ Name: GPX -Version: 0.6.3 +Version: 0.7.0 License: BSD3 License-File: LICENSE Synopsis: Parse GPX files @@ -26,6 +26,7 @@ , comonad-transformers , data-lens , xsd + , newtype GHC-Options: -Wall -fno-warn-name-shadowing @@ -33,25 +34,26 @@ Hs-Source-Dirs: src Exposed-Modules: Data.Geo.GPX - Data.Geo.GPX.DgpsStation - Data.Geo.GPX.Fix - Data.Geo.GPX.Degrees - Data.Geo.GPX.Longitude - Data.Geo.GPX.Latitude - Data.Geo.GPX.Bounds - Data.Geo.GPX.Extensions - Data.Geo.GPX.Pt - Data.Geo.GPX.Ptseg - Data.Geo.GPX.Email - Data.Geo.GPX.Link - Data.Geo.GPX.Person - Data.Geo.GPX.Copyright - Data.Geo.GPX.Wpt - Data.Geo.GPX.Trkseg - Data.Geo.GPX.Trk - Data.Geo.GPX.Rte - Data.Geo.GPX.Metadata - Data.Geo.GPX.Gpx + Data.Geo.GPX.Type + Data.Geo.GPX.Type.DgpsStation + Data.Geo.GPX.Type.Fix + Data.Geo.GPX.Type.Degrees + Data.Geo.GPX.Type.Longitude + Data.Geo.GPX.Type.Latitude + Data.Geo.GPX.Type.Bounds + Data.Geo.GPX.Type.Extensions + Data.Geo.GPX.Type.Pt + Data.Geo.GPX.Type.Ptseg + Data.Geo.GPX.Type.Email + Data.Geo.GPX.Type.Link + Data.Geo.GPX.Type.Person + Data.Geo.GPX.Type.Copyright + Data.Geo.GPX.Type.Wpt + Data.Geo.GPX.Type.Trkseg + Data.Geo.GPX.Type.Trk + Data.Geo.GPX.Type.Rte + Data.Geo.GPX.Type.Metadata + Data.Geo.GPX.Type.Gpx Data.Geo.GPX.Lens Data.Geo.GPX.Lens.MinlatL Data.Geo.GPX.Lens.MaxlatL diff --git a/src/Data/Geo/GPX.hs b/src/Data/Geo/GPX.hs --- a/src/Data/Geo/GPX.hs +++ b/src/Data/Geo/GPX.hs @@ -1,46 +1,69 @@ +{-# LANGUAGE MultiParamTypeClasses #-} + -- | GPX 1.1 Schema module Data.Geo.GPX( - module Data.Geo.GPX.DgpsStation -, module Data.Geo.GPX.Fix -, module Data.Geo.GPX.Degrees -, module Data.Geo.GPX.Longitude -, module Data.Geo.GPX.Latitude -, module Data.Geo.GPX.Bounds -, module Data.Geo.GPX.Extensions -, module Data.Geo.GPX.Pt -, module Data.Geo.GPX.Ptseg -, module Data.Geo.GPX.Email -, module Data.Geo.GPX.Link -, module Data.Geo.GPX.Person -, module Data.Geo.GPX.Copyright -, module Data.Geo.GPX.Wpt -, module Data.Geo.GPX.Trkseg -, module Data.Geo.GPX.Trk -, module Data.Geo.GPX.Rte -, module Data.Geo.GPX.Metadata -, module Data.Geo.GPX.Gpx + module Data.Geo.GPX.Type , module Data.Geo.GPX.Lens , module Control.Arrow +, GPX ) where -import Data.Geo.GPX.DgpsStation -import Data.Geo.GPX.Fix -import Data.Geo.GPX.Degrees -import Data.Geo.GPX.Longitude -import Data.Geo.GPX.Latitude -import Data.Geo.GPX.Bounds -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Pt -import Data.Geo.GPX.Ptseg -import Data.Geo.GPX.Email -import Data.Geo.GPX.Link -import Data.Geo.GPX.Person -import Data.Geo.GPX.Copyright -import Data.Geo.GPX.Wpt -import Data.Geo.GPX.Trkseg -import Data.Geo.GPX.Trk -import Data.Geo.GPX.Rte -import Data.Geo.GPX.Metadata -import Data.Geo.GPX.Gpx +import Data.Geo.GPX.Type import Data.Geo.GPX.Lens import Control.Arrow +import Text.XML.HXT.Arrow.Pickle +import Control.Newtype +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | Top-level GPX data type with the root XML element applied. +newtype GPX = GPX Gpx + deriving Eq + +instance XmlPickler GPX where + xpickle = xpWrap (GPX, \(GPX g) -> g) (xpElem "gpx" xpickle) + +instance GpxP GPX where + gpx v c m w r t e = + GPX (gpx v c m w r t e) + +instance Newtype GPX Gpx where + pack = + GPX + unpack (GPX x) = + x + +instance VersionL GPX where + versionL = + newtypeLens >>> versionL + +instance CreatorL GPX where + creatorL = + newtypeLens >>> creatorL + +instance MetadataL GPX where + metadataL = + newtypeLens >>> metadataL + +instance WptsL GPX where + wptsL = + newtypeLens >>> wptsL + +instance RtesL GPX where + rtesL = + newtypeLens >>> rtesL + +instance TrksL GPX where + trksL = + newtypeLens >>> trksL + +instance ExtensionsL GPX where + extensionsL = + newtypeLens >>> extensionsL + +-- not exported (belongs in data-lens) +newtypeLens :: + Lens GPX Gpx +newtypeLens = + Lens (store pack . unpack) + diff --git a/src/Data/Geo/GPX/Bounds.hs b/src/Data/Geo/GPX/Bounds.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Bounds.hs +++ /dev/null @@ -1,51 +0,0 @@ --- | Complex Type: @boundsType@ -module Data.Geo.GPX.Bounds( - Bounds -, bounds -) where - -import Data.Geo.GPX.Latitude -import Data.Geo.GPX.Longitude -import Data.Geo.GPX.Lens.MinlatL -import Data.Geo.GPX.Lens.MaxlatL -import Data.Geo.GPX.Lens.MinlonL -import Data.Geo.GPX.Lens.MaxlonL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Bounds = Bounds (Latitude, Longitude) (Latitude, Longitude) - deriving (Eq, Ord) - -bounds :: - (Latitude, Longitude) -- ^ The minimum latitude and longitude. - -> (Latitude, Longitude) -- ^ The maximum latitude and longitude. - -> Bounds -bounds = - Bounds - -instance MinlatL Bounds where - minlatL = - Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\minlat -> Bounds (minlat, minlon) (maxlat, maxlon)) minlat - -instance MinlonL Bounds where - minlonL = - Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\minlon -> Bounds (minlat, minlon) (maxlat, maxlon)) minlon - -instance MaxlatL Bounds where - maxlatL = - Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\maxlat -> Bounds (minlat, minlon) (maxlat, maxlon)) maxlat - -instance MaxlonL Bounds where - maxlonL = - Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\maxlon -> Bounds (minlat, minlon) (maxlat, maxlon)) maxlon - -instance XmlPickler Bounds where - xpickle = - xpWrap (\(minlat', minlon', maxlat', maxlon') -> bounds (minlat', minlon') (maxlat', maxlon'), - \(Bounds (minlat', minlon') (maxlat', maxlon')) -> (minlat', minlon', maxlat', maxlon')) (xp4Tuple - (xpAttr "minlat" xpickle) - (xpAttr "minlon" xpickle) - (xpAttr "maxlat" xpickle) - (xpAttr "maxlon" xpickle)) - diff --git a/src/Data/Geo/GPX/Copyright.hs b/src/Data/Geo/GPX/Copyright.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Copyright.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} - --- | Complex Type: @copyrightType@ -module Data.Geo.GPX.Copyright( - Copyright -, copyright -) where - -import Data.Geo.GPX.Lens.AuthorL -import Data.Geo.GPX.Lens.YearL -import Data.Geo.GPX.Lens.LicenseL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Copyright = Copyright String (Maybe String) (Maybe String) - deriving (Eq, Ord) - -copyright - :: String -- ^ The author. - -> Maybe String -- ^ The year. - -> Maybe String -- ^ The license. - -> Copyright -copyright = - Copyright - -instance AuthorL Copyright String where - authorL = - Lens $ \(Copyright author year license) -> store (\author -> Copyright author year license) author - -instance YearL Copyright where - yearL = - Lens $ \(Copyright author year license) -> store (\year -> Copyright author year license) year - -instance LicenseL Copyright where - licenseL = - Lens $ \(Copyright author year license) -> store (\license -> Copyright author year license) license - -instance XmlPickler Copyright where - xpickle = - xpWrap (\(author', year', license') -> copyright author' year' license', \(Copyright author' year' license') -> (author', year', license')) (xpTriple - (xpAttr "author" xpText) - (xpOption (xpElem "year" xpText)) - (xpOption (xpElem "license" xpText))) diff --git a/src/Data/Geo/GPX/Degrees.hs b/src/Data/Geo/GPX/Degrees.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Degrees.hs +++ /dev/null @@ -1,30 +0,0 @@ --- | Simple Type: @degreesType@ -module Data.Geo.GPX.Degrees( - Degrees -, degrees -, runDegrees -) where - - -import Data.Fixed -import Text.XML.HXT.Arrow.Pickle - -newtype Degrees = Degrees Double - deriving (Eq, Ord, Show) - -degrees :: - Double -- ^ The value which will be between 0 and 360 (values out of the range are truncated using a modulus operation). - -> Degrees -degrees n = - Degrees (n `mod'` 360) - -runDegrees :: - Degrees - -> Double -runDegrees (Degrees d) = - d - -instance XmlPickler Degrees where - xpickle = - xpWrap (degrees, \(Degrees n) -> n) xpPrim - diff --git a/src/Data/Geo/GPX/DgpsStation.hs b/src/Data/Geo/GPX/DgpsStation.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/DgpsStation.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | Simple Type: @dgpsStationType@ -module Data.Geo.GPX.DgpsStation( - DgpsStation -, dgpsStation -, runDgpsStation -) where - -import Data.Ix -import Text.XML.HXT.Arrow.Pickle - -newtype DgpsStation = DgpsStation Int - deriving (Eq, Ord) - -dgpsStation :: - Int -- ^ The value between 0 and 1023. - -> Maybe DgpsStation -dgpsStation n = - if inRange (0, 1023) n - then - Just (DgpsStation n) - else - Nothing - -runDgpsStation :: - DgpsStation - -> Int -runDgpsStation (DgpsStation i) = - i - -instance XmlPickler DgpsStation where - xpickle = - xpWrapMaybe (dgpsStation, \(DgpsStation n) -> n) xpickle - diff --git a/src/Data/Geo/GPX/Email.hs b/src/Data/Geo/GPX/Email.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Email.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | Complex Type: @emailType@ -module Data.Geo.GPX.Email( - Email -, email -) where - -import Data.Geo.GPX.Lens.IdL -import Data.Geo.GPX.Lens.DomainL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Email = Email String String - deriving (Eq, Ord) - -email :: - String -- ^ The id. - -> String -- ^ The domain. - -> Email -email = - Email - -instance IdL Email where - idL = - Lens $ \(Email id domain) -> store (\id -> Email id domain) id - -instance DomainL Email where - domainL = - Lens $ \(Email id domain) -> store (\domain -> Email id domain) domain - -instance XmlPickler Email where - xpickle = - xpWrap (uncurry email, \(Email id' domain') -> (id', domain')) - (xpPair (xpAttr "id" xpText) (xpAttr "domain" xpText)) - - diff --git a/src/Data/Geo/GPX/Extensions.hs b/src/Data/Geo/GPX/Extensions.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Extensions.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | Complex Type: @extensionsType@ -module Data.Geo.GPX.Extensions( - Extensions -, extensions -, runExtensions -) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.DOM.TypeDefs - -newtype Extensions = Extensions XmlTrees - deriving (Eq, Show) - -extensions :: - XmlTrees - -> Extensions -extensions = - Extensions - -runExtensions :: - Extensions - -> XmlTrees -runExtensions (Extensions t) = - t - -instance XmlPickler Extensions where - xpickle = - xpWrap (Extensions, \(Extensions t) -> t) xpTrees - diff --git a/src/Data/Geo/GPX/Fix.hs b/src/Data/Geo/GPX/Fix.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Fix.hs +++ /dev/null @@ -1,76 +0,0 @@ --- | Simple Type: @fixType@ -module Data.Geo.GPX.Fix( - Fix -, foldFix -, none -, twod -, threed -, dgps -, pps -, fix -) where - -import Text.XML.HXT.Arrow.Pickle - -data Fix = None | Twod | Threed | Dgps | Pps - deriving (Eq, Ord, Show, Enum) - --- | The catamorphism for @Fix@. -foldFix :: - a -- ^ The value if @none@. - -> a -- ^ The value if @twod@. - -> a -- ^ The value if @threed@. - -> a -- ^ The value if @dgps@. - -> a -- ^ The value if @pps@. - -> Fix -- ^ The value to fold. - -> a -foldFix n _ _ _ _ None = n -foldFix _ t _ _ _ Twod = t -foldFix _ _ t _ _ Threed = t -foldFix _ _ _ d _ Dgps = d -foldFix _ _ _ _ p Pps = p - --- | Construct a @Fix@ with a value of @none@. -none :: - Fix -none = - None - --- | Construct a @Fix@ with a value of @2d@. -twod :: Fix -twod = Twod - --- | Construct a @Fix@ with a value of @3d@. -threed :: - Fix -threed = - Threed - --- | Construct a @Fix@ with a value of @dgps@. -dgps :: - Fix -dgps = - Dgps - --- | Construct a @Fix@ with a value of @pps@. -pps :: - Fix -pps = - Pps - --- | Construct a @Fix@ using a string with a value of @["none", "2d", "3d", "dgps", "pps"]@. -fix :: - String -- ^ The string value to construct a @Fix@ with. - -> Maybe Fix -fix "none" = Just none -fix "2d"= Just twod -fix "3d" = Just threed -fix "dgps" = Just dgps -fix "pps" = Just pps -fix _ = Nothing - -instance XmlPickler Fix where - xpickle = - xpWrapMaybe (fix, show) xpText - - diff --git a/src/Data/Geo/GPX/Gpx.hs b/src/Data/Geo/GPX/Gpx.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Gpx.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} - --- | Complex Type: @gpxType@ -module Data.Geo.GPX.Gpx( - Gpx -, gpx -) where - -import Data.Geo.GPX.Metadata -import Data.Geo.GPX.Wpt -import Data.Geo.GPX.Rte -import Data.Geo.GPX.Trk -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Lens.VersionL -import Data.Geo.GPX.Lens.CreatorL -import Data.Geo.GPX.Lens.MetadataL -import Data.Geo.GPX.Lens.WptsL -import Data.Geo.GPX.Lens.RtesL -import Data.Geo.GPX.Lens.TrksL -import Data.Geo.GPX.Lens.ExtensionsL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Gpx = Gpx String String (Maybe Metadata) [Wpt] [Rte] [Trk] (Maybe Extensions) - deriving Eq - -gpx :: - String -- ^ The version. - -> String -- ^ The creator. - -> Maybe Metadata -- ^ The metadata. - -> [Wpt] -- ^ The waypoints (wpt). - -> [Rte] -- ^ The routes (rte). - -> [Trk] -- ^ The tracks (trk). - -> Maybe Extensions -- ^ The extensions. - -> Gpx -gpx = - Gpx - -instance VersionL Gpx where - versionL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\version -> Gpx version creator metadata wpts rtes trks extensions) version - -instance CreatorL Gpx where - creatorL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\creator -> Gpx version creator metadata wpts rtes trks extensions) creator - -instance MetadataL Gpx where - metadataL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\metadata -> Gpx version creator metadata wpts rtes trks extensions) metadata - -instance WptsL Gpx where - wptsL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\wpts -> Gpx version creator metadata wpts rtes trks extensions) wpts - -instance RtesL Gpx where - rtesL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\rtes -> Gpx version creator metadata wpts rtes trks extensions) rtes - -instance TrksL Gpx where - trksL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\trks -> Gpx version creator metadata wpts rtes trks extensions) trks - -instance ExtensionsL Gpx where - extensionsL = - Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\extensions -> Gpx version creator metadata wpts rtes trks extensions) extensions - -instance XmlPickler Gpx where - xpickle = - xpWrap (\(version', creator', metadata', wpt', rte', trk', extensions') -> gpx version' creator' metadata' wpt' rte' trk' extensions', - \(Gpx version' creator' metadata' wpt' rte' trk' extensions') -> (version', creator', metadata', wpt', rte', trk', extensions')) (xpElem "gpx" (xp7Tuple - (xpAttr "version" xpText) - (xpAttr "creator" xpText) - (xpOption (xpElem "metadata" xpickle)) - (xpList (xpElem "wpt" xpickle)) - (xpList (xpElem "rte" xpickle)) - (xpList (xpElem "trk" xpickle)) - (xpOption (xpElem "extensions" xpickle)))) - diff --git a/src/Data/Geo/GPX/Latitude.hs b/src/Data/Geo/GPX/Latitude.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Latitude.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- | Simple Type: @latitudeType@ -module Data.Geo.GPX.Latitude( - Latitude -, latitude -, runLatitude -) where - -import Data.Fixed -import Text.XML.HXT.Arrow.Pickle - -newtype Latitude = Latitude Double - deriving (Eq, Ord, Enum, Num, Fractional, Floating, Real, RealFrac, RealFloat) - -latitude :: - Double -- ^ The value which will be between -90 and 90 (values out of the range are truncated using a modulus operation). - -> Latitude -latitude n = - Latitude ((n + 90) `mod'` 180 - 90) - -runLatitude :: - Latitude - -> Double -runLatitude (Latitude d) = - d - -instance Show Latitude where - show (Latitude n) = show n - -instance XmlPickler Latitude where - xpickle = xpWrap (latitude, \(Latitude n) -> n) xpPrim - diff --git a/src/Data/Geo/GPX/Lens/BoundsL.hs b/src/Data/Geo/GPX/Lens/BoundsL.hs --- a/src/Data/Geo/GPX/Lens/BoundsL.hs +++ b/src/Data/Geo/GPX/Lens/BoundsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.BoundsL where -import Data.Geo.GPX.Bounds +import Data.Geo.GPX.Type.Bounds import Data.Lens.Common class BoundsL a where diff --git a/src/Data/Geo/GPX/Lens/CopyrightL.hs b/src/Data/Geo/GPX/Lens/CopyrightL.hs --- a/src/Data/Geo/GPX/Lens/CopyrightL.hs +++ b/src/Data/Geo/GPX/Lens/CopyrightL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.CopyrightL where -import Data.Geo.GPX.Copyright +import Data.Geo.GPX.Type.Copyright import Data.Lens.Common class CopyrightL a where diff --git a/src/Data/Geo/GPX/Lens/DgpsidL.hs b/src/Data/Geo/GPX/Lens/DgpsidL.hs --- a/src/Data/Geo/GPX/Lens/DgpsidL.hs +++ b/src/Data/Geo/GPX/Lens/DgpsidL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.DgpsidL where -import Data.Geo.GPX.DgpsStation +import Data.Geo.GPX.Type.DgpsStation import Data.Lens.Common class DgpsidL a where diff --git a/src/Data/Geo/GPX/Lens/EmailL.hs b/src/Data/Geo/GPX/Lens/EmailL.hs --- a/src/Data/Geo/GPX/Lens/EmailL.hs +++ b/src/Data/Geo/GPX/Lens/EmailL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.EmailL where -import Data.Geo.GPX.Email +import Data.Geo.GPX.Type.Email import Data.Lens.Common class EmailL a where diff --git a/src/Data/Geo/GPX/Lens/ExtensionsL.hs b/src/Data/Geo/GPX/Lens/ExtensionsL.hs --- a/src/Data/Geo/GPX/Lens/ExtensionsL.hs +++ b/src/Data/Geo/GPX/Lens/ExtensionsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.ExtensionsL where -import Data.Geo.GPX.Extensions +import Data.Geo.GPX.Type.Extensions import Data.Lens.Common class ExtensionsL a where diff --git a/src/Data/Geo/GPX/Lens/FixL.hs b/src/Data/Geo/GPX/Lens/FixL.hs --- a/src/Data/Geo/GPX/Lens/FixL.hs +++ b/src/Data/Geo/GPX/Lens/FixL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.FixL where -import Data.Geo.GPX.Fix +import Data.Geo.GPX.Type.Fix import Data.Lens.Common class FixL a where diff --git a/src/Data/Geo/GPX/Lens/LatL.hs b/src/Data/Geo/GPX/Lens/LatL.hs --- a/src/Data/Geo/GPX/Lens/LatL.hs +++ b/src/Data/Geo/GPX/Lens/LatL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.LatL where -import Data.Geo.GPX.Latitude +import Data.Geo.GPX.Type.Latitude import Data.Lens.Common class LatL a where diff --git a/src/Data/Geo/GPX/Lens/LinkL.hs b/src/Data/Geo/GPX/Lens/LinkL.hs --- a/src/Data/Geo/GPX/Lens/LinkL.hs +++ b/src/Data/Geo/GPX/Lens/LinkL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.LinkL where -import Data.Geo.GPX.Link +import Data.Geo.GPX.Type.Link import Data.Lens.Common class LinkL a where diff --git a/src/Data/Geo/GPX/Lens/LinksL.hs b/src/Data/Geo/GPX/Lens/LinksL.hs --- a/src/Data/Geo/GPX/Lens/LinksL.hs +++ b/src/Data/Geo/GPX/Lens/LinksL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.LinksL where -import Data.Geo.GPX.Link +import Data.Geo.GPX.Type.Link import Data.Lens.Common class LinksL a where diff --git a/src/Data/Geo/GPX/Lens/LonL.hs b/src/Data/Geo/GPX/Lens/LonL.hs --- a/src/Data/Geo/GPX/Lens/LonL.hs +++ b/src/Data/Geo/GPX/Lens/LonL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.LonL where -import Data.Geo.GPX.Longitude +import Data.Geo.GPX.Type.Longitude import Data.Lens.Common class LonL a where diff --git a/src/Data/Geo/GPX/Lens/MagvarL.hs b/src/Data/Geo/GPX/Lens/MagvarL.hs --- a/src/Data/Geo/GPX/Lens/MagvarL.hs +++ b/src/Data/Geo/GPX/Lens/MagvarL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.MagvarL where -import Data.Geo.GPX.Degrees +import Data.Geo.GPX.Type.Degrees import Data.Lens.Common class MagvarL a where diff --git a/src/Data/Geo/GPX/Lens/MaxlatL.hs b/src/Data/Geo/GPX/Lens/MaxlatL.hs --- a/src/Data/Geo/GPX/Lens/MaxlatL.hs +++ b/src/Data/Geo/GPX/Lens/MaxlatL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.MaxlatL where -import Data.Geo.GPX.Latitude +import Data.Geo.GPX.Type.Latitude import Data.Lens.Common class MaxlatL a where diff --git a/src/Data/Geo/GPX/Lens/MaxlonL.hs b/src/Data/Geo/GPX/Lens/MaxlonL.hs --- a/src/Data/Geo/GPX/Lens/MaxlonL.hs +++ b/src/Data/Geo/GPX/Lens/MaxlonL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.MaxlonL where -import Data.Geo.GPX.Longitude +import Data.Geo.GPX.Type.Longitude import Data.Lens.Common class MaxlonL a where diff --git a/src/Data/Geo/GPX/Lens/MetadataL.hs b/src/Data/Geo/GPX/Lens/MetadataL.hs --- a/src/Data/Geo/GPX/Lens/MetadataL.hs +++ b/src/Data/Geo/GPX/Lens/MetadataL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.MetadataL where -import Data.Geo.GPX.Metadata +import Data.Geo.GPX.Type.Metadata import Data.Lens.Common class MetadataL a where diff --git a/src/Data/Geo/GPX/Lens/MinlatL.hs b/src/Data/Geo/GPX/Lens/MinlatL.hs --- a/src/Data/Geo/GPX/Lens/MinlatL.hs +++ b/src/Data/Geo/GPX/Lens/MinlatL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.MinlatL where -import Data.Geo.GPX.Latitude +import Data.Geo.GPX.Type.Latitude import Data.Lens.Common class MinlatL a where diff --git a/src/Data/Geo/GPX/Lens/MinlonL.hs b/src/Data/Geo/GPX/Lens/MinlonL.hs --- a/src/Data/Geo/GPX/Lens/MinlonL.hs +++ b/src/Data/Geo/GPX/Lens/MinlonL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.MinlonL where -import Data.Geo.GPX.Longitude +import Data.Geo.GPX.Type.Longitude import Data.Lens.Common class MinlonL a where diff --git a/src/Data/Geo/GPX/Lens/PtsL.hs b/src/Data/Geo/GPX/Lens/PtsL.hs --- a/src/Data/Geo/GPX/Lens/PtsL.hs +++ b/src/Data/Geo/GPX/Lens/PtsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.PtsL where -import Data.Geo.GPX.Pt +import Data.Geo.GPX.Type.Pt import Data.Lens.Common class PtsL a where diff --git a/src/Data/Geo/GPX/Lens/RteptsL.hs b/src/Data/Geo/GPX/Lens/RteptsL.hs --- a/src/Data/Geo/GPX/Lens/RteptsL.hs +++ b/src/Data/Geo/GPX/Lens/RteptsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.RteptsL where -import Data.Geo.GPX.Wpt +import Data.Geo.GPX.Type.Wpt import Data.Lens.Common class RteptsL a where diff --git a/src/Data/Geo/GPX/Lens/RtesL.hs b/src/Data/Geo/GPX/Lens/RtesL.hs --- a/src/Data/Geo/GPX/Lens/RtesL.hs +++ b/src/Data/Geo/GPX/Lens/RtesL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.RtesL where -import Data.Geo.GPX.Rte +import Data.Geo.GPX.Type.Rte import Data.Lens.Common class RtesL a where diff --git a/src/Data/Geo/GPX/Lens/TrkptsL.hs b/src/Data/Geo/GPX/Lens/TrkptsL.hs --- a/src/Data/Geo/GPX/Lens/TrkptsL.hs +++ b/src/Data/Geo/GPX/Lens/TrkptsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.TrkptsL where -import Data.Geo.GPX.Wpt +import Data.Geo.GPX.Type.Wpt import Data.Lens.Common class TrkptsL a where diff --git a/src/Data/Geo/GPX/Lens/TrksL.hs b/src/Data/Geo/GPX/Lens/TrksL.hs --- a/src/Data/Geo/GPX/Lens/TrksL.hs +++ b/src/Data/Geo/GPX/Lens/TrksL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.TrksL where -import Data.Geo.GPX.Trk +import Data.Geo.GPX.Type.Trk import Data.Lens.Common class TrksL a where diff --git a/src/Data/Geo/GPX/Lens/TrksegsL.hs b/src/Data/Geo/GPX/Lens/TrksegsL.hs --- a/src/Data/Geo/GPX/Lens/TrksegsL.hs +++ b/src/Data/Geo/GPX/Lens/TrksegsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.TrksegsL where -import Data.Geo.GPX.Trkseg +import Data.Geo.GPX.Type.Trkseg import Data.Lens.Common class TrksegsL a where diff --git a/src/Data/Geo/GPX/Lens/WptsL.hs b/src/Data/Geo/GPX/Lens/WptsL.hs --- a/src/Data/Geo/GPX/Lens/WptsL.hs +++ b/src/Data/Geo/GPX/Lens/WptsL.hs @@ -1,6 +1,6 @@ module Data.Geo.GPX.Lens.WptsL where -import Data.Geo.GPX.Wpt +import Data.Geo.GPX.Type.Wpt import Data.Lens.Common class WptsL a where diff --git a/src/Data/Geo/GPX/Link.hs b/src/Data/Geo/GPX/Link.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Link.hs +++ /dev/null @@ -1,43 +0,0 @@ --- | Complex Type: @linkType@ -module Data.Geo.GPX.Link( - Link -, link -) where - -import Data.Geo.GPX.Lens.HrefL -import Data.Geo.GPX.Lens.TextL -import Data.Geo.GPX.Lens.TypeL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Link = Link String (Maybe String) (Maybe String) - deriving (Eq, Ord) - -link :: - String -- ^ The href. - -> Maybe String -- ^ The text. - -> Maybe String -- ^ The type. - -> Link -link = - Link - -instance HrefL Link where - hrefL = - Lens $ \(Link href text typ) -> store (\href -> Link href text typ) href - -instance TextL Link where - textL = - Lens $ \(Link href text typ) -> store (\text -> Link href text typ) text - -instance TypeL Link where - typeL = - Lens $ \(Link href text typ) -> store (\typ -> Link href text typ) typ - -instance XmlPickler Link where - xpickle = - xpWrap (\(href, text, type') -> link href text type', \(Link href text type') -> (href, text, type')) (xpTriple - (xpAttr "href" xpText) - (xpOption (xpElem "text" xpText)) - (xpOption (xpElem "type" xpText))) - diff --git a/src/Data/Geo/GPX/Longitude.hs b/src/Data/Geo/GPX/Longitude.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Longitude.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - --- | Simple Type: @latitudeType@ -module Data.Geo.GPX.Longitude( - Longitude -, longitude -, runLongitude -) where - -import Data.Fixed -import Text.XML.HXT.Arrow.Pickle - -newtype Longitude = Longitude Double - deriving (Eq, Ord, Enum, Num, Fractional, Floating, Real, RealFrac, RealFloat) - -longitude :: - Double -- ^ The value which will be between -180 and 180 (values out of the range are truncated using a modulus operation). - -> Longitude -longitude n = - Longitude ((n + 180) `mod'` 360 - 180) - -runLongitude :: - Longitude - -> Double -runLongitude (Longitude d) = - d - -instance Show Longitude where - show (Longitude n) = show n - -instance XmlPickler Longitude where - xpickle = xpWrap (longitude, \(Longitude n) -> n) xpPrim - diff --git a/src/Data/Geo/GPX/Metadata.hs b/src/Data/Geo/GPX/Metadata.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Metadata.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} - --- | Complex Type: @metadataType@ -module Data.Geo.GPX.Metadata( - Metadata -, metadata -) where - -import Data.Geo.GPX.Person -import Data.Geo.GPX.Copyright -import Data.Geo.GPX.Link -import Data.Geo.GPX.Bounds -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Lens.NameL -import Data.Geo.GPX.Lens.DescL -import Data.Geo.GPX.Lens.AuthorL -import Data.Geo.GPX.Lens.CopyrightL -import Data.Geo.GPX.Lens.LinksL -import Data.Geo.GPX.Lens.TimeL -import Data.Geo.GPX.Lens.KeywordsL -import Data.Geo.GPX.Lens.BoundsL -import Data.Geo.GPX.Lens.ExtensionsL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle -import Text.XML.XSD.DateTime - -data Metadata = Metadata (Maybe String) (Maybe String) (Maybe Person) (Maybe Copyright) [Link] (Maybe DateTime) (Maybe String) (Maybe Bounds) (Maybe Extensions) - deriving Eq - -metadata :: - Maybe String -- ^ The name. - -> Maybe String -- ^ The desc. - -> Maybe Person -- ^ The author. - -> Maybe Copyright -- ^ The copyright. - -> [Link] -- ^ The links (link). - -> Maybe DateTime -- ^ The time. - -> Maybe String -- ^ The keywords. - -> Maybe Bounds -- ^ The bounds. - -> Maybe Extensions -- ^ The extensions - -> Metadata -metadata = - Metadata - -instance NameL Metadata where - nameL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\name -> Metadata name desc author copyright links time keywords bounds extensions) name - -instance DescL Metadata where - descL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\desc -> Metadata name desc author copyright links time keywords bounds extensions) desc - -instance AuthorL Metadata (Maybe Person) where - authorL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\author -> Metadata name desc author copyright links time keywords bounds extensions) author - -instance CopyrightL Metadata where - copyrightL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\copyright -> Metadata name desc author copyright links time keywords bounds extensions) copyright - -instance LinksL Metadata where - linksL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\links -> Metadata name desc author copyright links time keywords bounds extensions) links - -instance TimeL Metadata where - timeL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\time -> Metadata name desc author copyright links time keywords bounds extensions) time - -instance KeywordsL Metadata where - keywordsL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\keywords -> Metadata name desc author copyright links time keywords bounds extensions) keywords - -instance BoundsL Metadata where - boundsL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\bounds -> Metadata name desc author copyright links time keywords bounds extensions) bounds - -instance ExtensionsL Metadata where - extensionsL = - Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\extensions -> Metadata name desc author copyright links time keywords bounds extensions) extensions - -instance XmlPickler Metadata where - xpickle = - xpWrap (\(a, b, c, d, e, f, g, h, i) -> metadata a b c d e f g h i, \(Metadata a b c d e f g h i) -> (a, b, c, d, e, f, g, h, i)) (xp9Tuple - (xpOption (xpElem "name" xpText)) - (xpOption (xpElem "desc" xpText)) - (xpOption (xpElem "author" xpickle)) - (xpOption (xpElem "copyright" xpickle)) - (xpList (xpElem "link" xpickle)) - (xpOption (xpElem "time" (xpWrapMaybe (dateTime, show) xpText))) - (xpOption (xpElem "keywords" xpText)) - (xpOption (xpElem "bounds" xpickle)) - (xpOption (xpElem "extensions" xpickle))) - - diff --git a/src/Data/Geo/GPX/Person.hs b/src/Data/Geo/GPX/Person.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Person.hs +++ /dev/null @@ -1,45 +0,0 @@ --- | Complex Type: @personType@ -module Data.Geo.GPX.Person( - Person -, person -) where - -import Data.Geo.GPX.Email -import Data.Geo.GPX.Link -import Data.Geo.GPX.Lens.NameL -import Data.Geo.GPX.Lens.EmailL -import Data.Geo.GPX.Lens.LinkL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Person = Person (Maybe String) (Maybe Email) (Maybe Link) - deriving (Eq, Ord) - -person :: - Maybe String -- ^ The name. - -> Maybe Email -- ^ The email. - -> Maybe Link -- ^ The link. - -> Person -person = - Person - -instance NameL Person where - nameL = - Lens $ \(Person name email link) -> store (\name -> Person name email link) name - -instance EmailL Person where - emailL = - Lens $ \(Person name email link) -> store (\email -> Person name email link) email - -instance LinkL Person where - linkL = - Lens $ \(Person name email link) -> store (\link -> Person name email link) link - -instance XmlPickler Person where - xpickle = - xpWrap (\(name', email', link') -> person name' email' link', \(Person name' email' link') -> (name', email', link')) (xpTriple - (xpOption (xpElem "name" xpText)) - (xpOption (xpElem "email" xpickle)) - (xpOption (xpElem "link" xpickle))) - diff --git a/src/Data/Geo/GPX/Pt.hs b/src/Data/Geo/GPX/Pt.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Pt.hs +++ /dev/null @@ -1,54 +0,0 @@ --- | Complex Type: @ptType@ -module Data.Geo.GPX.Pt( - Pt -, pt -) where - -import Data.Geo.GPX.Latitude -import Data.Geo.GPX.Longitude -import Data.Geo.GPX.Lens.LatL -import Data.Geo.GPX.Lens.LonL -import Data.Geo.GPX.Lens.EleL -import Data.Geo.GPX.Lens.TimeL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle -import Text.XML.XSD.DateTime - -data Pt = Pt Latitude Longitude (Maybe Double) (Maybe DateTime) - deriving (Eq, Ord) - -pt :: - Latitude -- ^ The lat. - -> Longitude -- ^ The lon. - -> Maybe Double -- ^ The ele. - -> Maybe DateTime -- ^ The time. - -> Pt -pt = - Pt - -instance LatL Pt where - latL = - Lens $ \(Pt lat lon ele time) -> store (\lat -> Pt lat lon ele time) lat - -instance LonL Pt where - lonL = - Lens $ \(Pt lat lon ele time) -> store (\lon -> Pt lat lon ele time) lon - -instance EleL Pt where - eleL = - Lens $ \(Pt lat lon ele time) -> store (\ele -> Pt lat lon ele time) ele - -instance TimeL Pt where - timeL = - Lens $ \(Pt lat lon ele time) -> store (\time -> Pt lat lon ele time) time - -instance XmlPickler Pt where - xpickle = - xpWrap (\(lat', lon', ele', time') -> pt lat' lon' ele' time', - \(Pt lat' lon' ele' time') -> (lat', lon', ele', time')) (xp4Tuple - (xpAttr "lat" xpickle) - (xpAttr "lon" xpickle) - (xpOption (xpElem "ele" xpPrim)) - (xpOption (xpElem "time" (xpWrapMaybe (dateTime, show) xpText)))) - diff --git a/src/Data/Geo/GPX/Ptseg.hs b/src/Data/Geo/GPX/Ptseg.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Ptseg.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | Complex Type: @ptsegType@ -module Data.Geo.GPX.Ptseg( - Ptseg -, ptseg -, runPtseg -) where - -import Data.Geo.GPX.Pt -import Text.XML.HXT.Arrow.Pickle - -newtype Ptseg = Ptseg [Pt] - deriving (Eq, Ord) - -ptseg :: - [Pt] -- ^ The points (pt). - -> Ptseg -ptseg = - Ptseg - -runPtseg :: - Ptseg - -> [Pt] -runPtseg (Ptseg p) = - p - -instance XmlPickler Ptseg where - xpickle = - xpWrap (ptseg, \(Ptseg k) -> k) (xpList (xpElem "pt" xpickle)) - diff --git a/src/Data/Geo/GPX/Rte.hs b/src/Data/Geo/GPX/Rte.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Rte.hs +++ /dev/null @@ -1,88 +0,0 @@ --- | Complex Type: @rteType@ -module Data.Geo.GPX.Rte( - Rte -, rte -) where - -import Data.Geo.GPX.Wpt -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Link -import Data.Geo.GPX.Lens.NameL -import Data.Geo.GPX.Lens.CmtL -import Data.Geo.GPX.Lens.DescL -import Data.Geo.GPX.Lens.SrcL -import Data.Geo.GPX.Lens.LinksL -import Data.Geo.GPX.Lens.NumberL -import Data.Geo.GPX.Lens.TypeL -import Data.Geo.GPX.Lens.ExtensionsL -import Data.Geo.GPX.Lens.RteptsL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Rte = Rte (Maybe String) (Maybe String) (Maybe String) (Maybe String) [Link] (Maybe Int) (Maybe String) (Maybe Extensions) [Wpt] - deriving Eq - -rte :: - Maybe String -- ^ The name. - -> Maybe String -- ^ The cmt. - -> Maybe String -- ^ The desc. - -> Maybe String -- ^ The src. - -> [Link] -- ^ The links (link). - -> Maybe Int -- ^ The number. - -> Maybe String -- ^ The type. - -> Maybe Extensions -- ^ The extensions. - -> [Wpt] -- ^ The route points (rtept). - -> Rte -rte a b c d e f = - Rte a b c d e (fmap abs f) - -instance NameL Rte where - nameL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\name -> Rte name cmt desc src links number typ extensions rtepts) name - -instance CmtL Rte where - cmtL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\cmt -> Rte name cmt desc src links number typ extensions rtepts) cmt - -instance DescL Rte where - descL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\desc -> Rte name cmt desc src links number typ extensions rtepts) desc - -instance SrcL Rte where - srcL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\src -> Rte name cmt desc src links number typ extensions rtepts) src - -instance LinksL Rte where - linksL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\links -> Rte name cmt desc src links number typ extensions rtepts) links - -instance NumberL Rte where - numberL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\number -> Rte name cmt desc src links number typ extensions rtepts) number - -instance TypeL Rte where - typeL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\typ -> Rte name cmt desc src links number typ extensions rtepts) typ - -instance ExtensionsL Rte where - extensionsL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\extensions -> Rte name cmt desc src links number typ extensions rtepts) extensions - -instance RteptsL Rte where - rteptsL = - Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\rtepts -> Rte name cmt desc src links number typ extensions rtepts) rtepts - -instance XmlPickler Rte where - xpickle = - xpWrap (\(a, b, c, d, e, f, g, h, i) -> rte a b c d e f g h i, \(Rte a b c d e f g h i) -> (a, b, c, d, e, f, g, h, i)) (xp9Tuple - (xpOption (xpElem "name" xpText)) - (xpOption (xpElem "cmt" xpText)) - (xpOption (xpElem "desc" xpText)) - (xpOption (xpElem "src" xpText)) - (xpList (xpElem "link" xpickle)) - (xpOption (xpElem "number" xpPrim)) - (xpOption (xpElem "type" xpText)) - (xpOption (xpElem "extensions" xpickle)) - (xpList (xpElem "rtept" xpickle))) - diff --git a/src/Data/Geo/GPX/Trk.hs b/src/Data/Geo/GPX/Trk.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Trk.hs +++ /dev/null @@ -1,88 +0,0 @@ --- | Complex Type: @trkType@ -module Data.Geo.GPX.Trk( - Trk -, trk -) where - -import Data.Geo.GPX.Trkseg -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Link -import Data.Geo.GPX.Lens.NameL -import Data.Geo.GPX.Lens.CmtL -import Data.Geo.GPX.Lens.DescL -import Data.Geo.GPX.Lens.SrcL -import Data.Geo.GPX.Lens.LinksL -import Data.Geo.GPX.Lens.NumberL -import Data.Geo.GPX.Lens.TypeL -import Data.Geo.GPX.Lens.ExtensionsL -import Data.Geo.GPX.Lens.TrksegsL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Trk = Trk (Maybe String) (Maybe String) (Maybe String) (Maybe String) [Link] (Maybe Int) (Maybe String) (Maybe Extensions) [Trkseg] - deriving Eq - -trk :: - Maybe String -- ^ The name. - -> Maybe String -- ^ The cmt. - -> Maybe String -- ^ The desc. - -> Maybe String -- ^ The src. - -> [Link] -- ^ The links (link). - -> Maybe Int -- ^ The number. - -> Maybe String -- ^ The type. - -> Maybe Extensions -- ^ The extensions. - -> [Trkseg] -- ^ The track segments (trkseg). - -> Trk -trk a b c d e f = - Trk a b c d e (fmap abs f) - -instance NameL Trk where - nameL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\name -> Trk name cmt desc src links number typ extensions trksegs) name - -instance CmtL Trk where - cmtL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\cmt -> Trk name cmt desc src links number typ extensions trksegs) cmt - -instance DescL Trk where - descL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\desc -> Trk name cmt desc src links number typ extensions trksegs) desc - -instance SrcL Trk where - srcL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\src -> Trk name cmt desc src links number typ extensions trksegs) src - -instance LinksL Trk where - linksL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\links -> Trk name cmt desc src links number typ extensions trksegs) links - -instance NumberL Trk where - numberL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\number -> Trk name cmt desc src links number typ extensions trksegs) number - -instance TypeL Trk where - typeL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\typ -> Trk name cmt desc src links number typ extensions trksegs) typ - -instance ExtensionsL Trk where - extensionsL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\extensions -> Trk name cmt desc src links number typ extensions trksegs) extensions - -instance TrksegsL Trk where - trksegsL = - Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\trksegs -> Trk name cmt desc src links number typ extensions trksegs) trksegs - -instance XmlPickler Trk where - xpickle = - xpWrap (\(a, b, c, d, e, f, g, h, i) -> trk a b c d e f g h i, \(Trk a b c d e f g h i) -> (a, b, c, d, e, f, g, h, i)) (xp9Tuple - (xpOption (xpElem "name" xpText)) - (xpOption (xpElem "cmt" xpText)) - (xpOption (xpElem "desc" xpText)) - (xpOption (xpElem "src" xpText)) - (xpList (xpElem "link" xpickle)) - (xpOption (xpElem "number" xpPrim)) - (xpOption (xpElem "type" xpText)) - (xpOption (xpElem "extensions" xpickle)) - (xpList (xpElem "trkseg" xpickle))) - diff --git a/src/Data/Geo/GPX/Trkseg.hs b/src/Data/Geo/GPX/Trkseg.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Trkseg.hs +++ /dev/null @@ -1,38 +0,0 @@ --- | Complex Type: @trksegType@ -module Data.Geo.GPX.Trkseg( - Trkseg, - trkseg -) where - -import Data.Geo.GPX.Wpt -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Lens.TrkptsL -import Data.Geo.GPX.Lens.ExtensionsL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle - -data Trkseg = Trkseg [Wpt] (Maybe Extensions) - deriving Eq - -trkseg :: - [Wpt] -- ^ The track points (trkpt). - -> Maybe Extensions -- ^ The extensions. - -> Trkseg -trkseg = - Trkseg - -instance TrkptsL Trkseg where - trkptsL = - Lens $ \(Trkseg trkpts extensions) -> store (\trkpts -> Trkseg trkpts extensions) trkpts - -instance ExtensionsL Trkseg where - extensionsL = - Lens $ \(Trkseg trkpts extensions) -> store (\extensions -> Trkseg trkpts extensions) extensions - -instance XmlPickler Trkseg where - xpickle = - xpWrap (uncurry trkseg, \(Trkseg trkpt' extensions') -> (trkpt', extensions')) (xpPair - (xpList (xpElem "trkpt" xpickle)) - (xpOption (xpElem "extensions" xpickle))) - diff --git a/src/Data/Geo/GPX/Type.hs b/src/Data/Geo/GPX/Type.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type.hs @@ -0,0 +1,43 @@ +-- | GPX 1.1 Schema +module Data.Geo.GPX.Type( + module Data.Geo.GPX.Type.DgpsStation +, module Data.Geo.GPX.Type.Fix +, module Data.Geo.GPX.Type.Degrees +, module Data.Geo.GPX.Type.Longitude +, module Data.Geo.GPX.Type.Latitude +, module Data.Geo.GPX.Type.Bounds +, module Data.Geo.GPX.Type.Extensions +, module Data.Geo.GPX.Type.Pt +, module Data.Geo.GPX.Type.Ptseg +, module Data.Geo.GPX.Type.Email +, module Data.Geo.GPX.Type.Link +, module Data.Geo.GPX.Type.Person +, module Data.Geo.GPX.Type.Copyright +, module Data.Geo.GPX.Type.Wpt +, module Data.Geo.GPX.Type.Trkseg +, module Data.Geo.GPX.Type.Trk +, module Data.Geo.GPX.Type.Rte +, module Data.Geo.GPX.Type.Metadata +, module Data.Geo.GPX.Type.Gpx +) where + +import Data.Geo.GPX.Type.DgpsStation +import Data.Geo.GPX.Type.Fix +import Data.Geo.GPX.Type.Degrees +import Data.Geo.GPX.Type.Longitude +import Data.Geo.GPX.Type.Latitude +import Data.Geo.GPX.Type.Bounds +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Type.Pt +import Data.Geo.GPX.Type.Ptseg +import Data.Geo.GPX.Type.Email +import Data.Geo.GPX.Type.Link +import Data.Geo.GPX.Type.Person +import Data.Geo.GPX.Type.Copyright +import Data.Geo.GPX.Type.Wpt +import Data.Geo.GPX.Type.Trkseg +import Data.Geo.GPX.Type.Trk +import Data.Geo.GPX.Type.Rte +import Data.Geo.GPX.Type.Metadata +import Data.Geo.GPX.Type.Gpx + diff --git a/src/Data/Geo/GPX/Type/Bounds.hs b/src/Data/Geo/GPX/Type/Bounds.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Bounds.hs @@ -0,0 +1,51 @@ +-- | Complex Type: @boundsType@ +module Data.Geo.GPX.Type.Bounds( + Bounds +, bounds +) where + +import Data.Geo.GPX.Type.Latitude +import Data.Geo.GPX.Type.Longitude +import Data.Geo.GPX.Lens.MinlatL +import Data.Geo.GPX.Lens.MaxlatL +import Data.Geo.GPX.Lens.MinlonL +import Data.Geo.GPX.Lens.MaxlonL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Bounds = Bounds (Latitude, Longitude) (Latitude, Longitude) + deriving (Eq, Ord) + +bounds :: + (Latitude, Longitude) -- ^ The minimum latitude and longitude. + -> (Latitude, Longitude) -- ^ The maximum latitude and longitude. + -> Bounds +bounds = + Bounds + +instance MinlatL Bounds where + minlatL = + Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\minlat -> Bounds (minlat, minlon) (maxlat, maxlon)) minlat + +instance MinlonL Bounds where + minlonL = + Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\minlon -> Bounds (minlat, minlon) (maxlat, maxlon)) minlon + +instance MaxlatL Bounds where + maxlatL = + Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\maxlat -> Bounds (minlat, minlon) (maxlat, maxlon)) maxlat + +instance MaxlonL Bounds where + maxlonL = + Lens $ \(Bounds (minlat, minlon) (maxlat, maxlon)) -> store (\maxlon -> Bounds (minlat, minlon) (maxlat, maxlon)) maxlon + +instance XmlPickler Bounds where + xpickle = + xpWrap (\(minlat', minlon', maxlat', maxlon') -> bounds (minlat', minlon') (maxlat', maxlon'), + \(Bounds (minlat', minlon') (maxlat', maxlon')) -> (minlat', minlon', maxlat', maxlon')) (xp4Tuple + (xpAttr "minlat" xpickle) + (xpAttr "minlon" xpickle) + (xpAttr "maxlat" xpickle) + (xpAttr "maxlon" xpickle)) + diff --git a/src/Data/Geo/GPX/Type/Copyright.hs b/src/Data/Geo/GPX/Type/Copyright.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Copyright.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} + +-- | Complex Type: @copyrightType@ +module Data.Geo.GPX.Type.Copyright( + Copyright +, copyright +) where + +import Data.Geo.GPX.Lens.AuthorL +import Data.Geo.GPX.Lens.YearL +import Data.Geo.GPX.Lens.LicenseL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Copyright = Copyright String (Maybe String) (Maybe String) + deriving (Eq, Ord) + +copyright + :: String -- ^ The author. + -> Maybe String -- ^ The year. + -> Maybe String -- ^ The license. + -> Copyright +copyright = + Copyright + +instance AuthorL Copyright String where + authorL = + Lens $ \(Copyright author year license) -> store (\author -> Copyright author year license) author + +instance YearL Copyright where + yearL = + Lens $ \(Copyright author year license) -> store (\year -> Copyright author year license) year + +instance LicenseL Copyright where + licenseL = + Lens $ \(Copyright author year license) -> store (\license -> Copyright author year license) license + +instance XmlPickler Copyright where + xpickle = + xpWrap (\(author', year', license') -> copyright author' year' license', \(Copyright author' year' license') -> (author', year', license')) (xpTriple + (xpAttr "author" xpText) + (xpOption (xpElem "year" xpText)) + (xpOption (xpElem "license" xpText))) diff --git a/src/Data/Geo/GPX/Type/Degrees.hs b/src/Data/Geo/GPX/Type/Degrees.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Degrees.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +-- | Simple Type: @degreesType@ +module Data.Geo.GPX.Type.Degrees( + Degrees +, degrees +, runDegrees +) where + + +import Data.Fixed +import Text.XML.HXT.Arrow.Pickle +import Control.Newtype + +newtype Degrees = Degrees Double + deriving (Eq, Ord, Show) + +degrees :: + Double -- ^ The value which will be between 0 and 360 (values out of the range are truncated using a modulus operation). + -> Degrees +degrees n = + Degrees (n `mod'` 360) + +runDegrees :: + Degrees + -> Double +runDegrees (Degrees d) = + d + +instance XmlPickler Degrees where + xpickle = + xpWrap (degrees, \(Degrees n) -> n) xpPrim + +instance Newtype Degrees Double where + pack = + degrees + unpack (Degrees x) = + x + diff --git a/src/Data/Geo/GPX/Type/DgpsStation.hs b/src/Data/Geo/GPX/Type/DgpsStation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/DgpsStation.hs @@ -0,0 +1,33 @@ +-- | Simple Type: @dgpsStationType@ +module Data.Geo.GPX.Type.DgpsStation( + DgpsStation +, dgpsStation +, runDgpsStation +) where + +import Data.Ix +import Text.XML.HXT.Arrow.Pickle + +newtype DgpsStation = DgpsStation Int + deriving (Eq, Ord) + +dgpsStation :: + Int -- ^ The value between 0 and 1023. + -> Maybe DgpsStation +dgpsStation n = + if inRange (0, 1023) n + then + Just (DgpsStation n) + else + Nothing + +runDgpsStation :: + DgpsStation + -> Int +runDgpsStation (DgpsStation i) = + i + +instance XmlPickler DgpsStation where + xpickle = + xpWrapMaybe (dgpsStation, \(DgpsStation n) -> n) xpickle + diff --git a/src/Data/Geo/GPX/Type/Email.hs b/src/Data/Geo/GPX/Type/Email.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Email.hs @@ -0,0 +1,36 @@ +-- | Complex Type: @emailType@ +module Data.Geo.GPX.Type.Email( + Email +, email +) where + +import Data.Geo.GPX.Lens.IdL +import Data.Geo.GPX.Lens.DomainL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Email = Email String String + deriving (Eq, Ord) + +email :: + String -- ^ The id. + -> String -- ^ The domain. + -> Email +email = + Email + +instance IdL Email where + idL = + Lens $ \(Email id domain) -> store (\id -> Email id domain) id + +instance DomainL Email where + domainL = + Lens $ \(Email id domain) -> store (\domain -> Email id domain) domain + +instance XmlPickler Email where + xpickle = + xpWrap (uncurry email, \(Email id' domain') -> (id', domain')) + (xpPair (xpAttr "id" xpText) (xpAttr "domain" xpText)) + + diff --git a/src/Data/Geo/GPX/Type/Extensions.hs b/src/Data/Geo/GPX/Type/Extensions.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Extensions.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +-- | Complex Type: @extensionsType@ +module Data.Geo.GPX.Type.Extensions( + Extensions +, extensions +, runExtensions +) where + +import Text.XML.HXT.Arrow.Pickle +import Text.XML.HXT.DOM.TypeDefs +import Control.Newtype + +newtype Extensions = Extensions XmlTrees + deriving (Eq, Show) + +extensions :: + XmlTrees + -> Extensions +extensions = + Extensions + +runExtensions :: + Extensions + -> XmlTrees +runExtensions (Extensions t) = + t + +instance XmlPickler Extensions where + xpickle = + xpWrap (Extensions, \(Extensions t) -> t) xpTrees + +instance Newtype Extensions XmlTrees where + pack = + Extensions + unpack (Extensions x) = + x + diff --git a/src/Data/Geo/GPX/Type/Fix.hs b/src/Data/Geo/GPX/Type/Fix.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Fix.hs @@ -0,0 +1,76 @@ +-- | Simple Type: @fixType@ +module Data.Geo.GPX.Type.Fix( + Fix +, foldFix +, none +, twod +, threed +, dgps +, pps +, fix +) where + +import Text.XML.HXT.Arrow.Pickle + +data Fix = None | Twod | Threed | Dgps | Pps + deriving (Eq, Ord, Show, Enum) + +-- | The catamorphism for @Fix@. +foldFix :: + a -- ^ The value if @none@. + -> a -- ^ The value if @twod@. + -> a -- ^ The value if @threed@. + -> a -- ^ The value if @dgps@. + -> a -- ^ The value if @pps@. + -> Fix -- ^ The value to fold. + -> a +foldFix n _ _ _ _ None = n +foldFix _ t _ _ _ Twod = t +foldFix _ _ t _ _ Threed = t +foldFix _ _ _ d _ Dgps = d +foldFix _ _ _ _ p Pps = p + +-- | Construct a @Fix@ with a value of @none@. +none :: + Fix +none = + None + +-- | Construct a @Fix@ with a value of @2d@. +twod :: Fix +twod = Twod + +-- | Construct a @Fix@ with a value of @3d@. +threed :: + Fix +threed = + Threed + +-- | Construct a @Fix@ with a value of @dgps@. +dgps :: + Fix +dgps = + Dgps + +-- | Construct a @Fix@ with a value of @pps@. +pps :: + Fix +pps = + Pps + +-- | Construct a @Fix@ using a string with a value of @["none", "2d", "3d", "dgps", "pps"]@. +fix :: + String -- ^ The string value to construct a @Fix@ with. + -> Maybe Fix +fix "none" = Just none +fix "2d"= Just twod +fix "3d" = Just threed +fix "dgps" = Just dgps +fix "pps" = Just pps +fix _ = Nothing + +instance XmlPickler Fix where + xpickle = + xpWrapMaybe (fix, show) xpText + + diff --git a/src/Data/Geo/GPX/Type/Gpx.hs b/src/Data/Geo/GPX/Type/Gpx.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Gpx.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} + +-- | Complex Type: @gpxType@ +module Data.Geo.GPX.Type.Gpx( + Gpx +, GpxP(..) +) where + +import Data.Geo.GPX.Type.Metadata +import Data.Geo.GPX.Type.Wpt +import Data.Geo.GPX.Type.Rte +import Data.Geo.GPX.Type.Trk +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Lens.VersionL +import Data.Geo.GPX.Lens.CreatorL +import Data.Geo.GPX.Lens.MetadataL +import Data.Geo.GPX.Lens.WptsL +import Data.Geo.GPX.Lens.RtesL +import Data.Geo.GPX.Lens.TrksL +import Data.Geo.GPX.Lens.ExtensionsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Gpx = Gpx String String (Maybe Metadata) [Wpt] [Rte] [Trk] (Maybe Extensions) + deriving Eq + +class GpxP g where + gpx :: + String -- ^ The version. + -> String -- ^ The creator. + -> Maybe Metadata -- ^ The metadata. + -> [Wpt] -- ^ The waypoints (wpt). + -> [Rte] -- ^ The routes (rte). + -> [Trk] -- ^ The tracks (trk). + -> Maybe Extensions -- ^ The extensions. + -> g + +instance GpxP Gpx where + gpx = + Gpx + +instance VersionL Gpx where + versionL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\version -> Gpx version creator metadata wpts rtes trks extensions) version + +instance CreatorL Gpx where + creatorL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\creator -> Gpx version creator metadata wpts rtes trks extensions) creator + +instance MetadataL Gpx where + metadataL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\metadata -> Gpx version creator metadata wpts rtes trks extensions) metadata + +instance WptsL Gpx where + wptsL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\wpts -> Gpx version creator metadata wpts rtes trks extensions) wpts + +instance RtesL Gpx where + rtesL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\rtes -> Gpx version creator metadata wpts rtes trks extensions) rtes + +instance TrksL Gpx where + trksL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\trks -> Gpx version creator metadata wpts rtes trks extensions) trks + +instance ExtensionsL Gpx where + extensionsL = + Lens $ \(Gpx version creator metadata wpts rtes trks extensions) -> store (\extensions -> Gpx version creator metadata wpts rtes trks extensions) extensions + +instance XmlPickler Gpx where + xpickle = + xpWrap (\(version', creator', metadata', wpt', rte', trk', extensions') -> gpx version' creator' metadata' wpt' rte' trk' extensions', + \(Gpx version' creator' metadata' wpt' rte' trk' extensions') -> (version', creator', metadata', wpt', rte', trk', extensions')) (xp7Tuple + (xpAttr "version" xpText) + (xpAttr "creator" xpText) + (xpOption (xpElem "metadata" xpickle)) + (xpList (xpElem "wpt" xpickle)) + (xpList (xpElem "rte" xpickle)) + (xpList (xpElem "trk" xpickle)) + (xpOption (xpElem "extensions" xpickle))) + diff --git a/src/Data/Geo/GPX/Type/Latitude.hs b/src/Data/Geo/GPX/Type/Latitude.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Latitude.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses #-} + +-- | Simple Type: @latitudeType@ +module Data.Geo.GPX.Type.Latitude( + Latitude +, latitude +, runLatitude +) where + +import Data.Fixed +import Text.XML.HXT.Arrow.Pickle +import Control.Newtype + +newtype Latitude = Latitude Double + deriving (Eq, Ord, Enum, Num, Fractional, Floating, Real, RealFrac, RealFloat) + +latitude :: + Double -- ^ The value which will be between -90 and 90 (values out of the range are truncated using a modulus operation). + -> Latitude +latitude n = + Latitude ((n + 90) `mod'` 180 - 90) + +runLatitude :: + Latitude + -> Double +runLatitude (Latitude d) = + d + +instance Show Latitude where + show (Latitude n) = show n + +instance XmlPickler Latitude where + xpickle = xpWrap (latitude, \(Latitude n) -> n) xpPrim + +instance Newtype Latitude Double where + pack = + latitude + unpack (Latitude x) = + x + diff --git a/src/Data/Geo/GPX/Type/Link.hs b/src/Data/Geo/GPX/Type/Link.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Link.hs @@ -0,0 +1,43 @@ +-- | Complex Type: @linkType@ +module Data.Geo.GPX.Type.Link( + Link +, link +) where + +import Data.Geo.GPX.Lens.HrefL +import Data.Geo.GPX.Lens.TextL +import Data.Geo.GPX.Lens.TypeL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Link = Link String (Maybe String) (Maybe String) + deriving (Eq, Ord) + +link :: + String -- ^ The href. + -> Maybe String -- ^ The text. + -> Maybe String -- ^ The type. + -> Link +link = + Link + +instance HrefL Link where + hrefL = + Lens $ \(Link href text typ) -> store (\href -> Link href text typ) href + +instance TextL Link where + textL = + Lens $ \(Link href text typ) -> store (\text -> Link href text typ) text + +instance TypeL Link where + typeL = + Lens $ \(Link href text typ) -> store (\typ -> Link href text typ) typ + +instance XmlPickler Link where + xpickle = + xpWrap (\(href, text, type') -> link href text type', \(Link href text type') -> (href, text, type')) (xpTriple + (xpAttr "href" xpText) + (xpOption (xpElem "text" xpText)) + (xpOption (xpElem "type" xpText))) + diff --git a/src/Data/Geo/GPX/Type/Longitude.hs b/src/Data/Geo/GPX/Type/Longitude.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Longitude.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses #-} + +-- | Simple Type: @latitudeType@ +module Data.Geo.GPX.Type.Longitude( + Longitude +, longitude +, runLongitude +) where + +import Data.Fixed +import Text.XML.HXT.Arrow.Pickle +import Control.Newtype + +newtype Longitude = Longitude Double + deriving (Eq, Ord, Enum, Num, Fractional, Floating, Real, RealFrac, RealFloat) + +longitude :: + Double -- ^ The value which will be between -180 and 180 (values out of the range are truncated using a modulus operation). + -> Longitude +longitude n = + Longitude ((n + 180) `mod'` 360 - 180) + +runLongitude :: + Longitude + -> Double +runLongitude (Longitude d) = + d + +instance Show Longitude where + show (Longitude n) = show n + +instance XmlPickler Longitude where + xpickle = xpWrap (longitude, \(Longitude n) -> n) xpPrim + +instance Newtype Longitude Double where + pack = + longitude + unpack (Longitude x) = + x + diff --git a/src/Data/Geo/GPX/Type/Metadata.hs b/src/Data/Geo/GPX/Type/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Metadata.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} + +-- | Complex Type: @metadataType@ +module Data.Geo.GPX.Type.Metadata( + Metadata +, metadata +) where + +import Data.Geo.GPX.Type.Person +import Data.Geo.GPX.Type.Copyright +import Data.Geo.GPX.Type.Link +import Data.Geo.GPX.Type.Bounds +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Lens.NameL +import Data.Geo.GPX.Lens.DescL +import Data.Geo.GPX.Lens.AuthorL +import Data.Geo.GPX.Lens.CopyrightL +import Data.Geo.GPX.Lens.LinksL +import Data.Geo.GPX.Lens.TimeL +import Data.Geo.GPX.Lens.KeywordsL +import Data.Geo.GPX.Lens.BoundsL +import Data.Geo.GPX.Lens.ExtensionsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle +import Text.XML.XSD.DateTime + +data Metadata = Metadata (Maybe String) (Maybe String) (Maybe Person) (Maybe Copyright) [Link] (Maybe DateTime) (Maybe String) (Maybe Bounds) (Maybe Extensions) + deriving Eq + +metadata :: + Maybe String -- ^ The name. + -> Maybe String -- ^ The desc. + -> Maybe Person -- ^ The author. + -> Maybe Copyright -- ^ The copyright. + -> [Link] -- ^ The links (link). + -> Maybe DateTime -- ^ The time. + -> Maybe String -- ^ The keywords. + -> Maybe Bounds -- ^ The bounds. + -> Maybe Extensions -- ^ The extensions + -> Metadata +metadata = + Metadata + +instance NameL Metadata where + nameL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\name -> Metadata name desc author copyright links time keywords bounds extensions) name + +instance DescL Metadata where + descL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\desc -> Metadata name desc author copyright links time keywords bounds extensions) desc + +instance AuthorL Metadata (Maybe Person) where + authorL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\author -> Metadata name desc author copyright links time keywords bounds extensions) author + +instance CopyrightL Metadata where + copyrightL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\copyright -> Metadata name desc author copyright links time keywords bounds extensions) copyright + +instance LinksL Metadata where + linksL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\links -> Metadata name desc author copyright links time keywords bounds extensions) links + +instance TimeL Metadata where + timeL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\time -> Metadata name desc author copyright links time keywords bounds extensions) time + +instance KeywordsL Metadata where + keywordsL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\keywords -> Metadata name desc author copyright links time keywords bounds extensions) keywords + +instance BoundsL Metadata where + boundsL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\bounds -> Metadata name desc author copyright links time keywords bounds extensions) bounds + +instance ExtensionsL Metadata where + extensionsL = + Lens $ \(Metadata name desc author copyright links time keywords bounds extensions) -> store (\extensions -> Metadata name desc author copyright links time keywords bounds extensions) extensions + +instance XmlPickler Metadata where + xpickle = + xpWrap (\(a, b, c, d, e, f, g, h, i) -> metadata a b c d e f g h i, \(Metadata a b c d e f g h i) -> (a, b, c, d, e, f, g, h, i)) (xp9Tuple + (xpOption (xpElem "name" xpText)) + (xpOption (xpElem "desc" xpText)) + (xpOption (xpElem "author" xpickle)) + (xpOption (xpElem "copyright" xpickle)) + (xpList (xpElem "link" xpickle)) + (xpOption (xpElem "time" (xpWrapMaybe (dateTime, show) xpText))) + (xpOption (xpElem "keywords" xpText)) + (xpOption (xpElem "bounds" xpickle)) + (xpOption (xpElem "extensions" xpickle))) + + diff --git a/src/Data/Geo/GPX/Type/Person.hs b/src/Data/Geo/GPX/Type/Person.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Person.hs @@ -0,0 +1,45 @@ +-- | Complex Type: @personType@ +module Data.Geo.GPX.Type.Person( + Person +, person +) where + +import Data.Geo.GPX.Type.Email +import Data.Geo.GPX.Type.Link +import Data.Geo.GPX.Lens.NameL +import Data.Geo.GPX.Lens.EmailL +import Data.Geo.GPX.Lens.LinkL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Person = Person (Maybe String) (Maybe Email) (Maybe Link) + deriving (Eq, Ord) + +person :: + Maybe String -- ^ The name. + -> Maybe Email -- ^ The email. + -> Maybe Link -- ^ The link. + -> Person +person = + Person + +instance NameL Person where + nameL = + Lens $ \(Person name email link) -> store (\name -> Person name email link) name + +instance EmailL Person where + emailL = + Lens $ \(Person name email link) -> store (\email -> Person name email link) email + +instance LinkL Person where + linkL = + Lens $ \(Person name email link) -> store (\link -> Person name email link) link + +instance XmlPickler Person where + xpickle = + xpWrap (\(name', email', link') -> person name' email' link', \(Person name' email' link') -> (name', email', link')) (xpTriple + (xpOption (xpElem "name" xpText)) + (xpOption (xpElem "email" xpickle)) + (xpOption (xpElem "link" xpickle))) + diff --git a/src/Data/Geo/GPX/Type/Pt.hs b/src/Data/Geo/GPX/Type/Pt.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Pt.hs @@ -0,0 +1,54 @@ +-- | Complex Type: @ptType@ +module Data.Geo.GPX.Type.Pt( + Pt +, pt +) where + +import Data.Geo.GPX.Type.Latitude +import Data.Geo.GPX.Type.Longitude +import Data.Geo.GPX.Lens.LatL +import Data.Geo.GPX.Lens.LonL +import Data.Geo.GPX.Lens.EleL +import Data.Geo.GPX.Lens.TimeL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle +import Text.XML.XSD.DateTime + +data Pt = Pt Latitude Longitude (Maybe Double) (Maybe DateTime) + deriving (Eq, Ord) + +pt :: + Latitude -- ^ The lat. + -> Longitude -- ^ The lon. + -> Maybe Double -- ^ The ele. + -> Maybe DateTime -- ^ The time. + -> Pt +pt = + Pt + +instance LatL Pt where + latL = + Lens $ \(Pt lat lon ele time) -> store (\lat -> Pt lat lon ele time) lat + +instance LonL Pt where + lonL = + Lens $ \(Pt lat lon ele time) -> store (\lon -> Pt lat lon ele time) lon + +instance EleL Pt where + eleL = + Lens $ \(Pt lat lon ele time) -> store (\ele -> Pt lat lon ele time) ele + +instance TimeL Pt where + timeL = + Lens $ \(Pt lat lon ele time) -> store (\time -> Pt lat lon ele time) time + +instance XmlPickler Pt where + xpickle = + xpWrap (\(lat', lon', ele', time') -> pt lat' lon' ele' time', + \(Pt lat' lon' ele' time') -> (lat', lon', ele', time')) (xp4Tuple + (xpAttr "lat" xpickle) + (xpAttr "lon" xpickle) + (xpOption (xpElem "ele" xpPrim)) + (xpOption (xpElem "time" (xpWrapMaybe (dateTime, show) xpText)))) + diff --git a/src/Data/Geo/GPX/Type/Ptseg.hs b/src/Data/Geo/GPX/Type/Ptseg.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Ptseg.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +-- | Complex Type: @ptsegType@ +module Data.Geo.GPX.Type.Ptseg( + Ptseg +, ptseg +, runPtseg +) where + +import Data.Geo.GPX.Type.Pt +import Text.XML.HXT.Arrow.Pickle +import Control.Newtype + +newtype Ptseg = Ptseg [Pt] + deriving (Eq, Ord) + +ptseg :: + [Pt] -- ^ The points (pt). + -> Ptseg +ptseg = + Ptseg + +runPtseg :: + Ptseg + -> [Pt] +runPtseg (Ptseg p) = + p + +instance XmlPickler Ptseg where + xpickle = + xpWrap (ptseg, \(Ptseg k) -> k) (xpList (xpElem "pt" xpickle)) + +instance Newtype Ptseg [Pt] where + pack = + Ptseg + unpack (Ptseg x) = + x + diff --git a/src/Data/Geo/GPX/Type/Rte.hs b/src/Data/Geo/GPX/Type/Rte.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Rte.hs @@ -0,0 +1,88 @@ +-- | Complex Type: @rteType@ +module Data.Geo.GPX.Type.Rte( + Rte +, rte +) where + +import Data.Geo.GPX.Type.Wpt +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Type.Link +import Data.Geo.GPX.Lens.NameL +import Data.Geo.GPX.Lens.CmtL +import Data.Geo.GPX.Lens.DescL +import Data.Geo.GPX.Lens.SrcL +import Data.Geo.GPX.Lens.LinksL +import Data.Geo.GPX.Lens.NumberL +import Data.Geo.GPX.Lens.TypeL +import Data.Geo.GPX.Lens.ExtensionsL +import Data.Geo.GPX.Lens.RteptsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Rte = Rte (Maybe String) (Maybe String) (Maybe String) (Maybe String) [Link] (Maybe Int) (Maybe String) (Maybe Extensions) [Wpt] + deriving Eq + +rte :: + Maybe String -- ^ The name. + -> Maybe String -- ^ The cmt. + -> Maybe String -- ^ The desc. + -> Maybe String -- ^ The src. + -> [Link] -- ^ The links (link). + -> Maybe Int -- ^ The number. + -> Maybe String -- ^ The type. + -> Maybe Extensions -- ^ The extensions. + -> [Wpt] -- ^ The route points (rtept). + -> Rte +rte a b c d e f = + Rte a b c d e (fmap abs f) + +instance NameL Rte where + nameL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\name -> Rte name cmt desc src links number typ extensions rtepts) name + +instance CmtL Rte where + cmtL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\cmt -> Rte name cmt desc src links number typ extensions rtepts) cmt + +instance DescL Rte where + descL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\desc -> Rte name cmt desc src links number typ extensions rtepts) desc + +instance SrcL Rte where + srcL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\src -> Rte name cmt desc src links number typ extensions rtepts) src + +instance LinksL Rte where + linksL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\links -> Rte name cmt desc src links number typ extensions rtepts) links + +instance NumberL Rte where + numberL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\number -> Rte name cmt desc src links number typ extensions rtepts) number + +instance TypeL Rte where + typeL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\typ -> Rte name cmt desc src links number typ extensions rtepts) typ + +instance ExtensionsL Rte where + extensionsL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\extensions -> Rte name cmt desc src links number typ extensions rtepts) extensions + +instance RteptsL Rte where + rteptsL = + Lens $ \(Rte name cmt desc src links number typ extensions rtepts) -> store (\rtepts -> Rte name cmt desc src links number typ extensions rtepts) rtepts + +instance XmlPickler Rte where + xpickle = + xpWrap (\(a, b, c, d, e, f, g, h, i) -> rte a b c d e f g h i, \(Rte a b c d e f g h i) -> (a, b, c, d, e, f, g, h, i)) (xp9Tuple + (xpOption (xpElem "name" xpText)) + (xpOption (xpElem "cmt" xpText)) + (xpOption (xpElem "desc" xpText)) + (xpOption (xpElem "src" xpText)) + (xpList (xpElem "link" xpickle)) + (xpOption (xpElem "number" xpPrim)) + (xpOption (xpElem "type" xpText)) + (xpOption (xpElem "extensions" xpickle)) + (xpList (xpElem "rtept" xpickle))) + diff --git a/src/Data/Geo/GPX/Type/Trk.hs b/src/Data/Geo/GPX/Type/Trk.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Trk.hs @@ -0,0 +1,88 @@ +-- | Complex Type: @trkType@ +module Data.Geo.GPX.Type.Trk( + Trk +, trk +) where + +import Data.Geo.GPX.Type.Trkseg +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Type.Link +import Data.Geo.GPX.Lens.NameL +import Data.Geo.GPX.Lens.CmtL +import Data.Geo.GPX.Lens.DescL +import Data.Geo.GPX.Lens.SrcL +import Data.Geo.GPX.Lens.LinksL +import Data.Geo.GPX.Lens.NumberL +import Data.Geo.GPX.Lens.TypeL +import Data.Geo.GPX.Lens.ExtensionsL +import Data.Geo.GPX.Lens.TrksegsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Trk = Trk (Maybe String) (Maybe String) (Maybe String) (Maybe String) [Link] (Maybe Int) (Maybe String) (Maybe Extensions) [Trkseg] + deriving Eq + +trk :: + Maybe String -- ^ The name. + -> Maybe String -- ^ The cmt. + -> Maybe String -- ^ The desc. + -> Maybe String -- ^ The src. + -> [Link] -- ^ The links (link). + -> Maybe Int -- ^ The number. + -> Maybe String -- ^ The type. + -> Maybe Extensions -- ^ The extensions. + -> [Trkseg] -- ^ The track segments (trkseg). + -> Trk +trk a b c d e f = + Trk a b c d e (fmap abs f) + +instance NameL Trk where + nameL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\name -> Trk name cmt desc src links number typ extensions trksegs) name + +instance CmtL Trk where + cmtL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\cmt -> Trk name cmt desc src links number typ extensions trksegs) cmt + +instance DescL Trk where + descL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\desc -> Trk name cmt desc src links number typ extensions trksegs) desc + +instance SrcL Trk where + srcL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\src -> Trk name cmt desc src links number typ extensions trksegs) src + +instance LinksL Trk where + linksL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\links -> Trk name cmt desc src links number typ extensions trksegs) links + +instance NumberL Trk where + numberL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\number -> Trk name cmt desc src links number typ extensions trksegs) number + +instance TypeL Trk where + typeL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\typ -> Trk name cmt desc src links number typ extensions trksegs) typ + +instance ExtensionsL Trk where + extensionsL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\extensions -> Trk name cmt desc src links number typ extensions trksegs) extensions + +instance TrksegsL Trk where + trksegsL = + Lens $ \(Trk name cmt desc src links number typ extensions trksegs) -> store (\trksegs -> Trk name cmt desc src links number typ extensions trksegs) trksegs + +instance XmlPickler Trk where + xpickle = + xpWrap (\(a, b, c, d, e, f, g, h, i) -> trk a b c d e f g h i, \(Trk a b c d e f g h i) -> (a, b, c, d, e, f, g, h, i)) (xp9Tuple + (xpOption (xpElem "name" xpText)) + (xpOption (xpElem "cmt" xpText)) + (xpOption (xpElem "desc" xpText)) + (xpOption (xpElem "src" xpText)) + (xpList (xpElem "link" xpickle)) + (xpOption (xpElem "number" xpPrim)) + (xpOption (xpElem "type" xpText)) + (xpOption (xpElem "extensions" xpickle)) + (xpList (xpElem "trkseg" xpickle))) + diff --git a/src/Data/Geo/GPX/Type/Trkseg.hs b/src/Data/Geo/GPX/Type/Trkseg.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Trkseg.hs @@ -0,0 +1,38 @@ +-- | Complex Type: @trksegType@ +module Data.Geo.GPX.Type.Trkseg( + Trkseg, + trkseg +) where + +import Data.Geo.GPX.Type.Wpt +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Lens.TrkptsL +import Data.Geo.GPX.Lens.ExtensionsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle + +data Trkseg = Trkseg [Wpt] (Maybe Extensions) + deriving Eq + +trkseg :: + [Wpt] -- ^ The track points (trkpt). + -> Maybe Extensions -- ^ The extensions. + -> Trkseg +trkseg = + Trkseg + +instance TrkptsL Trkseg where + trkptsL = + Lens $ \(Trkseg trkpts extensions) -> store (\trkpts -> Trkseg trkpts extensions) trkpts + +instance ExtensionsL Trkseg where + extensionsL = + Lens $ \(Trkseg trkpts extensions) -> store (\extensions -> Trkseg trkpts extensions) extensions + +instance XmlPickler Trkseg where + xpickle = + xpWrap (uncurry trkseg, \(Trkseg trkpt' extensions') -> (trkpt', extensions')) (xpPair + (xpList (xpElem "trkpt" xpickle)) + (xpOption (xpElem "extensions" xpickle))) + diff --git a/src/Data/Geo/GPX/Type/Wpt.hs b/src/Data/Geo/GPX/Type/Wpt.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/GPX/Type/Wpt.hs @@ -0,0 +1,230 @@ +-- | Complex Type: @wptType@ +module Data.Geo.GPX.Type.Wpt( + Wpt +, wpt +, wpt' +) where + +import Data.Geo.GPX.Type.Latitude +import Data.Geo.GPX.Type.Longitude +import Data.Geo.GPX.Type.Degrees +import Data.Geo.GPX.Type.Link +import Data.Geo.GPX.Type.Fix +import Data.Geo.GPX.Type.DgpsStation +import Data.Geo.GPX.Type.Extensions +import Data.Geo.GPX.Lens.LatL +import Data.Geo.GPX.Lens.LonL +import Data.Geo.GPX.Lens.EleL +import Data.Geo.GPX.Lens.TimeL +import Data.Geo.GPX.Lens.MagvarL +import Data.Geo.GPX.Lens.GeoidheightL +import Data.Geo.GPX.Lens.NameL +import Data.Geo.GPX.Lens.CmtL +import Data.Geo.GPX.Lens.DescL +import Data.Geo.GPX.Lens.SrcL +import Data.Geo.GPX.Lens.LinksL +import Data.Geo.GPX.Lens.SymL +import Data.Geo.GPX.Lens.TypeL +import Data.Geo.GPX.Lens.FixL +import Data.Geo.GPX.Lens.SatL +import Data.Geo.GPX.Lens.HdopL +import Data.Geo.GPX.Lens.VdopL +import Data.Geo.GPX.Lens.PdopL +import Data.Geo.GPX.Lens.AgeofdgpsdataL +import Data.Geo.GPX.Lens.DgpsidL +import Data.Geo.GPX.Lens.ExtensionsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Text.XML.HXT.Arrow.Pickle +import Text.XML.XSD.DateTime + +data Wpt = + Wpt + Latitude + Longitude + (Maybe Double) + (Maybe DateTime) + (Maybe Degrees) + (Maybe Double) + (Maybe String) + (Maybe String) + (Maybe String) + (Maybe String) + [Link] + (Maybe String) + (Maybe String) + (Maybe Fix) + (Maybe Int) + (Maybe Double) + (Maybe Double) + (Maybe Double) + (Maybe Double) + (Maybe DgpsStation) + (Maybe Extensions) + deriving Eq + +wpt :: + Latitude -- ^ The lat. + -> Longitude -- ^ The lon. + -> Maybe Double -- ^ The ele. + -> Maybe DateTime -- ^ The time. + -> Maybe Degrees -- ^ The magvar. + -> Maybe Double -- ^ The geoidheight. + -> Maybe String -- ^ The name. + -> Maybe String -- ^ The cmt. + -> Maybe String -- ^ The desc. + -> Maybe String -- ^ The src. + -> [Link] -- ^ The links (link). + -> Maybe String -- ^ The sym. + -> Maybe String -- ^ The type. + -> Maybe Fix -- ^ The fix. + -> Maybe Int -- ^ The sat. + -> Maybe Double -- ^ The hdop. + -> Maybe Double -- ^ The vdop. + -> Maybe Double -- ^ The pdop. + -> Maybe Double -- ^ The ageofdgpsdata. + -> Maybe DgpsStation -- ^ The dgpsid. + -> Maybe Extensions -- ^ The extensions. + -> Wpt +wpt a b c d e f g h i j k l m n o p = + Wpt a b c d e f g h i j k l m n o (fmap abs p) + +-- | A waypoint with only a latitude and longitude. +wpt' :: + Latitude -- ^ The lat. + -> Longitude -- ^ The lon. + -> Wpt +wpt' lat' lon' = + wpt + lat' + lon' + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + [] + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + Nothing + +instance LatL Wpt where + latL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\lat -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) lat + +instance LonL Wpt where + lonL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\lon -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) lon + +instance EleL Wpt where + eleL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\ele -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) ele + +instance TimeL Wpt where + timeL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\time -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) time + +instance MagvarL Wpt where + magvarL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\magvar -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) magvar + +instance GeoidheightL Wpt where + geoidheightL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\geoidheight -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) geoidheight + +instance NameL Wpt where + nameL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\name -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) name + +instance CmtL Wpt where + cmtL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\cmt -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) cmt + +instance DescL Wpt where + descL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\desc -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) desc + +instance SrcL Wpt where + srcL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\src -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) src + +instance LinksL Wpt where + linksL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\links -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) links + +instance SymL Wpt where + symL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\sym -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) sym + +instance TypeL Wpt where + typeL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\typ -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) typ + +instance FixL Wpt where + fixL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\fix -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) fix + +instance SatL Wpt where + satL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\sat -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) sat + +instance HdopL Wpt where + hdopL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\hdop -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) hdop + +instance VdopL Wpt where + vdopL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\vdop -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) vdop + +instance PdopL Wpt where + pdopL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\pdop -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) pdop + +instance AgeofdgpsdataL Wpt where + ageofdgpsdataL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\ageofdgpsdata -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) ageofdgpsdata + +instance DgpsidL Wpt where + dgpsidL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\dgpsid -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) dgpsid + +instance ExtensionsL Wpt where + extensionsL = + Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\extensions -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) extensions + +instance XmlPickler Wpt where + xpickle = + xpWrap (\(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u) -> wpt a b c d e f g h i j k l m n o p q r s t u, + \(Wpt a b c d e f g h i j k l m n o p q r s t u) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)) (xp21Tuple + (xpAttr "lat" xpickle) + (xpAttr "lon" xpickle) + (xpOption (xpElem "ele" xpPrim)) + (xpOption (xpElem "time" (xpWrapMaybe (dateTime, show) xpText))) + (xpOption (xpElem "magvar" xpickle)) + (xpOption (xpElem "geoidheight" xpPrim)) + (xpOption (xpElem "name" xpText)) + (xpOption (xpElem "cmt" xpText)) + (xpOption (xpElem "desc" xpText)) + (xpOption (xpElem "src" xpText)) + (xpList (xpElem "link" xpickle)) + (xpOption (xpElem "sym" xpText)) + (xpOption (xpElem "type" xpText)) + (xpOption (xpElem "fix" xpickle)) + (xpOption (xpElem "sat" xpPrim)) + (xpOption (xpElem "hdop" xpPrim)) + (xpOption (xpElem "vdop" xpPrim)) + (xpOption (xpElem "pdop" xpPrim)) + (xpOption (xpElem "ageofdgpsdata" xpPrim)) + (xpOption (xpElem "dgpsid" xpickle)) + (xpOption (xpElem "extensions" xpickle))) + diff --git a/src/Data/Geo/GPX/Wpt.hs b/src/Data/Geo/GPX/Wpt.hs deleted file mode 100644 --- a/src/Data/Geo/GPX/Wpt.hs +++ /dev/null @@ -1,230 +0,0 @@ --- | Complex Type: @wptType@ -module Data.Geo.GPX.Wpt( - Wpt -, wpt -, wpt' -) where - -import Data.Geo.GPX.Latitude -import Data.Geo.GPX.Longitude -import Data.Geo.GPX.Degrees -import Data.Geo.GPX.Link -import Data.Geo.GPX.Fix -import Data.Geo.GPX.DgpsStation -import Data.Geo.GPX.Extensions -import Data.Geo.GPX.Lens.LatL -import Data.Geo.GPX.Lens.LonL -import Data.Geo.GPX.Lens.EleL -import Data.Geo.GPX.Lens.TimeL -import Data.Geo.GPX.Lens.MagvarL -import Data.Geo.GPX.Lens.GeoidheightL -import Data.Geo.GPX.Lens.NameL -import Data.Geo.GPX.Lens.CmtL -import Data.Geo.GPX.Lens.DescL -import Data.Geo.GPX.Lens.SrcL -import Data.Geo.GPX.Lens.LinksL -import Data.Geo.GPX.Lens.SymL -import Data.Geo.GPX.Lens.TypeL -import Data.Geo.GPX.Lens.FixL -import Data.Geo.GPX.Lens.SatL -import Data.Geo.GPX.Lens.HdopL -import Data.Geo.GPX.Lens.VdopL -import Data.Geo.GPX.Lens.PdopL -import Data.Geo.GPX.Lens.AgeofdgpsdataL -import Data.Geo.GPX.Lens.DgpsidL -import Data.Geo.GPX.Lens.ExtensionsL -import Data.Lens.Common -import Control.Comonad.Trans.Store -import Text.XML.HXT.Arrow.Pickle -import Text.XML.XSD.DateTime - -data Wpt = - Wpt - Latitude - Longitude - (Maybe Double) - (Maybe DateTime) - (Maybe Degrees) - (Maybe Double) - (Maybe String) - (Maybe String) - (Maybe String) - (Maybe String) - [Link] - (Maybe String) - (Maybe String) - (Maybe Fix) - (Maybe Int) - (Maybe Double) - (Maybe Double) - (Maybe Double) - (Maybe Double) - (Maybe DgpsStation) - (Maybe Extensions) - deriving Eq - -wpt :: - Latitude -- ^ The lat. - -> Longitude -- ^ The lon. - -> Maybe Double -- ^ The ele. - -> Maybe DateTime -- ^ The time. - -> Maybe Degrees -- ^ The magvar. - -> Maybe Double -- ^ The geoidheight. - -> Maybe String -- ^ The name. - -> Maybe String -- ^ The cmt. - -> Maybe String -- ^ The desc. - -> Maybe String -- ^ The src. - -> [Link] -- ^ The links (link). - -> Maybe String -- ^ The sym. - -> Maybe String -- ^ The type. - -> Maybe Fix -- ^ The fix. - -> Maybe Int -- ^ The sat. - -> Maybe Double -- ^ The hdop. - -> Maybe Double -- ^ The vdop. - -> Maybe Double -- ^ The pdop. - -> Maybe Double -- ^ The ageofdgpsdata. - -> Maybe DgpsStation -- ^ The dgpsid. - -> Maybe Extensions -- ^ The extensions. - -> Wpt -wpt a b c d e f g h i j k l m n o p = - Wpt a b c d e f g h i j k l m n o (fmap abs p) - --- | A waypoint with only a latitude and longitude. -wpt' :: - Latitude -- ^ The lat. - -> Longitude -- ^ The lon. - -> Wpt -wpt' lat' lon' = - wpt - lat' - lon' - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - [] - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - Nothing - -instance LatL Wpt where - latL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\lat -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) lat - -instance LonL Wpt where - lonL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\lon -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) lon - -instance EleL Wpt where - eleL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\ele -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) ele - -instance TimeL Wpt where - timeL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\time -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) time - -instance MagvarL Wpt where - magvarL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\magvar -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) magvar - -instance GeoidheightL Wpt where - geoidheightL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\geoidheight -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) geoidheight - -instance NameL Wpt where - nameL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\name -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) name - -instance CmtL Wpt where - cmtL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\cmt -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) cmt - -instance DescL Wpt where - descL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\desc -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) desc - -instance SrcL Wpt where - srcL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\src -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) src - -instance LinksL Wpt where - linksL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\links -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) links - -instance SymL Wpt where - symL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\sym -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) sym - -instance TypeL Wpt where - typeL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\typ -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) typ - -instance FixL Wpt where - fixL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\fix -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) fix - -instance SatL Wpt where - satL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\sat -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) sat - -instance HdopL Wpt where - hdopL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\hdop -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) hdop - -instance VdopL Wpt where - vdopL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\vdop -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) vdop - -instance PdopL Wpt where - pdopL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\pdop -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) pdop - -instance AgeofdgpsdataL Wpt where - ageofdgpsdataL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\ageofdgpsdata -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) ageofdgpsdata - -instance DgpsidL Wpt where - dgpsidL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\dgpsid -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) dgpsid - -instance ExtensionsL Wpt where - extensionsL = - Lens $ \(Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) -> store (\extensions -> Wpt lat lon ele time magvar geoidheight name cmt desc src links sym typ fix sat hdop vdop pdop ageofdgpsdata dgpsid extensions) extensions - -instance XmlPickler Wpt where - xpickle = - xpWrap (\(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u) -> wpt a b c d e f g h i j k l m n o p q r s t u, - \(Wpt a b c d e f g h i j k l m n o p q r s t u) -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)) (xp21Tuple - (xpAttr "lat" xpickle) - (xpAttr "lon" xpickle) - (xpOption (xpElem "ele" xpPrim)) - (xpOption (xpElem "time" (xpWrapMaybe (dateTime, show) xpText))) - (xpOption (xpElem "magvar" xpickle)) - (xpOption (xpElem "geoidheight" xpPrim)) - (xpOption (xpElem "name" xpText)) - (xpOption (xpElem "cmt" xpText)) - (xpOption (xpElem "desc" xpText)) - (xpOption (xpElem "src" xpText)) - (xpList (xpElem "link" xpickle)) - (xpOption (xpElem "sym" xpText)) - (xpOption (xpElem "type" xpText)) - (xpOption (xpElem "fix" xpickle)) - (xpOption (xpElem "sat" xpPrim)) - (xpOption (xpElem "hdop" xpPrim)) - (xpOption (xpElem "vdop" xpPrim)) - (xpOption (xpElem "pdop" xpPrim)) - (xpOption (xpElem "ageofdgpsdata" xpPrim)) - (xpOption (xpElem "dgpsid" xpickle)) - (xpOption (xpElem "extensions" xpickle))) -