diff --git a/Data/Geo/OSM.hs b/Data/Geo/OSM.hs deleted file mode 100644 --- a/Data/Geo/OSM.hs +++ /dev/null @@ -1,126 +0,0 @@ --- | OpenStreetMap API v0.6 DTD -module Data.Geo.OSM( - module Data.Geo.OSM.Api, - module Data.Geo.OSM.Area, - module Data.Geo.OSM.Bound, - module Data.Geo.OSM.Bounds, - module Data.Geo.OSM.ChangesetE, - module Data.Geo.OSM.GpxFile, - module Data.Geo.OSM.Home, - module Data.Geo.OSM.Member, - module Data.Geo.OSM.MemberType, - module Data.Geo.OSM.Nd, - module Data.Geo.OSM.Node, - module Data.Geo.OSM.NodeWayRelation, - module Data.Geo.OSM.OSM, - module Data.Geo.OSM.OSMChildren, - module Data.Geo.OSM.Preferences, - module Data.Geo.OSM.Relation, - module Data.Geo.OSM.Tag, - module Data.Geo.OSM.Tracepoints, - module Data.Geo.OSM.UserE, - module Data.Geo.OSM.VersionE, - module Data.Geo.OSM.Way, - module Data.Geo.OSM.Waynodes, - module Data.Geo.OSM.Accessor.AccountCreated, - module Data.Geo.OSM.Accessor.Ar, - module Data.Geo.OSM.Accessor.BoundOrs, - module Data.Geo.OSM.Accessor.Box, - module Data.Geo.OSM.Accessor.Changeset, - module Data.Geo.OSM.Accessor.DisplayName, - module Data.Geo.OSM.Accessor.Generator, - module Data.Geo.OSM.Accessor.Hm, - module Data.Geo.OSM.Accessor.Id, - module Data.Geo.OSM.Accessor.K, - module Data.Geo.OSM.Accessor.Lat, - module Data.Geo.OSM.Accessor.Lon, - module Data.Geo.OSM.Accessor.Maximum, - module Data.Geo.OSM.Accessor.Maxlat, - module Data.Geo.OSM.Accessor.Maxlon, - module Data.Geo.OSM.Accessor.Members, - module Data.Geo.OSM.Accessor.Minimum, - module Data.Geo.OSM.Accessor.Minlat, - module Data.Geo.OSM.Accessor.Minlon, - module Data.Geo.OSM.Accessor.Mtype, - module Data.Geo.OSM.Accessor.Name, - module Data.Geo.OSM.Accessor.Nds, - module Data.Geo.OSM.Accessor.NodeWayRelations, - module Data.Geo.OSM.Accessor.Origin, - module Data.Geo.OSM.Accessor.Pending, - module Data.Geo.OSM.Accessor.PerPage, - module Data.Geo.OSM.Accessor.Ref, - module Data.Geo.OSM.Accessor.Role, - module Data.Geo.OSM.Accessor.Tags, - module Data.Geo.OSM.Accessor.Timestamp, - module Data.Geo.OSM.Accessor.Tpoints, - module Data.Geo.OSM.Accessor.Uid, - module Data.Geo.OSM.Accessor.User, - module Data.Geo.OSM.Accessor.Version, - module Data.Geo.OSM.Accessor.V, - module Data.Geo.OSM.Accessor.Visible, - module Data.Geo.OSM.Accessor.Wnodes, - module Data.Geo.OSM.Accessor.Zoom - ) where - - - -import Data.Geo.OSM.Api -import Data.Geo.OSM.Area -import Data.Geo.OSM.Bound -import Data.Geo.OSM.Bounds -import Data.Geo.OSM.ChangesetE -import Data.Geo.OSM.GpxFile -import Data.Geo.OSM.Home -import Data.Geo.OSM.Member -import Data.Geo.OSM.MemberType -import Data.Geo.OSM.Nd -import Data.Geo.OSM.Node -import Data.Geo.OSM.NodeWayRelation -import Data.Geo.OSM.OSM -import Data.Geo.OSM.OSMChildren -import Data.Geo.OSM.Preferences -import Data.Geo.OSM.Relation -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Tracepoints -import Data.Geo.OSM.UserE -import Data.Geo.OSM.VersionE -import Data.Geo.OSM.Way -import Data.Geo.OSM.Waynodes -import Data.Geo.OSM.Accessor.AccountCreated -import Data.Geo.OSM.Accessor.Ar -import Data.Geo.OSM.Accessor.BoundOrs -import Data.Geo.OSM.Accessor.Box -import Data.Geo.OSM.Accessor.Changeset -import Data.Geo.OSM.Accessor.DisplayName -import Data.Geo.OSM.Accessor.Generator -import Data.Geo.OSM.Accessor.Hm -import Data.Geo.OSM.Accessor.Id -import Data.Geo.OSM.Accessor.K -import Data.Geo.OSM.Accessor.Lat -import Data.Geo.OSM.Accessor.Lon -import Data.Geo.OSM.Accessor.Maximum -import Data.Geo.OSM.Accessor.Maxlat -import Data.Geo.OSM.Accessor.Maxlon -import Data.Geo.OSM.Accessor.Members -import Data.Geo.OSM.Accessor.Minimum -import Data.Geo.OSM.Accessor.Minlat -import Data.Geo.OSM.Accessor.Minlon -import Data.Geo.OSM.Accessor.Mtype -import Data.Geo.OSM.Accessor.Name -import Data.Geo.OSM.Accessor.Nds -import Data.Geo.OSM.Accessor.NodeWayRelations -import Data.Geo.OSM.Accessor.Origin -import Data.Geo.OSM.Accessor.Pending -import Data.Geo.OSM.Accessor.PerPage -import Data.Geo.OSM.Accessor.Ref -import Data.Geo.OSM.Accessor.Role -import Data.Geo.OSM.Accessor.Tags -import Data.Geo.OSM.Accessor.Timestamp -import Data.Geo.OSM.Accessor.Tpoints -import Data.Geo.OSM.Accessor.Uid -import Data.Geo.OSM.Accessor.User -import Data.Geo.OSM.Accessor.Version -import Data.Geo.OSM.Accessor.V -import Data.Geo.OSM.Accessor.Visible -import Data.Geo.OSM.Accessor.Wnodes -import Data.Geo.OSM.Accessor.Zoom diff --git a/Data/Geo/OSM/Accessor/Accessor.hs b/Data/Geo/OSM/Accessor/Accessor.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Accessor.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Data.Geo.OSM.Accessor.Accessor( - using - ) where - -import Control.Monad.Instances() - -using :: (a -> d) -> (c -> a -> b) -> (d -> c) -> a -> b -using f g = flip (flip =<< (g .) . flip id . f) diff --git a/Data/Geo/OSM/Accessor/AccountCreated.hs b/Data/Geo/OSM/Accessor/AccountCreated.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/AccountCreated.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @account_created@ string accessor. -module Data.Geo.OSM.Accessor.AccountCreated where - -import Data.Geo.OSM.Accessor.Accessor - -class AccountCreated a where - accountCreated :: a -> String - setAccountCreated :: String -> a -> a - - usingAccountCreated :: (String -> String) -> a -> a - usingAccountCreated = accountCreated `using` setAccountCreated diff --git a/Data/Geo/OSM/Accessor/Ar.hs b/Data/Geo/OSM/Accessor/Ar.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Ar.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @area@ string accessor. -module Data.Geo.OSM.Accessor.Ar where - -import Data.Geo.OSM.Area -import Data.Geo.OSM.Accessor.Accessor - -class Ar a where - ar :: a -> Area - setAr :: Area -> a -> a - - usingArea :: (Area -> Area) -> a -> a - usingArea = ar `using` setAr diff --git a/Data/Geo/OSM/Accessor/BoundOrs.hs b/Data/Geo/OSM/Accessor/BoundOrs.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/BoundOrs.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | Values with a @bounds@ accessor which is either empty, a @Bound@ or a @Bounds@. -module Data.Geo.OSM.Accessor.BoundOrs where - -import Data.Geo.OSM.Bound -import Data.Geo.OSM.Bounds - -class BoundOrs a where - boundOrs :: a -> x -> (Bound -> x) -> (Bounds -> x) -> x - setBoundOrs :: Maybe (Either Bound Bounds) -> a -> a - - setBound :: Bound -> a -> a - setBound = setBoundOrs . Just . Left - - setBounds :: Bounds -> a -> a - setBounds = setBoundOrs . Just . Right - - usingBoundOrs :: a -> (Maybe (Either Bound Bounds) -> Maybe (Either Bound Bounds)) -> a - usingBoundOrs a f = setBoundOrs (f (boundOrs a Nothing (Just . Left) (Just . Right))) a diff --git a/Data/Geo/OSM/Accessor/Box.hs b/Data/Geo/OSM/Accessor/Box.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Box.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @box@ string accessor. -module Data.Geo.OSM.Accessor.Box where - -import Data.Geo.OSM.Accessor.Accessor - -class Box a where - box :: a -> String - setBox :: String -> a -> a - - usingBox :: (String -> String) -> a -> a - usingBox = box `using` setBox diff --git a/Data/Geo/OSM/Accessor/Changeset.hs b/Data/Geo/OSM/Accessor/Changeset.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Changeset.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | Values with a @changeset@ optional string accessor. -module Data.Geo.OSM.Accessor.Changeset where - -import Data.Geo.OSM.Accessor.Accessor - -class Changeset a where - changeset :: a -> Maybe String - setChangeset :: Maybe String -> a -> a - - setChangeset' :: String -> a -> a - setChangeset' = setChangeset . return - - usingChangeset :: (Maybe String -> Maybe String) -> a -> a - usingChangeset = changeset `using` setChangeset - - usingChangeset' :: (String -> String) -> a -> a - usingChangeset' = usingChangeset . fmap diff --git a/Data/Geo/OSM/Accessor/DisplayName.hs b/Data/Geo/OSM/Accessor/DisplayName.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/DisplayName.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @display_name@ string accessor. -module Data.Geo.OSM.Accessor.DisplayName where - -import Data.Geo.OSM.Accessor.Accessor - -class DisplayName a where - displayName :: a -> String - setDisplayName :: String -> a -> a - - usingDisplayName :: (String -> String) -> a -> a - usingDisplayName = displayName `using` setDisplayName diff --git a/Data/Geo/OSM/Accessor/Generator.hs b/Data/Geo/OSM/Accessor/Generator.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Generator.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | Values with a @generator@ optional string accessor. -module Data.Geo.OSM.Accessor.Generator where - -import Data.Geo.OSM.Accessor.Accessor - -class Generator a where - generator :: a -> Maybe String - setGenerator :: Maybe String -> a -> a - - setGenerator' :: String -> a -> a - setGenerator' = setGenerator . return - - usingGenerator :: (Maybe String -> Maybe String) -> a -> a - usingGenerator = generator `using` setGenerator - - usingGenerator' :: (String -> String) -> a -> a - usingGenerator' = usingGenerator . fmap diff --git a/Data/Geo/OSM/Accessor/Hm.hs b/Data/Geo/OSM/Accessor/Hm.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Hm.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | Values with a @home@ optional string accessor. -module Data.Geo.OSM.Accessor.Hm where - -import Data.Geo.OSM.Accessor.Accessor -import Data.Geo.OSM.Home - -class Hm a where - hm :: a -> Maybe Home - setHm :: Maybe Home -> a -> a - - setHm' :: Home -> a -> a - setHm' = setHm . return - - usingHm :: (Maybe Home -> Maybe Home) -> a -> a - usingHm = hm `using` setHm - - usingHm' :: (Home -> Home) -> a -> a - usingHm' = usingHm . fmap diff --git a/Data/Geo/OSM/Accessor/Id.hs b/Data/Geo/OSM/Accessor/Id.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Id.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @id@ string accessor. -module Data.Geo.OSM.Accessor.Id where - -import Data.Geo.OSM.Accessor.Accessor -import Prelude hiding (id) - -class Id a where - id' :: a -> String - setId :: String -> a -> a - - updateId :: (String -> String) -> a -> a - updateId = id' `using` setId diff --git a/Data/Geo/OSM/Accessor/K.hs b/Data/Geo/OSM/Accessor/K.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/K.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @k@ string accessor. -module Data.Geo.OSM.Accessor.K where - -import Data.Geo.OSM.Accessor.Accessor - -class K a where - k :: a -> String - setK :: String -> a -> a - - usingK :: (String -> String) -> a -> a - usingK = k `using` setK diff --git a/Data/Geo/OSM/Accessor/Lat.hs b/Data/Geo/OSM/Accessor/Lat.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Lat.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @lat@ string accessor. -module Data.Geo.OSM.Accessor.Lat where - -import Data.Geo.OSM.Accessor.Accessor - -class Lat a where - lat :: a -> String - setLat :: String -> a -> a - - usingLat :: (String -> String) -> a -> a - usingLat = lat `using` setLat diff --git a/Data/Geo/OSM/Accessor/Lon.hs b/Data/Geo/OSM/Accessor/Lon.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Lon.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @lon@ string accessor. -module Data.Geo.OSM.Accessor.Lon where - -import Data.Geo.OSM.Accessor.Accessor - -class Lon a where - lon :: a -> String - setLon :: String -> a -> a - - usingLon :: (String -> String) -> a -> a - usingLon = lon `using` setLon diff --git a/Data/Geo/OSM/Accessor/Maximum.hs b/Data/Geo/OSM/Accessor/Maximum.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Maximum.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @maximum@ string accessor. -module Data.Geo.OSM.Accessor.Maximum where - -import Data.Geo.OSM.Accessor.Accessor -import Prelude hiding (maximum) - -class Maximum a where - maximum :: a -> String - setMaximum :: String -> a -> a - - usingMaximum :: (String -> String) -> a -> a - usingMaximum = maximum `using` setMaximum diff --git a/Data/Geo/OSM/Accessor/Maxlat.hs b/Data/Geo/OSM/Accessor/Maxlat.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Maxlat.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @maxlat@ string accessor. -module Data.Geo.OSM.Accessor.Maxlat where - -import Data.Geo.OSM.Accessor.Accessor - -class Maxlat a where - maxlat :: a -> String - setMaxlat :: String -> a -> a - - usingMaxlat :: (String -> String) -> a -> a - usingMaxlat = maxlat `using` setMaxlat diff --git a/Data/Geo/OSM/Accessor/Maxlon.hs b/Data/Geo/OSM/Accessor/Maxlon.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Maxlon.hs +++ /dev/null @@ -1,11 +0,0 @@ --- -- | Values with a @maxlon@ string accessor. -module Data.Geo.OSM.Accessor.Maxlon where - -import Data.Geo.OSM.Accessor.Accessor - -class Maxlon a where - maxlon :: a -> String - setMaxlon :: String -> a -> a - - usingMaxlon :: (String -> String) -> a -> a - usingMaxlon = maxlon `using` setMaxlon diff --git a/Data/Geo/OSM/Accessor/Members.hs b/Data/Geo/OSM/Accessor/Members.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Members.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | Values with a @member@ accessor that is a list of @Member@. -module Data.Geo.OSM.Accessor.Members where - -import Data.Geo.OSM.Member -import Data.Geo.OSM.Accessor.Accessor - -class Members a where - members :: a -> [Member] - setMembers :: [Member] -> a -> a - - setMember :: Member -> a -> a - setMember = setMembers . return - - usingMembers :: ([Member] -> [Member]) -> a -> a - usingMembers = members `using` setMembers - - usingMember :: (Member -> Member) -> a -> a - usingMember = usingMembers . map diff --git a/Data/Geo/OSM/Accessor/Minimum.hs b/Data/Geo/OSM/Accessor/Minimum.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Minimum.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @minimum@ string accessor. -module Data.Geo.OSM.Accessor.Minimum where - -import Data.Geo.OSM.Accessor.Accessor -import Prelude hiding (minimum) - -class Minimum a where - minimum :: a -> String - setMinimum :: String -> a -> a - - usingMinimum :: (String -> String) -> a -> a - usingMinimum = minimum `using` setMinimum diff --git a/Data/Geo/OSM/Accessor/Minlat.hs b/Data/Geo/OSM/Accessor/Minlat.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Minlat.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @minlat@ string accessor. -module Data.Geo.OSM.Accessor.Minlat where - -import Data.Geo.OSM.Accessor.Accessor - -class Minlat a where - minlat :: a -> String - setMinlat :: String -> a -> a - - usingMinlat :: (String -> String) -> a -> a - usingMinlat = minlat `using` setMinlat diff --git a/Data/Geo/OSM/Accessor/Minlon.hs b/Data/Geo/OSM/Accessor/Minlon.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Minlon.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @minlon@ string accessor. -module Data.Geo.OSM.Accessor.Minlon where - -import Data.Geo.OSM.Accessor.Accessor - -class Minlon a where - minlon :: a -> String - setMinlon :: String -> a -> a - - usingMinlon :: (String -> String) -> a -> a - usingMinlon = minlon `using` setMinlon diff --git a/Data/Geo/OSM/Accessor/Mtype.hs b/Data/Geo/OSM/Accessor/Mtype.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Mtype.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @type@ accessor. -module Data.Geo.OSM.Accessor.Mtype where - -import Data.Geo.OSM.MemberType -import Data.Geo.OSM.Accessor.Accessor - -class Mtype a where - mtype :: a -> MemberType - setMtype :: MemberType -> a -> a - - usingMtype :: (MemberType -> MemberType) -> a -> a - usingMtype = mtype `using` setMtype diff --git a/Data/Geo/OSM/Accessor/Name.hs b/Data/Geo/OSM/Accessor/Name.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Name.hs +++ /dev/null @@ -1,11 +0,0 @@ --- -- | Values with a @name@ string accessor. -module Data.Geo.OSM.Accessor.Name where - -import Data.Geo.OSM.Accessor.Accessor - -class Name a where - name :: a -> String - setName :: String -> a -> a - - usingName :: (String -> String) -> a -> a - usingName = name `using` setName diff --git a/Data/Geo/OSM/Accessor/Nds.hs b/Data/Geo/OSM/Accessor/Nds.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Nds.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | Values with a @nd@ accessor that is a list of @Nd@. -module Data.Geo.OSM.Accessor.Nds where - -import Data.Geo.OSM.Nd -import Data.Geo.OSM.Accessor.Accessor - -class Nds a where - nds :: a -> [Nd] - setNds :: [Nd] -> a -> a - - setNd :: Nd -> a -> a - setNd = setNds . return - - usingNds :: ([Nd] -> [Nd]) -> a -> a - usingNds = nds `using` setNds - - usingNd :: (Nd -> Nd) -> a -> a - usingNd = usingNds . map diff --git a/Data/Geo/OSM/Accessor/NodeWayRelations.hs b/Data/Geo/OSM/Accessor/NodeWayRelations.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/NodeWayRelations.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | Values with a @nwrs@ accessor that is a list of @NodeWayRelation@. -module Data.Geo.OSM.Accessor.NodeWayRelations where - -import Data.Geo.OSM.NodeWayRelation -import Data.Geo.OSM.Node -import Data.Geo.OSM.Way -import Data.Geo.OSM.Relation -import Data.Geo.OSM.Accessor.Accessor - -class NodeWayRelations a where - nwrs :: a -> [NodeWayRelation] - setNwrs :: [NodeWayRelation] -> a -> a - - setNwr :: NodeWayRelation -> a -> a - setNwr = setNwrs . return - - usingNwrs :: ([NodeWayRelation] -> [NodeWayRelation]) -> a -> a - usingNwrs = nwrs `using` setNwrs - - usingNwr :: (NodeWayRelation -> NodeWayRelation) -> a -> a - usingNwr = usingNwrs . map - - usingNode :: (Node -> Node) -> a -> a - usingNode f = usingNwr (\p -> foldNodeWayRelation p (node' . f) way' relation') - - usingWay :: (Way -> Way) -> a -> a - usingWay f = usingNwr (\p -> foldNodeWayRelation p node' (way' . f) relation') - - usingRelation :: (Relation -> Relation) -> a -> a - usingRelation f = usingNwr (\p -> foldNodeWayRelation p node' way' (relation' . f)) - -nodes :: (NodeWayRelations a) => a -> [Node] -nodes k = nwrs k >>= \t -> foldNodeWayRelation t return (const []) (const []) - -ways :: (NodeWayRelations a) => a -> [Way] -ways k = nwrs k >>= \t -> foldNodeWayRelation t (const []) return (const []) - -relations :: (NodeWayRelations a) => a -> [Relation] -relations k = nwrs k >>= \t -> foldNodeWayRelation t (const []) (const []) return diff --git a/Data/Geo/OSM/Accessor/Origin.hs b/Data/Geo/OSM/Accessor/Origin.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Origin.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | Values with a @origin@ optional string accessor. -module Data.Geo.OSM.Accessor.Origin where - -import Data.Geo.OSM.Accessor.Accessor - -class Origin a where - origin :: a -> Maybe String - setOrigin :: Maybe String -> a -> a - - setOrigin' :: String -> a -> a - setOrigin' = setOrigin . return - - usingOrigin :: (Maybe String -> Maybe String) -> a -> a - usingOrigin = origin `using` setOrigin - - usingOrigin' :: (String -> String) -> a -> a - usingOrigin' = usingOrigin . fmap diff --git a/Data/Geo/OSM/Accessor/Pending.hs b/Data/Geo/OSM/Accessor/Pending.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Pending.hs +++ /dev/null @@ -1,11 +0,0 @@ --- -- | Values with a @pending@ boolean accessor. -module Data.Geo.OSM.Accessor.Pending where - -import Data.Geo.OSM.Accessor.Accessor - -class Pending a where - pending :: a -> Bool - setPending :: Bool -> a -> a - - usingPending :: (Bool -> Bool) -> a -> a - usingPending = pending `using` setPending diff --git a/Data/Geo/OSM/Accessor/PerPage.hs b/Data/Geo/OSM/Accessor/PerPage.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/PerPage.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @per_page@ string accessor. -module Data.Geo.OSM.Accessor.PerPage where - -import Data.Geo.OSM.Accessor.Accessor - -class PerPage a where - perPage :: a -> String - setPerPage :: String -> a -> a - - usingPerPage :: (String -> String) -> a -> a - usingPerPage = perPage `using` setPerPage diff --git a/Data/Geo/OSM/Accessor/Public.hs b/Data/Geo/OSM/Accessor/Public.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Public.hs +++ /dev/null @@ -1,11 +0,0 @@ --- -- | Values with a @public@ boolean accessor. -module Data.Geo.OSM.Accessor.Public where - -import Data.Geo.OSM.Accessor.Accessor - -class Public a where - public :: a -> Bool - setPublic :: Bool -> a -> a - - usingPublic :: (Bool -> Bool) -> a -> a - usingPublic = public `using` setPublic diff --git a/Data/Geo/OSM/Accessor/Ref.hs b/Data/Geo/OSM/Accessor/Ref.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Ref.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @ref@ string accessor. -module Data.Geo.OSM.Accessor.Ref where - -import Data.Geo.OSM.Accessor.Accessor - -class Ref a where - ref :: a -> String - setRef :: String -> a -> a - - usingRef :: (String -> String) -> a -> a - usingRef = ref `using` setRef diff --git a/Data/Geo/OSM/Accessor/Role.hs b/Data/Geo/OSM/Accessor/Role.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Role.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @role@ string accessor. -module Data.Geo.OSM.Accessor.Role where - -import Data.Geo.OSM.Accessor.Accessor - -class Role a where - role :: a -> String - setRole :: String -> a -> a - - usingRole :: (String -> String) -> a -> a - usingRole = role `using` setRole diff --git a/Data/Geo/OSM/Accessor/Tags.hs b/Data/Geo/OSM/Accessor/Tags.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Tags.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | Values with a @tags@ accessor that is a list of tags. -module Data.Geo.OSM.Accessor.Tags where - -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.K -import Data.Geo.OSM.Accessor.V -import qualified Data.Map as M -import Control.Arrow -import Data.Foldable -import Prelude hiding (any) -import Data.Geo.OSM.Accessor.Accessor - -class Tags a where - tags :: a -> [Tag] - setTags :: [Tag] -> a -> a - - setTag :: Tag -> a -> a - setTag = setTags . return - - usingTags :: ([Tag] -> [Tag]) -> a -> a - usingTags = tags `using` setTags - - usingTag :: (Tag -> Tag) -> a -> a - usingTag = usingTags . map - - usingTag' :: ((String, String) -> (String, String)) -> a -> a - usingTag' f = usingTag (\t -> uncurry tag (f (k t, v t))) - -tagMap :: (Tags a) => a -> M.Map String String -tagMap = M.fromList . map (k &&& v) . tags - -tagValue :: (Tags a) => a -> String -> Maybe String -tagValue = flip lookup . map (k &&& v) . tags - -hasTagValue :: (Tags a) => String -> String -> a -> Bool -hasTagValue k' v' n = any (== v') (k' `M.lookup` tagMap n) diff --git a/Data/Geo/OSM/Accessor/Timestamp.hs b/Data/Geo/OSM/Accessor/Timestamp.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Timestamp.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} - --- | Values with a @timestamp@ optional string accessor. -module Data.Geo.OSM.Accessor.Timestamp where - -import Data.Geo.OSM.Accessor.Accessor - -class Timestamp a b | a -> b where - timestamp :: a -> b - setTimestamp :: b -> a -> a - - usingTimestamp :: (b -> b) -> a -> a - usingTimestamp = timestamp `using` setTimestamp diff --git a/Data/Geo/OSM/Accessor/Tpoints.hs b/Data/Geo/OSM/Accessor/Tpoints.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Tpoints.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @tracepoints@ string accessor. -module Data.Geo.OSM.Accessor.Tpoints where - -import Data.Geo.OSM.Tracepoints -import Data.Geo.OSM.Accessor.Accessor - -class Tpoints a where - tpoints :: a -> Tracepoints - setTpoints :: Tracepoints -> a -> a - - usingTpoints :: (Tracepoints -> Tracepoints) -> a -> a - usingTpoints = tpoints `using` setTpoints diff --git a/Data/Geo/OSM/Accessor/Uid.hs b/Data/Geo/OSM/Accessor/Uid.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Uid.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | Values with a @uid@ optional string accessor. -module Data.Geo.OSM.Accessor.Uid where - -import Data.Geo.OSM.Accessor.Accessor - -class Uid a where - uid :: a -> Maybe String - setUid :: Maybe String -> a -> a - - setUid' :: String -> a -> a - setUid' = setUid . return - - usingUid :: (Maybe String -> Maybe String) -> a -> a - usingUid = uid `using` setUid - - usingUid' :: (String -> String) -> a -> a - usingUid' = usingUid . fmap diff --git a/Data/Geo/OSM/Accessor/User.hs b/Data/Geo/OSM/Accessor/User.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/User.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} - --- | Values with a @user@ optional string accessor. -module Data.Geo.OSM.Accessor.User where - -import Data.Geo.OSM.Accessor.Accessor - -class User a b | a -> b where - user :: a -> b - setUser :: b -> a -> a - - usingUser :: (b -> b) -> a -> a - usingUser = user `using` setUser diff --git a/Data/Geo/OSM/Accessor/V.hs b/Data/Geo/OSM/Accessor/V.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/V.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @v@ string accessor. -module Data.Geo.OSM.Accessor.V where - -import Data.Geo.OSM.Accessor.Accessor - -class V a where - v :: a -> String - setV :: String -> a -> a - - usingV :: (String -> String) -> a -> a - usingV = v `using` setV diff --git a/Data/Geo/OSM/Accessor/Version.hs b/Data/Geo/OSM/Accessor/Version.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Version.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} - --- | Values with a @version@ string accessor. -module Data.Geo.OSM.Accessor.Version where - -import Data.Geo.OSM.Accessor.Accessor - -class Version a b | a -> b where - version :: a -> b - setVersion :: b -> a -> a - - usingVersion :: (b -> b) -> a -> a - usingVersion = version `using` setVersion diff --git a/Data/Geo/OSM/Accessor/Visible.hs b/Data/Geo/OSM/Accessor/Visible.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Visible.hs +++ /dev/null @@ -1,17 +0,0 @@ --- | Values with a @visible@ boolean accessor. -module Data.Geo.OSM.Accessor.Visible where - -import Data.Geo.OSM.Accessor.Accessor - -class Visible a where - visible :: a -> Bool - setVisible :: Bool -> a -> a - - makeVisible :: a -> a - makeVisible = setVisible True - - makeInvisible :: a -> a - makeInvisible = setVisible False - - usingVisible :: (Bool -> Bool) -> a -> a - usingVisible = visible `using` setVisible diff --git a/Data/Geo/OSM/Accessor/Wnodes.hs b/Data/Geo/OSM/Accessor/Wnodes.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Wnodes.hs +++ /dev/null @@ -1,12 +0,0 @@ --- | Values with a @waynodes@ string accessor. -module Data.Geo.OSM.Accessor.Wnodes where - -import Data.Geo.OSM.Waynodes -import Data.Geo.OSM.Accessor.Accessor - -class Wnodes a where - wnodes :: a -> Waynodes - setWnodes :: Waynodes -> a -> a - - usingWnodes :: (Waynodes -> Waynodes) -> a -> a - usingWnodes = wnodes `using` setWnodes diff --git a/Data/Geo/OSM/Accessor/Zoom.hs b/Data/Geo/OSM/Accessor/Zoom.hs deleted file mode 100644 --- a/Data/Geo/OSM/Accessor/Zoom.hs +++ /dev/null @@ -1,11 +0,0 @@ --- | Values with a @zoom@ string accessor. -module Data.Geo.OSM.Accessor.Zoom where - -import Data.Geo.OSM.Accessor.Accessor - -class Zoom a where - zoom :: a -> String - setZoom :: String -> a -> a - - usingZoom :: (String -> String) -> a -> a - usingZoom = zoom `using` setZoom diff --git a/Data/Geo/OSM/Api.hs b/Data/Geo/OSM/Api.hs deleted file mode 100644 --- a/Data/Geo/OSM/Api.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} - --- | The @api@ element of a OSM file. -module Data.Geo.OSM.Api( - Api, - api - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.VersionE -import Data.Geo.OSM.Area -import Data.Geo.OSM.Tracepoints -import Data.Geo.OSM.Waynodes -import Data.Geo.OSM.Accessor.Version -import Data.Geo.OSM.Accessor.Ar -import Data.Geo.OSM.Accessor.Tpoints -import Data.Geo.OSM.Accessor.Wnodes - --- | The @api@ element of a OSM file. -data Api = Api VersionE Area Tracepoints Waynodes - deriving Eq - --- | Constructs a @api@ with version, area, tracepoints and waynodes. -api :: VersionE -- ^ The @version@ element. - -> Area -- ^ The @area@ element. - -> Tracepoints -- ^ The @tracepoints@ element. - -> Waynodes -- ^ The @waynodes@ element. - -> Api -api = Api - -instance XmlPickler Api where - xpickle = xpElem "api" (xpWrap (\(version', area', tracepoints', waypoints') -> api version' area' tracepoints' waypoints', \(Api version' area' tracepoints' waynodes') -> (version', area', tracepoints', waynodes')) (xp4Tuple (xpElem "version" xpickle) (xpElem "area" xpickle) (xpElem "tracepoints" xpickle) (xpElem "waynodes" xpickle))) - -instance Show Api where - show = showPickled [] - -instance Version Api VersionE where - version (Api x _ _ _) = x - setVersion a (Api _ b c d) = api a b c d - -instance Ar Api where - ar (Api _ x _ _) = x - setAr b (Api a _ c d) = api a b c d - -instance Tpoints Api where - tpoints (Api _ _ x _) = x - setTpoints c (Api a b _ d) = api a b c d - -instance Wnodes Api where - wnodes (Api _ _ _ x) = x - setWnodes d (Api a b c _) = api a b c d diff --git a/Data/Geo/OSM/Area.hs b/Data/Geo/OSM/Area.hs deleted file mode 100644 --- a/Data/Geo/OSM/Area.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | The @area@ element of a OSM file. -module Data.Geo.OSM.Area( - Area, - area - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Maximum - --- | The @area@ element of a OSM file. -newtype Area = Area String - deriving Eq - --- | Constructs a @area@ with maximum. -area :: String -- ^ The @area@ element. - -> Area -area = Area - -instance XmlPickler Area where - xpickle = xpElem "area" (xpWrap (area, \(Area r) -> r) (xpAttr "maximum" xpText)) - -instance Show Area where - show = showPickled [] - -instance Maximum Area where - maximum (Area x) = x - setMaximum a (Area _) = area a diff --git a/Data/Geo/OSM/Bound.hs b/Data/Geo/OSM/Bound.hs deleted file mode 100644 --- a/Data/Geo/OSM/Bound.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | The @bound@ element of a OSM file. -module Data.Geo.OSM.Bound( - Bound, - bound - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Box -import Data.Geo.OSM.Accessor.Origin - --- | The @bound@ element of a OSM file. -data Bound = Bound String (Maybe String) - deriving Eq - -instance XmlPickler Bound where - xpickle = xpElem "bound" (xpWrap (uncurry bound, \(Bound b o) -> (b, o)) (xpPair (xpAttr "box" xpText) (xpOption (xpAttr "origin" xpText)))) - -instance Show Bound where - show = showPickled [] - -instance Box Bound where - box (Bound x _) = x - setBox a (Bound _ b) = bound a b - -instance Origin Bound where - origin (Bound _ x) = x - setOrigin b (Bound a _) = bound a b - --- | Constructs a bound with a box and origin attributes. -bound :: String -- ^ The @box@ attribute. - -> Maybe String -- ^ The @origin@ attribute. - -> Bound -bound = Bound diff --git a/Data/Geo/OSM/Bounds.hs b/Data/Geo/OSM/Bounds.hs deleted file mode 100644 --- a/Data/Geo/OSM/Bounds.hs +++ /dev/null @@ -1,53 +0,0 @@ --- | The @bounds@ element of a OSM file. -module Data.Geo.OSM.Bounds( - Bounds, - bounds - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Minlat -import Data.Geo.OSM.Accessor.Maxlat -import Data.Geo.OSM.Accessor.Minlon -import Data.Geo.OSM.Accessor.Maxlon -import Data.Geo.OSM.Accessor.Origin - --- | The @bounds@ element of a OSM file. -data Bounds = Bounds String String String String (Maybe String) - deriving Eq - -instance XmlPickler Bounds where - xpickle = xpElem "bounds" (xpWrap (\(minlat', minlon', maxlat', maxlon', origin') -> bounds minlat' minlon' maxlat' maxlon' origin', \(Bounds minlat' minlon' maxlat' maxlon' origin') -> (minlat', minlon', maxlat', maxlon', origin')) - (xp5Tuple (xpAttr "minlat" xpText) (xpAttr "minlon" xpText) (xpAttr "maxlat" xpText) (xpAttr "maxlon" xpText) (xpOption (xpAttr "origin" xpText)))) - -instance Show Bounds where - show = showPickled [] - -instance Minlat Bounds where - minlat (Bounds x _ _ _ _) = x - setMinlat a (Bounds _ b c d e) = bounds a b c d e - -instance Minlon Bounds where - minlon (Bounds _ x _ _ _) = x - setMinlon b (Bounds a _ c d e) = bounds a b c d e - -instance Maxlat Bounds where - maxlat (Bounds _ _ x _ _) = x - setMaxlat c (Bounds a b _ d e) = bounds a b c d e - -instance Maxlon Bounds where - maxlon (Bounds _ _ _ x _) = x - setMaxlon d (Bounds a b c _ e) = bounds a b c d e - -instance Origin Bounds where - origin (Bounds _ _ _ _ x) = x - setOrigin e (Bounds a b c d _) = bounds a b c d e - --- | Constructs a bounds with a minlat, minlon, maxlat, maxlon and origin attributes. -bounds :: String -- ^ The @minlat@ attribute. - -> String -- ^ The @minlon@ attribute. - -> String -- ^ The @maxlat@ attribute. - -> String -- ^ The @maxlon@ attribute. - -> Maybe String -- ^ The @origin@ attribute. - -> Bounds -bounds = Bounds diff --git a/Data/Geo/OSM/ChangesetE.hs b/Data/Geo/OSM/ChangesetE.hs deleted file mode 100644 --- a/Data/Geo/OSM/ChangesetE.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | The @changeset@ element of a OSM file. -module Data.Geo.OSM.ChangesetE( - ChangesetE, - changesetE - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.Tags - --- | The @changeset@ element of a OSM file. -newtype ChangesetE = ChangesetE [Tag] - deriving Eq - --- | Constructs a @changeset@ with tags. -changesetE :: [Tag] -- ^ The list of tags (@tag@ elements). - -> ChangesetE -changesetE = ChangesetE - -instance XmlPickler ChangesetE where - xpickle = xpElem "changeset" (xpWrap (changesetE, \(ChangesetE r) -> r) (xpList xpickle)) - -instance Show ChangesetE where - show = showPickled [] - -instance Tags ChangesetE where - tags (ChangesetE x) = x - setTags a (ChangesetE _) = changesetE a diff --git a/Data/Geo/OSM/GpxFile.hs b/Data/Geo/OSM/GpxFile.hs deleted file mode 100644 --- a/Data/Geo/OSM/GpxFile.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} - --- | The @gpx_file@ element of a OSM file. -module Data.Geo.OSM.GpxFile( - GpxFile, - gpxFile - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Char -import Data.Geo.OSM.Accessor.Id -import Data.Geo.OSM.Accessor.Name -import Data.Geo.OSM.Accessor.Lat -import Data.Geo.OSM.Accessor.Lon -import Data.Geo.OSM.Accessor.User -import Data.Geo.OSM.Accessor.Public -import Data.Geo.OSM.Accessor.Pending -import Data.Geo.OSM.Accessor.Timestamp - --- | The @gpx_file@ element of a OSM file. -data GpxFile = GpxFile String String String String String Bool Bool String - deriving Eq - --- | Constructs a @gpx_file@ with an id, name, lat, lon, user, public, pending and timestamp. -gpxFile - :: String -- ^ The @id@ attribute. - -> String -- ^ The @name@ attribute. - -> String -- ^ The @lat@ attribute. - -> String -- ^ The @lon@ attribute. - -> String -- ^ The @user@ attribute. - -> Bool -- ^ The @public@ attribute. - -> Bool -- ^ The @pending@ attribute. - -> String -- ^ The @timestamp@ attribute. - -> GpxFile -gpxFile = - GpxFile - -instance XmlPickler GpxFile where - xpickle = let b = xpWrapMaybe (\s -> case fmap toLower s - of "true" -> Just True - "false" -> Just False - _ -> Nothing, fmap toLower . show) - in xpElem "gpx_file" (xpWrap (\(id'', name', lat', lon', user', public', pending', timestamp') -> gpxFile id'' name' lat' lon' user' public' pending' timestamp', \(GpxFile id'' name' lat' lon' user' public' pending' timestamp') -> (id'', name', lat', lon', user', public', pending', timestamp')) (xp8Tuple (xpAttr "id" xpText) (xpAttr "name" xpText) (xpAttr "lat" xpText) (xpAttr "lon" xpText) (xpAttr "user" xpText) (xpDefault False (b (xpAttr "public" xpText))) (xpDefault False (b (xpAttr "pending" xpText))) (xpAttr "timestamp" xpText))) - -instance Show GpxFile where - show = showPickled [] - -instance Id GpxFile where - id' (GpxFile x _ _ _ _ _ _ _) = x - setId a (GpxFile _ b c d e f g h) = gpxFile a b c d e f g h - -instance Name GpxFile where - name (GpxFile _ x _ _ _ _ _ _) = x - setName b (GpxFile a _ c d e f g h) = gpxFile a b c d e f g h - -instance Lat GpxFile where - lat (GpxFile _ _ x _ _ _ _ _) = x - setLat c (GpxFile a b _ d e f g h) = gpxFile a b c d e f g h - -instance Lon GpxFile where - lon (GpxFile _ _ _ x _ _ _ _) = x - setLon d (GpxFile a b c _ e f g h) = gpxFile a b c d e f g h - -instance User GpxFile String where - user (GpxFile _ _ _ _ x _ _ _) = x - setUser e (GpxFile a b c d _ f g h) = gpxFile a b c d e f g h - -instance Public GpxFile where - public (GpxFile _ _ _ _ _ x _ _) = x - setPublic f (GpxFile a b c d e _ g h) = gpxFile a b c d e f g h - -instance Pending GpxFile where - pending (GpxFile _ _ _ _ _ _ x _) = x - setPending g (GpxFile a b c d e f _ h) = gpxFile a b c d e f g h - -instance Timestamp GpxFile String where - timestamp (GpxFile _ _ _ _ _ _ _ x) = x - setTimestamp h (GpxFile a b c d e f g _) = gpxFile a b c d e f g h diff --git a/Data/Geo/OSM/Home.hs b/Data/Geo/OSM/Home.hs deleted file mode 100644 --- a/Data/Geo/OSM/Home.hs +++ /dev/null @@ -1,40 +0,0 @@ --- | The @home@ element of a OSM file. -module Data.Geo.OSM.Home( - Home, - home - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Lat -import Data.Geo.OSM.Accessor.Lon -import Data.Geo.OSM.Accessor.Zoom - --- | The @home@ element of a OSM file. -data Home = Home String String String - deriving Eq - --- | Constructs a @home@ with lat, lon and zoom. -home :: String -- ^ The @lat@ attribute. - -> String -- ^ The @lon@ attribute. - -> String -- ^ The @zoom@ attribute. - -> Home -home = Home - -instance XmlPickler Home where - xpickle = xpElem "home" (xpWrap (\(lat', lon', zoom') -> home lat' lon' zoom', \(Home lat' lon' zoom') -> (lat', lon', zoom')) (xpTriple (xpAttr "lat" xpText) (xpAttr "lon" xpText) (xpAttr "zoom" xpText))) - -instance Show Home where - show = showPickled [] - -instance Lat Home where - lat (Home x _ _) = x - setLat a (Home _ b c) = home a b c - -instance Lon Home where - lon (Home _ x _) = x - setLon b (Home a _ c) = home a b c - -instance Zoom Home where - zoom (Home _ _ x) = x - setZoom c (Home a b _) = home a b c diff --git a/Data/Geo/OSM/Member.hs b/Data/Geo/OSM/Member.hs deleted file mode 100644 --- a/Data/Geo/OSM/Member.hs +++ /dev/null @@ -1,42 +0,0 @@ --- | The @member@ element of a OSM file. -module Data.Geo.OSM.Member( - Member, - member - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.MemberType -import Data.Geo.OSM.Accessor.Mtype -import Data.Geo.OSM.Accessor.Ref -import Data.Geo.OSM.Accessor.Role - --- | The @member@ element of a OSM file. -data Member = Member MemberType String String - deriving Eq - -instance XmlPickler Member where - xpickle = xpElem "member" (xpWrap (\(mtype', mref', mrole') -> member mtype' mref' mrole', \(Member mtype' mref' mrole') -> (mtype', mref', mrole')) - (xpTriple xpickle (xpAttr "ref" xpText) (xpAttr "role" xpText))) - -instance Show Member where - show = showPickled [] - -instance Mtype Member where - mtype (Member x _ _) = x - setMtype a (Member _ b c) = member a b c - -instance Ref Member where - ref (Member _ x _) = x - setRef b (Member a _ c) = member a b c - -instance Role Member where - role (Member _ _ x) = x - setRole c (Member a b _) = member a b c - --- | Constructs a member with a type, ref and role. -member :: MemberType -- ^ The member @type@ attribute. - -> String -- ^ The member @ref@ attribute. - -> String -- ^ The member @role@ attribute. - -> Member -member = Member diff --git a/Data/Geo/OSM/MemberType.hs b/Data/Geo/OSM/MemberType.hs deleted file mode 100644 --- a/Data/Geo/OSM/MemberType.hs +++ /dev/null @@ -1,50 +0,0 @@ --- | The @type@ attribute of a @member@ element of a OSM file. -module Data.Geo.OSM.MemberType( - MemberType, - foldMemberType, - wayType, - nodeType, - relationType - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Char - --- | The @type@ attribute of a @member@ element of a OSM file. -data MemberType = WayType | NodeType | RelationType - deriving Eq - --- | Folds a member-type (catamorphism). -foldMemberType :: MemberType -- ^ The member-type to fold. - -> x -- ^ If the type is a way. - -> x -- ^ If the type is a node. - -> x -- ^ If the type is a relation. - -> x -foldMemberType WayType x _ _ = x -foldMemberType NodeType _ x _ = x -foldMemberType RelationType _ _ x = x - -instance XmlPickler MemberType where - xpickle = xpWrapMaybe (\s -> case fmap toLower s of "way" -> Just WayType - "node" -> Just NodeType - "relation" -> Just RelationType - _ -> Nothing, - \t -> case t of WayType -> "way" - NodeType -> "node" - RelationType -> "relation") (xpAttr "type" xpText) - -instance Show MemberType where - show = showPickled [] - --- | Constructs a member-type that is a way. -wayType :: MemberType -wayType = WayType - --- | Constructs a member-type that is a node. -nodeType :: MemberType -nodeType = NodeType - --- | Constructs a member-type that is a relation. -relationType :: MemberType -relationType = RelationType diff --git a/Data/Geo/OSM/NWRCommon.hs b/Data/Geo/OSM/NWRCommon.hs deleted file mode 100644 --- a/Data/Geo/OSM/NWRCommon.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} - --- | The common attributes between the @node@, @way@ and @relation@ elements. -module Data.Geo.OSM.NWRCommon( - NWRCommon, - nwrCommon - ) where - -import Control.Arrow -import Text.XML.HXT.Arrow.Pickle -import Control.Applicative -import Data.Char -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.Id -import Data.Geo.OSM.Accessor.Tags -import Data.Geo.OSM.Accessor.Changeset -import Data.Geo.OSM.Accessor.Visible -import Data.Geo.OSM.Accessor.User -import Data.Geo.OSM.Accessor.Uid -import Data.Geo.OSM.Accessor.Timestamp - --- | The common attributes between the @node@, @way@ and @relation@ elements. -data NWRCommon = NWRCommon String [Tag] (Maybe String) Bool (Maybe String, Maybe String) (Maybe String) - deriving Eq - -instance XmlPickler NWRCommon where - xpickle = xpWrap (\(a, b, c, d, e, f) -> nwrCommon a b c d e f, \(NWRCommon a b c d e f) -> (a, b, c, d, e, f)) - (xp6Tuple (xpAttr "id" xpText) - (xpList xpickle) - (xpOption (xpAttr "changeset" xpText)) - (xpDefault True (xpWrapMaybe (\s -> case toLower <$> s of "true" -> Just True - "false" -> Just False - _ -> Nothing, (toLower <$>) . show) (xpAttr "visible" xpText))) - (xpPair (xpOption (xpAttr "user" xpText)) (xpOption (xpAttr "uid" xpText))) - (xpOption (xpAttr "timestamp" xpText))) - -instance Show NWRCommon where - show = showPickled [] - -instance Id NWRCommon where - id' (NWRCommon x _ _ _ _ _) = x - setId a (NWRCommon _ b c d e f) = nwrCommon a b c d e f - -instance Tags NWRCommon where - tags (NWRCommon _ x _ _ _ _) = x - setTags b (NWRCommon a _ c d e f) = nwrCommon a b c d e f - -instance Changeset NWRCommon where - changeset (NWRCommon _ _ x _ _ _) = x - setChangeset c (NWRCommon a b _ d e f) = nwrCommon a b c d e f - -instance Visible NWRCommon where - visible (NWRCommon _ _ _ x _ _) = x - setVisible d (NWRCommon a b c _ e f) = nwrCommon a b c d e f - -instance User NWRCommon (Maybe String) where - user (NWRCommon _ _ _ _ (x, _) _) = x - setUser e (NWRCommon a b c d ee f) = nwrCommon a b c d ((first . const) e ee) f - -instance Uid NWRCommon where - uid (NWRCommon _ _ _ _ (_, x) _) = x - setUid e (NWRCommon a b c d ee f) = nwrCommon a b c d ((second . const) e ee) f - -instance Timestamp NWRCommon (Maybe String) where - timestamp (NWRCommon _ _ _ _ _ x) = x - setTimestamp f (NWRCommon a b c d e _) = nwrCommon a b c d e f - --- | Constructs with id, list of tags, changeset, visible, user&uid and timestamp. -nwrCommon :: String -- ^ The @id@ attribute. - -> [Tag] -- ^ The list of tags (@tag@ elements). - -> Maybe String -- ^ The @changeset@ attribute. - -> Bool -- ^ The @visible@ attribute. - -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. - -> Maybe String -- ^ The @timestamp@ attribute. - -> NWRCommon -nwrCommon = NWRCommon diff --git a/Data/Geo/OSM/Nd.hs b/Data/Geo/OSM/Nd.hs deleted file mode 100644 --- a/Data/Geo/OSM/Nd.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | The @nd@ element of a OSM file. -module Data.Geo.OSM.Nd( - Nd, - nd - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Ref - --- | The @nd@ element of a OSM file. -newtype Nd = Nd String - deriving Eq - -instance XmlPickler Nd where - xpickle = xpElem "nd" (xpWrap (nd, \(Nd r) -> r) (xpAttr "ref" xpText)) - -instance Show Nd where - show = showPickled [] - -instance Ref Nd where - ref (Nd x) = x - setRef a (Nd _) = nd a - --- | Constructs a nd with a ref. -nd :: String -- ^ The @ref@ attribute. - -> Nd -nd = Nd diff --git a/Data/Geo/OSM/Node.hs b/Data/Geo/OSM/Node.hs deleted file mode 100644 --- a/Data/Geo/OSM/Node.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} - --- | The @node@ element of a OSM file. -module Data.Geo.OSM.Node( - Node, - node - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.NWRCommon -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.Id -import Data.Geo.OSM.Accessor.Tags -import Data.Geo.OSM.Accessor.Changeset -import Data.Geo.OSM.Accessor.Visible -import Data.Geo.OSM.Accessor.User -import Data.Geo.OSM.Accessor.Uid -import Data.Geo.OSM.Accessor.Timestamp -import Data.Geo.OSM.Accessor.Lat -import Data.Geo.OSM.Accessor.Lon -import Prelude hiding (id) - --- | The @node@ element of a OSM file. -data Node = Node String String NWRCommon - deriving Eq - -instance XmlPickler Node where - xpickle = xpElem "node" (xpWrap (\(lat', lon', nwr') -> Node lat' lon' nwr', \(Node lat' lon' nwr') -> (lat', lon', nwr')) - (xpTriple (xpAttr "lat" xpText) (xpAttr "lon" xpText) xpickle)) - -instance Show Node where - show = showPickled [] - -instance Lat Node where - lat (Node x _ _) = x - setLat a (Node _ b c) = Node a b c - -instance Lon Node where - lon (Node _ x _) = x - setLon b (Node a _ c) = Node a b c - -instance Id Node where - id' (Node _ _ x) = id' x - setId c (Node a b cc) = Node a b (nwrCommon c (tags cc) (changeset cc) (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Tags Node where - tags (Node _ _ x) = tags x - setTags c (Node a b cc) = Node a b (nwrCommon (id' cc) c (changeset cc) (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Changeset Node where - changeset (Node _ _ x) = changeset x - setChangeset c (Node a b cc) = Node a b (nwrCommon (id' cc) (tags cc) c (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Visible Node where - visible (Node _ _ x) = visible x - setVisible c (Node a b cc) = Node a b (nwrCommon (id' cc) (tags cc) (changeset cc) c (user cc, uid cc) (timestamp cc)) - -instance User Node (Maybe String) where - user (Node _ _ x) = user x - setUser c (Node a b cc) = Node a b (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (c, uid cc) (timestamp cc)) - -instance Uid Node where - uid (Node _ _ x) = uid x - setUid c (Node a b cc) = Node a b (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (user cc, c) (timestamp cc)) - -instance Timestamp Node (Maybe String) where - timestamp (Node _ _ x) = timestamp x - setTimestamp c (Node a b cc) = Node a b (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (user cc, uid cc) c) - --- | Constructs a node with a lat, lon, id, list of tags, changeset, visible, user&uid and timestamp. -node :: String -- ^ The @lat@ attribute. - -> String -- ^ The @lon@ attribute. - -> String -- ^ The @id@ attribute. - -> [Tag] -- ^ The list of tags (@tag@ elements). - -> Maybe String -- ^ The @changeset@ attribute. - -> Bool -- ^ The @visible@ attribute. - -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. - -> Maybe String -- ^ The @timestamp@ attribute. - -> Node -node = flip flip nwrCommon . (((.) . (.) . (.) . (.) . (.) . (.)) .) . Node diff --git a/Data/Geo/OSM/NodeWayRelation.hs b/Data/Geo/OSM/NodeWayRelation.hs deleted file mode 100644 --- a/Data/Geo/OSM/NodeWayRelation.hs +++ /dev/null @@ -1,67 +0,0 @@ --- | The @node@, @way@, or @relation@ element of a OSM file. -module Data.Geo.OSM.NodeWayRelation( - NodeWayRelation, - foldNodeWayRelation, - way', - relation', - node', - isNode, - isWay, - isRelation - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Node -import Data.Geo.OSM.Way -import Data.Geo.OSM.Relation - --- | The @node@, @way@, or @relation@ element of a OSM file. -data NodeWayRelation = N Node | W Way | R Relation - deriving Eq - --- | Folds a node-way-relation (catamorphism). -foldNodeWayRelation :: NodeWayRelation -- ^ The @node@, @way@ or @relation@ element. - -> (Node -> x) -- ^ If this is a @node@ element. - -> (Way -> x) -- ^ If this is a @way@ element. - -> (Relation -> x) -- ^ If this is a @relation@ element. - -> x -foldNodeWayRelation (N n) x _ _ = x n -foldNodeWayRelation (W w) _ x _ = x w -foldNodeWayRelation (R r) _ _ x = x r - -instance XmlPickler NodeWayRelation where - xpickle = xpAlt (\r -> case r of N _ -> 0 - W _ -> 1 - R _ -> 2) - [xpWrap (N, \(N n) -> n) xpickle, xpWrap (W, \(W w) -> w) xpickle, xpWrap (R, \(R r) -> r) xpickle] - -instance Show NodeWayRelation where - show = showPickled [] - --- | Construct a @way@ element value. -way' :: Way -> NodeWayRelation -way' = W - --- | Construct a @relation@ element value. -relation' :: Relation -> NodeWayRelation -relation' = R - --- | Construct a @node@ element value. -node' :: Node -> NodeWayRelation -node' = N - --- | Returns whether the @node@, @way@ or @relation@ element is a node. -isNode :: NodeWayRelation -> Bool -isNode (N _) = True -isNode _ = False - --- | Returns whether the @node@, @way@ or @relation@ element is a way. -isWay :: NodeWayRelation -> Bool -isWay (W _) = True -isWay _ = False - --- | Returns whether the @node@, @way@ or @relation@ element is a relation. -isRelation :: NodeWayRelation -> Bool -isRelation (R _) = True -isRelation _ = False diff --git a/Data/Geo/OSM/OSM.hs b/Data/Geo/OSM/OSM.hs deleted file mode 100644 --- a/Data/Geo/OSM/OSM.hs +++ /dev/null @@ -1,202 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} - --- | The @osm@ element of a OSM file, which is the root element. -module Data.Geo.OSM.OSM( - OSM, - osm, - readOsmFile, - readOsmFiles, - interactOSMIO, - interactsOSMIO, - interactOSMIO', - interactsOSMIO', - interactOSM, - interactsOSM, - interactOSM', - interactsOSM' - ) where - -import Prelude hiding (mapM, foldr) - -import Text.XML.HXT.Core -import Text.XML.HXT.Extras -import Control.Monad hiding (mapM) -import Data.Foldable -import Data.Traversable -import Data.Geo.OSM.OSMChildren -import Data.Geo.OSM.Bound -import Data.Geo.OSM.Bounds -import Data.Geo.OSM.Accessor.Version -import Data.Geo.OSM.Accessor.Generator -import Data.Geo.OSM.Accessor.BoundOrs -import Data.Geo.OSM.Accessor.NodeWayRelations -import Data.Monoid - --- | The @osm@ element of a OSM file, which is the root element. -data OSM = OSM String (Maybe String) (Maybe (Either Bound Bounds)) OSMChildren - deriving Eq - -instance XmlPickler OSM where - xpickle = - xpElem "osm" (xpWrap (\(version', generator', bound', nwr') -> osm version' generator' bound' nwr', \(OSM version' generator' bound' nwr') -> (version', generator', bound', nwr')) - (xp4Tuple (xpAttr "version" xpText) - (xpOption (xpAttr "generator" xpText)) - (xpOption (xpAlt (either (const 0) (const 1)) [xpWrap (Left, \(Left b) -> b) xpickle, xpWrap (Right, \(Right b) -> b) xpickle])) - xpickle)) - -instance Show OSM where - show = - showPickled [] - -instance Version OSM String where - version (OSM x _ _ _) = - x - setVersion a (OSM _ b c d) = - osm a b c d - -instance Generator OSM where - generator (OSM _ x _ _) = - x - setGenerator b (OSM a _ c d) = - osm a b c d - -instance BoundOrs OSM where - boundOrs (OSM _ _ x _) n b bs = - case x - of Nothing -> n - Just (Left b') -> b b' - Just (Right b') -> bs b' - setBoundOrs c (OSM a b _ d) = - osm a b c d - -instance NodeWayRelations OSM where - nwrs (OSM _ _ _ x) = - let t = const [] - in foldOSMChildren t t t t t id x - setNwrs d (OSM a b c _) = - osm a b c (osmNodeWayRelation d) - --- | Constructs a osm with a version, bound or bounds, and node attributes and way or relation elements. -osm :: String -- ^ The @version@ attribute. - -> Maybe String -- ^ The @generator@ attribute. - -> Maybe (Either Bound Bounds) -- ^ The @bound@ or @bounds@ elements. - -> OSMChildren -- ^ The child elements. - -> OSM -osm = - OSM - --- | Reads an OSM file into a list of @OSM@ values removing whitespace. -readOsmFile :: - FilePath - -> IO [OSM] -readOsmFile = - runX . xunpickleDocument (xpickle :: PU OSM) ([withRemoveWS yes, withFileMimeType v_1]) -- FIXME v_1? - --- | Reads 0 or more OSM files into a list of @OSM@ values removing whitespace. -readOsmFiles :: - [FilePath] - -> IO [OSM] -readOsmFiles = - fmap join . mapM readOsmFile - --- | Reads a OSM file, executes the given function on the XML, then writes the given file. -interactOSMIO' :: - (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. - -> SysConfigList -- ^ The options for reading the OSM file. - -> FilePath -- ^ The OSM file to read. - -> SysConfigList -- ^ The options for writing the OSM file. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactOSMIO' f froma from toa to = - runX (xunpickleDocument (xpickle :: PU OSM) froma from >>> arrIO f >>> xpickleDocument (xpickle :: PU OSM) toa to) >> return () - --- | Reads a OSM file, executes the given functions on the XML, then writes the given file. -interactsOSMIO' :: - Foldable t => - t (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. - -> SysConfigList -- ^ The options for reading the OSM file. - -> FilePath -- ^ The OSM file to read. - -> SysConfigList -- ^ The options for writing the OSM file. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactsOSMIO' = - interactOSMIO' . sumM - --- | Reads a OSM file removing whitespace, executes the given function on the XML, then writes the given file with indentation. -interactOSMIO :: - (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. - -> FilePath -- ^ The OSM file to read. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactOSMIO f from = - interactOSMIO' f [withRemoveWS yes, withFileMimeType v_1] from [withIndent yes, withFileMimeType v_1] - --- | Reads a OSM file removing whitespace, executes the given functions on the XML, then writes the given file with indentation. -interactsOSMIO :: - Foldable t => - t (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. - -> FilePath -- ^ The OSM file to read. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactsOSMIO = - interactOSMIO . sumM - --- | Reads a OSM file, executes the given function on the XML, then writes the given file. -interactOSM' :: - (OSM -> OSM) -- ^ The function to execute on the XML that is read. - -> SysConfigList -- ^ The options for reading the OSM file. - -> FilePath -- ^ The OSM file to read. - -> SysConfigList -- ^ The options for writing the OSM file. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactOSM' f = - interactOSMIO' (return . f) - --- | Reads a OSM file, executes the given functions on the XML, then writes the given file. -interactsOSM' :: - Foldable t => - t (OSM -> OSM) -- ^ The functions to execute on the XML that is read. - -> SysConfigList -- ^ The options for reading the OSM file. - -> FilePath -- ^ The OSM file to read. - -> SysConfigList -- ^ The options for writing the OSM file. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactsOSM' = - interactOSM' . sum' - --- | Reads a OSM file removing whitespace, executes the given function on the XML, then writes the given file with indentation. -interactOSM :: - (OSM -> OSM) -- ^ The function to execute on the XML that is read. - -> FilePath -- ^ The OSM file to read. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactOSM f = - interactOSMIO (return . f) - --- | Reads a OSM file removing whitespace, executes the given functions on the XML, then writes the given file with indentation. -interactsOSM :: - Foldable t => - t (OSM -> OSM) -- ^ The function to execute on the XML that is read. - -> FilePath -- ^ The OSM file to read. - -> FilePath -- ^ The OSM file to write. - -> IO () -interactsOSM = - interactOSM . sum' - --- not exported - -sum' :: - Foldable t => - t (a -> a) - -> a - -> a -sum' = - appEndo . foldMap Endo - -sumM :: - (Monad m, Foldable t) => - t (a -> m a) - -> a - -> m a -sumM = - foldr (>=>) return diff --git a/Data/Geo/OSM/OSMChildren.hs b/Data/Geo/OSM/OSMChildren.hs deleted file mode 100644 --- a/Data/Geo/OSM/OSMChildren.hs +++ /dev/null @@ -1,76 +0,0 @@ --- | The children elements of the @osm@ element of a OSM file. -module Data.Geo.OSM.OSMChildren( - OSMChildren, - osmUser, - osmGpxFile, - osmApi, - osmChangeset, - osmNodeWayRelation, - foldOSMChildren - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.UserE -import Data.Geo.OSM.Preferences -import Data.Geo.OSM.GpxFile -import Data.Geo.OSM.Api -import Data.Geo.OSM.ChangesetE -import Data.Geo.OSM.NodeWayRelation - --- | The children elements of the @osm@ element of a OSM file. -data OSMChildren = UserE UserE | Preferences Preferences | GpxFile GpxFile | Api Api | ChangesetE ChangesetE | NWR [NodeWayRelation] - deriving Eq - -instance XmlPickler OSMChildren where - xpickle = xpAlt (\r -> case r of UserE _ -> 0 - Preferences _ -> 1 - GpxFile _ -> 2 - Api _ -> 3 - ChangesetE _ -> 4 - NWR _ -> 5) [xpWrap (UserE, \(UserE u) -> u) xpickle, - xpWrap (Preferences, \(Preferences p) -> p) xpickle, - xpWrap (GpxFile, \(GpxFile f) -> f) xpickle, - xpWrap (Api, \(Api a) -> a) xpickle, - xpWrap (ChangesetE, \(ChangesetE c) -> c) xpickle, - xpWrap (NWR, \(NWR k) -> k) (xpList xpickle)] - -instance Show OSMChildren where - show = showPickled [] - --- | A @user@ element. -osmUser :: UserE -> OSMChildren -osmUser = UserE - --- | A @gpx_file@ element. -osmGpxFile :: GpxFile -> OSMChildren -osmGpxFile = GpxFile - --- | A @api@ element. -osmApi :: Api -> OSMChildren -osmApi = Api - --- | A @changeset@ element. -osmChangeset :: ChangesetE -> OSMChildren -osmChangeset = ChangesetE - --- | A list of @node@, @way@ or @relation@ elements. -osmNodeWayRelation :: [NodeWayRelation] -> OSMChildren -osmNodeWayRelation = NWR - --- | Folds OSM child elements (catamorphism). -foldOSMChildren - :: (UserE -> a) -- ^ If a @user@ element. - -> (Preferences -> a) -- ^ If a @preferences@ element. - -> (GpxFile -> a) -- ^ If a @gpx_file@ element. - -> (Api -> a) -- ^ If a @api@ element. - -> (ChangesetE -> a) -- ^ If a @changeset@ element. - -> ([NodeWayRelation] -> a) -- ^ If a list of @node@, @way@ or @relation@ elements. - -> OSMChildren -- ^ The disjunctive type of child elements. - -> a -foldOSMChildren z _ _ _ _ _ (UserE u) = z u -foldOSMChildren _ z _ _ _ _ (Preferences p) = z p -foldOSMChildren _ _ z _ _ _ (GpxFile f) = z f -foldOSMChildren _ _ _ z _ _ (Api a) = z a -foldOSMChildren _ _ _ _ z _ (ChangesetE c) = z c -foldOSMChildren _ _ _ _ _ z (NWR k) = z k diff --git a/Data/Geo/OSM/Preferences.hs b/Data/Geo/OSM/Preferences.hs deleted file mode 100644 --- a/Data/Geo/OSM/Preferences.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | The @preferences@ element of a OSM file. -module Data.Geo.OSM.Preferences( - Preferences, - preferences - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.Tags - --- | The @preferences@ element of a OSM file. -newtype Preferences = Preferences [Tag] - deriving Eq - --- | Constructs a @preferences@ with tags. -preferences :: [Tag] -- ^ The list of tags (@tag@ elements). - -> Preferences -preferences = Preferences - -instance XmlPickler Preferences where - xpickle = xpElem "preferences" (xpWrap (preferences, \(Preferences r) -> r) (xpList xpickle)) - -instance Show Preferences where - show = showPickled [] - -instance Tags Preferences where - tags (Preferences x) = x - setTags a (Preferences _) = preferences a diff --git a/Data/Geo/OSM/Relation.hs b/Data/Geo/OSM/Relation.hs deleted file mode 100644 --- a/Data/Geo/OSM/Relation.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} - --- | The @relation@ element of a OSM file. -module Data.Geo.OSM.Relation( - Relation, - relation - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Member -import Data.Geo.OSM.NWRCommon -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.Id -import Data.Geo.OSM.Accessor.Tags -import Data.Geo.OSM.Accessor.Changeset -import Data.Geo.OSM.Accessor.Visible -import Data.Geo.OSM.Accessor.User -import Data.Geo.OSM.Accessor.Uid -import Data.Geo.OSM.Accessor.Timestamp -import Data.Geo.OSM.Accessor.Members -import Prelude hiding (id) - --- | The @relation@ element of a OSM file. -data Relation = Relation [Member] NWRCommon - deriving Eq - -instance XmlPickler Relation where - xpickle = xpElem "relation" (xpWrap (uncurry Relation, \(Relation m r) -> (m, r)) - (xpPair (xpList xpickle) xpickle)) - -instance Show Relation where - show = showPickled [] - -instance Members Relation where - members (Relation x _) = x - setMembers a (Relation _ c) = Relation a c - -instance Id Relation where - id' (Relation _ x) = id' x - setId c (Relation a cc) = Relation a (nwrCommon c (tags cc) (changeset cc) (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Tags Relation where - tags (Relation _ x) = tags x - setTags c (Relation a cc) = Relation a (nwrCommon (id' cc) c (changeset cc) (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Changeset Relation where - changeset (Relation _ x) = changeset x - setChangeset c (Relation a cc) = Relation a (nwrCommon (id' cc) (tags cc) c (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Visible Relation where - visible (Relation _ x) = visible x - setVisible c (Relation a cc) = Relation a (nwrCommon (id' cc) (tags cc) (changeset cc) c (user cc, uid cc) (timestamp cc)) - -instance User Relation (Maybe String) where - user (Relation _ x) = user x - setUser c (Relation a cc) = Relation a (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (c, uid cc) (timestamp cc)) - -instance Uid Relation where - uid (Relation _ x) = uid x - setUid c (Relation a cc) = Relation a (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (user cc, c) (timestamp cc)) - -instance Timestamp Relation (Maybe String) where - timestamp (Relation _ x) = timestamp x - setTimestamp c (Relation a cc) = Relation a (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (user cc, uid cc) c) - --- | Constructs a relation with a list of members, id, list of tags, changeset, visible, user&uid and timestamp. -relation :: [Member] -- ^ The list of members (@member@ elements). - -> String -- ^ The @id@ attribute. - -> [Tag] -- ^ The list of tags (@tag@ elements). - -> Maybe String -- ^ The @changeset@ attribute. - -> Bool -- ^ The @visible@ attribute. - -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. - -> Maybe String -- ^ The @timestamp@ attribute. - -> Relation -relation = (. nwrCommon) . (.) . (.) . (.) . (.) . (.) . Relation diff --git a/Data/Geo/OSM/Tag.hs b/Data/Geo/OSM/Tag.hs deleted file mode 100644 --- a/Data/Geo/OSM/Tag.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | The @tag@ element of a OSM file. -module Data.Geo.OSM.Tag( - Tag, - tag - ) where - - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.K -import Data.Geo.OSM.Accessor.V - --- | The @tag@ element of a OSM file. -data Tag = Tag String String - deriving Eq - -instance XmlPickler Tag where - xpickle = xpElem "tag" (xpWrap (uncurry tag, \(Tag k' v') -> (k', v')) (xpPair (xpAttr "k" xpText) (xpAttr "v" xpText))) - -instance Show Tag where - show = showPickled [] - -instance K Tag where - k (Tag x _) = x - setK a (Tag _ b) = tag a b - -instance V Tag where - v (Tag _ x) = x - setV b (Tag a _) = tag a b - --- | Constructs a tag with a key and value. -tag :: String -- ^ The key (@k@ attribute). - -> String -- ^ The value (@v@ attribute). - -> Tag -tag = Tag diff --git a/Data/Geo/OSM/Tracepoints.hs b/Data/Geo/OSM/Tracepoints.hs deleted file mode 100644 --- a/Data/Geo/OSM/Tracepoints.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | The @tracepoints@ element of a OSM file. -module Data.Geo.OSM.Tracepoints( - Tracepoints, - tracepoints - ) where - - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.PerPage - --- | The @tracepoints@ element of a OSM file. -newtype Tracepoints = Tracepoints String - deriving Eq - --- | Constructs a @tracepoints@ with per_page. -tracepoints :: String -- ^ The @per_page@ attribute. - -> Tracepoints -tracepoints = Tracepoints - -instance XmlPickler Tracepoints where - xpickle = xpElem "tracepoints" (xpWrap (tracepoints, \(Tracepoints r) -> r) (xpAttr "per_page" xpText)) - -instance Show Tracepoints where - show = showPickled [] - -instance PerPage Tracepoints where - perPage (Tracepoints x) = x - setPerPage a (Tracepoints _) = tracepoints a diff --git a/Data/Geo/OSM/UserE.hs b/Data/Geo/OSM/UserE.hs deleted file mode 100644 --- a/Data/Geo/OSM/UserE.hs +++ /dev/null @@ -1,41 +0,0 @@ --- | The @user@ element of a OSM file. -module Data.Geo.OSM.UserE( - UserE, - userE - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Home -import Data.Geo.OSM.Accessor.Hm -import Data.Geo.OSM.Accessor.DisplayName -import Data.Geo.OSM.Accessor.AccountCreated - --- | The @user@ element of a OSM file. -data UserE = UserE (Maybe Home) String String - deriving Eq - --- | Constructs a @user@ with an optional home, display_name and account_created. -userE :: Maybe Home -- ^ The @home@ element. - -> String -- ^ The @display_name@ attribute. - -> String -- ^ The @account_created@ attribute. - -> UserE -userE = UserE - -instance XmlPickler UserE where - xpickle = xpElem "user" (xpWrap (\(home', dn', ac') -> userE home' dn' ac', \(UserE home' dn' ac') -> (home', dn', ac')) (xpTriple (xpOption (xpElem "home" xpickle)) (xpAttr "display_name" xpText) (xpAttr "account_created" xpText))) - -instance Show UserE where - show = showPickled [] - -instance Hm UserE where - hm (UserE x _ _) = x - setHm a (UserE _ b c) = userE a b c - -instance DisplayName UserE where - displayName (UserE _ x _) = x - setDisplayName b (UserE a _ c) = userE a b c - -instance AccountCreated UserE where - accountCreated (UserE _ _ x) = x - setAccountCreated c (UserE a b _) = userE a b c diff --git a/Data/Geo/OSM/VersionE.hs b/Data/Geo/OSM/VersionE.hs deleted file mode 100644 --- a/Data/Geo/OSM/VersionE.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | The @version@ element of a OSM file. -module Data.Geo.OSM.VersionE( - VersionE, - versionE - ) where - - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Minimum -import Data.Geo.OSM.Accessor.Maximum - --- | The @version@ element of a OSM file. -data VersionE = VersionE String String - deriving Eq - --- | Constructs a @version@ with minimum and maximum. -versionE :: String -- ^ The @minimum@ attribute. - -> String -- ^ The @maximum@ attribute. - -> VersionE -versionE = VersionE - -instance XmlPickler VersionE where - xpickle = xpElem "version" (xpWrap (uncurry versionE, \(VersionE min' max') -> (min', max')) (xpPair (xpAttr "minimum" xpText) (xpAttr "maximum" xpText))) - -instance Show VersionE where - show = showPickled [] - -instance Minimum VersionE where - minimum (VersionE x _) = x - setMinimum a (VersionE _ b) = versionE a b - -instance Maximum VersionE where - maximum (VersionE _ x) = x - setMaximum b (VersionE a _) = versionE a b diff --git a/Data/Geo/OSM/Way.hs b/Data/Geo/OSM/Way.hs deleted file mode 100644 --- a/Data/Geo/OSM/Way.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} - --- | The @way@ element of a OSM file. -module Data.Geo.OSM.Way( - Way, - way - ) where - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Nd -import Data.Geo.OSM.NWRCommon -import Data.Geo.OSM.Tag -import Data.Geo.OSM.Accessor.Id -import Data.Geo.OSM.Accessor.Tags -import Data.Geo.OSM.Accessor.Changeset -import Data.Geo.OSM.Accessor.Visible -import Data.Geo.OSM.Accessor.User -import Data.Geo.OSM.Accessor.Uid -import Data.Geo.OSM.Accessor.Timestamp -import Data.Geo.OSM.Accessor.Nds -import Prelude hiding (id) - --- | The @way@ element of a OSM file. -data Way = Way [Nd] NWRCommon - deriving Eq - -instance XmlPickler Way where - xpickle = xpElem "way" (xpWrap (uncurry Way, \(Way n r) -> (n, r)) - (xpPair (xpList xpickle) xpickle)) - -instance Show Way where - show = showPickled [] - -instance Nds Way where - nds (Way x _) = x - setNds a (Way _ c) = Way a c - -instance Id Way where - id' (Way _ x) = id' x - setId c (Way a cc) = Way a (nwrCommon c (tags cc) (changeset cc) (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Tags Way where - tags (Way _ x) = tags x - setTags c (Way a cc) = Way a (nwrCommon (id' cc) c (changeset cc) (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Changeset Way where - changeset (Way _ x) = changeset x - setChangeset c (Way a cc) = Way a (nwrCommon (id' cc) (tags cc) c (visible cc) (user cc, uid cc) (timestamp cc)) - -instance Visible Way where - visible (Way _ x) = visible x - setVisible c (Way a cc) = Way a (nwrCommon (id' cc) (tags cc) (changeset cc) c (user cc, uid cc) (timestamp cc)) - -instance User Way (Maybe String) where - user (Way _ x) = user x - setUser c (Way a cc) = Way a (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (c, uid cc) (timestamp cc)) - -instance Uid Way where - uid (Way _ x) = uid x - setUid c (Way a cc) = Way a (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (user cc, c) (timestamp cc)) - -instance Timestamp Way (Maybe String) where - timestamp (Way _ x) = timestamp x - setTimestamp c (Way a cc) = Way a (nwrCommon (id' cc) (tags cc) (changeset cc) (visible cc) (user cc, uid cc) c) - --- | Constructs a way with a list of nds, id, list of tags, changeset, visible, user&uid and timestamp. -way :: [Nd] -- ^ The list of nds (@nd@ elements). - -> String -- ^ The @id@ attribute. - -> [Tag] -- ^ The list of tags (@tag@ elements). - -> Maybe String -- ^ The @changeset@ attribute. - -> Bool -- ^ The @visible@ attribute. - -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. - -> Maybe String -- ^ The @timestamp@ attribute. - -> Way -way = (. nwrCommon) . (.) . (.) . (.) . (.) . (.) . Way diff --git a/Data/Geo/OSM/Waynodes.hs b/Data/Geo/OSM/Waynodes.hs deleted file mode 100644 --- a/Data/Geo/OSM/Waynodes.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | The @waynodes@ element of a OSM file. -module Data.Geo.OSM.Waynodes( - Waynodes, - waynodes - ) where - - -import Text.XML.HXT.Arrow.Pickle -import Text.XML.HXT.Extras -import Data.Geo.OSM.Accessor.Maximum - --- | The @waynodes@ element of a OSM file. -newtype Waynodes = Waynodes String - deriving Eq - --- | Constructs a @waynodes@ with maximum. -waynodes :: String -- ^ The @maximum@ attribute. - -> Waynodes -waynodes = Waynodes - -instance XmlPickler Waynodes where - xpickle = xpElem "waynodes" (xpWrap (waynodes, \(Waynodes r) -> r) (xpAttr "maximum" xpText)) - -instance Show Waynodes where - show = showPickled [] - -instance Maximum Waynodes where - maximum (Waynodes x) = x - setMaximum a (Waynodes _) = waynodes a diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2009 Tony Morris +Copyright 2011 Tony Morris All rights reserved. diff --git a/OSM.cabal b/OSM.cabal --- a/OSM.cabal +++ b/OSM.cabal @@ -1,34 +1,44 @@ Name: OSM -Version: 0.5.1 +Version: 0.6.0 License: BSD3 License-File: LICENSE Synopsis: Parse OpenStreetMap files Description: Parse OpenStreetMap http:\/\/osm.org/ files using HXT into data structures. The Data.Geo.OSM module is the core module that exports all others. -Homepage: http://code.google.com/p/geo-osm/ +Homepage: https://github.com/tonymorris/geo-osm Category: Utils -Author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> -Maintainer: Tony Morris -Copyright: 2009-2010 Tony Morris -build-type: Simple -cabal-version: >= 1.2 +Author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>, Thomas DuBuisson +Maintainer: Tony Morris, Thomas DuBuisson +Copyright: 2009 -- 2012 Tony Morris, Thomas DuBuisson +Build-Type: Simple +Cabal-Version: >= 1.6 +Source-Repository head + Type: git + Location: git@github.com:tonymorris/geo-osm.git -Flag small_base +Flag small_base Description: Choose the new, split-up base package. Library - if flag(small_base) - Build-Depends: base < 5 && >= 3, hxt >= 9.0 && < 10.0, hxt-extras, containers - else - Build-Depends: base < 5 && >= 3, hxt >= 9.0 && < 10.0, hxt-extras, containers + Build-Depends: base < 5 && >= 3 + , hxt >= 9 + , containers + , data-lens + , comonad-transformers + , newtype GHC-Options: -Wall + -fno-warn-name-shadowing + + Hs-Source-Dirs: src + Exposed-Modules: Data.Geo.OSM Data.Geo.OSM.Api Data.Geo.OSM.Area Data.Geo.OSM.Bound Data.Geo.OSM.Bounds - Data.Geo.OSM.ChangesetE + Data.Geo.OSM.Changeset + Data.Geo.OSM.Children Data.Geo.OSM.GpxFile Data.Geo.OSM.Home Data.Geo.OSM.Nd @@ -38,52 +48,12 @@ Data.Geo.OSM.MemberType Data.Geo.OSM.Member Data.Geo.OSM.OSM - Data.Geo.OSM.OSMChildren Data.Geo.OSM.Preferences Data.Geo.OSM.Relation Data.Geo.OSM.Tag Data.Geo.OSM.Tracepoints - Data.Geo.OSM.UserE - Data.Geo.OSM.VersionE + Data.Geo.OSM.User + Data.Geo.OSM.Version Data.Geo.OSM.Way Data.Geo.OSM.Waynodes - Data.Geo.OSM.Accessor.Accessor - Data.Geo.OSM.Accessor.AccountCreated - Data.Geo.OSM.Accessor.Ar - Data.Geo.OSM.Accessor.BoundOrs - Data.Geo.OSM.Accessor.Box - Data.Geo.OSM.Accessor.Changeset - Data.Geo.OSM.Accessor.DisplayName - Data.Geo.OSM.Accessor.Generator - Data.Geo.OSM.Accessor.Hm - Data.Geo.OSM.Accessor.Id - Data.Geo.OSM.Accessor.K - Data.Geo.OSM.Accessor.Lat - Data.Geo.OSM.Accessor.Lon - Data.Geo.OSM.Accessor.Members - Data.Geo.OSM.Accessor.Maximum - Data.Geo.OSM.Accessor.Maxlat - Data.Geo.OSM.Accessor.Maxlon - Data.Geo.OSM.Accessor.Minimum - Data.Geo.OSM.Accessor.Minlat - Data.Geo.OSM.Accessor.Minlon - Data.Geo.OSM.Accessor.Mtype - Data.Geo.OSM.Accessor.Name - Data.Geo.OSM.Accessor.Nds - Data.Geo.OSM.Accessor.NodeWayRelations - Data.Geo.OSM.Accessor.Origin - Data.Geo.OSM.Accessor.Pending - Data.Geo.OSM.Accessor.PerPage - Data.Geo.OSM.Accessor.Public - Data.Geo.OSM.Accessor.Ref - Data.Geo.OSM.Accessor.Role - Data.Geo.OSM.Accessor.Tags - Data.Geo.OSM.Accessor.Timestamp - Data.Geo.OSM.Accessor.Tpoints - Data.Geo.OSM.Accessor.User - Data.Geo.OSM.Accessor.Uid - Data.Geo.OSM.Accessor.V - Data.Geo.OSM.Accessor.Version - Data.Geo.OSM.Accessor.Visible - Data.Geo.OSM.Accessor.Wnodes - Data.Geo.OSM.Accessor.Zoom + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,3 +0,0 @@ -#!/usr/bin/env runhaskell -> import Distribution.Simple -> main = defaultMain diff --git a/src/Data/Geo/OSM.hs b/src/Data/Geo/OSM.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM.hs @@ -0,0 +1,51 @@ +-- | OpenStreetMap API v0.6 DTD +module Data.Geo.OSM +( + module Data.Geo.OSM.Api +, module Data.Geo.OSM.Area +, module Data.Geo.OSM.Bound +, module Data.Geo.OSM.Bounds +, module Data.Geo.OSM.Changeset +, module Data.Geo.OSM.GpxFile +, module Data.Geo.OSM.Home +, module Data.Geo.OSM.Member +, module Data.Geo.OSM.MemberType +, module Data.Geo.OSM.Nd +, module Data.Geo.OSM.Node +, module Data.Geo.OSM.NodeWayRelation +, module Data.Geo.OSM.OSM +, module Data.Geo.OSM.Children +, module Data.Geo.OSM.Preferences +, module Data.Geo.OSM.Relation +, module Data.Geo.OSM.Tag +, module Data.Geo.OSM.Tracepoints +, module Data.Geo.OSM.User +, module Data.Geo.OSM.Version +, module Data.Geo.OSM.Way +, module Data.Geo.OSM.Waynodes +, module Data.Geo.OSM.Lens +) where + +import Data.Geo.OSM.Api +import Data.Geo.OSM.Area +import Data.Geo.OSM.Bound +import Data.Geo.OSM.Bounds +import Data.Geo.OSM.Changeset +import Data.Geo.OSM.GpxFile +import Data.Geo.OSM.Home +import Data.Geo.OSM.Member +import Data.Geo.OSM.MemberType +import Data.Geo.OSM.Nd +import Data.Geo.OSM.Node +import Data.Geo.OSM.NodeWayRelation +import Data.Geo.OSM.OSM +import Data.Geo.OSM.Children +import Data.Geo.OSM.Preferences +import Data.Geo.OSM.Relation +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Tracepoints +import Data.Geo.OSM.User +import Data.Geo.OSM.Version +import Data.Geo.OSM.Way +import Data.Geo.OSM.Waynodes +import Data.Geo.OSM.Lens diff --git a/src/Data/Geo/OSM/Api.hs b/src/Data/Geo/OSM/Api.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Api.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} + +-- | The @api@ element of a OSM file. +module Data.Geo.OSM.Api +( + Api +, api +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Version +import Data.Geo.OSM.Area +import Data.Geo.OSM.Tracepoints +import Data.Geo.OSM.Waynodes +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Data.Geo.OSM.Lens.VersionL +import Data.Geo.OSM.Lens.AreaL +import Data.Geo.OSM.Lens.TracepointsL +import Data.Geo.OSM.Lens.WaynodesL + +-- | The @api@ element of a OSM file. +data Api = + Api Version Area Tracepoints Waynodes + deriving Eq + +-- | Constructs a @api@ with version, area, tracepoints and waynodes. +api :: + Version -- ^ The @version@ element. + -> Area -- ^ The @area@ element. + -> Tracepoints -- ^ The @tracepoints@ element. + -> Waynodes -- ^ The @waynodes@ element. + -> Api +api = + Api + +instance XmlPickler Api where + xpickle = + xpElem "api" (xpWrap (\(version', area', tracepoints', waypoints') -> api version' area' tracepoints' waypoints', \(Api version' area' tracepoints' waynodes') -> (version', area', tracepoints', waynodes')) (xp4Tuple (xpElem "version" xpickle) (xpElem "area" xpickle) (xpElem "tracepoints" xpickle) (xpElem "waynodes" xpickle))) + +instance Show Api where + show = + showPickled [] + +instance VersionL Api Version where + versionL = + Lens $ \(Api version area tracepoints waynodes) -> store (\version -> Api version area tracepoints waynodes) version + +instance AreaL Api where + areaL = + Lens $ \(Api version area tracepoints waynodes) -> store (\area -> Api version area tracepoints waynodes) area + +instance TracepointsL Api where + tracepointsL = + Lens $ \(Api version area tracepoints waynodes) -> store (\tracepoints -> Api version area tracepoints waynodes) tracepoints + +instance WaynodesL Api where + waynodesL = + Lens $ \(Api version area tracepoints waynodes) -> store (\waynodes -> Api version area tracepoints waynodes) waynodes + diff --git a/src/Data/Geo/OSM/Area.hs b/src/Data/Geo/OSM/Area.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Area.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} + +-- | The @area@ element of a OSM file. +module Data.Geo.OSM.Area +( + Area +, area +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.MaximumL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Newtype + +-- | The @area@ element of a OSM file. +newtype Area = + Area String + deriving Eq + +-- | Constructs a @area@ with maximum. +area :: + String -- ^ The @area@ element. + -> Area +area = + Area + +instance XmlPickler Area where + xpickle = + xpElem "area" (xpWrap (area, \(Area r) -> r) (xpAttr "maximum" xpText)) + +instance Show Area where + show = + showPickled [] + +instance MaximumL Area where + maximumL = + Lens $ \(Area maximum) -> store (\maximum -> Area maximum) maximum + +instance Newtype Area String where + pack = + Area + unpack (Area x) = + x diff --git a/src/Data/Geo/OSM/Bound.hs b/src/Data/Geo/OSM/Bound.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Bound.hs @@ -0,0 +1,41 @@ +-- | The @bound@ element of a OSM file. +module Data.Geo.OSM.Bound +( + Bound +, bound +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.BoxL +import Data.Geo.OSM.Lens.OriginL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @bound@ element of a OSM file. +data Bound = + Bound String (Maybe String) + deriving Eq + +instance XmlPickler Bound where + xpickle = + xpElem "bound" (xpWrap (uncurry bound, \(Bound b o) -> (b, o)) (xpPair (xpAttr "box" xpText) (xpOption (xpAttr "origin" xpText)))) + +instance Show Bound where + show = + showPickled [] + +instance BoxL Bound where + boxL = + Lens $ \(Bound box origin) -> store (\box -> Bound box origin) box + +instance OriginL Bound where + originL = + Lens $ \(Bound box origin) -> store (\origin -> Bound box origin) origin + +-- | Constructs a bound with a box and origin attributes. +bound :: + String -- ^ The @box@ attribute. + -> Maybe String -- ^ The @origin@ attribute. + -> Bound +bound = + Bound diff --git a/src/Data/Geo/OSM/Bounds.hs b/src/Data/Geo/OSM/Bounds.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Bounds.hs @@ -0,0 +1,60 @@ +-- | The @bounds@ element of a OSM file. +module Data.Geo.OSM.Bounds +( + Bounds +, bounds +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.MinlatL +import Data.Geo.OSM.Lens.MaxlatL +import Data.Geo.OSM.Lens.MinlonL +import Data.Geo.OSM.Lens.MaxlonL +import Data.Geo.OSM.Lens.OriginL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @bounds@ element of a OSM file. +data Bounds = + Bounds String String String String (Maybe String) + deriving Eq + +instance XmlPickler Bounds where + xpickle = + xpElem "bounds" (xpWrap (\(minlat', minlon', maxlat', maxlon', origin') -> bounds minlat' minlon' maxlat' maxlon' origin', \(Bounds minlat' minlon' maxlat' maxlon' origin') -> (minlat', minlon', maxlat', maxlon', origin')) + (xp5Tuple (xpAttr "minlat" xpText) (xpAttr "minlon" xpText) (xpAttr "maxlat" xpText) (xpAttr "maxlon" xpText) (xpOption (xpAttr "origin" xpText)))) + +instance Show Bounds where + show = + showPickled [] + +instance MinlatL Bounds where + minlatL = + Lens $ \(Bounds minlat minlon maxlat maxlon origin) -> store (\minlat -> Bounds minlat minlon maxlat maxlon origin) minlat + +instance MinlonL Bounds where + minlonL = + Lens $ \(Bounds minlat minlon maxlat maxlon origin) -> store (\minlon -> Bounds minlat minlon maxlat maxlon origin) minlon + +instance MaxlatL Bounds where + maxlatL = + Lens $ \(Bounds minlat minlon maxlat maxlon origin) -> store (\maxlat -> Bounds minlat minlon maxlat maxlon origin) maxlat + +instance MaxlonL Bounds where + maxlonL = + Lens $ \(Bounds minlat minlon maxlat maxlon origin) -> store (\maxlon -> Bounds minlat minlon maxlat maxlon origin) maxlon + +instance OriginL Bounds where + originL = + Lens $ \(Bounds minlat minlon maxlat maxlon origin) -> store (\origin -> Bounds minlat minlon maxlat maxlon origin) origin + +-- | Constructs a bounds with a minlat, minlon, maxlat, maxlon and origin attributes. +bounds :: + String -- ^ The @minlat@ attribute. + -> String -- ^ The @minlon@ attribute. + -> String -- ^ The @maxlat@ attribute. + -> String -- ^ The @maxlon@ attribute. + -> Maybe String -- ^ The @origin@ attribute. + -> Bounds +bounds = + Bounds diff --git a/src/Data/Geo/OSM/Changeset.hs b/src/Data/Geo/OSM/Changeset.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Changeset.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +-- | The @changeset@ element of a OSM file. +module Data.Geo.OSM.Changeset +( + Changeset +, changeset +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Lens.TagsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Newtype + +-- | The @changeset@ element of a OSM file. +newtype Changeset = + Changeset [Tag] + deriving Eq + +-- | Constructs a @changeset@ with tags. +changeset :: + [Tag] -- ^ The list of tags (@tag@ elements). + -> Changeset +changeset = + Changeset + +instance XmlPickler Changeset where + xpickle = + xpElem "changeset" (xpWrap (changeset, \(Changeset r) -> r) (xpList xpickle)) + +instance Show Changeset where + show = + showPickled [] + +instance TagsL Changeset where + tagsL = + Lens $ \(Changeset tags) -> store (\tags -> Changeset tags) tags + +instance Newtype Changeset [Tag] where + pack = + Changeset + unpack (Changeset x) = + x + diff --git a/src/Data/Geo/OSM/Children.hs b/src/Data/Geo/OSM/Children.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Children.hs @@ -0,0 +1,106 @@ +-- | The children elements of the @osm@ element of a OSM file. +module Data.Geo.OSM.Children +( + Children +, osmUser +, osmGpxFile +, osmApi +, osmChangeset +, osmNodeWayRelation +, foldChildren +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.User +import Data.Geo.OSM.Preferences +import Data.Geo.OSM.GpxFile +import Data.Geo.OSM.Api +import Data.Geo.OSM.Changeset +import Data.Geo.OSM.NodeWayRelation + +-- | The children elements of the @osm@ element of a OSM file. +data Children = + User User + | Preferences Preferences + | GpxFile GpxFile + | Api Api + | Changeset Changeset + | NWR [NodeWayRelation] + deriving Eq + +instance XmlPickler Children where + xpickle = + xpAlt (\r -> case r of + User _ -> 0 + Preferences _ -> 1 + GpxFile _ -> 2 + Api _ -> 3 + Changeset _ -> 4 + NWR _ -> 5) [xpWrap (User, \(User u) -> u) xpickle, + xpWrap (Preferences, \(Preferences p) -> p) xpickle, + xpWrap (GpxFile, \(GpxFile f) -> f) xpickle, + xpWrap (Api, \(Api a) -> a) xpickle, + xpWrap (Changeset, \(Changeset c) -> c) xpickle, + xpWrap (NWR, \(NWR k) -> k) (xpList xpickle)] + +instance Show Children where + show = + showPickled [] + +-- | A @user@ element. +osmUser :: + User + -> Children +osmUser = + User + +-- | A @gpx_file@ element. +osmGpxFile :: + GpxFile + -> Children +osmGpxFile = + GpxFile + +-- | A @api@ element. +osmApi :: + Api + -> Children +osmApi = + Api + +-- | A @changeset@ element. +osmChangeset :: + Changeset + -> Children +osmChangeset = + Changeset + +-- | A list of @node@, @way@ or @relation@ elements. +osmNodeWayRelation :: + [NodeWayRelation] + -> Children +osmNodeWayRelation = + NWR + +-- | Folds OSM child elements (catamorphism). +foldChildren :: + (User -> a) -- ^ If a @user@ element. + -> (Preferences -> a) -- ^ If a @preferences@ element. + -> (GpxFile -> a) -- ^ If a @gpx_file@ element. + -> (Api -> a) -- ^ If a @api@ element. + -> (Changeset -> a) -- ^ If a @changeset@ element. + -> ([NodeWayRelation] -> a) -- ^ If a list of @node@, @way@ or @relation@ elements. + -> Children -- ^ The disjunctive type of child elements. + -> a +foldChildren z _ _ _ _ _ (User u) = + z u +foldChildren _ z _ _ _ _ (Preferences p) = + z p +foldChildren _ _ z _ _ _ (GpxFile f) = + z f +foldChildren _ _ _ z _ _ (Api a) = + z a +foldChildren _ _ _ _ z _ (Changeset c) = + z c +foldChildren _ _ _ _ _ z (NWR k) = + z k diff --git a/src/Data/Geo/OSM/GpxFile.hs b/src/Data/Geo/OSM/GpxFile.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/GpxFile.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} + +-- | The @gpx_file@ element of a OSM file. +module Data.Geo.OSM.GpxFile +( + GpxFile +, gpxFile +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Char +import Data.Geo.OSM.Lens.IdL +import Data.Geo.OSM.Lens.NameL +import Data.Geo.OSM.Lens.LatL +import Data.Geo.OSM.Lens.LonL +import Data.Geo.OSM.Lens.UserL +import Data.Geo.OSM.Lens.PublicL +import Data.Geo.OSM.Lens.PendingL +import Data.Geo.OSM.Lens.TimestampL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @gpx_file@ element of a OSM file. +data GpxFile = + GpxFile String String String String String Bool Bool String + deriving Eq + +-- | Constructs a @gpx_file@ with an id, name, lat, lon, user, public, pending and timestamp. +gpxFile :: + String -- ^ The @id@ attribute. + -> String -- ^ The @name@ attribute. + -> String -- ^ The @lat@ attribute. + -> String -- ^ The @lon@ attribute. + -> String -- ^ The @user@ attribute. + -> Bool -- ^ The @public@ attribute. + -> Bool -- ^ The @pending@ attribute. + -> String -- ^ The @timestamp@ attribute. + -> GpxFile +gpxFile = + GpxFile + +instance XmlPickler GpxFile where + xpickle = + let b = xpWrapMaybe (\s -> case fmap toLower s + of "true" -> Just True + "false" -> Just False + _ -> Nothing, fmap toLower . show) + in xpElem "gpx_file" (xpWrap (\(id'', name', lat', lon', user', public', pending', timestamp') -> gpxFile id'' name' lat' lon' user' public' pending' timestamp', \(GpxFile id'' name' lat' lon' user' public' pending' timestamp') -> (id'', name', lat', lon', user', public', pending', timestamp')) (xp8Tuple (xpAttr "id" xpText) (xpAttr "name" xpText) (xpAttr "lat" xpText) (xpAttr "lon" xpText) (xpAttr "user" xpText) (xpDefault False (b (xpAttr "public" xpText))) (xpDefault False (b (xpAttr "pending" xpText))) (xpAttr "timestamp" xpText))) + +instance Show GpxFile where + show = + showPickled [] + +instance IdL GpxFile where + idL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\id -> GpxFile id name lat lon user public pending timestamp) id + +instance NameL GpxFile where + nameL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\name -> GpxFile id name lat lon user public pending timestamp) name + +instance LatL GpxFile where + latL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\lat -> GpxFile id name lat lon user public pending timestamp) lat + +instance LonL GpxFile where + lonL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\lon -> GpxFile id name lat lon user public pending timestamp) lon + +instance UserL GpxFile String where + userL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\user -> GpxFile id name lat lon user public pending timestamp) user + +instance PublicL GpxFile where + publicL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\public -> GpxFile id name lat lon user public pending timestamp) public + +instance PendingL GpxFile where + pendingL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\pending -> GpxFile id name lat lon user public pending timestamp) pending + +instance TimestampL GpxFile String where + timestampL = + Lens $ \(GpxFile id name lat lon user public pending timestamp) -> store (\timestamp -> GpxFile id name lat lon user public pending timestamp) timestamp + diff --git a/src/Data/Geo/OSM/Home.hs b/src/Data/Geo/OSM/Home.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Home.hs @@ -0,0 +1,48 @@ +-- | The @home@ element of a OSM file. +module Data.Geo.OSM.Home +( + Home +, home +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.LatL +import Data.Geo.OSM.Lens.LonL +import Data.Geo.OSM.Lens.ZoomL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @home@ element of a OSM file. +data Home = + Home String String String + deriving Eq + +-- | Constructs a @home@ with lat, lon and zoom. +home :: + String -- ^ The @lat@ attribute. + -> String -- ^ The @lon@ attribute. + -> String -- ^ The @zoom@ attribute. + -> Home +home = + Home + +instance XmlPickler Home where + xpickle = + xpElem "home" (xpWrap (\(lat', lon', zoom') -> home lat' lon' zoom', \(Home lat' lon' zoom') -> (lat', lon', zoom')) (xpTriple (xpAttr "lat" xpText) (xpAttr "lon" xpText) (xpAttr "zoom" xpText))) + +instance Show Home where + show = + showPickled [] + +instance LatL Home where + latL = + Lens $ \(Home lat lon zoom) -> store (\lat -> Home lat lon zoom) lat + +instance LonL Home where + lonL = + Lens $ \(Home lat lon zoom) -> store (\lon -> Home lat lon zoom) lon + +instance ZoomL Home where + zoomL = + Lens $ \(Home lat lon zoom) -> store (\zoom -> Home lat lon zoom) zoom + diff --git a/src/Data/Geo/OSM/Member.hs b/src/Data/Geo/OSM/Member.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Member.hs @@ -0,0 +1,49 @@ +-- | The @member@ element of a OSM file. +module Data.Geo.OSM.Member +( + Member +, member +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.MemberType +import Data.Geo.OSM.Lens.TypeL +import Data.Geo.OSM.Lens.RefL +import Data.Geo.OSM.Lens.RoleL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @member@ element of a OSM file. +data Member = + Member MemberType String String + deriving Eq + +instance XmlPickler Member where + xpickle = + xpElem "member" (xpWrap (\(mtype', mref', mrole') -> member mtype' mref' mrole', \(Member mtype' mref' mrole') -> (mtype', mref', mrole')) + (xpTriple xpickle (xpAttr "ref" xpText) (xpAttr "role" xpText))) + +instance Show Member where + show = + showPickled [] + +instance TypeL Member where + typeL = + Lens $ \(Member typ ref role) -> store (\typ -> Member typ ref role) typ + +instance RefL Member where + refL = + Lens $ \(Member typ ref role) -> store (\ref -> Member typ ref role) ref + +instance RoleL Member where + roleL = + Lens $ \(Member typ ref role) -> store (\role -> Member typ ref role) role + +-- | Constructs a member with a type, ref and role. +member :: + MemberType -- ^ The member @type@ attribute. + -> String -- ^ The member @ref@ attribute. + -> String -- ^ The member @role@ attribute. + -> Member +member = + Member diff --git a/src/Data/Geo/OSM/MemberType.hs b/src/Data/Geo/OSM/MemberType.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/MemberType.hs @@ -0,0 +1,67 @@ +-- | The @type@ attribute of a @member@ element of a OSM file. +module Data.Geo.OSM.MemberType +( + MemberType +, foldMemberType +, wayType +, nodeType +, relationType +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Char + +-- | The @type@ attribute of a @member@ element of a OSM file. +data MemberType = + WayType + | NodeType + | RelationType + deriving Eq + +-- | Folds a member-type (catamorphism). +foldMemberType :: + MemberType -- ^ The member-type to fold. + -> x -- ^ If the type is a way. + -> x -- ^ If the type is a node. + -> x -- ^ If the type is a relation. + -> x +foldMemberType WayType x _ _ = + x +foldMemberType NodeType _ x _ = + x +foldMemberType RelationType _ _ x = + x + +instance XmlPickler MemberType where + xpickle = + xpWrapMaybe (\s -> case fmap toLower s of + "way" -> Just WayType + "node" -> Just NodeType + "relation" -> Just RelationType + _ -> Nothing, + \t -> case t of + WayType -> "way" + NodeType -> "node" + RelationType -> "relation") (xpAttr "type" xpText) + +instance Show MemberType where + show = + showPickled [] + +-- | Constructs a member-type that is a way. +wayType :: + MemberType +wayType = + WayType + +-- | Constructs a member-type that is a node. +nodeType :: + MemberType +nodeType = + NodeType + +-- | Constructs a member-type that is a relation. +relationType :: + MemberType +relationType = + RelationType diff --git a/src/Data/Geo/OSM/NWRCommon.hs b/src/Data/Geo/OSM/NWRCommon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/NWRCommon.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +-- | The common attributes between the @node@, @way@ and @relation@ elements. +module Data.Geo.OSM.NWRCommon +( + NWRCommon +, nwrCommon +) where + +import Text.XML.HXT.Arrow.Pickle +import Control.Applicative +import Data.Char +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Lens.IdL +import Data.Geo.OSM.Lens.TagsL +import Data.Geo.OSM.Lens.ChangesetL +import Data.Geo.OSM.Lens.VisibleL +import Data.Geo.OSM.Lens.UserL +import Data.Geo.OSM.Lens.UidL +import Data.Geo.OSM.Lens.TimestampL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The common attributes between the @node@, @way@ and @relation@ elements. +data NWRCommon = + NWRCommon String [Tag] (Maybe String) Bool (Maybe String, Maybe String) (Maybe String) + deriving Eq + +instance XmlPickler NWRCommon where + xpickle = + xpWrap (\(a, b, c, d, e, f) -> nwrCommon a b c d e f, \(NWRCommon a b c d e f) -> (a, b, c, d, e, f)) + (xp6Tuple (xpAttr "id" xpText) + (xpList xpickle) + (xpOption (xpAttr "changeset" xpText)) + (xpDefault True (xpWrapMaybe (\s -> case toLower <$> s of + "true" -> Just True + "false" -> Just False + _ -> Nothing, (toLower <$>) . show) (xpAttr "visible" xpText))) + (xpPair (xpOption (xpAttr "user" xpText)) (xpOption (xpAttr "uid" xpText))) + (xpOption (xpAttr "timestamp" xpText))) + +instance Show NWRCommon where + show = + showPickled [] + +instance IdL NWRCommon where + idL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\id -> NWRCommon id tags changeset visible (user, uid) timestamp) id + +instance TagsL NWRCommon where + tagsL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\tags -> NWRCommon id tags changeset visible (user, uid) timestamp) tags + +instance ChangesetL NWRCommon where + changesetL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\changeset -> NWRCommon id tags changeset visible (user, uid) timestamp) changeset + +instance VisibleL NWRCommon where + visibleL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\visible -> NWRCommon id tags changeset visible (user, uid) timestamp) visible + +instance UserL NWRCommon (Maybe String) where + userL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\user -> NWRCommon id tags changeset visible (user, uid) timestamp) user + +instance UidL NWRCommon where + uidL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\uid -> NWRCommon id tags changeset visible (user, uid) timestamp) uid + +instance TimestampL NWRCommon (Maybe String) where + timestampL = + Lens $ \(NWRCommon id tags changeset visible (user, uid) timestamp) -> store (\timestamp -> NWRCommon id tags changeset visible (user, uid) timestamp) timestamp + +-- | Constructs with id, list of tags, changeset, visible, user&uid and timestamp. +nwrCommon :: + String -- ^ The @id@ attribute. + -> [Tag] -- ^ The list of tags (@tag@ elements). + -> Maybe String -- ^ The @changeset@ attribute. + -> Bool -- ^ The @visible@ attribute. + -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. + -> Maybe String -- ^ The @timestamp@ attribute. + -> NWRCommon +nwrCommon = + NWRCommon diff --git a/src/Data/Geo/OSM/Nd.hs b/src/Data/Geo/OSM/Nd.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Nd.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} + +-- | The @nd@ element of a OSM file. +module Data.Geo.OSM.Nd +( + Nd +, nd +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.RefL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Newtype + +-- | The @nd@ element of a OSM file. +newtype Nd = + Nd String + deriving Eq + +instance XmlPickler Nd where + xpickle = + xpElem "nd" (xpWrap (nd, \(Nd r) -> r) (xpAttr "ref" xpText)) + +instance Show Nd where + show = + showPickled [] + +instance RefL Nd where + refL = + Lens $ \(Nd ref) -> store (\ref -> Nd ref) ref + +instance Newtype Nd String where + pack = + Nd + unpack (Nd x) = + x + +-- | Constructs a nd with a ref. +nd :: + String -- ^ The @ref@ attribute. + -> Nd +nd = + Nd diff --git a/src/Data/Geo/OSM/Node.hs b/src/Data/Geo/OSM/Node.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Node.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +-- | The @node@ element of a OSM file. +module Data.Geo.OSM.Node +( + Node +, node +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.NWRCommon +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Lens.LatL +import Data.Geo.OSM.Lens.LonL +import Data.Geo.OSM.Lens.IdL +import Data.Geo.OSM.Lens.TagsL +import Data.Geo.OSM.Lens.ChangesetL +import Data.Geo.OSM.Lens.VisibleL +import Data.Geo.OSM.Lens.UserL +import Data.Geo.OSM.Lens.UidL +import Data.Geo.OSM.Lens.TimestampL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Category +import Prelude hiding ((.)) + +-- | The @node@ element of a OSM file. +data Node = + Node String String NWRCommon + deriving Eq + +instance XmlPickler Node where + xpickle = + xpElem "node" (xpWrap (\(lat', lon', nwr') -> Node lat' lon' nwr', \(Node lat' lon' nwr') -> (lat', lon', nwr')) + (xpTriple (xpAttr "lat" xpText) (xpAttr "lon" xpText) xpickle)) + +instance Show Node where + show = + showPickled [] + +instance LatL Node where + latL = + Lens $ \(Node lat lon common) -> store (\lat -> Node lat lon common) lat + +instance LonL Node where + lonL = + Lens $ \(Node lat lon common) -> store (\lon -> Node lat lon common) lon + +-- not exported +commonL :: + Lens Node NWRCommon +commonL = + Lens (\(Node lat lon common) -> store (\common -> Node lat lon common) common) + +instance IdL Node where + idL = + idL . commonL + +instance TagsL Node where + tagsL = + tagsL . commonL + +instance ChangesetL Node where + changesetL = + changesetL . commonL + +instance VisibleL Node where + visibleL = + visibleL . commonL + +instance UserL Node (Maybe String) where + userL = + userL . commonL + +instance UidL Node where + uidL = + uidL . commonL + +instance TimestampL Node (Maybe String) where + timestampL = + timestampL . commonL + +-- | Constructs a node with a lat, lon, id, list of tags, changeset, visible, user&uid and timestamp. +node :: + String -- ^ The @lat@ attribute. + -> String -- ^ The @lon@ attribute. + -> String -- ^ The @id@ attribute. + -> [Tag] -- ^ The list of tags (@tag@ elements). + -> Maybe String -- ^ The @changeset@ attribute. + -> Bool -- ^ The @visible@ attribute. + -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. + -> Maybe String -- ^ The @timestamp@ attribute. + -> Node +node = + flip flip nwrCommon . (((.) . (.) . (.) . (.) . (.) . (.)) .) . Node diff --git a/src/Data/Geo/OSM/NodeWayRelation.hs b/src/Data/Geo/OSM/NodeWayRelation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/NodeWayRelation.hs @@ -0,0 +1,98 @@ +-- | The @node@, @way@, or @relation@ element of a OSM file. +module Data.Geo.OSM.NodeWayRelation +( + NodeWayRelation +, foldNodeWayRelation +, way' +, relation' +, node' +, isNode +, isWay +, isRelation +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Node +import Data.Geo.OSM.Way +import Data.Geo.OSM.Relation + +-- | The @node@, @way@, or @relation@ element of a OSM file. +data NodeWayRelation = + N Node + | W Way + | R Relation + deriving Eq + +-- | Folds a node-way-relation (catamorphism). +foldNodeWayRelation :: + NodeWayRelation -- ^ The @node@, @way@ or @relation@ element. + -> (Node -> x) -- ^ If this is a @node@ element. + -> (Way -> x) -- ^ If this is a @way@ element. + -> (Relation -> x) -- ^ If this is a @relation@ element. + -> x +foldNodeWayRelation (N n) x _ _ = + x n +foldNodeWayRelation (W w) _ x _ = + x w +foldNodeWayRelation (R r) _ _ x = + x r + +instance XmlPickler NodeWayRelation where + xpickle = + xpAlt (\r -> case r of + N _ -> 0 + W _ -> 1 + R _ -> 2) + [xpWrap (N, \(N n) -> n) xpickle, xpWrap (W, \(W w) -> w) xpickle, xpWrap (R, \(R r) -> r) xpickle] + +instance Show NodeWayRelation where + show = + showPickled [] + +-- | Construct a @way@ element value. +way' :: + Way + -> NodeWayRelation +way' = + W + +-- | Construct a @relation@ element value. +relation' :: + Relation + -> NodeWayRelation +relation' = + R + +-- | Construct a @node@ element value. +node' :: + Node + -> NodeWayRelation +node' = + N + +-- | Returns whether the @node@, @way@ or @relation@ element is a node. +isNode :: + NodeWayRelation + -> Bool +isNode (N _) = + True +isNode _ = + False + +-- | Returns whether the @node@, @way@ or @relation@ element is a way. +isWay :: + NodeWayRelation + -> Bool +isWay (W _) = + True +isWay _ = + False + +-- | Returns whether the @node@, @way@ or @relation@ element is a relation. +isRelation :: + NodeWayRelation + -> Bool +isRelation (R _) = + True +isRelation _ = + False diff --git a/src/Data/Geo/OSM/OSM.hs b/src/Data/Geo/OSM/OSM.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/OSM.hs @@ -0,0 +1,199 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} + +-- | The @osm@ element of a OSM file, which is the root element. +module Data.Geo.OSM.OSM +( + OSM +, osm +, readOsmFile +, readOsmFiles +, interactOSMIO +, interactsOSMIO +, interactOSMIO' +, interactsOSMIO' +, interactOSM +, interactsOSM +, interactOSM' +, interactsOSM' +) where + +import Prelude hiding (mapM, foldr) + +import Text.XML.HXT.Core +import Control.Monad hiding (mapM) +import Data.Foldable +import Data.Traversable +import Data.Geo.OSM.Children +import Data.Geo.OSM.Bound +import Data.Geo.OSM.Bounds +import Data.Geo.OSM.BoundOption +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Data.Geo.OSM.Lens.VersionL +import Data.Geo.OSM.Lens.GeneratorL +import Data.Geo.OSM.Lens.BoundsL +import Data.Geo.OSM.Lens.ChildrenL +import Data.Monoid + +-- | The @osm@ element of a OSM file, which is the root element. +data OSM = + OSM String (Maybe String) (Maybe (Either Bound Bounds)) Children + deriving Eq + +instance XmlPickler OSM where + xpickle = + xpElem "osm" (xpWrap (\(version', generator', bound', nwr') -> osm version' generator' bound' nwr', \(OSM version' generator' bound' nwr') -> (version', generator', bound', nwr')) + (xp4Tuple (xpAttr "version" xpText) + (xpOption (xpAttr "generator" xpText)) + (xpOption (xpAlt (either (const 0) (const 1)) [xpWrap (Left, \(Left b) -> b) xpickle, xpWrap (Right, \(Right b) -> b) xpickle])) + xpickle)) + +instance Show OSM where + show = + showPickled [] + +instance VersionL OSM String where + versionL = + Lens $ \(OSM version generator bounds children) -> store (\version -> OSM version generator bounds children) version + +instance BoundsL OSM where + boundsL = + Lens $ \(OSM version generator bounds children) -> store (\bounds -> OSM version generator (foldBoundOption (Just . Left) (Just . Right) Nothing bounds) children) $ + case bounds of + Nothing -> optionEmptyBound + Just (Left b) -> optionBound b + Just (Right b) -> optionBounds b + +instance GeneratorL OSM where + generatorL = + Lens $ \(OSM version generator bounds children) -> store (\generator -> OSM version generator bounds children) generator + +instance ChildrenL OSM where + childrenL = + Lens $ \(OSM version generator bounds children) -> store (\children -> OSM version generator bounds children) children + +-- | Constructs a osm with a version, bound or bounds, and node attributes and way or relation elements. +osm :: + String -- ^ The @version@ attribute. + -> Maybe String -- ^ The @generator@ attribute. + -> Maybe (Either Bound Bounds) -- ^ The @bound@ or @bounds@ elements. + -> Children -- ^ The child elements. + -> OSM +osm = + OSM + +-- | Reads an OSM file into a list of @OSM@ values removing whitespace. +readOsmFile :: + FilePath + -> IO [OSM] +readOsmFile = + runX . xunpickleDocument (xpickle :: PU OSM) ([withRemoveWS yes, withFileMimeType v_1]) -- FIXME v_1? + +-- | Reads 0 or more OSM files into a list of @OSM@ values removing whitespace. +readOsmFiles :: + [FilePath] + -> IO [OSM] +readOsmFiles = + fmap join . mapM readOsmFile + +-- | Reads a OSM file, executes the given function on the XML, then writes the given file. +interactOSMIO' :: + (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. + -> SysConfigList -- ^ The options for reading the OSM file. + -> FilePath -- ^ The OSM file to read. + -> SysConfigList -- ^ The options for writing the OSM file. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactOSMIO' f froma from toa to = + runX (xunpickleDocument (xpickle :: PU OSM) froma from >>> arrIO f >>> xpickleDocument (xpickle :: PU OSM) toa to) >> return () + +-- | Reads a OSM file, executes the given functions on the XML, then writes the given file. +interactsOSMIO' :: + Foldable t => + t (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. + -> SysConfigList -- ^ The options for reading the OSM file. + -> FilePath -- ^ The OSM file to read. + -> SysConfigList -- ^ The options for writing the OSM file. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactsOSMIO' = + interactOSMIO' . sumM + +-- | Reads a OSM file removing whitespace, executes the given function on the XML, then writes the given file with indentation. +interactOSMIO :: + (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. + -> FilePath -- ^ The OSM file to read. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactOSMIO f from = + interactOSMIO' f [withRemoveWS yes, withFileMimeType v_1] from [withIndent yes, withFileMimeType v_1] + +-- | Reads a OSM file removing whitespace, executes the given functions on the XML, then writes the given file with indentation. +interactsOSMIO :: + Foldable t => + t (OSM -> IO OSM) -- ^ The function to execute on the XML that is read. + -> FilePath -- ^ The OSM file to read. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactsOSMIO = + interactOSMIO . sumM + +-- | Reads a OSM file, executes the given function on the XML, then writes the given file. +interactOSM' :: + (OSM -> OSM) -- ^ The function to execute on the XML that is read. + -> SysConfigList -- ^ The options for reading the OSM file. + -> FilePath -- ^ The OSM file to read. + -> SysConfigList -- ^ The options for writing the OSM file. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactOSM' f = + interactOSMIO' (return . f) + +-- | Reads a OSM file, executes the given functions on the XML, then writes the given file. +interactsOSM' :: + Foldable t => + t (OSM -> OSM) -- ^ The functions to execute on the XML that is read. + -> SysConfigList -- ^ The options for reading the OSM file. + -> FilePath -- ^ The OSM file to read. + -> SysConfigList -- ^ The options for writing the OSM file. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactsOSM' = + interactOSM' . sum' + +-- | Reads a OSM file removing whitespace, executes the given function on the XML, then writes the given file with indentation. +interactOSM :: + (OSM -> OSM) -- ^ The function to execute on the XML that is read. + -> FilePath -- ^ The OSM file to read. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactOSM f = + interactOSMIO (return . f) + +-- | Reads a OSM file removing whitespace, executes the given functions on the XML, then writes the given file with indentation. +interactsOSM :: + Foldable t => + t (OSM -> OSM) -- ^ The function to execute on the XML that is read. + -> FilePath -- ^ The OSM file to read. + -> FilePath -- ^ The OSM file to write. + -> IO () +interactsOSM = + interactOSM . sum' + +-- not exported + +sum' :: + Foldable t => + t (a -> a) + -> a + -> a +sum' = + appEndo . foldMap Endo + +sumM :: + (Monad m, Foldable t) => + t (a -> m a) + -> a + -> m a +sumM = + foldr (>=>) return diff --git a/src/Data/Geo/OSM/Preferences.hs b/src/Data/Geo/OSM/Preferences.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Preferences.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +-- | The @preferences@ element of a OSM file. +module Data.Geo.OSM.Preferences +( + Preferences +, preferences +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Lens.TagsL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Newtype + +-- | The @preferences@ element of a OSM file. +newtype Preferences = + Preferences [Tag] + deriving Eq + +-- | Constructs a @preferences@ with tags. +preferences :: + [Tag] -- ^ The list of tags (@tag@ elements). + -> Preferences +preferences = + Preferences + +instance XmlPickler Preferences where + xpickle = + xpElem "preferences" (xpWrap (preferences, \(Preferences r) -> r) (xpList xpickle)) + +instance Show Preferences where + show = + showPickled [] + +instance TagsL Preferences where + tagsL = + Lens $ \(Preferences tags) -> store (\tags -> Preferences tags) tags + +instance Newtype Preferences [Tag] where + pack = + Preferences + unpack (Preferences x) = + x + diff --git a/src/Data/Geo/OSM/Relation.hs b/src/Data/Geo/OSM/Relation.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Relation.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +-- | The @relation@ element of a OSM file. +module Data.Geo.OSM.Relation +( + Relation +, relation +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Member +import Data.Geo.OSM.NWRCommon +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Lens.IdL +import Data.Geo.OSM.Lens.TagsL +import Data.Geo.OSM.Lens.ChangesetL +import Data.Geo.OSM.Lens.VisibleL +import Data.Geo.OSM.Lens.UserL +import Data.Geo.OSM.Lens.UidL +import Data.Geo.OSM.Lens.TimestampL +import Data.Geo.OSM.Lens.MemberL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Category +import Prelude hiding ((.)) + +-- | The @relation@ element of a OSM file. +data Relation = + Relation [Member] NWRCommon + deriving Eq + +instance XmlPickler Relation where + xpickle = + xpElem "relation" (xpWrap (uncurry Relation, \(Relation m r) -> (m, r)) + (xpPair (xpList xpickle) xpickle)) + +instance Show Relation where + show = + showPickled [] + +instance MemberL Relation where + memberL = + Lens $ \(Relation members common) -> store (\members -> Relation members common) members + +-- not exported +commonL :: + Lens Relation NWRCommon +commonL = + Lens (\(Relation members common) -> store (\common -> Relation members common) common) + +instance IdL Relation where + idL = + idL . commonL + +instance TagsL Relation where + tagsL = + tagsL . commonL + +instance ChangesetL Relation where + changesetL = + changesetL . commonL + +instance VisibleL Relation where + visibleL = + visibleL . commonL + +instance UserL Relation (Maybe String) where + userL = + userL . commonL + +instance UidL Relation where + uidL = + uidL . commonL + +instance TimestampL Relation (Maybe String) where + timestampL = + timestampL . commonL + +-- | Constructs a relation with a list of members, id, list of tags, changeset, visible, user&uid and timestamp. +relation :: + [Member] -- ^ The list of members (@member@ elements). + -> String -- ^ The @id@ attribute. + -> [Tag] -- ^ The list of tags (@tag@ elements). + -> Maybe String -- ^ The @changeset@ attribute. + -> Bool -- ^ The @visible@ attribute. + -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. + -> Maybe String -- ^ The @timestamp@ attribute. + -> Relation +relation = + (. nwrCommon) . (.) . (.) . (.) . (.) . (.) . Relation diff --git a/src/Data/Geo/OSM/Tag.hs b/src/Data/Geo/OSM/Tag.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Tag.hs @@ -0,0 +1,42 @@ +-- | The @tag@ element of a OSM file. +module Data.Geo.OSM.Tag +( + Tag +, tag +) where + + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.KL +import Data.Geo.OSM.Lens.VL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @tag@ element of a OSM file. +data Tag = + Tag String String + deriving Eq + +instance XmlPickler Tag where + xpickle = + xpElem "tag" (xpWrap (uncurry tag, \(Tag k' v') -> (k', v')) (xpPair (xpAttr "k" xpText) (xpAttr "v" xpText))) + +instance Show Tag where + show = + showPickled [] + +instance KL Tag where + kL = + Lens $ \(Tag k v) -> store (\k -> Tag k v) k + +instance VL Tag where + vL = + Lens $ \(Tag k v) -> store (\v -> Tag k v) v + +-- | Constructs a tag with a key and value. +tag :: + String -- ^ The key (@k@ attribute). + -> String -- ^ The value (@v@ attribute). + -> Tag +tag = + Tag diff --git a/src/Data/Geo/OSM/Tracepoints.hs b/src/Data/Geo/OSM/Tracepoints.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Tracepoints.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} + +-- | The @tracepoints@ element of a OSM file. +module Data.Geo.OSM.Tracepoints +( + Tracepoints +, tracepoints +) where + + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.PerPageL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Newtype + +-- | The @tracepoints@ element of a OSM file. +newtype Tracepoints = + Tracepoints String + deriving Eq + +-- | Constructs a @tracepoints@ with per_page. +tracepoints :: + String -- ^ The @per_page@ attribute. + -> Tracepoints +tracepoints = + Tracepoints + +instance XmlPickler Tracepoints where + xpickle = + xpElem "tracepoints" (xpWrap (tracepoints, \(Tracepoints r) -> r) (xpAttr "per_page" xpText)) + +instance Show Tracepoints where + show = + showPickled [] + +instance PerPageL Tracepoints where + perPageL = + Lens $ \(Tracepoints perPage) -> store (\perPage -> Tracepoints perPage) perPage + +instance Newtype Tracepoints String where + pack = + Tracepoints + unpack (Tracepoints x) = + x + diff --git a/src/Data/Geo/OSM/User.hs b/src/Data/Geo/OSM/User.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/User.hs @@ -0,0 +1,49 @@ +-- | The @user@ element of a OSM file. +module Data.Geo.OSM.User +( + User +, user +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Home +import Data.Geo.OSM.Lens.HomeL +import Data.Geo.OSM.Lens.DisplayNameL +import Data.Geo.OSM.Lens.AccountCreatedL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @user@ element of a OSM file. +data User = + User (Maybe Home) String String + deriving Eq + +-- | Constructs a @user@ with an optional home, display_name and account_created. +user :: + Maybe Home -- ^ The @home@ element. + -> String -- ^ The @display_name@ attribute. + -> String -- ^ The @account_created@ attribute. + -> User +user = + User + +instance XmlPickler User where + xpickle = + xpElem "user" (xpWrap (\(home', dn', ac') -> user home' dn' ac', \(User home' dn' ac') -> (home', dn', ac')) (xpTriple (xpOption (xpElem "home" xpickle)) (xpAttr "display_name" xpText) (xpAttr "account_created" xpText))) + +instance Show User where + show = + showPickled [] + +instance HomeL User where + homeL = + Lens $ \(User home displayName accountCreated) -> store (\home -> User home displayName accountCreated) home + +instance DisplayNameL User where + displayNameL = + Lens $ \(User home displayName accountCreated) -> store (\displayName -> User home displayName accountCreated) displayName + +instance AccountCreatedL User where + accountCreatedL = + Lens $ \(User home displayName accountCreated) -> store (\accountCreated -> User home displayName accountCreated) accountCreated + diff --git a/src/Data/Geo/OSM/Version.hs b/src/Data/Geo/OSM/Version.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Version.hs @@ -0,0 +1,43 @@ +-- | The @version@ element of a OSM file. +module Data.Geo.OSM.Version +( + Version +, version +) where + + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.MinimumL +import Data.Geo.OSM.Lens.MaximumL +import Data.Lens.Common +import Control.Comonad.Trans.Store + +-- | The @version@ element of a OSM file. +data Version = + Version String String + deriving Eq + +-- | Constructs a @version@ with minimum and maximum. +version :: + String -- ^ The @minimum@ attribute. + -> String -- ^ The @maximum@ attribute. + -> Version +version = + Version + +instance XmlPickler Version where + xpickle = + xpElem "version" (xpWrap (uncurry version, \(Version min' max') -> (min', max')) (xpPair (xpAttr "minimum" xpText) (xpAttr "maximum" xpText))) + +instance Show Version where + show = + showPickled [] + +instance MinimumL Version where + minimumL = + Lens $ \(Version minimum maximum) -> store (\minimum -> Version minimum maximum) minimum + +instance MaximumL Version where + maximumL = + Lens $ \(Version minimum maximum) -> store (\maximum -> Version minimum maximum) maximum + diff --git a/src/Data/Geo/OSM/Way.hs b/src/Data/Geo/OSM/Way.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Way.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} + +-- | The @way@ element of a OSM file. +module Data.Geo.OSM.Way +( + Way +, way +) where + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Nd +import Data.Geo.OSM.NWRCommon +import Data.Geo.OSM.Tag +import Data.Geo.OSM.Lens.NdL +import Data.Geo.OSM.Lens.IdL +import Data.Geo.OSM.Lens.TagsL +import Data.Geo.OSM.Lens.ChangesetL +import Data.Geo.OSM.Lens.VisibleL +import Data.Geo.OSM.Lens.UserL +import Data.Geo.OSM.Lens.UidL +import Data.Geo.OSM.Lens.TimestampL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Category +import Prelude hiding ((.)) + +-- | The @way@ element of a OSM file. +data Way = + Way [Nd] NWRCommon + deriving Eq + +instance XmlPickler Way where + xpickle = + xpElem "way" (xpWrap (uncurry Way, \(Way n r) -> (n, r)) + (xpPair (xpList xpickle) xpickle)) + +instance Show Way where + show = + showPickled [] + +instance NdL Way where + ndL = + Lens $ \(Way nds common) -> store (\nds -> Way nds common) nds + +-- not exported +commonL :: + Lens Way NWRCommon +commonL = + Lens (\(Way nds common) -> store (\common -> Way nds common) common) + +instance IdL Way where + idL = + idL . commonL + +instance TagsL Way where + tagsL = + tagsL . commonL + +instance ChangesetL Way where + changesetL = + changesetL . commonL + +instance VisibleL Way where + visibleL = + visibleL . commonL + +instance UserL Way (Maybe String) where + userL = + userL . commonL + +instance UidL Way where + uidL = + uidL . commonL + +instance TimestampL Way (Maybe String) where + timestampL = + timestampL . commonL + +-- | Constructs a way with a list of nds, id, list of tags, changeset, visible, user&uid and timestamp. +way :: + [Nd] -- ^ The list of nds (@nd@ elements). + -> String -- ^ The @id@ attribute. + -> [Tag] -- ^ The list of tags (@tag@ elements). + -> Maybe String -- ^ The @changeset@ attribute. + -> Bool -- ^ The @visible@ attribute. + -> (Maybe String, Maybe String) -- ^ The @user@ and @uid@ attributes. + -> Maybe String -- ^ The @timestamp@ attribute. + -> Way +way = + (. nwrCommon) . (.) . (.) . (.) . (.) . (.) . Way diff --git a/src/Data/Geo/OSM/Waynodes.hs b/src/Data/Geo/OSM/Waynodes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geo/OSM/Waynodes.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} + +-- | The @waynodes@ element of a OSM file. +module Data.Geo.OSM.Waynodes +( + Waynodes +, waynodes +) where + + +import Text.XML.HXT.Arrow.Pickle +import Data.Geo.OSM.Lens.MaximumL +import Data.Lens.Common +import Control.Comonad.Trans.Store +import Control.Newtype + +-- | The @waynodes@ element of a OSM file. +newtype Waynodes = + Waynodes String + deriving Eq + +-- | Constructs a @waynodes@ with maximum. +waynodes :: + String -- ^ The @maximum@ attribute. + -> Waynodes +waynodes = + Waynodes + +instance XmlPickler Waynodes where + xpickle = + xpElem "waynodes" (xpWrap (waynodes, \(Waynodes r) -> r) (xpAttr "maximum" xpText)) + +instance Show Waynodes where + show = + showPickled [] + +instance MaximumL Waynodes where + maximumL = + Lens $ \(Waynodes maximum) -> store (\maximum -> Waynodes maximum) maximum + +instance Newtype Waynodes String where + pack = + Waynodes + unpack (Waynodes x) = + x +