packages feed

streaming-osm 1.0.0 → 1.0.0.1

raw patch · 12 files changed

+494/−525 lines, 12 filesdep +resourcetdep +streaming-attoparsecdep −criteriondep −streaming-utilsdep ~attoparsecdep ~basedep ~streamingPVP ok

version bump matches the API change (PVP)

Dependencies added: resourcet, streaming-attoparsec

Dependencies removed: criterion, streaming-utils

Dependency ranges changed: attoparsec, base, streaming, streaming-bytestring, tasty, tasty-hunit, text, vector, zlib

API changes (from Hackage documentation)

Files

ChangeLog.md view
@@ -1,3 +1,7 @@-### 1.0.0 ###+## 1.0.0.1++- Massaging bounds and future-proofing.++## 1.0.0  - Initial release.
− bench/Bench.hs 
@@ -1,24 +0,0 @@-module Main where--import           Criterion.Main-import           Streaming-import           Streaming.Osm-import qualified Streaming.Prelude as S-------main :: IO ()-main = defaultMain-  [ bgroup "Counting Nodes"-    [ bench "Uku Seq" $ nfIO (runResourceT .  S.length_ . nodes . blocks $ blobs "test/uku.osm.pbf")-   -- , bench "Uku Par" $ nfIO (runResourceT . blocks' (S.length_ . nodes) $ blobs "test/uku.osm.pbf")-   --  , bench "Van Seq" $ nfIO (runResourceT .  S.length_ . nodes . blocks $ blobs "test/vancouver.osm.pbf")-   --  , bench "Van Par" $ nfIO (runResourceT . blocks' (S.length_ . nodes) $ blobs "test/vancouver.osm.pbf")-    ]-  , bgroup "Counting Ways"-    [ bench "Uku" $ nfIO (runResourceT .  S.length_ . ways . blocks $ blobs "test/uku.osm.pbf")-    ]-  , bgroup "Counting Relations"-    [ bench "Uku" $ nfIO (runResourceT .  S.length_ . relations . blocks $ blobs "test/uku.osm.pbf")-    ]-  ]
+ lib/Streaming/Osm.hs view
@@ -0,0 +1,83 @@+-- |+-- Module    : Streaming.Osm+-- Copyright : (c) Azavea, 2017+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- This library provides the ability to read and process <http://www.openstreetmap.org/ OpenStreetMap>+-- data via the <https://hackage.haskell.org/package/streaming streaming> ecosystem. Since /streaming/+-- allows for very little RAM overhead despite file size, we can process very large OSM PBF files+-- just by providing a file path:+--+-- @+-- import           Streaming+-- import           Streaming.Osm+-- import qualified Streaming.Prelude as S+--+-- -- | Count all nodes.+-- count :: IO ()+-- count = do+--   len <- runResourceT . S.length_ . nodes . blocks $ blobs "yourfile.osm.pbf"+--   print len+-- @++module Streaming.Osm+  (+    -- * Streams+    blobs+  , blocks+  , nodes+  , ways+  , relations+    -- * Util+  , RIO+  ) where++import           Codec.Compression.Zlib (decompress)+import           Control.Monad.Trans.Resource (ResourceT)+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.ByteString.Streaming as A+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Streaming as Q+import           Streaming+import           Streaming.Osm.Internal.Parser+import           Streaming.Osm.Types+import qualified Streaming.Prelude as S++---++-- | A friendly alias. All `Stream`s in this module are constrained to this+-- type for optimal performance. The opposite, say:+--+-- @+-- nodes :: Monad m => Stream (Of Block) m () -> Stream (Of Node) m ()+-- @+-- will actually run significantly slower.+--+-- After evaluating your `Stream` to some final `RIO`, you can further+-- escape back to `IO` via `runResourceT`.+type RIO = ResourceT IO++-- | Given a `FilePath` to read OSM PBF data from, stream all parsed `Blob`s+-- out of it. A `Blob` is a potentially compressed @ByteString@ that further+-- parse into actual OSM Elements.+blobs :: FilePath -> Stream (Of Blob) RIO ()+blobs = void . A.parsed (header *> blob) . Q.readFile++-- | Every `Block` of ~8000 Elements.+blocks :: Stream (Of Blob) RIO () -> Stream (Of Block) RIO ()+blocks = S.concat . S.map f+  where f (Blob (Left bs)) = A.parseOnly block bs+        f (Blob (Right (_, bs))) = A.parseOnly block . BL.toStrict . decompress $ BL.fromStrict bs++-- | All OSM `Node`s.+nodes :: Stream (Of Block) RIO () -> Stream (Of Node) RIO ()+nodes = S.concat . S.map _nodes++-- | All OSM `Way`s.+ways :: Stream (Of Block) RIO () -> Stream (Of Way) RIO ()+ways = S.concat . S.map _ways++-- | All OSM `Relation`s.+relations :: Stream (Of Block) RIO () -> Stream (Of Relation) RIO ()+relations = S.concat . S.map _relations
+ lib/Streaming/Osm/Internal/Parser.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module    : Streaming.Osm.Internal.Parser+-- Copyright : (c) Azavea, 2017+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Streaming.Osm.Internal.Parser where++import           Control.Applicative (optional, (<|>))+import           Control.Monad (void)+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.Internal.Types as T+import           Data.Bits+import qualified Data.ByteString as B+import           Data.List (zipWith4, zipWith7)+import qualified Data.Map.Strict as M+import qualified Data.Vector as V+import           Streaming.Osm.Internal.Util+import           Streaming.Osm.Types++---++-- | Parse a `BlobHeader`.+header :: A.Parser ()+header = do+  void $ A.take 4+  void $ A.word8 0x0a+  void $ A.anyWord8+  void $ A.string "OSMHeader" <|> A.string "OSMData"+  void $ optional (A.word8 0x12 *> varint >>= advance)+  void (A.word8 0x18 *> varint)++-- | Borrowed from Attoparsec.+advance :: Int -> A.Parser ()+advance n = T.Parser $ \t pos more _lose suc -> suc t (pos + T.Pos n) more ()+{-# INLINE advance #-}++-- | Called a @Blob@ in the OSM literature.+blob :: A.Parser Blob+blob = Blob <$> A.eitherP dcmp comp+  where dcmp = A.word8 0x0a *> varint >>= A.take+        comp = (,) <$> (A.word8 0x10 *> varint) <*> (A.word8 0x1a *> varint >>= A.take)++-- | Called a @PrimitiveBlock@ in the OSM literature.+block :: A.Parser Block+block = do+  st <- A.word8 0x0a  *> varint *> stringTable+  ns <- (A.word8 0x12 *> varint *> A.many1' (node st)) <|> pure []+  dn <- (A.word8 0x12 *> varint *> dense st) <|> pure []+  ws <- (A.word8 0x12 *> varint *> A.many1' (way st)) <|> pure []+  rs <- (A.word8 0x12 *> varint *> A.many1' (relation st)) <|> pure []+  void $ optional (A.word8 0x88 *> A.word8 0x01 *> varint)  -- granularity+  void $ optional (A.word8 0x90 *> A.word8 0x01 *> varint)  -- date_granularity+  void $ optional (A.word8 0x98 *> A.word8 0x01 *> varint)  -- lat_offset+  void $ optional (A.word8 0xa0 *> A.word8 0x01 *> varint)  -- lon_offset+  pure $ Block (ns ++ dn) ws rs++-- | The String Table will never be empty, since all Elements have+-- non-geographic metadata (username, etc.) which contain Strings. The result+-- must be a `V.Vector`, since we need random access to its contents.+stringTable :: A.Parser (V.Vector B.ByteString)+stringTable = V.fromList <$> A.many1' (A.word8 0x0a *> varint >>= A.take)++-- | Parse a `Node`. Uses `V.unsafeIndex` to quickly retrieve its tag+-- Strings, assuming that the Node's key/value pairs will always index a legal+-- value in the given String Table.+node :: V.Vector B.ByteString -> A.Parser Node+node st = do+  void $ A.word8 0x0a *> varint+  i   <- unzig <$> (A.word8 0x08 *> varint)                          -- id+  ks  <- packed <$> (A.word8 0x12 *> varint >>= A.take) <|> pure []  -- keys+  vs  <- packed <$> (A.word8 0x1a *> varint >>= A.take) <|> pure []  -- vals+  oi  <- optional (A.word8 0x22 *> varint *> info i st)              -- info+  lat <- unzig <$> (A.word8 0x40 *> varint)                          -- lat+  lon <- unzig <$> (A.word8 0x48 *> varint)                          -- lon+  let ts = M.fromList $ zip (map (V.unsafeIndex st) ks) (map (V.unsafeIndex st) vs)+  pure $ Node (offset lat) (offset lon) oi ts++-- | Parse a @DenseNodes@ in a similar way to `node`.+dense :: V.Vector B.ByteString -> A.Parser [Node]+dense st = do+  void $ A.word8 0x12 *> varint+  ids <- ints <$> (A.word8 0x0a *> varint >>= A.take)+  ifs <- (A.word8 0x2a *> varint *> denseInfo ids st) <|> pure (repeat Nothing)+  lts <- ints <$> (A.word8 0x42 *> varint >>= A.take)+  lns <- ints <$> (A.word8 0x4a *> varint >>= A.take)+  kvs <- (packed <$> (A.word8 0x52 *> varint >>= A.take)) <|> pure []+  pure $ zipWith4 f lts lns ifs (denseTags st kvs)+  where f lat lon inf ts = Node (offset lat) (offset lon) inf ts++-- | Interpret a list of flattened key-value pairs as Tag metadata `Map`s.+denseTags :: V.Vector B.ByteString -> [Int] -> [M.Map B.ByteString B.ByteString]+denseTags _ [] = repeat M.empty+denseTags st kvs = map (M.fromList . map (both (V.unsafeIndex st)) . pairs) $ breakOn0 kvs++-- | Parse a `Way`.+way :: V.Vector B.ByteString -> A.Parser Way+way st = do+  void $ A.word8 0x1a *> varint+  i <- A.word8 0x08 *> varint                                       -- id+  ks <- packed <$> (A.word8 0x12 *> varint >>= A.take) <|> pure []  -- keys+  vs <- packed <$> (A.word8 0x1a *> varint >>= A.take) <|> pure []  -- vals+  oi <- optional (A.word8 0x22 *> varint *> info i st)              -- info+  ns <- ints <$> (A.word8 0x42 *> varint >>= A.take)+  let ts = M.fromList $ zip (map (V.unsafeIndex st) ks) (map (V.unsafeIndex st) vs)+  pure $ Way ns oi ts++-- | Parse a `Relation`.+relation :: V.Vector B.ByteString -> A.Parser Relation+relation st = do+  void $ A.word8 0x22 *> varint+  i  <- A.word8 0x08 *> varint+  ks <- packed <$> (A.word8 0x12 *> varint >>= A.take) <|> pure []                -- keys+  vs <- packed <$> (A.word8 0x1a *> varint >>= A.take) <|> pure []                -- vals+  oi <- optional (A.word8 0x22 *> varint *> info i st)                            -- info+  rs <- packed <$> (A.word8 0x42 *> varint >>= A.take) <|> pure []                -- roles_sid+  ms <- map unzig . packed <$> (A.word8 0x4a *> varint >>= A.take) <|> pure []    -- memids+  ts <- map memtype . packed <$> (A.word8 0x52 *> varint >>= A.take) <|> pure []  -- types+  let tags = M.fromList $ zip (map (V.unsafeIndex st) ks) (map (V.unsafeIndex st) vs)+      mems = zipWith3 Member ms ts $ map (V.unsafeIndex st) rs+  pure $ Relation mems oi tags++-- | Parse an `Info`.+info :: Int -> V.Vector B.ByteString -> A.Parser Info+info i st = do+  vn <- (A.word8 0x08 *> varint) <|> pure (-1)                    -- version+  ts <- optional (A.word8 0x10 *> varint)                         -- timestamp+  cs <- optional (A.word8 0x18 *> varint)                         -- changeset+  ui <- optional (A.word8 0x20 *> varint)                         -- uid+  us <- optional (V.unsafeIndex st <$> (A.word8 0x28 *> varint))  -- user_sid+  vi <- (>>= booly) <$> optional (A.word8 0x30 *> varint)         -- visible+  pure $ Info (fromIntegral i) vn (toffset <$> ts) cs ui us vi++-- | Parse a @DenseInfo@ message.+denseInfo :: [Int] -> V.Vector B.ByteString -> A.Parser [Maybe Info]+denseInfo nis st = do+  ver <- packed <$> (A.word8 0x0a *> varint >>= A.take)+  tms <- map Just . ints <$> (A.word8 0x12 *> varint >>= A.take)+  chs <- map Just . ints <$> (A.word8 0x1a *> varint >>= A.take)+  uid <- map Just . ints <$> (A.word8 0x22 *> varint >>= A.take)+  uss <- map (st V.!?) . ints <$> (A.word8 0x2a *> varint >>= A.take)+  vis <- (map booly . packed <$> (A.word8 0x32 *> varint >>= A.take)) <|> pure (repeat $ Just True)+  pure $ zipWith7 f nis ver tms chs uid uss vis+    where f ni vs tm ch ui us vi = Just $ Info ni vs (toffset <$> tm) ch ui us vi++-- | Parse some Varint, which may be made up of multiple bytes.+varint :: A.Parser Int+varint = foldBytes <$> A.takeWhile (`testBit` 7) <*> A.anyWord8+{-# INLINE varint #-}++-- | Reparse a `B.ByteString` as a list of some Varints.+packed :: B.ByteString -> [Int]+packed bs = either (const []) id $ A.parseOnly (A.many1' varint) bs++-- | Decode some packed, Z-encoded, delta-encoded Ints.+ints :: B.ByteString -> [Int]+ints = undelta . map unzig . packed++-- | Restore truncated LatLng values to their true `Double` representation.+offset :: Int -> Double+offset coord = 0.000000001 * fromIntegral (100 * coord)++-- | Restore truncated timestamps to the number of millis since the 1970 epoch.+toffset :: Int -> Int+toffset time = 1000 * time++-- | Try to parse a `Bool` from a bit.+booly :: Int -> Maybe Bool+booly 0 = Just False+booly 1 = Just True+booly _ = Nothing
+ lib/Streaming/Osm/Internal/Util.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE BinaryLiterals #-}++-- |+-- Module    : Streaming.Osm.Internal.Util+-- Copyright : (c) Azavea, 2017+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Streaming.Osm.Internal.Util+  ( foldBytes+  , breakOn0+  , pairs+  , both+  , unzig, undelta+  ) where++import           Data.Bits+import qualified Data.ByteString as BS+import           Data.List (scanl')+import           Data.Word++---++-- to16 :: Word8 -> Word16+-- to16 = fromIntegral++-- to8 :: Word16 -> Word8+-- to8 = fromIntegral++-- unkey :: Word8 -> Word8 -> Either (Word8, Word8) Word8+-- unkey f w = case (to8 $ shiftR smash 7, to8 $ smash .&. 0b01111111) of+--   (0, r) -> Right r+--   (l, r) -> Left (setBit r 7, l)+--   where smash = shift (to16 f) 3 .|. to16 w++-- | Discover a field's number and /Wire Type/. The wire type is expected to+-- be a value from 0 to 5. The field number itself can probably be any varint,+-- although in practice these are in `Word8` range.+--+-- The results are left as numbers, since pattern matching on those should+-- be faster.+-- key :: (Num t, Bits t) => t -> (t, t)+-- key w = (shiftR w 3, w .&. 0b00000111)++-- | For the case when two bytes denote the field number and /Wire Type/. We+-- know that for OSM data, the highest field number is 34. Encoding 34 with any+-- wire type takes 2 bytes, so we know we'll never need to check for more.+-- key2 :: Word8 -> Word8 -> (Word16, Word16)+-- key2 w1 w0 = key $ shift (to16 w0) 7 .|. to16 (clearBit w1 7)++-- `BS.foldr'` is tail-recursive, unlike List's foldr, so it should be just as fast as foldl.+-- | Fold a `BS.ByteString` into an `Int` which was parsed with wire-type 2+-- (Length-delimited). These follow the pattern @tagByte byteCount bytes@,+-- where we've parsed @byteCount@ and done an attoparsec @take@ on the @bytes@.+-- These bytes could be a packed repeated field of varints, meaning they could+-- all have different byte lengths.+--+-- This function uses the rules described+-- <https://developers.google.com/protocol-buffers/docs/encoding here> for+-- determining when to accumulate the current byte, or to consider it the first+-- byte of the next value. In short, the rule is:+--+--   1. If the MSB of a byte is 1, then expect at least the next byte to belong to this value.+--   2. If the MSB of a byte is 0, we're at the end of the current accumulating value (or+--      at the first byte of a single byte value).+foldBytes :: BS.ByteString -> Word8 -> Int+foldBytes bs b = BS.foldr' (\w acc -> shift acc 7 .|. clearBit (fromIntegral w) 7) (fromIntegral b) bs++-- | `words` for `Int`, where 0 is the whitespace. Implementation adapted+-- from `words`.+breakOn0 :: [Int] -> [[Int]]+breakOn0 [] = []+breakOn0 ns = xs : breakOn0 ys+  where (xs, 0 : ys) = span (/= 0) ns++-- | A sort of "self-zip", forming pairs from every two elements in a list.+-- Assumes that the list is of even length.+pairs :: [a] -> [(a,a)]+pairs []       = []+pairs (x:y:zs) = (x,y) : pairs zs+pairs _        = error "List was of uneven length."++-- | Apply a function to both elements of a tuple.+both :: (a -> b) -> (a, a) -> (b, b)+both f (a,b) = (f a, f b)++-- | Decode a Z-encoded `Int`.+unzig :: Int -> Int+unzig n = shift n (-1) `xor` negate (n .&. 1)++-- | Restore a list of numbers that have been Delta Encoded.+undelta :: [Int] -> [Int]+undelta []       = []+undelta (x : xs) = scanl' (+) x xs
+ lib/Streaming/Osm/Types.hs view
@@ -0,0 +1,79 @@+-- |+-- Module    : Streaming.Osm.Types+-- Copyright : (c) Azavea, 2017+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>++module Streaming.Osm.Types+  ( -- * OpenStreetMap /Elements/+    Node(..)+  , Way(..)+  , Relation(..)+  , Info(..)+  , Member(..)+  , MemType(..), memtype+  -- * Helper Types+  , Blob(..)+  , Block(..)+  ) where++import qualified Data.ByteString as B+import qualified Data.Map as M++---++-- | An OpenStreetMap /Node/ element. Represents a single point in 2D space.+data Node = Node { _lat   :: Double+                 , _lng   :: Double+                 , _ninfo :: Maybe Info+                 , _ntags :: M.Map B.ByteString B.ByteString+                 } deriving (Eq, Show)++-- | An OpenStreetMap /Way/ element. Made up of `Node`s, and represents+-- some line on the earth, or a Polygon if its first and last Nodes are the same.+data Way = Way { _nodeRefs :: [Int]+               , _winfo    :: Maybe Info+               , _wtags    :: M.Map B.ByteString B.ByteString+               } deriving (Eq, Show)++-- | An OpenStreetMap /Relation/ element. These are logical groups of Nodes, Ways,+-- and other Relations. They can represent large multipolygons, or more abstract+-- non-polygonal objects like bus route networks.+data Relation = Relation { _members :: [Member]+                         , _rinfo   :: Maybe Info+                         , _rtags   :: M.Map B.ByteString B.ByteString+                         } deriving (Eq, Show)++-- | Equivalent to the /member/ tag, found in OSM `Relation`s.+data Member = Member { _mref :: Int, _mtype :: MemType, _mrole :: B.ByteString } deriving (Eq, Show)++-- | Is a `Member` entry referencing a Node, a Way, or a Relation?+data MemType = N | W | R deriving (Eq, Show)++-- | A bridge between the Int-based enum value for `MemType` is protobuf and+-- a more useful Haskell type.+memtype :: Int -> MemType+memtype 0 = N+memtype 1 = W+memtype 2 = R+memtype _ = error "Unknown `MemType`"++-- | Non-geographic `Element` metadata. The OSM database is a wild place, so+-- many of these fields may be missing for older Elements.+data Info = Info { _id        :: Int+                 , _version   :: Int+                 , _timestamp :: Maybe Int+                 , _changeset :: Maybe Int+                 , _uid       :: Maybe Int+                 , _username  :: Maybe B.ByteString+                 , _visible   :: Maybe Bool+                 } deriving (Eq, Show)++-- | Bytes parsed out of an @OSMData@ section. Either non-compressed (Left) or+-- compressed (Right) with its post-decompression size.+newtype Blob = Blob { bytes :: Either B.ByteString (Int, B.ByteString) } deriving (Eq, Show)++-- | A group of ~8000 OSM Elements.+data Block = Block { _nodes     :: [Node]+                   , _ways      :: [Way]+                   , _relations :: [Relation] } deriving (Eq, Show)
− src/Streaming/Osm.hs 
@@ -1,82 +0,0 @@--- |--- Module    : Streaming.Osm--- Copyright : (c) Azavea, 2017--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>------ This library provides the ability to read and process <http://www.openstreetmap.org/ OpenStreetMap>--- data via the <https://hackage.haskell.org/package/streaming streaming> ecosystem. Since /streaming/--- allows for very little RAM overhead despite file size, we can process very large OSM PBF files--- just by providing a file path:------ @--- import           Streaming--- import           Streaming.Osm--- import qualified Streaming.Prelude as S------ -- | Count all nodes.--- count :: IO ()--- count = do---   len <- runResourceT . S.length_ . nodes . blocks $ blobs "yourfile.osm.pbf"---   print len--- @--module Streaming.Osm-  (-    -- * Streams-    blobs-  , blocks-  , nodes-  , ways-  , relations-    -- * Util-  , RIO-  ) where--import           Codec.Compression.Zlib (decompress)-import qualified Data.Attoparsec.ByteString as A-import qualified Data.Attoparsec.ByteString.Streaming as A-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Streaming as Q-import           Streaming-import           Streaming.Osm.Internal.Parser-import           Streaming.Osm.Types-import qualified Streaming.Prelude as S--------- | A friendly alias. All `Stream`s in this module are constrained to this--- type for optimal performance. The opposite, say:------ @--- nodes :: Monad m => Stream (Of Block) m () -> Stream (Of Node) m ()--- @--- will actually run significantly slower.------ After evaluating your `Stream` to some final `RIO`, you can further--- escape back to `IO` via `runResourceT`.-type RIO = ResourceT IO---- | Given a `FilePath` to read OSM PBF data from, stream all parsed `Blob`s--- out of it. A `Blob` is a potentially compressed @ByteString@ that further--- parse into actual OSM Elements.-blobs :: FilePath -> Stream (Of Blob) RIO ()-blobs = void . A.parsed (header *> blob) . Q.readFile---- | Every `Block` of ~8000 Elements.-blocks :: Stream (Of Blob) RIO () -> Stream (Of Block) RIO ()-blocks = S.concat . S.map f-  where f (Blob (Left bs)) = A.parseOnly block bs-        f (Blob (Right (_, bs))) = A.parseOnly block . BL.toStrict . decompress $ BL.fromStrict bs---- | All OSM `Node`s.-nodes :: Stream (Of Block) RIO () -> Stream (Of Node) RIO ()-nodes = S.concat . S.map _nodes---- | All OSM `Way`s.-ways :: Stream (Of Block) RIO () -> Stream (Of Way) RIO ()-ways = S.concat . S.map _ways---- | All OSM `Relation`s.-relations :: Stream (Of Block) RIO () -> Stream (Of Relation) RIO ()-relations = S.concat . S.map _relations
− src/Streaming/Osm/Internal/Parser.hs 
@@ -1,173 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- |--- Module    : Streaming.Osm.Internal.Parser--- Copyright : (c) Azavea, 2017--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Streaming.Osm.Internal.Parser where--import           Control.Applicative ((<|>), optional)-import           Control.Monad (void)-import qualified Data.Attoparsec.ByteString as A-import qualified Data.Attoparsec.Internal.Types as T-import           Data.Bits-import qualified Data.ByteString as B-import           Data.List (zipWith4, zipWith7)-import qualified Data.Map.Strict as M-import qualified Data.Vector as V-import           Streaming.Osm.Types-import           Streaming.Osm.Internal.Util--------- | Parse a `BlobHeader`.-header :: A.Parser ()-header = do-  A.take 4-  A.word8 0x0a-  A.anyWord8-  A.string "OSMHeader" <|> A.string "OSMData"-  optional (A.word8 0x12 *> varint >>= advance)-  void (A.word8 0x18 *> varint)---- | Borrowed from Attoparsec.-advance :: Int -> A.Parser ()-advance n = T.Parser $ \t pos more _lose suc -> suc t (pos + T.Pos n) more ()-{-# INLINE advance #-}---- | Called a @Blob@ in the OSM literature.-blob :: A.Parser Blob-blob = Blob <$> A.eitherP dcmp comp-  where dcmp = A.word8 0x0a *> varint >>= A.take-        comp = (,) <$> (A.word8 0x10 *> varint) <*> (A.word8 0x1a *> varint >>= A.take)---- | Called a @PrimitiveBlock@ in the OSM literature.-block :: A.Parser Block-block = do-  st <- A.word8 0x0a  *> varint *> stringTable-  ns <- (A.word8 0x12 *> varint *> A.many1' (node st)) <|> pure []-  dn <- (A.word8 0x12 *> varint *> dense st) <|> pure []-  ws <- (A.word8 0x12 *> varint *> A.many1' (way st)) <|> pure []-  rs <- (A.word8 0x12 *> varint *> A.many1' (relation st)) <|> pure []-  optional (A.word8 0x88 *> A.word8 0x01 *> varint)  -- granularity-  optional (A.word8 0x90 *> A.word8 0x01 *> varint)  -- date_granularity-  optional (A.word8 0x98 *> A.word8 0x01 *> varint)  -- lat_offset-  optional (A.word8 0xa0 *> A.word8 0x01 *> varint)  -- lon_offset-  pure $ Block (ns ++ dn) ws rs---- | The String Table will never be empty, since all Elements have--- non-geographic metadata (username, etc.) which contain Strings. The result--- must be a `V.Vector`, since we need random access to its contents.-stringTable :: A.Parser (V.Vector B.ByteString)-stringTable = V.fromList <$> A.many1' (A.word8 0x0a *> varint >>= A.take)---- | Parse a `Node`. Uses `V.unsafeIndex` to quickly retrieve its tag--- Strings, assuming that the Node's key/value pairs will always index a legal--- value in the given String Table.-node :: V.Vector B.ByteString -> A.Parser Node-node st = do-  A.word8 0x0a *> varint-  i   <- unzig <$> (A.word8 0x08 *> varint)                          -- id-  ks  <- packed <$> (A.word8 0x12 *> varint >>= A.take) <|> pure []  -- keys-  vs  <- packed <$> (A.word8 0x1a *> varint >>= A.take) <|> pure []  -- vals-  oi  <- optional (A.word8 0x22 *> varint *> info i st)              -- info-  lat <- unzig <$> (A.word8 0x40 *> varint)                          -- lat-  lon <- unzig <$> (A.word8 0x48 *> varint)                          -- lon-  let ts = M.fromList $ zip (map (V.unsafeIndex st) ks) (map (V.unsafeIndex st) vs)-  pure $ Node (offset lat) (offset lon) oi ts---- | Parse a @DenseNodes@ in a similar way to `node`.-dense :: V.Vector B.ByteString -> A.Parser [Node]-dense st = do-  A.word8 0x12 *> varint-  ids <- ints <$> (A.word8 0x0a *> varint >>= A.take)-  ifs <- (A.word8 0x2a *> varint *> denseInfo ids st) <|> pure (repeat Nothing)-  lts <- ints <$> (A.word8 0x42 *> varint >>= A.take)-  lns <- ints <$> (A.word8 0x4a *> varint >>= A.take)-  kvs <- (packed <$> (A.word8 0x52 *> varint >>= A.take)) <|> pure []-  pure $ zipWith4 f lts lns ifs (denseTags st kvs)-  where f lat lon inf ts = Node (offset lat) (offset lon) inf ts---- | Interpret a list of flattened key-value pairs as Tag metadata `Map`s.-denseTags :: V.Vector B.ByteString -> [Int] -> [M.Map B.ByteString B.ByteString]-denseTags _ [] = repeat M.empty-denseTags st kvs = map (M.fromList . map (both (V.unsafeIndex st)) . pairs) $ breakOn0 kvs---- | Parse a `Way`.-way :: V.Vector B.ByteString -> A.Parser Way-way st = do-  A.word8 0x1a *> varint-  i <- A.word8 0x08 *> varint                                       -- id-  ks <- packed <$> (A.word8 0x12 *> varint >>= A.take) <|> pure []  -- keys-  vs <- packed <$> (A.word8 0x1a *> varint >>= A.take) <|> pure []  -- vals-  oi <- optional (A.word8 0x22 *> varint *> info i st)              -- info-  ns <- ints <$> (A.word8 0x42 *> varint >>= A.take)-  let ts = M.fromList $ zip (map (V.unsafeIndex st) ks) (map (V.unsafeIndex st) vs)-  pure $ Way ns oi ts---- | Parse a `Relation`.-relation :: V.Vector B.ByteString -> A.Parser Relation-relation st = do-  A.word8 0x22 *> varint-  i  <- A.word8 0x08 *> varint-  ks <- packed <$> (A.word8 0x12 *> varint >>= A.take) <|> pure []                -- keys-  vs <- packed <$> (A.word8 0x1a *> varint >>= A.take) <|> pure []                -- vals-  oi <- optional (A.word8 0x22 *> varint *> info i st)                            -- info-  rs <- packed <$> (A.word8 0x42 *> varint >>= A.take) <|> pure []                -- roles_sid-  ms <- map unzig . packed <$> (A.word8 0x4a *> varint >>= A.take) <|> pure []    -- memids-  ts <- map memtype . packed <$> (A.word8 0x52 *> varint >>= A.take) <|> pure []  -- types-  let tags = M.fromList $ zip (map (V.unsafeIndex st) ks) (map (V.unsafeIndex st) vs)-      mems = zipWith3 Member ms ts $ map (V.unsafeIndex st) rs-  pure $ Relation mems oi tags---- | Parse an `Info`.-info :: Int -> V.Vector B.ByteString -> A.Parser Info-info i st = do-  vn <- (A.word8 0x08 *> varint) <|> pure (-1)                    -- version-  ts <- optional (A.word8 0x10 *> varint)                         -- timestamp-  cs <- optional (A.word8 0x18 *> varint)                         -- changeset-  ui <- optional (A.word8 0x20 *> varint)                         -- uid-  us <- optional (V.unsafeIndex st <$> (A.word8 0x28 *> varint))  -- user_sid-  vi <- (>>= booly) <$> optional (A.word8 0x30 *> varint)         -- visible-  pure $ Info (fromIntegral i) vn (toffset <$> ts) cs ui us vi---- | Parse a @DenseInfo@ message.-denseInfo :: [Int] -> V.Vector B.ByteString -> A.Parser [Maybe Info]-denseInfo nis st = do-  ver <- packed <$> (A.word8 0x0a *> varint >>= A.take)-  tms <- map Just . ints <$> (A.word8 0x12 *> varint >>= A.take)-  chs <- map Just . ints <$> (A.word8 0x1a *> varint >>= A.take)-  uid <- map Just . ints <$> (A.word8 0x22 *> varint >>= A.take)-  uss <- map (st V.!?) . ints <$> (A.word8 0x2a *> varint >>= A.take)-  vis <- (map booly . packed <$> (A.word8 0x32 *> varint >>= A.take)) <|> pure (repeat $ Just True)-  pure $ zipWith7 f nis ver tms chs uid uss vis-    where f ni vs tm ch ui us vi = Just $ Info ni vs (toffset <$> tm) ch ui us vi---- | Parse some Varint, which may be made up of multiple bytes.-varint :: A.Parser Int-varint = foldBytes <$> A.takeWhile (`testBit` 7) <*> A.anyWord8-{-# INLINE varint #-}---- | Reparse a `B.ByteString` as a list of some Varints.-packed :: B.ByteString -> [Int]-packed bs = either (const []) id $ A.parseOnly (A.many1' varint) bs---- | Decode some packed, Z-encoded, delta-encoded Ints.-ints :: B.ByteString -> [Int]-ints = undelta . map unzig . packed---- | Restore truncated LatLng values to their true `Double` representation.-offset :: Int -> Double-offset coord = 0.000000001 * fromIntegral (100 * coord)---- | Restore truncated timestamps to the number of millis since the 1970 epoch.-toffset :: Int -> Int-toffset time = 1000 * time---- | Try to parse a `Bool` from a bit.-booly :: Int -> Maybe Bool-booly 0 = Just False-booly 1 = Just True-booly _ = Nothing
− src/Streaming/Osm/Internal/Util.hs 
@@ -1,93 +0,0 @@-{-# LANGUAGE BinaryLiterals #-}---- |--- Module    : Streaming.Osm.Internal.Util--- Copyright : (c) Azavea, 2017--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Streaming.Osm.Internal.Util-  ( foldBytes-  , breakOn0-  , pairs-  , both-  , unzig, undelta-  ) where--import           Data.Bits-import qualified Data.ByteString as BS-import           Data.List (scanl')-import           Data.Word--------- to16 :: Word8 -> Word16--- to16 = fromIntegral---- to8 :: Word16 -> Word8--- to8 = fromIntegral---- unkey :: Word8 -> Word8 -> Either (Word8, Word8) Word8--- unkey f w = case (to8 $ shiftR smash 7, to8 $ smash .&. 0b01111111) of---   (0, r) -> Right r---   (l, r) -> Left (setBit r 7, l)---   where smash = shift (to16 f) 3 .|. to16 w---- | Discover a field's number and /Wire Type/. The wire type is expected to--- be a value from 0 to 5. The field number itself can probably be any varint,--- although in practice these are in `Word8` range.------ The results are left as numbers, since pattern matching on those should--- be faster.--- key :: (Num t, Bits t) => t -> (t, t)--- key w = (shiftR w 3, w .&. 0b00000111)---- | For the case when two bytes denote the field number and /Wire Type/. We--- know that for OSM data, the highest field number is 34. Encoding 34 with any--- wire type takes 2 bytes, so we know we'll never need to check for more.--- key2 :: Word8 -> Word8 -> (Word16, Word16)--- key2 w1 w0 = key $ shift (to16 w0) 7 .|. to16 (clearBit w1 7)---- `BS.foldr'` is tail-recursive, unlike List's foldr, so it should be just as fast as foldl.--- | Fold a `BS.ByteString` into an `Int` which was parsed with wire-type 2--- (Length-delimited). These follow the pattern @tagByte byteCount bytes@,--- where we've parsed @byteCount@ and done an attoparsec @take@ on the @bytes@.--- These bytes could be a packed repeated field of varints, meaning they could--- all have different byte lengths.------ This function uses the rules described--- <https://developers.google.com/protocol-buffers/docs/encoding here> for--- determining when to accumulate the current byte, or to consider it the first--- byte of the next value. In short, the rule is:------   1. If the MSB of a byte is 1, then expect at least the next byte to belong to this value.---   2. If the MSB of a byte is 0, we're at the end of the current accumulating value (or---      at the first byte of a single byte value).-foldBytes :: BS.ByteString -> Word8 -> Int-foldBytes bs b = BS.foldr' (\w acc -> shift acc 7 .|. clearBit (fromIntegral w) 7) (fromIntegral b) bs---- | `words` for `Int`, where 0 is the whitespace. Implementation adapted--- from `words`.-breakOn0 :: [Int] -> [[Int]]-breakOn0 [] = []-breakOn0 ns = xs : breakOn0 ys-  where (xs, 0 : ys) = span (/= 0) ns---- | A sort of "self-zip", forming pairs from every two elements in a list.--- Assumes that the list is of even length.-pairs :: [a] -> [(a,a)]-pairs [] = []-pairs (x:y:zs) = (x,y) : pairs zs---- | Apply a function to both elements of a tuple.-both :: (a -> b) -> (a, a) -> (b, b)-both f (a,b) = (f a, f b)---- | Decode a Z-encoded `Int`.-unzig :: Int -> Int-unzig n = shift n (-1) `xor` negate (n .&. 1)---- | Restore a list of numbers that have been Delta Encoded.-undelta :: [Int] -> [Int]-undelta [] = []-undelta (x : xs) = scanl' (+) x xs
− src/Streaming/Osm/Types.hs 
@@ -1,78 +0,0 @@--- |--- Module    : Streaming.Osm.Types--- Copyright : (c) Azavea, 2017--- License   : BSD3--- Maintainer: Colin Woodbury <colingw@gmail.com>--module Streaming.Osm.Types-  ( -- * OpenStreetMap /Elements/-    Node(..)-  , Way(..)-  , Relation(..)-  , Info(..)-  , Member(..)-  , MemType(..), memtype-  -- * Helper Types-  , Blob(..)-  , Block(..)-  ) where--import qualified Data.ByteString as B-import qualified Data.Map as M--------- | An OpenStreetMap /Node/ element. Represents a single point in 2D space.-data Node = Node { _lat   :: Double-                 , _lng   :: Double-                 , _ninfo :: Maybe Info-                 , _ntags :: M.Map B.ByteString B.ByteString-                 } deriving (Eq, Show)---- | An OpenStreetMap /Way/ element. Made up of `Node`s, and represents--- some line on the earth, or a Polygon if its first and last Nodes are the same.-data Way = Way { _nodeRefs :: [Int]-               , _winfo    :: Maybe Info-               , _wtags    :: M.Map B.ByteString B.ByteString-               } deriving (Eq, Show)---- | An OpenStreetMap /Relation/ element. These are logical groups of Nodes, Ways,--- and other Relations. They can represent large multipolygons, or more abstract--- non-polygonal objects like bus route networks.-data Relation = Relation { _members :: [Member]-                         , _rinfo   :: Maybe Info-                         , _rtags   :: M.Map B.ByteString B.ByteString-                         } deriving (Eq, Show)---- | Equivalent to the /member/ tag, found in OSM `Relation`s.-data Member = Member { _mref :: Int, _mtype :: MemType, _mrole :: B.ByteString } deriving (Eq, Show)---- | Is a `Member` entry referencing a Node, a Way, or a Relation?-data MemType = N | W | R deriving (Eq, Show)---- | A bridge between the Int-based enum value for `MemType` is protobuf and--- a more useful Haskell type.-memtype :: Int -> MemType-memtype 0 = N-memtype 1 = W-memtype 2 = R---- | Non-geographic `Element` metadata. The OSM database is a wild place, so--- many of these fields may be missing for older Elements.-data Info = Info { _id        :: Int-                 , _version   :: Int-                 , _timestamp :: Maybe Int-                 , _changeset :: Maybe Int-                 , _uid       :: Maybe Int-                 , _username  :: Maybe B.ByteString-                 , _visible   :: Maybe Bool-                 } deriving (Eq, Show)---- | Bytes parsed out of an @OSMData@ section. Either non-compressed (Left) or--- compressed (Right) with its post-decompression size.-newtype Blob = Blob { bytes :: Either B.ByteString (Int, B.ByteString) } deriving (Eq, Show)---- | A group of ~8000 OSM Elements.-data Block = Block { _nodes :: [Node]-                   , _ways  :: [Way]-                   , _relations :: [Relation] } deriving (Eq, Show)
streaming-osm.cabal view
@@ -1,84 +1,65 @@--- This file has been generated from package.yaml by hpack version 0.17.0.------ see: https://github.com/sol/hpack+cabal-version: 2.2 -name:                streaming-osm-version:             1.0.0-synopsis:            A hand-written streaming byte parser for OpenStreetMap Protobuf data.-description:         A hand-written streaming byte parser for OpenStreetMap Protobuf data.-license:             BSD3-license-file:        LICENSE-author:              Colin Woodbury-maintainer:          colingw@gmail.com-copyright:           Copyright (c) 2017 Azavea-category:            Streaming-build-type:          Simple-cabal-version:       >= 1.10+name:         streaming-osm+version:      1.0.0.1+synopsis:     A hand-written streaming byte parser for OpenStreetMap Protobuf data.+description:  A hand-written streaming byte parser for OpenStreetMap Protobuf data.+license:      BSD-3-Clause+license-file: LICENSE+author:       Colin Woodbury+maintainer:   colin@fosskers.ca+copyright:    Copyright (c) 2017 - 2019 Azavea+category:     Streaming+build-type:   Simple  extra-source-files:     ChangeLog.md-    test/ajishima.osm.pbf-    test/diomede.osm.pbf-    test/north-van.osm.pbf-    test/nozakijima.osm.pbf-    test/shrine.osm.pbf-    test/tashirojima.osm.pbf-    test/uku.osm.pbf+    test/*.osm.pbf +common commons+  default-language: Haskell2010+  ghc-options: -Wall+  build-depends:+      base >= 4.8 && < 5+    , attoparsec ^>= 0.13+    , bytestring+    , resourcet ^>= 1.2+    , streaming ^>= 0.2+    , vector ^>= 0.12+    , zlib ^>= 0.6+ library+  import: commons+  hs-source-dirs: lib   exposed-modules:       Streaming.Osm       Streaming.Osm.Internal.Parser       Streaming.Osm.Internal.Util       Streaming.Osm.Types   build-depends:-      base >=4.8 && <4.11-    , attoparsec >=0.13 && <0.14-    , bytestring-    , streaming >=0.1 && <0.2-    , vector >= 0.11 && < 0.13-    , zlib >=0.6 && <0.7-    , containers-    , streaming-bytestring >=0.1 && <0.2-    , streaming-utils >= 0.1 && < 0.2-    , text+      containers+    , streaming-attoparsec ^>= 1.0+    , streaming-bytestring ^>= 0.1+    , text ^>= 1.2     , transformers-  hs-source-dirs:-      src-  default-language: Haskell2010-  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -O2  test-suite streaming-osm-test+  import: commons   type: exitcode-stdio-1.0-  build-depends:-      base >=4.8 && <4.11-    , attoparsec >=0.13 && <0.14-    , bytestring-    , streaming >=0.1 && <0.2-    , vector >= 0.11 && < 0.13-    , zlib >=0.6 && <0.7-    , streaming-osm-    , tasty >=0.11 && <0.12-    , tasty-hunit >=0.9 && <0.10-  hs-source-dirs:-      test+  hs-source-dirs: test   main-is: Test.hs-  default-language: Haskell2010-  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -O2 -threaded--benchmark streaming-osm-bench-  type: exitcode-stdio-1.0-  main-is: Bench.hs-  hs-source-dirs:-      bench-  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -O2 -threaded+  ghc-options: -threaded -with-rtsopts=-N   build-depends:-      base >=4.8 && <4.11-    , attoparsec >=0.13 && <0.14-    , bytestring-    , streaming >=0.1 && <0.2-    , vector >= 0.11 && < 0.13-    , zlib >=0.6 && <0.7-    , criterion >= 1.1 && < 1.3-    , streaming-osm-  default-language: Haskell2010+      streaming-osm+    , tasty >= 1.1 && < 1.3+    , tasty-hunit ^>= 0.10++-- benchmark streaming-osm-bench+--   import: commons+--   type: exitcode-stdio-1.0+--   main-is: Bench.hs+--   hs-source-dirs: bench+--   ghc-options: -threaded -O2+--   build-depends:+--       criterion >=1.1+--     , streaming-osm
test/Test.hs view
@@ -1,11 +1,11 @@ module Main where  import           Codec.Compression.Zlib (decompress)+import           Control.Monad.Trans.Resource (runResourceT) import           Data.Attoparsec.ByteString as A import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.Vector as V-import           Streaming import           Streaming.Osm import           Streaming.Osm.Internal.Parser import           Streaming.Osm.Internal.Util@@ -87,7 +87,7 @@  assertRight :: Either t1 t -> Assertion assertRight (Left _) = assertFailure "Crap"-assertRight _ = pure ()+assertRight _        = pure ()  -- | Bytes which represent a `StringTable`. st :: BS.ByteString@@ -139,8 +139,13 @@   , 0x2a, 0x06   , 0x02, 0x00, 0x00, 0x00, 0x00, 0x00 ] +ids :: BS.ByteString ids = BS.pack [0x9c, 0xb3, 0xaf, 0xde, 0x0a, 0x04, 0x10, 0x16, 0x02, 0x10]++lts :: BS.ByteString lts = BS.pack [0x98, 0x88, 0x8a, 0xbc, 0x02, 0x78, 0xac, 0x02, 0xf8, 0x05, 0x28, 0x90, 0x03]++lns :: BS.ByteString lns = BS.pack [0xf4, 0xd4, 0xc6, 0xcf, 0x09, 0xa7, 0x0a, 0xe4, 0x0f, 0xf3, 0x0d, 0xe8, 0x0c, 0x8b, 0x06 ]  -- | Bytes which represent a `Way` from @shrine.osm@.@@ -164,28 +169,28 @@  stringTableT :: Assertion stringTableT = case A.parseOnly stringTable st of-  Left _ -> assertFailure "Couldn't parse StringTable"-  Right t -> assert . not $ V.null t+  Left _  -> assertFailure "Couldn't parse StringTable"+  Right t -> assertBool "Damn" . not $ V.null t  denseNodesT :: Assertion denseNodesT = case A.parseOnly (dense V.empty) dn of   Left err -> assertFailure err-  Right _ -> pure ()+  Right _  -> pure ()  denseInfoT :: Assertion denseInfoT = case A.parseOnly stringTable st >>= \t -> A.parseOnly (denseInfo [1..] t) dinf of   Left err -> assertFailure err-  Right _ -> pure ()+  Right _  -> pure ()  varintT :: BS.ByteString -> Assertion varintT bs = case A.parseOnly (A.many1 (unzig <$> varint)) bs of                Left err -> assertFailure err-               Right t -> length t @?= 6+               Right t  -> length t @?= 6  wayT :: Assertion wayT = case A.parseOnly stringTable st >>= \t -> A.parseOnly (way t) wey of   Left err -> assertFailure err-  Right _ -> pure ()+  Right _  -> pure ()  shrineT :: Assertion shrineT = fileT "test/shrine.osm.pbf" >>= blockT (5, 1, 0)