osm-conduit (empty) → 0.1.0.0
raw patch · 6 files changed
+472/−0 lines, 6 filesdep +basedep +conduitdep +exceptionssetup-changed
Dependencies added: base, conduit, exceptions, hspec, osm-conduit, resourcet, text, transformers, xml-conduit, xml-types
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- osm-conduit.cabal +48/−0
- src/Data/Conduit/OSM.hs +146/−0
- src/Data/Conduit/OSM/Types.hs +103/−0
- test/Spec.hs +143/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Przemyslaw Kopanski (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Przemyslaw Kopanski nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ osm-conduit.cabal view
@@ -0,0 +1,48 @@+name: osm-conduit+version: 0.1.0.0+synopsis: Parse and operate on OSM data in efficient way+description: Convenient *.osm parsing. See "Data.Conduit.OSM" or README.md+homepage: http://github.com/przembot/osm-conduit#readme+license: BSD3+license-file: LICENSE+author: Przemysław Kopański+maintainer: P.Kopanski@stud.elka.pw.edu.pl+copyright: (c) 2016 Przemysław Kopański+category: Data, Geography+build-type: Simple+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.Conduit.OSM+ , Data.Conduit.OSM.Types+ build-depends: base >= 4.7 && < 5+ , conduit+ , xml-types+ , xml-conduit >= 1.3.2+ , resourcet+ , transformers+ , text+ , exceptions+ ghc-options: -Wall+ default-language: Haskell2010++test-suite osm-conduit-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , osm-conduit+ , conduit+ , text+ , hspec+ , exceptions+ , resourcet+ , xml-conduit+ , xml-types+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/przembot/osm-conduit
+ src/Data/Conduit/OSM.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Available conduit combinators to process data from *.osm file.+-- For the best performance, use any of conduitNodes/Ways/Relations/NWR.+-- Example:+--+-- > import qualified Data.Conduit.List as CL+-- > import Text.XML.Stream.Parse (parseFile, def)+-- > printNodes filepath = parseFile def filepath =$ conduitNodes $$ CL.mapM_ print+--++module Data.Conduit.OSM+ (+ sourceFileOSM+ , conduitNWR+ , conduitNodes+ , conduitWays+ , conduitRelations+ , conduitOSM+ )+ where++import Data.Conduit (Consumer, Conduit, Source, ConduitM, (=$))+import Data.Text (Text, unpack, toLower)+import Data.XML.Types (Event, Name)+import Control.Monad.Catch (MonadThrow, throwM)+import Control.Monad.Trans.Resource (MonadResource)+import Control.Exception (ErrorCall(..))+import Text.Read (readMaybe)+import Text.XML.Stream.Parse (AttrParser, tagName, requireAttr, attr+ , ignoreAttrs, many, many', manyYield, manyYield'+ , parseFile, def, choose, tagIgnoreAttrs)+import Data.Conduit.OSM.Types++++sourceFileOSM :: MonadResource m => FilePath -> Source m OSM+sourceFileOSM path = parseFile def path =$ conduitOSM++conduitOSM :: MonadThrow m => Conduit Event m OSM+conduitOSM = manyYield parseOSM++conduitNodes :: MonadThrow m => Conduit Event m Node+conduitNodes = loopConduit $ tagIgnoreAttrs "osm" $ manyYield' parseNode++conduitWays :: MonadThrow m => Conduit Event m Way+conduitWays = loopConduit $ tagIgnoreAttrs "osm" $ manyYield' parseWay++conduitRelations :: MonadThrow m => Conduit Event m Relation+conduitRelations = loopConduit $ tagIgnoreAttrs "osm" $ manyYield' parseRelation++conduitNWR :: MonadThrow m => Conduit Event m NWRWrap+conduitNWR = loopConduit $ tagIgnoreAttrs "osm" $ manyYield' parseNWR++-- | Keep yielding output if parser can still parse anything remaining+loopConduit :: Monad m => ConduitM i o m (Maybe ()) -> Conduit i m o+loopConduit cond = loop+ where+ loop = cond >>= maybe (return ()) (const loop)++parseOSM :: MonadThrow m => Consumer Event m (Maybe OSM)+parseOSM = tagName "osm" tagParser $ \cont -> cont <$> parseBounds <*> many parseNode <*> many parseWay <*> many' parseRelation+ where+ tagParser = OSM <$> requireAttrRead "version" <*> attr "generator" <* ignoreAttrs+++-- | Wrap nodes, ways and relations+parseNWR :: MonadThrow m => Consumer Event m (Maybe NWRWrap)+parseNWR = choose [ fmap N <$> parseNode+ , fmap W <$> parseWay+ , fmap R <$> parseRelation ]+++parseNode :: MonadThrow m => Consumer Event m (Maybe Node)+parseNode = tagName "node" tagParser $ \cont -> cont <$> many' parseTag+ where+ tagParser = (\f latitude longitude tagz -> Node latitude longitude (f tagz))+ <$> nwrCommonParser+ <*> requireAttrRead "lat"+ <*> requireAttrRead "lon"+ <* ignoreAttrs+++parseWay :: MonadThrow m => Consumer Event m (Maybe Way)+parseWay = tagName "way" (nwrCommonParser <* ignoreAttrs)+ $ \cont -> Way <$> many parseNd <*> (cont <$> many' parseTag)+++parseRelation :: MonadThrow m => Consumer Event m (Maybe Relation)+parseRelation = tagName "relation" (nwrCommonParser <* ignoreAttrs)+ $ \cont -> Relation <$> many parseMember <*> (cont <$> many' parseTag)+++parseMember :: MonadThrow m => Consumer Event m (Maybe Member)+parseMember = tagName "member" tagParser return+ where+ tagParser = Member <$> (requireAttr "type" >>= readNWRType)+ <*> requireAttr "ref"+ <*> attr "role"+ <* ignoreAttrs+++parseNd :: MonadThrow m => Consumer Event m (Maybe Nd)+parseNd = tagName "nd" (Nd <$> requireAttr "ref" <* ignoreAttrs) return+++parseTag :: MonadThrow m => Consumer Event m (Maybe Tag)+parseTag = tagName "tag" tagParser (return . Tag)+ where+ tagParser = (,) <$> requireAttr "k" <*> requireAttr "v" <* ignoreAttrs++parseBounds :: MonadThrow m => Consumer Event m (Maybe Bounds)+parseBounds = tagName "bounds" tagParser return+ where+ tagParser = Bounds <$> requireAttrRead "minlat"+ <*> requireAttrRead "minlon"+ <*> requireAttrRead "maxlat"+ <*> requireAttrRead "maxlon"++nwrCommonParser :: AttrParser ([Tag] -> NWRCommon)+nwrCommonParser = NWRCommon <$> requireAttr "id"+ <*> fmap (>>= readBool) (attr "visible")+ <*> attr "chageset"+ <*> attr "timestamp"+ <*> attr "user"++readNWRType :: Text -> AttrParser NWR+readNWRType a =+ case toLower a of+ "node" -> return NWRn+ "relation" -> return NWRr+ "way" -> return NWRw+ _ -> throwM $ ErrorCall "unknown type in <member>"++fromStr :: Read a => Text -> Maybe a+fromStr = readMaybe . unpack++requireAttrRead :: Read a => Name -> AttrParser a+requireAttrRead str = requireAttr str+ >>= maybe (throwM $ ErrorCall "Could not parse attribute value") return . fromStr++readBool :: Text -> Maybe Bool+readBool a+ | toLower a == "true" = Just True+ | toLower a == "false" = Just False+ | otherwise = Nothing
+ src/Data/Conduit/OSM/Types.hs view
@@ -0,0 +1,103 @@+-- |+-- The following data types correspond to documentation of API version 0.6.+-- See https://wiki.openstreetmap.org/wiki/API_v0.6/DTD+module Data.Conduit.OSM.Types where++import Data.Text (Text)+++type Version = Double+type Generator = Text++data OSM =+ OSM {+ _version :: Version+ , _generator :: Maybe Generator+ , _bounds :: Maybe Bounds+ , _nodes :: [Node]+ , _ways :: [Way]+ , _relations :: [Relation]+ }+ deriving (Show, Eq)++data Bounds =+ Bounds {+ _minlat :: Lat+ , _minlon :: Lon+ , _maxlat :: Lat+ , _maxlon :: Lon+ }+ deriving (Show, Eq)++type Id = Text+type Lat = Double+type Lon = Double+type Changeset = Text+type Visible = Bool+type User = Text+type Timestamp = Text -- maybe data.time?+type Role = Text++data Node =+ Node {+ _lat :: Lat+ , _lon :: Lon+ , _nCommon :: NWRCommon+ }+ deriving (Show, Eq)++data Relation =+ Relation {+ _members :: [Member]+ , _rCommon :: NWRCommon+ }+ deriving (Show, Eq)++data Way =+ Way {+ _nds :: [Nd]+ , _wCommon :: NWRCommon+ }+ deriving (Show, Eq)++data NWRCommon =+ NWRCommon {+ _id :: Id+ , _visible :: Maybe Visible+ , _changeset :: Maybe Changeset+ , _timestamp :: Maybe Timestamp+ , _user :: Maybe User+ , _tags :: [Tag]+ }+ deriving (Show, Eq)++data NWR = NWRn | NWRw | NWRr+ deriving (Show, Eq)++data NWRWrap = N Node+ | W Way+ | R Relation+ deriving (Show, Eq)++data Member =+ Member {+ _type :: NWR+ , _mRef :: Id+ , _role :: Maybe Role+ }+ deriving (Show, Eq)+++data Nd =+ Nd {+ _ref :: Id+ }+ deriving (Show, Eq)++-- | Tag stores (Key, Value)+data Tag =+ Tag {+ _tag :: (Text, Text)+ }+ deriving (Show, Eq)+
+ test/Spec.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE OverloadedStrings #-}+import Test.Hspec+import Control.Monad.Catch (MonadThrow)+import Control.Monad.Trans.Resource (runResourceT)++import Data.Text (Text)++import Data.XML.Types (Event)+import Text.XML.Stream.Parse hiding (force)++import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.Conduit.OSM+import Data.Conduit.OSM.Types++main :: IO ()+main = hspec $ do+ describe "parser success" $ do+ it "parse node with tags" $ do+ parsed <- runTest testCase01 conduitOSM+ parsed `shouldBe` [OSM 0.6 (Just "lulz generator") Nothing [Node 52.153 22.341 (NWRCommon "43221" (Just True) Nothing Nothing Nothing [Tag ("shop", "alcohol"), Tag ("area", "safe")])] [] []]++ it "parse way" $ do+ parsed <- runTest testCase03 conduitOSM+ parsed `shouldBe` [OSM 0.6 (Just "lulz generator") Nothing [] [Way [Nd "1234", Nd "2345", Nd "3456"] (NWRCommon "1995" (Just True) Nothing Nothing Nothing [Tag ("rodzaj drogi", "do ukochanej")]) ] [] ]++ it "parse relation" $ do+ parsed <- runTest testCase04 conduitOSM+ parsed `shouldBe` [OSM 0.6 (Just "lulz generator") Nothing [] [] [Relation [Member NWRn "1234" Nothing] (NWRCommon "4747" (Just True) Nothing Nothing Nothing [Tag ("testk", "testv")])]]++ describe "parser throws error" $ do+ it "should throw when reading a double value fails" $ do+ runTest testCase02 conduitOSM `shouldThrow` errorCall "Could not parse attribute value"++ describe "reading from file" $ do+ it "should be able to read using sourceFileOSM" $ do+ parsed <- runResourceT $ sourceFileOSM "test/readingTest.xml" $$ CL.consume+ parsed `shouldBe` [OSM 0.6 Nothing Nothing [Node 12.34 34.56 (NWRCommon "1111" Nothing Nothing Nothing Nothing [])] [] []]++ describe "parsing ommiting osm tag" $ do+ it "parse nwr at once" $ do+ parsed <- runTest testCase05 conduitNWR+ parsed `shouldMatchList` [+ N (Node 52.153 22.341 (NWRCommon "43221" (Just True) Nothing Nothing Nothing [])),+ W (Way [Nd "12"] (NWRCommon "1337" (Just True) Nothing Nothing Nothing [])),+ R (Relation [Member NWRn "1234" Nothing] (NWRCommon "4747" (Just True) Nothing Nothing Nothing [Tag ("testk", "testv")]))+ ]++ it "parse nodes using conduitNodes" $ do+ parsed <- runTest testCase01 conduitNodes+ parsed `shouldBe` [Node 52.153 22.341 (NWRCommon "43221" (Just True) Nothing Nothing Nothing [Tag ("shop", "alcohol"), Tag ("area", "safe")])]++ it "parse ways using conduitWays" $ do+ parsed <- runTest testCase03 conduitWays+ parsed `shouldBe` [Way [Nd "1234", Nd "2345", Nd "3456"] (NWRCommon "1995" (Just True) Nothing Nothing Nothing [Tag ("rodzaj drogi", "do ukochanej")])]++ it "parse relations using conduitRelations" $ do+ parsed <- runTest testCase04 conduitRelations+ parsed `shouldBe` [Relation [Member NWRn "1234" Nothing] (NWRCommon "4747" (Just True) Nothing Nothing Nothing [Tag ("testk", "testv")])]++ it "parse items from many osm tags" $ do+ parsed <- runTest testCase06 conduitNWR+ parsed `shouldMatchList` [+ N (Node 52 20 (NWRCommon "21" (Just True) Nothing Nothing Nothing [])),+ N (Node 52.153 22.341 (NWRCommon "43221" (Just True) Nothing Nothing Nothing []))+ ]++runTest :: MonadThrow m => Source m Text -> Conduit Event m a -> m [a]+runTest tcase cond = tcase $$ parseText' def =$ cond =$ CL.consume++xmlPrefix :: Text+xmlPrefix = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"++testCase01 :: Monad m => Source m Text+testCase01 = CL.sourceList+ [xmlPrefix+ , "<osm version=\"0.6\" generator=\"lulz generator\">"+ , "<node id=\"43221\" lat=\"52.153\" lon=\"22.341\" visible=\"true\">"+ , "<tag k=\"shop\" v=\"alcohol\" />"+ , "<tag k=\"area\" v=\"safe\" />"+ , "</node>"+ , "</osm>"+ ]++testCase02 :: Monad m => Source m Text+testCase02 = CL.sourceList+ [xmlPrefix+ , "<osm version=\"0.6\" generator=\"lulz generator\">"+ , "<node id=\"43221\" lat=\"52.ad153\" lon=\"22.341\" visible=\"true\">"+ , "<tag k=\"shop\" v=\"alcohol\" />"+ , "</node>"+ , "</osm>"+ ]++testCase03 :: Monad m => Source m Text+testCase03 = CL.sourceList+ [xmlPrefix+ , "<osm version=\"0.6\" generator=\"lulz generator\">"+ , "<way id=\"1995\" visible=\"true\">"+ , "<nd ref=\"1234\" />"+ , "<nd ref=\"2345\" />"+ , "<nd ref=\"3456\" />"+ , "<tag k=\"rodzaj drogi\" v=\"do ukochanej\" />"+ , "</way>"+ , "</osm>"+ ]++testCase04 :: Monad m => Source m Text+testCase04 = CL.sourceList+ [xmlPrefix+ , "<osm version=\"0.6\" generator=\"lulz generator\">"+ , "<relation id=\"4747\" visible=\"true\">"+ , "<member type=\"node\" ref=\"1234\" />"+ , "<tag k=\"testk\" v=\"testv\" />"+ , "</relation>"+ , "</osm>"+ ]++testCase05 :: Monad m => Source m Text+testCase05 = CL.sourceList+ [xmlPrefix+ , "<osm version=\"0.6\" generator=\"lulz generator\">"+ , "<relation id=\"4747\" visible=\"true\">"+ , "<member type=\"node\" ref=\"1234\" />"+ , "<tag k=\"testk\" v=\"testv\" />"+ , "</relation>"+ , "<node id=\"43221\" lat=\"52.153\" lon=\"22.341\" visible=\"true\" />"+ , "<way id=\"1337\" visible=\"true\">"+ , "<nd ref=\"12\" />"+ , "</way>"+ , "</osm>"+ ]++testCase06 :: Monad m => Source m Text+testCase06 = CL.sourceList+ [xmlPrefix+ , "<osm version=\"0.6\" generator=\"lulz generator\">"+ , "<node id=\"21\" lat=\"52\" lon=\"20\" visible=\"true\" />"+ , "</osm>"+ , "<osm version=\"0.6\" generator=\"phun generator\">"+ , "<node id=\"43221\" lat=\"52.153\" lon=\"22.341\" visible=\"true\" />"+ , "</osm>"+ ]