diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +### 1.0.0 ### + +- Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Azavea + +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 Colin Woodbury 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,24 @@ +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/src/Streaming/Osm.hs b/src/Streaming/Osm.hs new file mode 100644 --- /dev/null +++ b/src/Streaming/Osm.hs @@ -0,0 +1,82 @@ +-- | +-- 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 new file mode 100644 --- /dev/null +++ b/src/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.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 new file mode 100644 --- /dev/null +++ b/src/Streaming/Osm/Internal/Util.hs @@ -0,0 +1,93 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/src/Streaming/Osm/Types.hs @@ -0,0 +1,78 @@ +-- | +-- 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 new file mode 100644 --- /dev/null +++ b/streaming-osm.cabal @@ -0,0 +1,84 @@ +-- This file has been generated from package.yaml by hpack version 0.17.0. +-- +-- see: https://github.com/sol/hpack + +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 + +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 + +library + 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 + , 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 + 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 + 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 + 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 diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,231 @@ +module Main where + +import Codec.Compression.Zlib (decompress) +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 +import Streaming.Osm.Types +import qualified Streaming.Prelude as S +import Test.Tasty +import Test.Tasty.HUnit + +--- + +main :: IO () +main = defaultMain suite + +suite :: TestTree +suite = testGroup "Unit Tests" + [ testGroup "Util" + [ testGroup "foldBytes" + [ testCase "3" $ foldBytes (BS.pack [0x03]) 0 @?= 3 + , testCase "124" $ foldBytes (BS.pack [0x7c]) 0 @?= 124 + , testCase "150" $ foldBytes (BS.pack [0x96, 0x01]) 0 @?= 150 + , testCase "270" $ foldBytes (BS.pack [0x8e, 0x02]) 0 @?= 270 + , testCase "86942" $ foldBytes (BS.pack [0x9e, 0xa7, 0x05]) 0 @?= 86942 + ] + -- , testGroup "key" + -- [ testCase "08" $ key @Word8 0x08 @?= (1, 0) + -- , testCase "51" $ key @Word8 0x51 @?= (10, 1) + -- , testCase "12" $ key @Word8 0x12 @?= (2, 2) + -- , testCase "1a" $ key @Word8 0x1a @?= (3, 2) + -- , testCase "22" $ key @Word8 0x22 @?= (4, 2) + -- , testCase "55" $ key @Word8 0x55 @?= (10, 5) + -- ] + -- , testGroup "key2" + -- [ testCase "82 01" $ key2 0x82 0x01 @?= (16, 2) + -- , testCase "92 02" $ key2 0x92 0x02 @?= (34, 2) + -- ] + -- , testGroup "unkey" + -- [ testCase "34 string" $ unkey 34 2 @?= Left (0x92, 0x02) + -- , testCase "16 string" $ unkey 16 2 @?= Left (0x82, 0x01) + -- , testCase "01 varint" $ unkey 01 0 @?= Right 0x08 + -- , testCase "02 string" $ unkey 02 2 @?= Right 0x12 + -- , testCase "03 string" $ unkey 03 2 @?= Right 0x1a + -- , testCase "04 string" $ unkey 04 2 @?= Right 0x22 + -- , testCase "10 64bit" $ unkey 10 1 @?= Right 0x51 + -- , testCase "10 32bit" $ unkey 10 5 @?= Right 0x55 + -- ] + , testGroup "breakOn0" + [ testCase "Simple" $ breakOn0 [0,0,0,0,7,2,9,5,0] @?= [[], [], [], [], [7,2,9,5]] + ] +-- , testGroup "groupBytes" +-- [ testCase "03 8E 02 9E A7 05" groupBytesT +-- ] + ] + , testGroup "Parser functions" + [ testCase "StringTable" stringTableT + , testCase "DenseNodes" denseNodesT + , testCase "DenseInfo" denseInfoT + , testCase "varint" $ varintT ids + , testCase "varint" $ varintT lts + , testCase "varint" $ varintT lns + , testCase "way" wayT + ] + , testGroup "Parsing Whole Files" + [ testCase "shrine" shrineT + , testCase "diomede" diomedeT + , testCase "tashirojima" tashirojimaT + , testCase "ajishima" ajishimaT + , testCase "nozakijima" nozakijimaT + ] + , testGroup "Streaming" + [ testCase "shrine" $ fileS "test/shrine.osm.pbf" (5, 1, 0) + , testCase "tashirojima" $ fileS "test/tashirojima.osm.pbf" (4040, 384, 2) + , testCase "nozakijima" $ fileS "test/nozakijima.osm.pbf" (3371, 151, 8) + , testCase "ajishima" $ fileS "test/ajishima.osm.pbf" (5118, 325, 1) + , testCase "uku" $ fileS "test/uku.osm.pbf" (17390, 1228, 6) + , testCase "North Van" $ fileS "test/north-van.osm.pbf" (48596, 7757, 52) +-- , testCase "Vancouver" $ fileS "test/vancouver.osm.pbf" (804749, 156053, 1689) + ] + ] + +assertRight :: Either t1 t -> Assertion +assertRight (Left _) = assertFailure "Crap" +assertRight _ = pure () + +-- | Bytes which represent a `StringTable`. +st :: BS.ByteString +st = BS.pack [ 0x0a, 0x00, 0x0a, 0x07, 0x54, 0x6f, 0x6d, 0x5f, 0x47, 0x33, 0x58, 0x0a, 0x06, 0x73 + , 0x6f, 0x75, 0x72, 0x63, 0x65, 0x0a, 0x0c, 0x79, 0x68, 0x3a, 0x53, 0x54, 0x52, 0x55 + , 0x43, 0x54, 0x55, 0x52, 0x45, 0x0a, 0x09, 0x63, 0x6f, 0x61, 0x73, 0x74, 0x6c, 0x69 + , 0x6e, 0x65, 0x0a, 0x07, 0x6e, 0x61, 0x74, 0x75, 0x72, 0x61, 0x6c, 0x0a, 0x0f, 0xe9 + , 0x80, 0x9a, 0xe5, 0xb8, 0xb8, 0xe6, 0xb0, 0xb4, 0xe6, 0xb6, 0xaf, 0xe7, 0xb7, 0x9a + , 0x0a, 0x07, 0x79, 0x68, 0x3a, 0x54, 0x59, 0x50, 0x45, 0x0a, 0x12, 0x59, 0x61, 0x68 + , 0x6f, 0x6f, 0x4a, 0x61, 0x70, 0x61, 0x6e, 0x2f, 0x41, 0x4c, 0x50, 0x53, 0x4d, 0x41 + , 0x50, 0x0a, 0x09, 0xe6, 0xb5, 0xb7, 0xe5, 0xb2, 0xb8, 0xe7, 0xb7, 0x9a ] + +-- | Bytes which represent `DenseNodes`. +dn :: BS.ByteString +dn = BS.pack [ + -- Header stuff + 0x12, 0x5f + -- Packed list of IDs + , 0x0a, 0x0a + , 0x9c, 0xb3, 0xaf, 0xde, 0x0a, 0x04, 0x10, 0x16, 0x02, 0x10 + -- Embedded `DenseInfo` + , 0x2a, 0x31, 0x0a, 0x06, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x12, 0x0a, 0x9e, 0xcf + , 0xde, 0xe7, 0x09, 0x00, 0x02, 0x00, 0x00, 0x02, 0x1a, 0x09, 0xe2, 0x99, 0xf8, 0x08 + , 0x00, 0x00, 0x00, 0x00, 0x00, 0x22, 0x08, 0xe4, 0xf7, 0x11, 0x00, 0x00, 0x00, 0x00 + , 0x00, 0x2a, 0x06, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00 + -- Packed list of LATs + , 0x42, 0x0d + , 0x98, 0x88, 0x8a, 0xbc, 0x02, 0x78, 0xac, 0x02, 0xf8, 0x05, 0x28, 0x90, 0x03 + -- Packed list of LNGs + , 0x4a, 0x0f + , 0xf4, 0xd4, 0xc6, 0xcf, 0x09, 0xa7, 0x0a, 0xe4, 0x0f, 0xf3, 0x0d, 0xe8, 0x0c, 0x8b, 0x06 ] + +-- | Bytes which represent `DenseInfo`. +dinf :: BS.ByteString +dinf = BS.pack [ + -- Versions + 0x0a, 0x06 + , 0x01, 0x01, 0x01, 0x01, 0x01, 0x01 + -- Timestamps + , 0x12, 0x0a + , 0x9e, 0xcf, 0xde, 0xe7, 0x09, 0x00, 0x02, 0x00, 0x00, 0x02 + -- Changesets + , 0x1a, 0x09 + , 0xe2, 0x99, 0xf8, 0x08, 0x00, 0x00, 0x00, 0x00, 0x00 + -- UIDs + , 0x22, 0x08 + , 0xe4, 0xf7, 0x11, 0x00, 0x00, 0x00, 0x00, 0x00 + -- Indices to username in StringTable + , 0x2a, 0x06 + , 0x02, 0x00, 0x00, 0x00, 0x00, 0x00 ] + +ids = BS.pack [0x9c, 0xb3, 0xaf, 0xde, 0x0a, 0x04, 0x10, 0x16, 0x02, 0x10] +lts = BS.pack [0x98, 0x88, 0x8a, 0xbc, 0x02, 0x78, 0xac, 0x02, 0xf8, 0x05, 0x28, 0x90, 0x03] +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@. +wey :: BS.ByteString +wey = BS.pack [ + -- PrimitiveGroup field marking this as a Way + 0x1a, 0x2d + -- id + , 0x08, 0xfa, 0xd8, 0xfc, 0x6f + -- keys + , 0x12, 0x02, 0x04, 0x03 + -- vals + , 0x1a, 0x02, 0x08, 0x0a + -- Embedded `Info` + , 0x22, 0x13 + , 0x08, 0x01, 0x10, 0xb0, 0xba, 0xdf, 0x90, 0x05, 0x18, 0xe6, 0xd8, 0xaa + , 0x08, 0x20, 0xb9, 0x8f, 0x0d, 0x28, 0x01 + -- Node ids + , 0x42, 0x09 + , 0xfa, 0x8c, 0x81, 0x8d, 0x12, 0x29, 0x08, 0x30, 0x0d ] + +stringTableT :: Assertion +stringTableT = case A.parseOnly stringTable st of + Left _ -> assertFailure "Couldn't parse StringTable" + Right t -> assert . not $ V.null t + +denseNodesT :: Assertion +denseNodesT = case A.parseOnly (dense V.empty) dn of + Left err -> assertFailure err + Right _ -> pure () + +denseInfoT :: Assertion +denseInfoT = case A.parseOnly stringTable st >>= \t -> A.parseOnly (denseInfo [1..] t) dinf of + Left err -> assertFailure err + 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 + +wayT :: Assertion +wayT = case A.parseOnly stringTable st >>= \t -> A.parseOnly (way t) wey of + Left err -> assertFailure err + Right _ -> pure () + +shrineT :: Assertion +shrineT = fileT "test/shrine.osm.pbf" >>= blockT (5, 1, 0) + +fileS :: FilePath -> (Int, Int, Int) -> Assertion +fileS fp expected = do + let bs = blocks $ blobs fp + nwrs <- runResourceT $ (,,) + <$> S.length_ (nodes bs) + <*> S.length_ (ways bs) + <*> S.length_ (relations bs) + nwrs @?= expected + +diomedeT :: Assertion +diomedeT = fileT "test/diomede.osm.pbf" >>= blockT (510, 74, 1) + +tashirojimaT :: Assertion +tashirojimaT = fileT "test/tashirojima.osm.pbf" >>= blockT (4040, 384, 2) + +nozakijimaT :: Assertion +nozakijimaT = fileT "test/nozakijima.osm.pbf" >>= blockT (3371, 151, 8) + +ajishimaT :: Assertion +ajishimaT = fileT "test/ajishima.osm.pbf" >>= blockT (5118, 325, 1) + +--ukuT :: Assertion +--ukuT = fileT "uku.osm.pbf" >>= blockT (8000, 0, 0) + +blockT :: (Int, Int, Int) -> Either String Block -> Assertion +blockT _ (Left err) = assertFailure err +blockT (n, w, r) (Right b) = do + length (_nodes b) @?= n + length (_ways b) @?= w + length (_relations b) @?= r + +-- | Parse the first data `Blob` from a given file. +fileT :: FilePath -> IO (Either String Block) +fileT f = do + bites <- BS.readFile f + case A.parseOnly (header *> blob *> header *> blob) bites of + Left err -> pure $ Left err + Right (Blob (Left bs)) -> pure $ A.parseOnly block bs + Right (Blob (Right (_, bs))) -> pure $ A.parseOnly block . BL.toStrict . decompress $ BL.fromStrict bs diff --git a/test/ajishima.osm.pbf b/test/ajishima.osm.pbf new file mode 100644 Binary files /dev/null and b/test/ajishima.osm.pbf differ diff --git a/test/diomede.osm.pbf b/test/diomede.osm.pbf new file mode 100644 Binary files /dev/null and b/test/diomede.osm.pbf differ diff --git a/test/north-van.osm.pbf b/test/north-van.osm.pbf new file mode 100644 Binary files /dev/null and b/test/north-van.osm.pbf differ diff --git a/test/nozakijima.osm.pbf b/test/nozakijima.osm.pbf new file mode 100644 Binary files /dev/null and b/test/nozakijima.osm.pbf differ diff --git a/test/shrine.osm.pbf b/test/shrine.osm.pbf new file mode 100644 Binary files /dev/null and b/test/shrine.osm.pbf differ diff --git a/test/tashirojima.osm.pbf b/test/tashirojima.osm.pbf new file mode 100644 Binary files /dev/null and b/test/tashirojima.osm.pbf differ diff --git a/test/uku.osm.pbf b/test/uku.osm.pbf new file mode 100644 Binary files /dev/null and b/test/uku.osm.pbf differ