diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ -### 1.0.0 ### +## 1.0.0.1 + +- Massaging bounds and future-proofing. + +## 1.0.0 - Initial release. diff --git a/bench/Bench.hs b/bench/Bench.hs deleted file mode 100644 --- a/bench/Bench.hs +++ /dev/null @@ -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") - ] - ] diff --git a/lib/Streaming/Osm.hs b/lib/Streaming/Osm.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/Osm.hs @@ -0,0 +1,83 @@ +-- | +-- Module : Streaming.Osm +-- Copyright : (c) Azavea, 2017 +-- License : BSD3 +-- Maintainer: Colin Woodbury +-- +-- This library provides the ability to read and process +-- data via the 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 diff --git a/lib/Streaming/Osm/Internal/Parser.hs b/lib/Streaming/Osm/Internal/Parser.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/Osm/Internal/Parser.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Streaming.Osm.Internal.Parser +-- Copyright : (c) Azavea, 2017 +-- License : BSD3 +-- Maintainer: Colin Woodbury + +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 diff --git a/lib/Streaming/Osm/Internal/Util.hs b/lib/Streaming/Osm/Internal/Util.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/Osm/Internal/Util.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE BinaryLiterals #-} + +-- | +-- Module : Streaming.Osm.Internal.Util +-- Copyright : (c) Azavea, 2017 +-- License : BSD3 +-- Maintainer: Colin Woodbury + +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 +-- 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 diff --git a/lib/Streaming/Osm/Types.hs b/lib/Streaming/Osm/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Streaming/Osm/Types.hs @@ -0,0 +1,79 @@ +-- | +-- Module : Streaming.Osm.Types +-- Copyright : (c) Azavea, 2017 +-- License : BSD3 +-- Maintainer: Colin Woodbury + +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) diff --git a/src/Streaming/Osm.hs b/src/Streaming/Osm.hs deleted file mode 100644 --- a/src/Streaming/Osm.hs +++ /dev/null @@ -1,82 +0,0 @@ --- | --- Module : Streaming.Osm --- Copyright : (c) Azavea, 2017 --- License : BSD3 --- Maintainer: Colin Woodbury --- --- This library provides the ability to read and process --- data via the 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 diff --git a/src/Streaming/Osm/Internal/Parser.hs b/src/Streaming/Osm/Internal/Parser.hs deleted file mode 100644 --- a/src/Streaming/Osm/Internal/Parser.hs +++ /dev/null @@ -1,173 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - --- | --- Module : Streaming.Osm.Internal.Parser --- Copyright : (c) Azavea, 2017 --- License : BSD3 --- Maintainer: Colin Woodbury - -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 diff --git a/src/Streaming/Osm/Internal/Util.hs b/src/Streaming/Osm/Internal/Util.hs deleted file mode 100644 --- a/src/Streaming/Osm/Internal/Util.hs +++ /dev/null @@ -1,93 +0,0 @@ -{-# LANGUAGE BinaryLiterals #-} - --- | --- Module : Streaming.Osm.Internal.Util --- Copyright : (c) Azavea, 2017 --- License : BSD3 --- Maintainer: Colin Woodbury - -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 --- 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 diff --git a/src/Streaming/Osm/Types.hs b/src/Streaming/Osm/Types.hs deleted file mode 100644 --- a/src/Streaming/Osm/Types.hs +++ /dev/null @@ -1,78 +0,0 @@ --- | --- Module : Streaming.Osm.Types --- Copyright : (c) Azavea, 2017 --- License : BSD3 --- Maintainer: Colin Woodbury - -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) diff --git a/streaming-osm.cabal b/streaming-osm.cabal --- a/streaming-osm.cabal +++ b/streaming-osm.cabal @@ -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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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)