vectortiles 1.2.0.6 → 1.3.0

raw patch · 17 files changed

+1246/−994 lines, 17 filesdep +hashabledep +protocol-buffersdep +protocol-buffers-descriptordep −cerealdep −protobufdep ~basedep ~criterionPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, protocol-buffers, protocol-buffers-descriptor, unordered-containers

Dependencies removed: cereal, protobuf

Dependency ranges changed: base, criterion

API changes (from Hackage documentation)

Files

• LICENSE +24/−196
• bench/Bench.hs +14/−20
• lib/Geography/VectorTile.hs +45/−37
• lib/Geography/VectorTile/Geometry.hs +15/−15
• lib/Geography/VectorTile/Internal.hs +353/−0
• lib/Geography/VectorTile/Protobuf.hs +0/−59
• lib/Geography/VectorTile/Protobuf/Internal.hs +0/−410
• lib/Geography/VectorTile/Protobuf/Internal/Vector_tile.hs +23/−0
• lib/Geography/VectorTile/Protobuf/Internal/Vector_tile/Tile.hs +87/−0
• lib/Geography/VectorTile/Protobuf/Internal/Vector_tile/Tile/Feature.hs +108/−0
• lib/Geography/VectorTile/Protobuf/Internal/Vector_tile/Tile/GeomType.hs +78/−0
• lib/Geography/VectorTile/Protobuf/Internal/Vector_tile/Tile/Layer.hs +138/−0
• lib/Geography/VectorTile/Protobuf/Internal/Vector_tile/Tile/Value.hs +152/−0
• lib/Geography/VectorTile/Util.hs +12/−17
• lib/Geography/VectorTile/VectorTile.hs +44/−42
• test/Test.hs +102/−157
• vectortiles.cabal +51/−41

@@ -1,202 +1,30 @@--                                 Apache License-                           Version 2.0, January 2004-                        http://www.apache.org/licenses/--   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION--   1. Definitions.--      "License" shall mean the terms and conditions for use, reproduction,-      and distribution as defined by Sections 1 through 9 of this document.--      "Licensor" shall mean the copyright owner or entity authorized by-      the copyright owner that is granting the License.--      "Legal Entity" shall mean the union of the acting entity and all-      other entities that control, are controlled by, or are under common-      control with that entity. For the purposes of this definition,-      "control" means (i) the power, direct or indirect, to cause the-      direction or management of such entity, whether by contract or-      otherwise, or (ii) ownership of fifty percent (50%) or more of the-      outstanding shares, or (iii) beneficial ownership of such entity.--      "You" (or "Your") shall mean an individual or Legal Entity-      exercising permissions granted by this License.--      "Source" form shall mean the preferred form for making modifications,-      including but not limited to software source code, documentation-      source, and configuration files.--      "Object" form shall mean any form resulting from mechanical-      transformation or translation of a Source form, including but-      not limited to compiled object code, generated documentation,-      and conversions to other media types.--      "Work" shall mean the work of authorship, whether in Source or-      Object form, made available under the License, as indicated by a-      copyright notice that is included in or attached to the work-      (an example is provided in the Appendix below).--      "Derivative Works" shall mean any work, whether in Source or Object-      form, that is based on (or derived from) the Work and for which the-      editorial revisions, annotations, elaborations, or other modifications-      represent, as a whole, an original work of authorship. For the purposes-      of this License, Derivative Works shall not include works that remain-      separable from, or merely link (or bind by name) to the interfaces of,-      the Work and Derivative Works thereof.--      "Contribution" shall mean any work of authorship, including-      the original version of the Work and any modifications or additions-      to that Work or Derivative Works thereof, that is intentionally-      submitted to Licensor for inclusion in the Work by the copyright owner-      or by an individual or Legal Entity authorized to submit on behalf of-      the copyright owner. For the purposes of this definition, "submitted"-      means any form of electronic, verbal, or written communication sent-      to the Licensor or its representatives, including but not limited to-      communication on electronic mailing lists, source code control systems,-      and issue tracking systems that are managed by, or on behalf of, the-      Licensor for the purpose of discussing and improving the Work, but-      excluding communication that is conspicuously marked or otherwise-      designated in writing by the copyright owner as "Not a Contribution."--      "Contributor" shall mean Licensor and any individual or Legal Entity-      on behalf of whom a Contribution has been received by Licensor and-      subsequently incorporated within the Work.--   2. Grant of Copyright License. Subject to the terms and conditions of-      this License, each Contributor hereby grants to You a perpetual,-      worldwide, non-exclusive, no-charge, royalty-free, irrevocable-      copyright license to reproduce, prepare Derivative Works of,-      publicly display, publicly perform, sublicense, and distribute the-      Work and such Derivative Works in Source or Object form.--   3. Grant of Patent License. Subject to the terms and conditions of-      this License, each Contributor hereby grants to You a perpetual,-      worldwide, non-exclusive, no-charge, royalty-free, irrevocable-      (except as stated in this section) patent license to make, have made,-      use, offer to sell, sell, import, and otherwise transfer the Work,-      where such license applies only to those patent claims licensable-      by such Contributor that are necessarily infringed by their-      Contribution(s) alone or by combination of their Contribution(s)-      with the Work to which such Contribution(s) was submitted. If You-      institute patent litigation against any entity (including a-      cross-claim or counterclaim in a lawsuit) alleging that the Work-      or a Contribution incorporated within the Work constitutes direct-      or contributory patent infringement, then any patent licenses-      granted to You under this License for that Work shall terminate-      as of the date such litigation is filed.--   4. Redistribution. You may reproduce and distribute copies of the-      Work or Derivative Works thereof in any medium, with or without-      modifications, and in Source or Object form, provided that You-      meet the following conditions:--      (a) You must give any other recipients of the Work or-          Derivative Works a copy of this License; and--      (b) You must cause any modified files to carry prominent notices-          stating that You changed the files; and--      (c) You must retain, in the Source form of any Derivative Works-          that You distribute, all copyright, patent, trademark, and-          attribution notices from the Source form of the Work,-          excluding those notices that do not pertain to any part of-          the Derivative Works; and--      (d) If the Work includes a "NOTICE" text file as part of its-          distribution, then any Derivative Works that You distribute must-          include a readable copy of the attribution notices contained-          within such NOTICE file, excluding those notices that do not-          pertain to any part of the Derivative Works, in at least one-          of the following places: within a NOTICE text file distributed-          as part of the Derivative Works; within the Source form or-          documentation, if provided along with the Derivative Works; or,-          within a display generated by the Derivative Works, if and-          wherever such third-party notices normally appear. The contents-          of the NOTICE file are for informational purposes only and-          do not modify the License. You may add Your own attribution-          notices within Derivative Works that You distribute, alongside-          or as an addendum to the NOTICE text from the Work, provided-          that such additional attribution notices cannot be construed-          as modifying the License.--      You may add Your own copyright statement to Your modifications and-      may provide additional or different license terms and conditions-      for use, reproduction, or distribution of Your modifications, or-      for any such Derivative Works as a whole, provided Your use,-      reproduction, and distribution of the Work otherwise complies with-      the conditions stated in this License.--   5. Submission of Contributions. Unless You explicitly state otherwise,-      any Contribution intentionally submitted for inclusion in the Work-      by You to the Licensor shall be under the terms and conditions of-      this License, without any additional terms or conditions.-      Notwithstanding the above, nothing herein shall supersede or modify-      the terms of any separate license agreement you may have executed-      with Licensor regarding such Contributions.--   6. Trademarks. This License does not grant permission to use the trade-      names, trademarks, service marks, or product names of the Licensor,-      except as required for reasonable and customary use in describing the-      origin of the Work and reproducing the content of the NOTICE file.--   7. Disclaimer of Warranty. Unless required by applicable law or-      agreed to in writing, Licensor provides the Work (and each-      Contributor provides its Contributions) on an "AS IS" BASIS,-      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or-      implied, including, without limitation, any warranties or conditions-      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A-      PARTICULAR PURPOSE. You are solely responsible for determining the-      appropriateness of using or redistributing the Work and assume any-      risks associated with Your exercise of permissions under this License.--   8. Limitation of Liability. In no event and under no legal theory,-      whether in tort (including negligence), contract, or otherwise,-      unless required by applicable law (such as deliberate and grossly-      negligent acts) or agreed to in writing, shall any Contributor be-      liable to You for damages, including any direct, indirect, special,-      incidental, or consequential damages of any character arising as a-      result of this License or out of the use or inability to use the-      Work (including but not limited to damages for loss of goodwill,-      work stoppage, computer failure or malfunction, or any and all-      other commercial damages or losses), even if such Contributor-      has been advised of the possibility of such damages.--   9. Accepting Warranty or Additional Liability. While redistributing-      the Work or Derivative Works thereof, You may choose to offer,-      and charge a fee for, acceptance of support, warranty, indemnity,-      or other liability obligations and/or rights consistent with this-      License. However, in accepting such obligations, You may act only-      on Your own behalf and on Your sole responsibility, not on behalf-      of any other Contributor, and only if You agree to indemnify,-      defend, and hold each Contributor harmless for any liability-      incurred by, or claims asserted against, such Contributor by reason-      of your accepting any such warranty or additional liability.--   END OF TERMS AND CONDITIONS+Copyright Colin Woodbury (c) 2017 -   APPENDIX: How to apply the Apache License to your work.+All rights reserved. -      To apply the Apache License to your work, attach the following-      boilerplate notice, with the fields enclosed by brackets "[]"-      replaced with your own identifying information. (Don't include-      the brackets!)  The text should be enclosed in the appropriate-      comment syntax for the file format. We also recommend that a-      file or class name and description of purpose be included on the-      same "printed page" as the copyright notice for easier-      identification within third-party archives.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: -   Copyright [yyyy] [name of copyright owner]+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer. -   Licensed under the Apache License, Version 2.0 (the "License");-   you may not use this file except in compliance with the License.-   You may obtain a copy of the License at+    * 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. -       http://www.apache.org/licenses/LICENSE-2.0+    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission. -   Unless required by applicable law or agreed to in writing, software-   distributed under the License is distributed on an "AS IS" BASIS,-   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.-   See the License for the specific language governing permissions and-   limitations under the License.+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.

@@ -1,14 +1,14 @@+-- -*- dante-target: "vectortiles-bench"; -*-+ {-# LANGUAGE OverloadedStrings #-}  module Main where -import           Control.Monad ((>=>)) import           Criterion.Main import qualified Data.ByteString as BS-import qualified Data.Map.Lazy as M-import           Data.Text (Text)+import qualified Data.ByteString.Lazy as BL+import qualified Data.HashMap.Lazy as M import           Geography.VectorTile-import           Geography.VectorTile.Geometry (Polygon) import           Lens.Micro import           Lens.Micro.Platform ()  -- Instances only. @@ -20,10 +20,10 @@   ls <- BS.readFile "test/linestring.mvt"   pl <- BS.readFile "test/polygon.mvt"   rd <- BS.readFile "test/roads.mvt"-  let op' = fromRight $ decode op >>= tile-      ls' = fromRight $ decode ls >>= tile-      pl' = fromRight $ decode pl >>= tile-      rd' = fromRight $ decode rd >>= tile+  let op' = fromRight $ tile op+      ls' = fromRight $ tile ls+      pl' = fromRight $ tile pl+      rd' = fromRight $ tile rd   defaultMain [ bgroup "Decoding"                 [ bgroup "onepoint.mvt" $ decodes op                 , bgroup "linestring.mvt" $ decodes ls@@ -51,22 +51,16 @@               ]  decodes :: BS.ByteString -> [Benchmark]-decodes bs = [ bench "Raw.VectorTile" $ nf decode bs-             , bench "VectorTile" $ nf (decode >=> tile) bs-             ]+decodes bs = [ bench "VectorTile" $ nf tile bs ]  encodes :: VectorTile -> [Benchmark]-encodes vt = [ bench "Raw.VectorTile" $ nf untile vt-             , bench "ByteString" $ nf (encode . untile) vt-             ]+encodes vt = [ bench "ByteString" $ nf untile vt ] -layerNames :: BS.ByteString -> [Text]-layerNames mvt = M.keys $ _layers t-  where t = fromRight $ decode mvt >>= tile+layerNames :: BS.ByteString -> [BL.ByteString]+layerNames = M.keys . _layers . fromRight . tile -firstPoly :: Text -> BS.ByteString -> Maybe Polygon-firstPoly ln mvt = r ^? _Right . layers . ix ln . polygons . _head . geometries . _head-  where r = decode mvt >>= tile+firstPoly :: BL.ByteString -> BS.ByteString -> Maybe Polygon+firstPoly ln mvt = tile mvt ^? _Right . layers . ix ln . polygons . _head . geometries . _head  fromRight :: Either a b -> b fromRight (Right b) = b

@@ -1,8 +1,8 @@ -- | -- Module    : Geography.VectorTile--- Copyright : (c) Azavea, 2016--- License   : Apache 2--- Maintainer: Colin Woodbury <cwoodbury@azavea.com>+-- Copyright : (c) Colin Woodbury 2016 - 2018+-- License   : BSD3+-- Maintainer: Colin Woodbury <colingw@gmail.com> -- -- GIS Vector Tiles, as defined by Mapbox. --@@ -12,17 +12,10 @@ -- Note that currently this library ignores top-level protobuf extensions, -- /Value/ extensions, and /UNKNOWN/ geometries. ----- The order in which to explore the modules of this library is as follows:------ 1. "Geography.VectorTile.VectorTile"--- 2. "Geography.VectorTile.Geometry"--- 3. "Geography.VectorTile.Protobuf"--- -- == Usage ----- This library reads and writes strict `ByteString`s. By importing this module,--- you use the default protobuf backend. Given some legal--- VectorTile file called @roads.mvt@:+-- This library reads and writes strict `BS.ByteString`s.+-- Given some legal VectorTile file called @roads.mvt@: -- -- > import qualified Data.ByteString as BS -- > import           Data.Text (Text)@@ -30,39 +23,54 @@ -- > -- > -- | Read in raw protobuf data and decode it into a high-level type. -- > roads :: IO (Either Text VectorTile)--- > roads = do--- >   mvt <- BS.readFile "roads.mvt"--- >   pure $ decode mvt >>= tile------ Or encode a `VectorTile` back into a `ByteString`:+-- > roads = tile <$> BS.readFile "roads.mvt" ----- > roadsBytes :: VectorTile -> BS.ByteString--- > roadsBytes = encode . untile-+-- Likewise, use the `untile` function to convert a `VectorTile` back into a `ByteString`.  module Geography.VectorTile-  ( -- * High-level Types-    -- | This module also provides lenses for data field access,-    -- as `VectorTile`s are highly nested objects.-    module Geography.VectorTile.VectorTile-  , -- * Protobuf Backend-    -- ** Conversions-    tile+  ( -- * Vector Tiles+    VectorTile(..)+  , tile   , untile-  -- ** ByteString Encoding / Decoding-  , decode-  , encode+  , Lens'+  , layers+  , Layer(..)+  , version+  , name+  , points+  , linestrings+  , polygons+  , extent+  , Feature(..)+  , featureId+  , metadata+  , geometries+  , Val(..)+  -- * Geometries+  , Point, x, y+  , LineString(..)+  , Polygon(..)+  , area+  , surveyor+  , distance   ) where -import           Data.Text (Text)-import qualified Geography.VectorTile.Protobuf.Internal as PB-import           Geography.VectorTile.Protobuf (decode, encode)+import           Control.Monad ((>=>))+import           Data.Bifunctor (bimap)+import qualified Data.ByteString as BS+import           Data.ByteString.Lazy (fromStrict, toStrict)+import           Data.Text (Text, pack)+import           Geography.VectorTile.Internal (fromProtobuf, toProtobuf) import           Geography.VectorTile.VectorTile+import           Geography.VectorTile.Geometry+import           Text.ProtocolBuffers.WireMessage (messageGet, messagePut)  --- -tile :: PB.RawVectorTile -> Either Text VectorTile-tile = PB.fromProtobuf+-- | Attempt to parse a `VectorTile` from a strict collection of bytes.+tile :: BS.ByteString -> Either Text VectorTile+tile = bimap pack id . messageGet . fromStrict >=> fromProtobuf . fst -untile :: VectorTile -> PB.RawVectorTile-untile = PB.toProtobuf+-- | Convert a `VectorTile` back into bytes.+untile :: VectorTile -> BS.ByteString+untile = toStrict . messagePut . toProtobuf

@@ -3,14 +3,14 @@  -- | -- Module    : Geography.VectorTile.Geometry--- Copyright : (c) Azavea, 2016--- License   : Apache 2--- Maintainer: Colin Woodbury <cwoodbury@azavea.com>+-- Copyright : (c) Colin Woodbury 2016 - 2018+-- License   : BSD3+-- Maintainer: Colin Woodbury <colingw@gmail.com>  module Geography.VectorTile.Geometry   ( -- * Geometries     -- ** Types-    Point, x, y+    Point, pattern Point, x, y   , LineString(..)   , Polygon(..)   -- ** Operations@@ -20,7 +20,8 @@   ) where  import           Control.DeepSeq (NFData)-import qualified Data.Vector as V+import           Data.Foldable (foldl')+import qualified Data.Sequence as Seq import qualified Data.Vector.Unboxed as U import           GHC.Generics (Generic) @@ -40,27 +41,26 @@ instance NFData LineString  -- | A polygon aware of its interior rings.+--+-- VectorTiles require that Polygon exteriors have clockwise winding order,+-- and that interior holes have counter-clockwise winding order.+-- These assume that the origin (0,0) is in the *top-left* corner. data Polygon = Polygon { polyPoints :: U.Vector Point-                       , inner :: V.Vector Polygon } deriving (Eq,Show,Generic)+                       , inner :: Seq.Seq Polygon } deriving (Eq,Show,Generic)  instance NFData Polygon -{---- | Very performant for the same reason as `LineString`.-newtype Polygon = Polygon { points :: U.Vector Point } deriving (Eq,Show)--}- -- | The area of a `Polygon` is the difference between the areas of its -- outer ring and inner rings.-area :: Polygon -> Float-area p = surveyor (polyPoints p) + sum (V.map area $ inner p)+area :: Polygon -> Double+area p = surveyor (polyPoints p) + foldl' (\acc i -> acc + area i) 0 (inner p)  -- | The surveyor's formula for calculating the area of a `Polygon`. -- If the value reported here is negative, then the `Polygon` should be -- considered an Interior Ring. -- -- Assumption: The `U.Vector` given has at least 4 `Point`s.-surveyor :: U.Vector Point -> Float+surveyor :: U.Vector Point -> Double surveyor v = (/ 2) . fromIntegral . U.sum $ U.zipWith3 (\xn yn yp -> xn * (yn - yp)) xs yns yps   where v' = U.init v         xs = U.map x v'@@ -68,7 +68,7 @@         yps = U.map y . U.init $ U.cons (U.last v') v'  -- | Euclidean distance.-distance :: Point -> Point -> Float+distance :: Point -> Point -> Double distance p1 p2 = sqrt . fromIntegral $ dx ^ 2 + dy ^ 2   where dx = x p1 - x p2         dy = y p1 - y p2

@@ -0,0 +1,353 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}++-- |+-- Module    : Geography.VectorTile.Internal+-- Copyright : (c) Colin Woodbury 2016 - 2018+-- License   : BSD3+-- Maintainer: Colin Woodbury <colingw@gmail.com>+--+-- Raw Vector Tile data is stored as binary protobuf data.+-- This module reads and writes raw protobuf ByteStrings between a data type+-- which closely matches the current Mapbox vector tile spec defined here:+-- https://github.com/mapbox/vector-tile-spec/blob/master/2.1/vector_tile.proto+--+-- As this raw version of the data is hard to work with, in practice we convert+-- to a more canonical Haskell type for further processing.+-- See "Geography.VectorTile" for the user-friendly version.++module Geography.VectorTile.Internal+  ( -- * Types+    -- ** Protobuf Conversion+    Protobuf(..)+  , Protobuffable(..)+  , ProtobufGeom(..)+    -- ** Decoded Middle-Types+  , Tile.Tile(Tile, layers)+  , Layer.Layer(Layer, version, name, features, keys, values, extent)+  , Feature.Feature(..)+  , Value.Value(..)+  , GeomType.GeomType(..)+    -- * Commands+  , Command(..)+  , commands+  , uncommands+   -- * Z-Encoding+  , zig+  , unzig+    -- * Protobuf Conversions+    -- | Due to Protobuf Layers and Features having their data coupled,+    -- we can't define a `Protobuffable` instance for `VT.Feature`s,+    -- and instead must use the two functions below.+  , feats+  , unfeats+  ) where++import           Control.Applicative ((<|>))+import           Control.Monad (void)+import           Control.Monad.Trans.State.Strict+import           Data.Bits+import qualified Data.ByteString.Lazy as BL+import           Data.Foldable (fold, foldl', foldlM, toList)+import           Data.Int+import qualified Data.HashMap.Lazy as M+import qualified Data.HashSet as HS+import           Data.Maybe (fromJust)+import           Data.Monoid+import qualified Data.Sequence as Seq+import           Data.Sequence (Seq, (<|), (|>), Seq((:<|)))+import           Data.Text (Text, pack)+import qualified Data.Vector.Unboxed as U+import           Data.Word+import qualified Geography.VectorTile.Geometry as G+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile as Tile+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Feature as Feature+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType as GeomType+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Layer as Layer+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Value as Value+import           Geography.VectorTile.Util+import qualified Geography.VectorTile.VectorTile as VT+import           Text.Printf+import           Text.ProtocolBuffers.Basic (defaultValue, Utf8(..), utf8)++---++-- | A family of data types which can associated with concrete underlying+-- Protobuf types.+type family Protobuf a = pb | pb -> a+type instance Protobuf VT.VectorTile = Tile.Tile+type instance Protobuf VT.Layer = Layer.Layer+type instance Protobuf VT.Val = Value.Value++-- | A type which can be converted to and from an underlying Protobuf type,+-- according to the `Protobuf` type family.+class Protobuffable a where+  fromProtobuf :: Protobuf a -> Either Text a+  toProtobuf   :: a -> Protobuf a++instance Protobuffable VT.VectorTile where+  fromProtobuf raw = do+    ls <- traverse fromProtobuf . toList $ Tile.layers raw+    pure . VT.VectorTile . M.fromList $ map (\l -> (VT._name l, l)) ls++  toProtobuf vt = Tile.Tile { Tile.layers    = Seq.fromList . map toProtobuf . M.elems $ VT._layers vt+                            , Tile.ext'field = defaultValue }++instance Protobuffable VT.Layer where+  fromProtobuf l = do+    (ps,ls,polys) <- feats (utf8 <$> Layer.keys l) (Layer.values l) $ Layer.features l+    pure VT.Layer { VT._version = fromIntegral $ Layer.version l+                  , VT._name = utf8 $ Layer.name l+                  , VT._points = ps+                  , VT._linestrings = ls+                  , VT._polygons = polys+                  , VT._extent = maybe 4096 fromIntegral (Layer.extent l) }++  toProtobuf l = Layer.Layer { Layer.version   = fromIntegral $ VT._version l+                             , Layer.name      = Utf8 $ VT._name l+                             , Layer.features  = fs+                             , Layer.keys      = Seq.fromList $ map Utf8 ks+                             , Layer.values    = Seq.fromList $ map toProtobuf vs+                             , Layer.extent    = Just . fromIntegral $ VT._extent l+                             , Layer.ext'field = defaultValue }+    where (ks,vs) = totalMeta (VT._points l) (VT._linestrings l) (VT._polygons l)+          (km,vm) = (M.fromList $ zip ks [0..], M.fromList $ zip vs [0..])+          fs = fold [ fmap (unfeats km vm GeomType.POINT) (VT._points l)+                    , fmap (unfeats km vm GeomType.LINESTRING) (VT._linestrings l)+                    , fmap (unfeats km vm GeomType.POLYGON) (VT._polygons l) ]++instance Protobuffable VT.Val where+  fromProtobuf v = maybe (Left "Value decode: No legal Value type offered") Right $+        fmap (VT.St . utf8) (Value.string_value v)+    <|> fmap VT.Fl  (Value.float_value v)+    <|> fmap VT.Do  (Value.double_value v)+    <|> fmap VT.I64 (Value.int_value v)+    <|> fmap VT.W64 (Value.uint_value v)+    <|> fmap VT.S64 (Value.sint_value v)+    <|> fmap VT.B   (Value.bool_value v)++  toProtobuf (VT.St v)  = defaultValue { Value.string_value = Just $ Utf8 v }+  toProtobuf (VT.Fl v)  = defaultValue { Value.float_value  = Just v }+  toProtobuf (VT.Do v)  = defaultValue { Value.double_value = Just v }+  toProtobuf (VT.I64 v) = defaultValue { Value.int_value    = Just v }+  toProtobuf (VT.W64 v) = defaultValue { Value.uint_value   = Just v }+  toProtobuf (VT.S64 v) = defaultValue { Value.sint_value   = Just v }+  toProtobuf (VT.B v)   = defaultValue { Value.bool_value   = Just v }++-- | Any classical type considered a GIS "geometry". These must be able+-- to convert between an encodable list of `Command`s.+class ProtobufGeom g where+  fromCommands :: Seq Command -> Either Text (Seq g)+  toCommands :: Seq g -> Seq Command++-- | A valid `RawFeature` of points must contain a single `MoveTo` command+-- with a count greater than 0.+instance ProtobufGeom G.Point where+  fromCommands (MoveTo ps :<| Seq.Empty) = Right $ expand' (0, 0) ps+  fromCommands (c :<| _) = Left . pack $ printf "Invalid command found in Point feature: %s" (show c)+  fromCommands Seq.Empty = Left "No points given!"++  -- | A multipoint geometry must reduce to a single `MoveTo` command.+  toCommands ps = Seq.singleton (MoveTo $ evalState (traverse collapse ps) (0,0))++-- | A valid `RawFeature` of linestrings must contain pairs of:+--+-- A `MoveTo` with a count of 1, followed by one `LineTo` command with+-- a count greater than 0.+instance ProtobufGeom G.LineString where+  fromCommands cs = evalState (f cs) (0,0)+    where f (MoveTo (p :<| Seq.Empty) :<| LineTo ps :<| rs) = do+            curr <- get+            let ls = G.LineString . expand curr . U.fromList . toList $ p <| ps+            put . U.last $ G.lsPoints ls+            fmap (ls <|) <$> f rs+          f Seq.Empty = pure $ Right Seq.Empty+          f _ = pure $ Left "LineString decode: Invalid command sequence given."++  toCommands ls = fold $ evalState (traverse f ls) (0,0)+    where f (G.LineString ps) = do+            l <- U.mapM collapse ps+            pure $ MoveTo (Seq.singleton $ U.head l) <| LineTo (Seq.fromList . U.toList $ U.tail l) <| Seq.Empty++-- | A valid `RawFeature` of polygons must contain at least one sequence of:+--+-- An Exterior Ring, followed by 0 or more Interior Rings.+--+-- Any Ring must have a `MoveTo` with a count of 1, a single `LineTo`+-- with a count of at least 2, and a single `ClosePath` command.+--+-- Performs no sanity checks for malformed Interior Rings.+instance ProtobufGeom G.Polygon where+  fromCommands cs = do+    h :<| t <- evalState (f cs) (0,0)+    let (ps',p') = runState (foldlM g Seq.Empty t) h+    pure $ ps' |> p'  -- Include the last Exterior Ring worked on.+    where f (MoveTo (p :<| Seq.Empty) :<| LineTo ps :<| ClosePath :<| rs) = do+            curr <- get+            let ps' = expand curr . U.fromList . toList $ p <| ps  -- Conversion bottleneck?+            put $ U.last ps'+            fmap (G.Polygon (U.snoc ps' $ U.head ps') Seq.Empty <|) <$> f rs+          f Seq.Empty = pure $ Right Seq.Empty+          f _  = pure . Left . pack $ printf "Polygon decode: Invalid command sequence given: %s" (show cs)+          g acc p | G.area p > 0 = do  -- New external rings.+                      curr <- get+                      put p+                      pure $ acc |> curr+                  | otherwise = do  -- Next internal ring.+                      modify (\s -> s { G.inner = G.inner s |> p })+                      pure acc++  toCommands ps = fold $ evalState (traverse f ps) (0,0)+    where f :: G.Polygon -> State (Int, Int) (Seq Command)+          f (G.Polygon p i) = do+            l <- U.mapM collapse $ U.init p  -- Exclude the final point.+            let cs = MoveTo (Seq.singleton $ U.head l) <| LineTo (Seq.fromList . U.toList $ U.tail l) <| ClosePath <| Seq.Empty+            fold . (cs <|) <$> traverse f i++-- | The possible commands, and the values they hold.+data Command = MoveTo (Seq (Int,Int))+             | LineTo (Seq (Int,Int))+             | ClosePath deriving (Eq,Show)++-- | Z-encode a 64-bit Int.+zig :: Int -> Word32+zig n = fromIntegral $ shift n 1 `xor` shift n (-63)+{-# INLINE zig #-}++-- | Decode a Z-encoded Word32 into a 64-bit Int.+unzig :: Word32 -> Int+unzig n = fromIntegral (fromIntegral unzigged :: Int32)+  where unzigged = shift n (-1) `xor` negate (n .&. 1)+{-# INLINE unzig #-}++-- | Divide a "Command Integer" into its @(Command,Count)@.+parseCmd :: Word32 -> Either Text (Int,Int)+parseCmd n = case (cmd,count) of+  (1,m) -> Right (1, fromIntegral m)+  (2,m) -> Right (2, fromIntegral m)+  (7,1) -> Right (7,1)+  (7,m) -> Left $ "ClosePath was given a parameter count: " <> pack (show m)+  (m,_) -> Left . pack $ printf "Invalid command integer %d found in: %X" m n+  where cmd = n .&. 7+        count = shift n (-3)++-- | Recombine a Command ID and parameter count into a Command Integer.+unparseCmd :: (Int,Int) -> Word32+unparseCmd (cmd,count) = fromIntegral $ (cmd .&. 7) .|. shift count 3+{-# INLINE unparseCmd #-}++-- | Attempt to parse a list of Command/Parameter integers, as defined here:+--+-- https://github.com/mapbox/vector-tile-spec/tree/master/2.1#43-geometry-encoding+commands :: Seq Word32 -> Either Text (Seq Command)+commands = go (Right Seq.Empty)+  where go !acc Seq.Empty = acc+        go (Left e) _ = Left e+        go (Right !acc) (n :<| ns) = parseCmd n >>= \case+          (1, count) -> do+            let (ls,rs) = Seq.splitAt (count * 2) ns+            mts <- MoveTo <$> pairsWith unzig ls+            go (Right $ acc |> mts) rs+          (2, count) -> do+            let (ls,rs) = Seq.splitAt (count * 2) ns+            mts <- LineTo <$> pairsWith unzig ls+            go (Right $ acc |> mts) rs+          (7, _) -> go (Right $ acc |> ClosePath) ns+          _ -> Left "Sentinel: You should never see this."++-- | Convert a list of parsed `Command`s back into their original Command+-- and Z-encoded Parameter integer forms.+uncommands :: Seq Command -> Seq Word32+uncommands = (>>= f)+  where f (MoveTo ps) = unparseCmd (1, length ps) <| params ps+        f (LineTo ls) = unparseCmd (2, length ls) <| params ls+        f ClosePath   = Seq.singleton $ unparseCmd (7,1)  -- ClosePath, Count 1.++{- FROM PROTOBUF -}++-- | Convert a list of `RawFeature`s of parsed protobuf data into `V.Vector`s+-- of each of the three legal `ProtobufGeom` types.+--+-- The long type signature is due to two things:+--+-- 1. `Feature`s are polymorphic at the high level, but not at the parsed+-- protobuf mid-level. In a @[RawFeature]@, there are features of points,+-- linestrings, and polygons all mixed together.+--+-- 2. `RawLayer`s and `RawFeature`s+-- are strongly coupled at the protobuf level. In order to achieve higher+-- compression ratios, `RawLayer`s contain all metadata in key/value lists+-- to be shared across their `RawFeature`s, while those `RawFeature`s store only+-- indices into those lists. As a result, this function needs to be passed+-- those key/value lists from the parent `RawLayer`, and a more isomorphic:+--+-- > feature :: ProtobufGeom g => RawFeature -> Either Text (Feature g)+--+-- is not possible.+feats :: Seq BL.ByteString -> Seq Value.Value -> Seq Feature.Feature+  -> Either Text (Seq (VT.Feature G.Point), Seq (VT.Feature G.LineString), Seq (VT.Feature G.Polygon))+feats _ _ Seq.Empty = Left "VectorTile.features: `[RawFeature]` empty"+feats keys vals fs = foldlM g mempty fs+  where f :: ProtobufGeom g => Feature.Feature -> Either Text (VT.Feature g)+        f x = VT.Feature+          <$> pure (maybe 0 fromIntegral $ Feature.id x)+          <*> getMeta keys vals (Feature.tags x)+          <*> (commands (Feature.geometry x) >>= fromCommands)+        g (!pnt,!lin,!ply) fe = case Feature.type' fe of+          Just GeomType.POINT      -> (\fe' -> (pnt |> fe', lin, ply)) <$> f fe+          Just GeomType.LINESTRING -> (\fe' -> (pnt, lin |> fe', ply)) <$> f fe+          Just GeomType.POLYGON    -> (\fe' -> (pnt, lin, ply |> fe')) <$> f fe+          _ -> Left "Geometry type of UNKNOWN given."++getMeta :: Seq BL.ByteString -> Seq Value.Value -> Seq Word32 -> Either Text (M.HashMap BL.ByteString VT.Val)+getMeta keys vals tags = do+  kv <- pairsWith fromIntegral tags+  foldlM (\acc (k,v) -> (\v' -> M.insert (keys `Seq.index` k) v' acc) <$> fromProtobuf (vals `Seq.index` v)) M.empty kv++{- TO PROTOBUF -}++totalMeta :: Seq (VT.Feature G.Point) -> Seq (VT.Feature G.LineString) -> Seq (VT.Feature G.Polygon) -> ([BL.ByteString], [VT.Val])+totalMeta ps ls polys = (keys, vals)+  where keys = HS.toList $ f ps <> f ls <> f polys+        vals = HS.toList $ g ps <> g ls <> g polys+        f = foldMap (HS.fromMap . void . VT._metadata)+        g = foldMap (HS.fromList . M.elems . VT._metadata)++-- | Encode a high-level `Feature` back into its mid-level `RawFeature` form.+unfeats :: ProtobufGeom g => M.HashMap BL.ByteString Int -> M.HashMap VT.Val Int -> GeomType.GeomType -> VT.Feature g -> Feature.Feature+unfeats keys vals gt fe = Feature.Feature+                            { Feature.id       = Just . fromIntegral $ VT._featureId fe+                            , Feature.tags     = Seq.fromList $ tags fe+                            , Feature.type'    = Just gt+                            , Feature.geometry = uncommands . toCommands $ VT._geometries fe }+  where tags = unpairs . map f . M.toList . VT._metadata+        f (k,v) = (fromIntegral . fromJust $ M.lookup k keys, fromIntegral . fromJust $ M.lookup v vals)++{- UTIL -}++-- | Transform a `Seq` of `Point`s into one of Z-encoded Parameter ints.+params :: Seq (Int,Int) -> Seq Word32+params = foldl' (\acc (a,b) -> acc |> zig a |> zig b) Seq.Empty++-- | Expand a pair of diffs from some reference point into that of a `Point` value.+expand :: (Int, Int) -> U.Vector (Int, Int) -> U.Vector (Int, Int)+expand = U.postscanl' (\(x, y) (dx, dy) -> (x + dx, y + dy))++expand' :: (Int, Int) -> Seq (Int, Int) -> Seq (Int, Int)+expand' curr s = Seq.drop 1 $ Seq.scanl (\(x, y) (dx, dy) -> (x + dx, y + dy)) curr s++-- | Collapse a given `Point` into a pair of diffs, relative to+-- the previous point in the sequence. The reference point is moved+-- to the `Point` given.+collapse :: G.Point -> State (Int,Int) (Int,Int)+collapse p = do+  curr <- get+  let diff = (G.x p - G.x curr, G.y p - G.y curr)+  put p+  pure diff

@@ -1,59 +0,0 @@--- |--- Module    : Geography.VectorTile.Protobuf--- Copyright : (c) Azavea, 2016--- License   : Apache 2--- Maintainer: Colin Woodbury <cwoodbury@azavea.com>------ Most of the details of Protobuf conversion are kept in--- "Geometry.VectorTile.Protobuf.Internal", a module which is not intended--- to be imported.------ A user's main concern here should be the `Protobuffable` class, and its--- `VectorTile` instance. With it, one can do the following:------ > import Geography.VectorTile.Protobuf--- >--- > decode bytes >>= fromProtobuf  -- Either Text VectorTile------ which in fact is sugared in the top-level module of this library as:------ > decode bytes >>= tile--module Geography.VectorTile.Protobuf-  ( -- * Types-    Protobuffable(..)-    -- * ByteString Encoding / Decoding-  , decode-  , encode-  , decodeIO-  , encodeIO-  ) where--import qualified Data.ByteString as BS-import           Data.ProtocolBuffers hiding (decode, encode)-import           Data.Serialize.Get-import           Data.Serialize.Put-import           Data.Text (Text, pack)-import           Geography.VectorTile.Protobuf.Internal--------- | Attempt to decode a `BS.ByteString` of raw protobuf data into a mid-level--- representation of a `RawVectorTile`.-decode :: BS.ByteString -> Either Text RawVectorTile-decode bs = case runGet decodeMessage bs of-  Left e -> Left $ pack e-  Right vt -> Right vt---- | Encode a mid-level representation of a `RawVectorTile` into raw protobuf data.-encode :: RawVectorTile -> BS.ByteString-encode = runPut . encodeMessage---- | Given a filename, attempt to decode bytes read from that file.-decodeIO :: FilePath -> IO (Either Text RawVectorTile)-decodeIO = fmap decode . BS.readFile---- | Write a mid-level representation of a `RawVectorTile` to a file as raw--- protobuf data.-encodeIO :: RawVectorTile -> FilePath -> IO ()-encodeIO vt fp = BS.writeFile fp $ encode vt

@@ -1,410 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilyDependencies #-}---- |--- Module    : Geography.VectorTile.Protobuf.Internal--- Copyright : (c) Azavea, 2016 - 2017--- License   : Apache 2--- Maintainer: Colin Woodbury <cwoodbury@azavea.com>------ Raw Vector Tile data is stored as binary protobuf data.--- This module reads and writes raw protobuf ByteStrings between a data type--- which closely matches the current Mapbox vector tile spec defined here:--- https://github.com/mapbox/vector-tile-spec/blob/master/2.1/vector_tile.proto------ As this raw version of the data is hard to work with, in practice we convert--- to a more canonical Haskell type for further processing.--- See "Geography.VectorTile.VectorTile" for the user-friendly version.------ Please import this module @qualified@ to avoid namespace clashes:------ > import qualified Geography.VectorTile.Protobuf.Internal as PB--module Geography.VectorTile.Protobuf.Internal-  ( -- * Types-    Protobuf(..)-  , Protobuffable(..)-  , ProtobufGeom(..)-  , RawVectorTile(..)-  , RawLayer(..)-  , RawVal(..)-  , RawFeature(..)-  , GeomType(..)-    -- * Commands-  , Command(..)-  , commands-  , uncommands-   -- * Z-Encoding-  , zig-  , unzig-    -- * Protobuf Conversions-    -- | Due to Protobuf Layers and Features having their data coupled,-    -- we can't define a `Protobuffable` instance for `VT.Feature`s,-    -- and instead must use the two functions below.-  , features-  , unfeature-  ) where--import           Control.Applicative ((<|>))-import           Control.DeepSeq (NFData)-import           Control.Monad.Trans.State.Lazy-import           Data.Bits-import           Data.Foldable (foldrM, foldlM)-import           Data.Int-import           Data.List (nub)-import qualified Data.Map.Lazy as M-import           Data.Maybe (fromJust)-import           Data.Monoid-import           Data.ProtocolBuffers hiding (decode, encode)-import qualified Data.Set as S-import           Data.Text (Text, pack)-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import           Data.Word-import           GHC.Generics (Generic)-import qualified Geography.VectorTile.Geometry as G-import           Geography.VectorTile.Util-import qualified Geography.VectorTile.VectorTile as VT-import           Text.Printf--------- | A family of data types which can associated with concrete underlying--- Protobuf types.-type family Protobuf a = pb | pb -> a-type instance Protobuf VT.VectorTile = RawVectorTile-type instance Protobuf VT.Layer = RawLayer-type instance Protobuf VT.Val = RawVal---- | A type which can be converted to and from an underlying Protobuf type,--- according to the `Protobuf` type family.-class Protobuffable a where-  fromProtobuf :: Protobuf a -> Either Text a-  toProtobuf :: a -> Protobuf a--instance Protobuffable VT.VectorTile where-  fromProtobuf raw = do-    ls <- mapM fromProtobuf . getField $ _layers raw-    pure . VT.VectorTile . M.fromList $ map (\l -> (VT._name l, l)) ls--  toProtobuf vt = RawVectorTile { _layers = putField . map toProtobuf . M.elems $ VT._layers vt }--instance Protobuffable VT.Layer where-  fromProtobuf l = do-    (ps,ls,polys) <- features keys vals . getField $ _features l-    pure VT.Layer { VT._version = fromIntegral . getField $ _version l-                  , VT._name = getField $ _name l-                  , VT._points = ps-                  , VT._linestrings = ls-                  , VT._polygons = polys-                  , VT._extent = maybe 4096 fromIntegral (getField $ _extent l) }-      where keys = getField $ _keys l-            vals = getField $ _values l--  toProtobuf l = RawLayer { _version = putField . fromIntegral $ VT._version l-                          , _name = putField $ VT._name l-                          , _features = putField fs-                          , _keys = putField ks-                          , _values = putField $ map toProtobuf vs-                          , _extent = putField . Just . fromIntegral $ VT._extent l }-    where (ks,vs) = totalMeta (VT._points l) (VT._linestrings l) (VT._polygons l)-          (km,vm) = (M.fromList $ zip ks [0..], M.fromList $ zip vs [0..])-          fs = V.toList $ V.concat [ V.map (unfeature km vm Point) (VT._points l)-                                   , V.map (unfeature km vm LineString) (VT._linestrings l)-                                   , V.map (unfeature km vm Polygon) (VT._polygons l) ]--instance Protobuffable VT.Val where-  fromProtobuf v = mtoe "Value decode: No legal Value type offered" $ fmap VT.St (getField $ _string v)-    <|> fmap VT.Fl  (getField $ _float v)-    <|> fmap VT.Do  (getField $ _double v)-    <|> fmap VT.I64 (getField $ _int64 v)-    <|> fmap VT.W64 (getField $ _uint64 v)-    <|> fmap (\(Signed n) -> VT.S64 n) (getField $ _sint v)-    <|> fmap VT.B   (getField $ _bool v)--  toProtobuf (VT.St v)  = def { _string = putField $ Just v }-  toProtobuf (VT.Fl v)  = def { _float = putField $ Just v }-  toProtobuf (VT.Do v)  = def { _double = putField $ Just v }-  toProtobuf (VT.I64 v) = def { _int64 = putField $ Just v }-  toProtobuf (VT.W64 v) = def { _uint64 = putField $ Just v }-  toProtobuf (VT.S64 v) = def { _sint = putField . Just $ Signed v }-  toProtobuf (VT.B v)   = def { _bool = putField $ Just v }---- | A list of `RawLayer`s.-data RawVectorTile = RawVectorTile { _layers :: Repeated 3 (Message RawLayer) }-                   deriving (Generic,Show,Eq)--instance Encode RawVectorTile-instance Decode RawVectorTile-instance NFData RawVectorTile---- | Contains a pseudo-map of metadata, to be shared across all `RawFeature`s--- of this `RawLayer`.-data RawLayer = RawLayer { _version :: Required 15 (Value Word32)-                         , _name :: Required 1 (Value Text)-                         , _features :: Repeated 2 (Message RawFeature)-                         , _keys :: Repeated 3 (Value Text)-                         , _values :: Repeated 4 (Message RawVal)-                         , _extent :: Optional 5 (Value Word32)-                         } deriving (Generic,Show,Eq)--instance Encode RawLayer-instance Decode RawLayer-instance NFData RawLayer---- | The /Value/ types of metadata fields.-data RawVal = RawVal { _string :: Optional 1 (Value Text)-                     , _float :: Optional 2 (Value Float)-                     , _double :: Optional 3 (Value Double)-                     , _int64 :: Optional 4 (Value Int64)-                     , _uint64 :: Optional 5 (Value Word64)-                     , _sint :: Optional 6 (Value (Signed Int64))  -- ^ Z-encoded.-                     , _bool :: Optional 7 (Value Bool)-                     } deriving (Generic,Show,Eq)--instance Encode RawVal-instance Decode RawVal-instance NFData RawVal---- | A set of geometries unified by some theme.-data RawFeature = RawFeature { _featureId :: Optional 1 (Value Word64)-                             , _tags :: Packed 2 (Value Word32)-                             , _geom :: Optional 3 (Enumeration GeomType)-                             , _geometries :: Packed 4 (Value Word32)-                             } deriving (Generic,Show,Eq)--instance Encode RawFeature-instance Decode RawFeature-instance NFData RawFeature---- | The four potential Geometry types. The spec allows for encoders to set--- `Unknown` as the type, but our decoder ignores these.-data GeomType = Unknown | Point | LineString | Polygon-              deriving (Generic,Enum,Show,Eq)--instance Encode GeomType-instance Decode GeomType-instance NFData GeomType---- | Any classical type considered a GIS "geometry". These must be able--- to convert between an encodable list of `Command`s.-class ProtobufGeom g where-  fromCommands :: [Command] -> Either Text (V.Vector g)-  toCommands :: V.Vector g -> [Command]---- | A valid `RawFeature` of points must contain a single `MoveTo` command--- with a count greater than 0.-instance ProtobufGeom G.Point where-  fromCommands [MoveTo ps] = Right . U.convert $ evalState (U.mapM expand ps) (0,0)-  fromCommands (c:_) = Left . pack $ printf "Invalid command found in Point feature: %s" (show c)-  fromCommands [] = Left "No points given!"--  -- | A multipoint geometry must reduce to a single `MoveTo` command.-  toCommands ps = [MoveTo $ evalState (U.mapM collapse $ U.convert ps) (0,0)]---- | A valid `RawFeature` of linestrings must contain pairs of:------ A `MoveTo` with a count of 1, followed by one `LineTo` command with--- a count greater than 0.-instance ProtobufGeom G.LineString where-  fromCommands cs = evalState (f cs) (0,0)-    where f (MoveTo p : LineTo ps : rs) = fmap . V.cons <$> ls <*> f rs-            where ls = G.LineString <$> U.mapM expand (p <> ps)-          f [] = pure $ Right V.empty-          f _  = pure $ Left "LineString decode: Invalid command sequence given."--  toCommands ls = concat $ evalState (mapM f ls) (0,0)-    where f (G.LineString ps) = do-            l <- U.mapM collapse ps-            pure [MoveTo . U.singleton $ U.head l, LineTo $ U.tail l]---- | A valid `RawFeature` of polygons must contain at least one sequence of:------ An Exterior Ring, followed by 0 or more Interior Rings.------ Any Ring must have a `MoveTo` with a count of 1, a single `LineTo`--- with a count of at least 2, and a single `ClosePath` command.------ Performs no sanity checks for malformed Interior Rings.-instance ProtobufGeom G.Polygon where-  fromCommands cs = do-    ps <- evalState (f cs) (0,0)-    let (h,t) = (V.head ps, V.tail ps)-        (ps',p') = runState (foldlM g V.empty t) h-    pure $ V.snoc ps' p'  -- Include the last Exterior Ring worked on.-    where f (MoveTo p : LineTo ps : ClosePath : rs) = do-            curr <- get-            let h = U.head p-                here = (G.x h + G.x curr, G.y h + G.y curr)-            po <- flip U.snoc here <$> U.mapM expand (U.cons h ps)-            fmap (V.cons (G.Polygon po V.empty)) <$> f rs-          f [] = pure $ Right V.empty-          f _  = pure . Left . pack $ printf "Polygon decode: Invalid command sequence given: %s" (show cs)-          g acc p | G.area p > 0 = do  -- New external rings.-                      curr <- get-                      put p-                      pure $ V.snoc acc curr-                  | otherwise = do  -- Next internal ring.-                      modify (\s -> s { G.inner = V.snoc (G.inner s) p })-                      pure acc--  toCommands ps = concat $ evalState (mapM f ps) (0,0)-    where f (G.Polygon p i) = do-            l <- U.mapM collapse $ U.init p  -- Exclude the final point.-            let cs = [MoveTo . U.singleton $ U.head l, LineTo $ U.tail l, ClosePath]-            concat . V.cons cs <$> mapM f i---- | The possible commands, and the values they hold.-data Command = MoveTo (U.Vector (Int,Int))-             | LineTo (U.Vector (Int,Int))-             | ClosePath deriving (Eq,Show)---- | Z-encode a 64-bit Int.-zig :: Int -> Word32-zig n = fromIntegral $ shift n 1 `xor` shift n (-63)---- | Decode a Z-encoded Word32 into a 64-bit Int.-unzig :: Word32 -> Int-unzig n = fromIntegral (fromIntegral unzigged :: Int32)-  where unzigged = shift n (-1) `xor` negate (n .&. 1)---- | Divide a "Command Integer" into its @(Command,Count)@.-parseCmd :: Word32 -> Either Text (Int,Int)-parseCmd n = case (cmd,count) of-  (1,m) -> Right $ both fromIntegral (1,m)-  (2,m) -> Right $ both fromIntegral (2,m)-  (7,1) -> Right (7,1)-  (7,m) -> Left $ "ClosePath was given a parameter count: " <> pack (show m)-  (m,_) -> Left . pack $ printf "Invalid command integer %d found in: %X" m n-  where cmd = n .&. 7-        count = shift n (-3)---- | Recombine a Command ID and parameter count into a Command Integer.-unparseCmd :: (Int,Int) -> Word32-unparseCmd (cmd,count) = fromIntegral $ (cmd .&. 7) .|. shift count 3---- | Attempt to parse a list of Command/Parameter integers, as defined here:------ https://github.com/mapbox/vector-tile-spec/tree/master/2.1#43-geometry-encoding-commands :: [Word32] -> Either Text [Command]-commands [] = Right []-commands (n:ns) = parseCmd n >>= f-  where f (1,count) = do-          mts <- MoveTo . U.fromList . map (both unzig) <$> pairs (take (count * 2) ns)-          (mts :) <$> commands (drop (count * 2) ns)-        f (2,count) = do-          mts <- LineTo . U.fromList . map (both unzig) <$> pairs (take (count * 2) ns)-          (mts :) <$> commands (drop (count * 2) ns)-        f (7,_) = (ClosePath :) <$> commands ns-        f _ = Left "Sentinel: You should never see this."---- | Convert a list of parsed `Command`s back into their original Command--- and Z-encoded Parameter integer forms.-uncommands :: [Command] -> [Word32]-uncommands = U.toList . U.concat . map f-  where f (MoveTo ps) = U.cons (unparseCmd (1, U.length ps)) $ params ps-        f (LineTo ls) = U.cons (unparseCmd (2, U.length ls)) $ params ls-        f ClosePath = U.singleton $ unparseCmd (7,1)  -- ClosePath, Count 1.--{- FROM PROTOBUF -}---- | Convert a list of `RawFeature`s of parsed protobuf data into `V.Vector`s--- of each of the three legal `ProtobufGeom` types.------ The long type signature is due to two things:------ 1. `Feature`s are polymorphic at the high level, but not at the parsed--- protobuf mid-level. In a @[RawFeature]@, there are features of points,--- linestrings, and polygons all mixed together.------ 2. `RawLayer`s and `RawFeature`s--- are strongly coupled at the protobuf level. In order to achieve higher--- compression ratios, `RawLayer`s contain all metadata in key/value lists--- to be shared across their `RawFeature`s, while those `RawFeature`s store only--- indices into those lists. As a result, this function needs to be passed--- those key/value lists from the parent `RawLayer`, and a more isomorphic:------ > feature :: ProtobufGeom g => RawFeature -> Either Text (Feature g)------ is not possible.-features :: [Text] -> [RawVal] -> [RawFeature]-  -> Either Text (V.Vector (VT.Feature G.Point), V.Vector (VT.Feature G.LineString), V.Vector (VT.Feature G.Polygon))-features _ _ [] = Left "VectorTile.features: `[RawFeature]` empty"-features keys vals fs = (,,) <$> ps <*> ls <*> polys-  where -- (_:ps':ls':polys':_) = groupBy sameGeom $ sortOn geomBias fs  -- ok ok ok-        ps = foldrM f V.empty $ filter (\fe -> getField (_geom fe) == Just Point) fs-        ls = foldrM f V.empty $ filter (\fe -> getField (_geom fe) == Just LineString) fs-        polys = foldrM f V.empty $ filter (\fe -> getField (_geom fe) == Just Polygon) fs--        f :: ProtobufGeom g => RawFeature -> V.Vector (VT.Feature g) -> Either Text (V.Vector (VT.Feature g))-        f x acc = do-          geos <- commands (getField $ _geometries x) >>= fromCommands-          meta <- getMeta keys vals . getField $ _tags x-          pure $ VT.Feature { VT._featureId = maybe 0 fromIntegral . getField $ _featureId x-                            , VT._metadata = meta-                            , VT._geometries = geos-                            } `V.cons` acc--getMeta :: [Text] -> [RawVal] -> [Word32] -> Either Text (M.Map Text VT.Val)-getMeta keys vals tags = do-  kv <- map (both fromIntegral) <$> pairs tags-  foldrM (\(k,v) acc -> (\v' -> M.insert (keys !! k) v' acc) <$> fromProtobuf (vals !! v)) M.empty kv--{- TO PROTOBUF -}--totalMeta :: V.Vector (VT.Feature G.Point) -> V.Vector (VT.Feature G.LineString) -> V.Vector (VT.Feature G.Polygon) -> ([Text], [VT.Val])-totalMeta ps ls polys = (keys, vals)-  where keys = S.toList . S.unions $ f ps <> f ls <> f polys-        vals = nub . concat $ g ps <> g ls <> g polys  -- `nub` is O(n^2)-        f = V.foldr (\feat acc -> M.keysSet (VT._metadata feat) : acc) []-        g = V.foldr (\feat acc -> M.elems (VT._metadata feat) : acc) []---- | Encode a high-level `Feature` back into its mid-level `RawFeature` form.-unfeature :: ProtobufGeom g => M.Map Text Int -> M.Map VT.Val Int -> GeomType -> VT.Feature g -> RawFeature-unfeature keys vals gt fe = RawFeature-                            { _featureId = putField . Just . fromIntegral $ VT._featureId fe-                            , _tags = putField $ tags fe-                            , _geom = putField $ Just gt-                            , _geometries = putField . uncommands . toCommands $ VT._geometries fe }-  where tags = unpairs . map f . M.toList . VT._metadata-        f (k,v) = both (fromIntegral . fromJust) (M.lookup k keys, M.lookup v vals)--{- UTIL -}---- | A `RawVal` with every entry set to `Nothing`.-def :: RawVal-def = RawVal { _string = putField Nothing-             , _float  = putField Nothing-             , _double = putField Nothing-             , _int64  = putField Nothing-             , _uint64 = putField Nothing-             , _sint   = putField Nothing-             , _bool   = putField Nothing }---- | Transform a `V.Vector` of `Point`s into one of Z-encoded Parameter ints.-params :: U.Vector (Int,Int) -> U.Vector Word32-params = U.foldr (\(a,b) acc -> U.cons (zig a) $ U.cons (zig b) acc) U.empty---- | Expand a pair of diffs from some reference point into that--- of a `Point` value. The reference point is moved to our new `Point`.-expand :: (Int,Int) -> State (Int,Int) G.Point-expand p = do-  curr <- get-  let here = (G.x p + G.x curr, G.y p + G.y curr)-  put here-  pure here---- | Collapse a given `Point` into a pair of diffs, relative to--- the previous point in the sequence. The reference point is moved--- to the `Point` given.-collapse :: G.Point -> State (Int,Int) (Int,Int)-collapse p = do-  curr <- get-  let diff = (G.x p - G.x curr, G.y p - G.y curr)-  put p-  pure diff

@@ -0,0 +1,23 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC  -fno-warn-unused-imports #-}+module Geography.VectorTile.Protobuf.Internal.Vector_tile (protoInfo, fileDescriptorProto) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto)+import Text.ProtocolBuffers.Reflections (ProtoInfo)+import qualified Text.ProtocolBuffers.WireMessage as P' (wireGet,getFromBS)++protoInfo :: ProtoInfo+protoInfo+ = Prelude'.read+    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".vector_tile\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [], baseName = MName \"Vector_tile\"}, protoFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile.hs\"], protoSource = \"vector_tile.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\"], baseName = MName \"Tile\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.layers\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\"], baseName' = FName \"layers\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.Layer\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Layer\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 16},FieldId {getFieldId = 8191})], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile.Value\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Value\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"Value.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.string_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"string_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.float_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"float_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 21}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.double_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"double_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.int_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"int_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.uint_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"uint_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.sint_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"sint_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.bool_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"bool_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 8},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile.Feature\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Feature\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"Feature.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.id\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"id\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Just \"0\", hsDefault = Just (HsDef'Integer 0)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.tags\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"tags\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Just (WireTag {getWireTag = 16},WireTag {getWireTag = 18}), wireTagLength = 1, isPacked = True, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.type\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"type'\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.GeomType\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"GeomType\"}), hsRawDefault = Just \"UNKNOWN\", hsDefault = Just (HsDef'Enum \"UNKNOWN\")},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.geometry\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"geometry\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Just (WireTag {getWireTag = 32},WireTag {getWireTag = 34}), wireTagLength = 1, isPacked = True, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile.Layer\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Layer\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"Layer.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.version\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"version\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 15}, wireTag = WireTag {getWireTag = 120}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just \"1\", hsDefault = Just (HsDef'Integer 1)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.name\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.features\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"features\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.Feature\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Feature\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.keys\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"keys\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.values\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"values\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.Value\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Value\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.extent\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"extent\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just \"4096\", hsDefault = Just (HsDef'Integer 4096)}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 16},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}], enums = [EnumInfo {enumName = ProtoName {protobufName = FIName \".vector_tile.Tile.GeomType\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"GeomType\"}, enumFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"GeomType.hs\"], enumValues = [(EnumCode {getEnumCode = 0},\"UNKNOWN\"),(EnumCode {getEnumCode = 1},\"POINT\"),(EnumCode {getEnumCode = 2},\"LINESTRING\"),(EnumCode {getEnumCode = 3},\"POLYGON\")]}], oneofs = [], knownKeyMap = fromList []}"++fileDescriptorProto :: FileDescriptorProto+fileDescriptorProto+ = P'.getFromBS (P'.wireGet 11)+    (P'.pack+      "\147\ENQ\n\DC1vector_tile.proto\DC2\vvector_tile\"\213\EOT\n\EOTTile\DC2'\n\ACKlayers\CAN\ETX \ETX(\v2\ETB.vector_tile.Tile.Layer\SUB\161\SOH\n\ENQValue\DC2\DC4\n\fstring_value\CAN\SOH \SOH(\t\DC2\DC3\n\vfloat_value\CAN\STX \SOH(\STX\DC2\DC4\n\fdouble_value\CAN\ETX \SOH(\SOH\DC2\DC1\n\tint_value\CAN\EOT \SOH(\ETX\DC2\DC2\n\nuint_value\CAN\ENQ \SOH(\EOT\DC2\DC2\n\nsint_value\CAN\ACK \SOH(\DC2\DC2\DC2\n\nbool_value\CAN\a \SOH(\b*\b\b\b\DLE\128\128\128\128\STX\SUB\135\SOH\n\aFeature\DC2\r\n\STXid\CAN\SOH \SOH(\EOT:\SOH0\DC2\SUB\n\EOTtags\CAN\STX \ETX(\rB\f\b\NUL\DLE\SOH\CAN\NUL(\NUL0\NULP\NUL\DC21\n\EOTtype\CAN\ETX \SOH(\SO2\SUB.vector_tile.Tile.GeomType:\aUNKNOWN\DC2\RS\n\bgeometry\CAN\EOT \ETX(\rB\f\b\NUL\DLE\SOH\CAN\NUL(\NUL0\NULP\NUL\SUB\173\SOH\n\ENQLayer\DC2\DC2\n\aversion\CAN\SI \STX(\r:\SOH1\DC2\f\n\EOTname\CAN\SOH \STX(\t\DC2+\n\bfeatures\CAN\STX \ETX(\v2\EM.vector_tile.Tile.Feature\DC2\f\n\EOTkeys\CAN\ETX \ETX(\t\DC2'\n\ACKvalues\CAN\EOT \ETX(\v2\ETB.vector_tile.Tile.Value\DC2\DC4\n\ACKextent\CAN\ENQ \SOH(\r:\EOT4096*\b\b\DLE\DLE\128\128\128\128\STX\"?\n\bGeomType\DC2\v\n\aUNKNOWN\DLE\NUL\DC2\t\n\ENQPOINT\DLE\SOH\DC2\SO\n\nLINESTRING\DLE\STX\DC2\v\n\aPOLYGON\DLE\ETX*\ENQ\b\DLE\DLE\128@B\EMH\ETXP\NUL\128\SOH\NUL\136\SOH\NUL\144\SOH\NUL\160\SOH\NUL\184\SOH\NUL\216\SOH\NUL\248\SOH\NUL")

@@ -0,0 +1,87 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC  -fno-warn-unused-imports #-}+module Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile (Tile(..)) where+import Prelude ((+), (/), (==), (<=), (&&))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Layer as Vector_tile.Tile (Layer)++data Tile = Tile{layers :: !(P'.Seq Vector_tile.Tile.Layer), ext'field :: !(P'.ExtField)}+          deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)++instance P'.ExtendMessage Tile where+  getExtField = ext'field+  putExtField e'f msg = msg{ext'field = e'f}+  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)++instance P'.Mergeable Tile where+  mergeAppend (Tile x'1 x'2) (Tile y'1 y'2) = Tile (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)++instance P'.Default Tile where+  defaultValue = Tile P'.defaultValue P'.defaultValue++instance P'.Wire Tile where+  wireSize ft' self'@(Tile x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 11 x'1 + P'.wireSizeExtField x'2)+  wirePut ft' self'@(Tile x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutRep 26 11 x'1+             P'.wirePutExtField x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{layers = P'.append (layers old'Self) new'Field}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in+                   if Prelude'.or [16 <= field'Number && field'Number <= 8191] then P'.loadExtension field'Number wire'Type old'Self+                    else P'.unknown field'Number wire'Type old'Self++instance P'.MessageAPI msg' (msg' -> Tile) Tile where+  getVal m' f' = f' m'++instance P'.GPB Tile++instance P'.ReflectDescriptor Tile where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [26])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\"], baseName = MName \"Tile\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.layers\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\"], baseName' = FName \"layers\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.Layer\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Layer\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 16},FieldId {getFieldId = 8191})], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"++instance P'.TextType Tile where+  tellT = P'.tellSubMessage+  getT = P'.getSubMessage++instance P'.TextMsg Tile where+  textPut msg+   = do+       P'.tellT "layers" (layers msg)+  textGet+   = do+       mods <- P'.sepEndBy (P'.choice [parse'layers]) P'.spaces+       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+    where+        parse'layers+         = P'.try+            (do+               v <- P'.getT "layers"+               Prelude'.return (\ o -> o{layers = P'.append (layers o) v}))

@@ -0,0 +1,108 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC  -fno-warn-unused-imports #-}+module Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Feature (Feature(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType as Vector_tile.Tile (GeomType)++data Feature = Feature{id :: !(P'.Maybe P'.Word64), tags :: !(P'.Seq P'.Word32), type' :: !(P'.Maybe Vector_tile.Tile.GeomType),+                       geometry :: !(P'.Seq P'.Word32)}+             deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)++instance P'.Mergeable Feature where+  mergeAppend (Feature x'1 x'2 x'3 x'4) (Feature y'1 y'2 y'3 y'4)+   = Feature (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)++instance P'.Default Feature where+  defaultValue = Feature (Prelude'.Just 0) P'.defaultValue (Prelude'.Just (Prelude'.read "UNKNOWN")) P'.defaultValue++instance P'.Wire Feature where+  wireSize ft' self'@(Feature x'1 x'2 x'3 x'4)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeOpt 1 4 x'1 + P'.wireSizePacked 1 13 x'2 + P'.wireSizeOpt 1 14 x'3 + P'.wireSizePacked 1 13 x'4)+  wirePut ft' self'@(Feature x'1 x'2 x'3 x'4)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutOpt 8 4 x'1+             P'.wirePutPacked 18 13 x'2+             P'.wirePutOpt 24 14 x'3+             P'.wirePutPacked 34 13 x'4+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             8 -> Prelude'.fmap (\ !new'Field -> old'Self{id = Prelude'.Just new'Field}) (P'.wireGet 4)+             16 -> Prelude'.fmap (\ !new'Field -> old'Self{tags = P'.append (tags old'Self) new'Field}) (P'.wireGet 13)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{tags = P'.mergeAppend (tags old'Self) new'Field}) (P'.wireGetPacked 13)+             24 -> Prelude'.fmap (\ !new'Field -> old'Self{type' = Prelude'.Just new'Field}) (P'.wireGet 14)+             32 -> Prelude'.fmap (\ !new'Field -> old'Self{geometry = P'.append (geometry old'Self) new'Field}) (P'.wireGet 13)+             34 -> Prelude'.fmap (\ !new'Field -> old'Self{geometry = P'.mergeAppend (geometry old'Self) new'Field})+                    (P'.wireGetPacked 13)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self++instance P'.MessageAPI msg' (msg' -> Feature) Feature where+  getVal m' f' = f' m'++instance P'.GPB Feature++instance P'.ReflectDescriptor Feature where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 16, 18, 24, 32, 34])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile.Feature\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Feature\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"Feature.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.id\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"id\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Just \"0\", hsDefault = Just (HsDef'Integer 0)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.tags\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"tags\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Just (WireTag {getWireTag = 16},WireTag {getWireTag = 18}), wireTagLength = 1, isPacked = True, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.type\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"type'\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.GeomType\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"GeomType\"}), hsRawDefault = Just \"UNKNOWN\", hsDefault = Just (HsDef'Enum \"UNKNOWN\")},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Feature.geometry\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Feature\"], baseName' = FName \"geometry\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Just (WireTag {getWireTag = 32},WireTag {getWireTag = 34}), wireTagLength = 1, isPacked = True, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"++instance P'.TextType Feature where+  tellT = P'.tellSubMessage+  getT = P'.getSubMessage++instance P'.TextMsg Feature where+  textPut msg+   = do+       P'.tellT "id" (id msg)+       P'.tellT "tags" (tags msg)+       P'.tellT "type" (type' msg)+       P'.tellT "geometry" (geometry msg)+  textGet+   = do+       mods <- P'.sepEndBy (P'.choice [parse'id, parse'tags, parse'type', parse'geometry]) P'.spaces+       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+    where+        parse'id+         = P'.try+            (do+               v <- P'.getT "id"+               Prelude'.return (\ o -> o{id = v}))+        parse'tags+         = P'.try+            (do+               v <- P'.getT "tags"+               Prelude'.return (\ o -> o{tags = P'.append (tags o) v}))+        parse'type'+         = P'.try+            (do+               v <- P'.getT "type"+               Prelude'.return (\ o -> o{type' = v}))+        parse'geometry+         = P'.try+            (do+               v <- P'.getT "geometry"+               Prelude'.return (\ o -> o{geometry = P'.append (geometry o) v}))

@@ -0,0 +1,78 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC  -fno-warn-unused-imports #-}+module Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType (GeomType(..)) where+import Prelude ((+), (/), (.))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'++data GeomType = UNKNOWN+              | POINT+              | LINESTRING+              | POLYGON+              deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)++instance P'.Mergeable GeomType++instance Prelude'.Bounded GeomType where+  minBound = UNKNOWN+  maxBound = POLYGON++instance P'.Default GeomType where+  defaultValue = UNKNOWN++toMaybe'Enum :: Prelude'.Int -> P'.Maybe GeomType+toMaybe'Enum 0 = Prelude'.Just UNKNOWN+toMaybe'Enum 1 = Prelude'.Just POINT+toMaybe'Enum 2 = Prelude'.Just LINESTRING+toMaybe'Enum 3 = Prelude'.Just POLYGON+toMaybe'Enum _ = Prelude'.Nothing++instance Prelude'.Enum GeomType where+  fromEnum UNKNOWN = 0+  fromEnum POINT = 1+  fromEnum LINESTRING = 2+  fromEnum POLYGON = 3+  toEnum+   = P'.fromMaybe+      (Prelude'.error+        "hprotoc generated code: toEnum failure for type Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType")+      . toMaybe'Enum+  succ UNKNOWN = POINT+  succ POINT = LINESTRING+  succ LINESTRING = POLYGON+  succ _+   = Prelude'.error "hprotoc generated code: succ failure for type Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType"+  pred POINT = UNKNOWN+  pred LINESTRING = POINT+  pred POLYGON = LINESTRING+  pred _+   = Prelude'.error "hprotoc generated code: pred failure for type Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType"++instance P'.Wire GeomType where+  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)+  wireGet 14 = P'.wireGetEnum toMaybe'Enum+  wireGet ft' = P'.wireGetErr ft'+  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum+  wireGetPacked ft' = P'.wireGetErr ft'++instance P'.GPB GeomType++instance P'.MessageAPI msg' (msg' -> GeomType) GeomType where+  getVal m' f' = f' m'++instance P'.ReflectEnum GeomType where+  reflectEnum = [(0, "UNKNOWN", UNKNOWN), (1, "POINT", POINT), (2, "LINESTRING", LINESTRING), (3, "POLYGON", POLYGON)]+  reflectEnumInfo _+   = P'.EnumInfo+      (P'.makePNF (P'.pack ".vector_tile.Tile.GeomType") ["Geography", "VectorTile", "Protobuf", "Internal"] ["Vector_tile", "Tile"]+        "GeomType")+      ["Geography", "VectorTile", "Protobuf", "Internal", "Vector_tile", "Tile", "GeomType.hs"]+      [(0, "UNKNOWN"), (1, "POINT"), (2, "LINESTRING"), (3, "POLYGON")]++instance P'.TextType GeomType where+  tellT = P'.tellShow+  getT = P'.getRead

@@ -0,0 +1,138 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC  -fno-warn-unused-imports #-}+module Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Layer (Layer(..)) where+import Prelude ((+), (/), (==), (<=), (&&))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Feature as Vector_tile.Tile (Feature)+import qualified Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Value as Vector_tile.Tile (Value)++data Layer = Layer{version :: !(P'.Word32), name :: !(P'.Utf8), features :: !(P'.Seq Vector_tile.Tile.Feature),+                   keys :: !(P'.Seq P'.Utf8), values :: !(P'.Seq Vector_tile.Tile.Value), extent :: !(P'.Maybe P'.Word32),+                   ext'field :: !(P'.ExtField)}+           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)++instance P'.ExtendMessage Layer where+  getExtField = ext'field+  putExtField e'f msg = msg{ext'field = e'f}+  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)++instance P'.Mergeable Layer where+  mergeAppend (Layer x'1 x'2 x'3 x'4 x'5 x'6 x'7) (Layer y'1 y'2 y'3 y'4 y'5 y'6 y'7)+   = Layer (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+      (P'.mergeAppend x'5 y'5)+      (P'.mergeAppend x'6 y'6)+      (P'.mergeAppend x'7 y'7)++instance P'.Default Layer where+  defaultValue = Layer 1 P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue (Prelude'.Just 4096) P'.defaultValue++instance P'.Wire Layer where+  wireSize ft' self'@(Layer x'1 x'2 x'3 x'4 x'5 x'6 x'7)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+         = (P'.wireSizeReq 1 13 x'1 + P'.wireSizeReq 1 9 x'2 + P'.wireSizeRep 1 11 x'3 + P'.wireSizeRep 1 9 x'4 ++             P'.wireSizeRep 1 11 x'5+             + P'.wireSizeOpt 1 13 x'6+             + P'.wireSizeExtField x'7)+  wirePut ft' self'@(Layer x'1 x'2 x'3 x'4 x'5 x'6 x'7)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 9 x'2+             P'.wirePutRep 18 11 x'3+             P'.wirePutRep 26 9 x'4+             P'.wirePutRep 34 11 x'5+             P'.wirePutOpt 40 13 x'6+             P'.wirePutReq 120 13 x'1+             P'.wirePutExtField x'7+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             120 -> Prelude'.fmap (\ !new'Field -> old'Self{version = new'Field}) (P'.wireGet 13)+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{name = new'Field}) (P'.wireGet 9)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{features = P'.append (features old'Self) new'Field}) (P'.wireGet 11)+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{keys = P'.append (keys old'Self) new'Field}) (P'.wireGet 9)+             34 -> Prelude'.fmap (\ !new'Field -> old'Self{values = P'.append (values old'Self) new'Field}) (P'.wireGet 11)+             40 -> Prelude'.fmap (\ !new'Field -> old'Self{extent = Prelude'.Just new'Field}) (P'.wireGet 13)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in+                   if Prelude'.or [16 <= field'Number && field'Number <= 18999, 20000 <= field'Number] then+                    P'.loadExtension field'Number wire'Type old'Self else P'.unknown field'Number wire'Type old'Self++instance P'.MessageAPI msg' (msg' -> Layer) Layer where+  getVal m' f' = f' m'++instance P'.GPB Layer++instance P'.ReflectDescriptor Layer where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 120]) (P'.fromDistinctAscList [10, 18, 26, 34, 40, 120])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile.Layer\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Layer\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"Layer.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.version\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"version\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 15}, wireTag = WireTag {getWireTag = 120}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just \"1\", hsDefault = Just (HsDef'Integer 1)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.name\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"name\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.features\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"features\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.Feature\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Feature\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.keys\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"keys\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.values\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"values\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".vector_tile.Tile.Value\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Value\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Layer.extent\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Layer\"], baseName' = FName \"extent\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Just \"4096\", hsDefault = Just (HsDef'Integer 4096)}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 16},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"++instance P'.TextType Layer where+  tellT = P'.tellSubMessage+  getT = P'.getSubMessage++instance P'.TextMsg Layer where+  textPut msg+   = do+       P'.tellT "version" (version msg)+       P'.tellT "name" (name msg)+       P'.tellT "features" (features msg)+       P'.tellT "keys" (keys msg)+       P'.tellT "values" (values msg)+       P'.tellT "extent" (extent msg)+  textGet+   = do+       mods <- P'.sepEndBy (P'.choice [parse'version, parse'name, parse'features, parse'keys, parse'values, parse'extent]) P'.spaces+       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+    where+        parse'version+         = P'.try+            (do+               v <- P'.getT "version"+               Prelude'.return (\ o -> o{version = v}))+        parse'name+         = P'.try+            (do+               v <- P'.getT "name"+               Prelude'.return (\ o -> o{name = v}))+        parse'features+         = P'.try+            (do+               v <- P'.getT "features"+               Prelude'.return (\ o -> o{features = P'.append (features o) v}))+        parse'keys+         = P'.try+            (do+               v <- P'.getT "keys"+               Prelude'.return (\ o -> o{keys = P'.append (keys o) v}))+        parse'values+         = P'.try+            (do+               v <- P'.getT "values"+               Prelude'.return (\ o -> o{values = P'.append (values o) v}))+        parse'extent+         = P'.try+            (do+               v <- P'.getT "extent"+               Prelude'.return (\ o -> o{extent = v}))

@@ -0,0 +1,152 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS_GHC  -fno-warn-unused-imports #-}+module Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Value (Value(..)) where+import Prelude ((+), (/), (==), (<=), (&&))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified GHC.Generics as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'++data Value = Value{string_value :: !(P'.Maybe P'.Utf8), float_value :: !(P'.Maybe P'.Float), double_value :: !(P'.Maybe P'.Double),+                   int_value :: !(P'.Maybe P'.Int64), uint_value :: !(P'.Maybe P'.Word64), sint_value :: !(P'.Maybe P'.Int64),+                   bool_value :: !(P'.Maybe P'.Bool), ext'field :: !(P'.ExtField)}+           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)++instance P'.ExtendMessage Value where+  getExtField = ext'field+  putExtField e'f msg = msg{ext'field = e'f}+  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)++instance P'.Mergeable Value where+  mergeAppend (Value x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8) (Value y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8)+   = Value (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+      (P'.mergeAppend x'5 y'5)+      (P'.mergeAppend x'6 y'6)+      (P'.mergeAppend x'7 y'7)+      (P'.mergeAppend x'8 y'8)++instance P'.Default Value where+  defaultValue+   = Value P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+      P'.defaultValue++instance P'.Wire Value where+  wireSize ft' self'@(Value x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+         = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 2 x'2 + P'.wireSizeOpt 1 1 x'3 + P'.wireSizeOpt 1 3 x'4 ++             P'.wireSizeOpt 1 4 x'5+             + P'.wireSizeOpt 1 18 x'6+             + P'.wireSizeOpt 1 8 x'7+             + P'.wireSizeExtField x'8)+  wirePut ft' self'@(Value x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutOpt 10 9 x'1+             P'.wirePutOpt 21 2 x'2+             P'.wirePutOpt 25 1 x'3+             P'.wirePutOpt 32 3 x'4+             P'.wirePutOpt 40 4 x'5+             P'.wirePutOpt 48 18 x'6+             P'.wirePutOpt 56 8 x'7+             P'.wirePutExtField x'8+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{string_value = Prelude'.Just new'Field}) (P'.wireGet 9)+             21 -> Prelude'.fmap (\ !new'Field -> old'Self{float_value = Prelude'.Just new'Field}) (P'.wireGet 2)+             25 -> Prelude'.fmap (\ !new'Field -> old'Self{double_value = Prelude'.Just new'Field}) (P'.wireGet 1)+             32 -> Prelude'.fmap (\ !new'Field -> old'Self{int_value = Prelude'.Just new'Field}) (P'.wireGet 3)+             40 -> Prelude'.fmap (\ !new'Field -> old'Self{uint_value = Prelude'.Just new'Field}) (P'.wireGet 4)+             48 -> Prelude'.fmap (\ !new'Field -> old'Self{sint_value = Prelude'.Just new'Field}) (P'.wireGet 18)+             56 -> Prelude'.fmap (\ !new'Field -> old'Self{bool_value = Prelude'.Just new'Field}) (P'.wireGet 8)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in+                   if Prelude'.or [8 <= field'Number && field'Number <= 18999, 20000 <= field'Number] then+                    P'.loadExtension field'Number wire'Type old'Self else P'.unknown field'Number wire'Type old'Self++instance P'.MessageAPI msg' (msg' -> Value) Value where+  getVal m' f' = f' m'++instance P'.GPB Value++instance P'.ReflectDescriptor Value where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 21, 25, 32, 40, 48, 56])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".vector_tile.Tile.Value\", haskellPrefix = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule = [MName \"Vector_tile\",MName \"Tile\"], baseName = MName \"Value\"}, descFilePath = [\"Geography\",\"VectorTile\",\"Protobuf\",\"Internal\",\"Vector_tile\",\"Tile\",\"Value.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.string_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"string_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.float_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"float_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 21}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 2}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.double_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"double_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.int_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"int_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.uint_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"uint_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.sint_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"sint_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 48}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".vector_tile.Tile.Value.bool_value\", haskellPrefix' = [MName \"Geography\",MName \"VectorTile\",MName \"Protobuf\",MName \"Internal\"], parentModule' = [MName \"Vector_tile\",MName \"Tile\",MName \"Value\"], baseName' = FName \"bool_value\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 7}, wireTag = WireTag {getWireTag = 56}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [(FieldId {getFieldId = 8},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 536870911})], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"++instance P'.TextType Value where+  tellT = P'.tellSubMessage+  getT = P'.getSubMessage++instance P'.TextMsg Value where+  textPut msg+   = do+       P'.tellT "string_value" (string_value msg)+       P'.tellT "float_value" (float_value msg)+       P'.tellT "double_value" (double_value msg)+       P'.tellT "int_value" (int_value msg)+       P'.tellT "uint_value" (uint_value msg)+       P'.tellT "sint_value" (sint_value msg)+       P'.tellT "bool_value" (bool_value msg)+  textGet+   = do+       mods <- P'.sepEndBy+                (P'.choice+                  [parse'string_value, parse'float_value, parse'double_value, parse'int_value, parse'uint_value, parse'sint_value,+                   parse'bool_value])+                P'.spaces+       Prelude'.return (Prelude'.foldl (\ v f -> f v) P'.defaultValue mods)+    where+        parse'string_value+         = P'.try+            (do+               v <- P'.getT "string_value"+               Prelude'.return (\ o -> o{string_value = v}))+        parse'float_value+         = P'.try+            (do+               v <- P'.getT "float_value"+               Prelude'.return (\ o -> o{float_value = v}))+        parse'double_value+         = P'.try+            (do+               v <- P'.getT "double_value"+               Prelude'.return (\ o -> o{double_value = v}))+        parse'int_value+         = P'.try+            (do+               v <- P'.getT "int_value"+               Prelude'.return (\ o -> o{int_value = v}))+        parse'uint_value+         = P'.try+            (do+               v <- P'.getT "uint_value"+               Prelude'.return (\ o -> o{uint_value = v}))+        parse'sint_value+         = P'.try+            (do+               v <- P'.getT "sint_value"+               Prelude'.return (\ o -> o{sint_value = v}))+        parse'bool_value+         = P'.try+            (do+               v <- P'.getT "bool_value"+               Prelude'.return (\ o -> o{bool_value = v}))

@@ -2,35 +2,30 @@  -- | -- Module    : Geography.VectorTile.Util--- Copyright : (c) Azavea, 2016--- License   : Apache 2--- Maintainer: Colin Woodbury <cwoodbury@azavea.com>+-- Copyright : (c) Colin Woodbury 2016 - 2018+-- License   : BSD3+-- Maintainer: Colin Woodbury <colingw@gmail.com>  module Geography.VectorTile.Util where +import Data.Sequence (Seq, (|>), Seq(Empty, (:<|))) import Data.Text (Text)  ---  -- | A sort of "self-zip", forming pairs from every two elements in a list. -- Fails if there is an uneven number of elements.-pairs :: [a] -> Either Text [(a,a)]-pairs [] = Right []-pairs [_] = Left "Uneven number of parameters given."-pairs (x:y:zs) = ((x,y) :) <$>  pairs zs+pairsWith :: (a -> b) -> Seq a -> Either Text (Seq (b, b))+pairsWith _ Empty = Right Empty+pairsWith f s | odd $ length s = Left "Uneven number of parameters given."+              | otherwise = Right $ go Empty s+  where go acc Empty = acc+        go acc (x :<| y :<| zs) = go (acc |> (f x, f y)) zs+        go acc (_ :<| Empty) = acc  -- | Flatten a list of pairs. Equivalent to: -- -- > ps ^.. each . both unpairs :: [(a,a)] -> [a] unpairs = foldr (\(a,b) acc -> a : b : acc) []---- | Apply a pure function to both elements of a tuple.-both :: (a -> b) -> (a,a) -> (b,b)-both f (x,y) = (f x, f y)---- | Convert a `Maybe` to an `Either`, with some given default value--- should the result of the `Maybe` be `Nothing`.-mtoe :: a -> Maybe b -> Either a b-mtoe _ (Just b) = Right b-mtoe a _ = Left a+{-# INLINE unpairs #-}

@@ -1,11 +1,11 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}+{-# LANGUAGE Rank2Types #-}  -- | -- Module    : Geography.VectorTile.VectorTile--- Copyright : (c) Azavea, 2016 - 2017--- License   : Apache 2--- Maintainer: Colin Woodbury <cwoodbury@azavea.com>+-- Copyright : (c) Colin Woodbury 2016 - 2018+-- License   : BSD3+-- Maintainer: Colin Woodbury <colingw@gmail.com> -- -- High-level types for representing Vector Tiles. @@ -22,6 +22,7 @@     --     -- These lenses are written in a generic way to avoid taking a dependency     -- on one of the lens libraries.+  , Lens'   , layers   , version   , name@@ -35,23 +36,30 @@   ) where  import           Control.DeepSeq (NFData)+import qualified Data.ByteString.Lazy as BL+import           Data.Hashable (Hashable) import           Data.Int-import qualified Data.Map.Lazy as M-import           Data.Text (Text)-import qualified Data.Vector as V+import qualified Data.HashMap.Lazy as M+import qualified Data.Sequence as Seq import           Data.Word import           GHC.Generics (Generic) import           Geography.VectorTile.Geometry  --- +-- | Simple Lenses compatible with both lens and microlens.+type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s+ -- | A high-level representation of a Vector Tile. Implemented internally--- as a `M.Map`, so that access to individual layers can be fast if you+-- as a `M.HashMap`, so that access to individual layers can be fast if you -- know the layer names ahead of time.-newtype VectorTile = VectorTile { _layers :: M.Map Text Layer } deriving (Eq,Show,Generic)+--+-- The layer name itself, a lazy `BL.ByteString`, is guaranteed to be UTF-8.+-- If you wish to convert it to `Data.Text.Lazy.Text`, consider+-- `Data.Text.Lazy.Encoding.decodeUtf8`.+newtype VectorTile = VectorTile { _layers :: M.HashMap BL.ByteString Layer } deriving (Eq,Show,Generic) --- | > Lens' VectorTile (Map Text Layer)-layers :: Functor f => (M.Map Text Layer -> f (M.Map Text Layer)) -> VectorTile -> f VectorTile+layers :: Lens' VectorTile (M.HashMap BL.ByteString Layer) layers f v = VectorTile <$> f (_layers v) {-# INLINE layers #-} @@ -60,41 +68,35 @@ -- | A layer, which could contain any number of `Feature`s of any `Geometry` type. -- This codec only respects the canonical three `Geometry` types, and we split -- them here explicitely to allow for more fine-grained access to each type.-data Layer = Layer { _version :: Int  -- ^ The version of the spec we follow. Should always be 2.-                   , _name :: Text-                   , _points :: V.Vector (Feature Point)-                   , _linestrings :: V.Vector (Feature LineString)-                   , _polygons :: V.Vector (Feature Polygon)-                   , _extent :: Int  -- ^ Default: 4096+data Layer = Layer { _version     :: Word  -- ^ The version of the spec we follow. Should always be 2.+                   , _name        :: BL.ByteString+                   , _points      :: Seq.Seq (Feature Point)+                   , _linestrings :: Seq.Seq (Feature LineString)+                   , _polygons    :: Seq.Seq (Feature Polygon)+                   , _extent      :: Word  -- ^ Default: 4096                    } deriving (Eq,Show,Generic) --- | > Lens' Layer Int-version :: Functor f => (Int -> f Int) -> Layer -> f Layer+version :: Lens' Layer Word version f l = (\v -> l { _version = v }) <$> f (_version l) {-# INLINE version #-} --- | > Lens' Layer Text-name :: Functor f => (Text -> f Text) -> Layer -> f Layer+name :: Lens' Layer BL.ByteString name f l = (\v -> l { _name = v }) <$> f (_name l) {-# INLINE name #-} --- | > Lens' Layer (Vector (Feature Point))-points :: Functor f => (V.Vector (Feature Point) -> f (V.Vector (Feature Point))) -> Layer -> f Layer+points :: Lens' Layer (Seq.Seq (Feature Point)) points f l = (\v -> l { _points = v }) <$> f (_points l) {-# INLINE points #-} --- | > Lens' Layer (Vector (Feature LineString)))-linestrings :: Functor f => (V.Vector (Feature LineString) -> f (V.Vector (Feature LineString))) -> Layer -> f Layer+linestrings :: Lens' Layer (Seq.Seq (Feature LineString)) linestrings f l = (\v -> l { _linestrings = v }) <$> f (_linestrings l) {-# INLINE linestrings #-} --- | > Lens' Layer (Vector (Feature Polygon)))-polygons :: Functor f => (V.Vector (Feature Polygon) -> f (V.Vector (Feature Polygon))) -> Layer -> f Layer+polygons :: Lens' Layer (Seq.Seq (Feature Polygon)) polygons f l = (\v -> l { _polygons = v }) <$> f (_polygons l) {-# INLINE polygons #-} --- | > Lens' Layer Int-extent :: Functor f => (Int -> f Int) -> Layer -> f Layer+extent :: Lens' Layer Word extent f l = (\v -> l { _extent = v }) <$> f (_extent l) {-# INLINE extent #-} @@ -113,30 +115,30 @@ -- -- Note: Each `Geometry` type and their /Multi*/ counterpart are considered -- the same thing, as a `V.Vector` of that `Geometry`.-data Feature g = Feature { _featureId :: Int  -- ^ Default: 0-                         , _metadata :: M.Map Text Val-                         , _geometries :: V.Vector g } deriving (Eq,Show,Generic)+--+-- Note: The keys to the metadata are `BL.ByteString`, but are guaranteed+-- to be UTF-8.+data Feature g = Feature { _featureId :: Word  -- ^ Default: 0+                         , _metadata :: M.HashMap BL.ByteString Val+                         , _geometries :: Seq.Seq g } deriving (Eq,Show,Generic) --- | > Lens' (Feature g) Int-featureId :: Functor f => (Int -> f Int) -> Feature g -> f (Feature g)+featureId :: Lens' (Feature g) Word featureId f l = (\v -> l { _featureId = v }) <$> f (_featureId l) {-# INLINE featureId #-} --- | > Lens' (Feature g) (Map Text Val)-metadata :: Functor f => (M.Map Text Val -> f (M.Map Text Val)) -> Feature g -> f (Feature g)+metadata :: Lens' (Feature g) (M.HashMap BL.ByteString Val) metadata f l = (\v -> l { _metadata = v }) <$> f (_metadata l) {-# INLINE metadata #-} --- | > Lens' (Feature g) (Vector g)-geometries :: Functor f => (V.Vector g -> f (V.Vector g)) -> Feature g -> f (Feature g)+geometries :: Lens' (Feature g) (Seq.Seq g) geometries f l = (\v -> l { _geometries = v }) <$> f (_geometries l) {-# INLINE geometries #-}  instance NFData g => NFData (Feature g)  -- | Legal Metadata /Value/ types. Note that `S64` are Z-encoded automatically--- by the underlying "Data.ProtocolBuffers" library.-data Val = St Text | Fl Float | Do Double | I64 Int64 | W64 Word64 | S64 Int64 | B Bool-         deriving (Eq,Ord,Show,Generic)+-- by the underlying "Text.ProtocolBuffers" library.+data Val = St BL.ByteString | Fl Float | Do Double | I64 Int64 | W64 Word64 | S64 Int64 | B Bool+         deriving (Eq,Ord,Show,Generic,Hashable)  instance NFData Val

@@ -1,3 +1,5 @@+-- -*- dante-target: "vectortiles-test"; -*-+ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeApplications #-}@@ -5,16 +7,17 @@ module Main where  import qualified Data.ByteString as BS-import           Data.Hex-import           Data.ProtocolBuffers hiding (decode)-import           Data.Serialize.Get-import           Data.Serialize.Put-import qualified Geography.VectorTile.Protobuf.Internal as R+import qualified Data.ByteString.Lazy as BL+import qualified Data.Sequence as Seq+import qualified Data.Text as T+import qualified Data.Vector.Unboxed as U+import           Geography.VectorTile+import qualified Geography.VectorTile.Internal as I import           Test.Tasty import           Test.Tasty.HUnit-import           Geography.VectorTile-import           Geography.VectorTile.Geometry-import qualified Data.Vector.Unboxed as U+import           Text.ProtocolBuffers.Basic (Utf8(..), defaultValue)+import           Text.ProtocolBuffers.WireMessage (Wire, messageGet)+import           Text.ProtocolBuffers.Reflections (ReflectDescriptor)  --- @@ -33,35 +36,25 @@ suite op ls pl rd cl = testGroup "Unit Tests"   [ testGroup "Protobuf"     [ testGroup "Decoding"-      [ testCase "onepoint.mvt -> Raw.Tile" $ testOnePoint op-      , testCase "linestring.mvt -> Raw.Tile" $ testLineString ls-      , testCase "polygon.mvt -> Raw.Tile" $ testPolygon pl-      , testCase "roads.mvt -> Raw.Tile" $ testDecode rd-      , testCase "clearlake.mvt -> Raw.Tile" $ testDecode cl-      , testCase "onepoint.mvt -> VectorTile" $ tileDecode op+      [ testCase "onepoint.mvt -> VectorTile" $ tileDecode op       , testCase "linestring.mvt -> VectorTile" $ tileDecode ls       , testCase "polygon.mvt -> VectorTile" $ tileDecode pl       , testCase "roads.mvt -> VectorTile" $ tileDecode rd-      , testCase "clearlake.mvt -> VectorTile" $ tileDecode cl-      ]+      , testCase "clearlake.mvt -> VectorTile" $ tileDecode cl ]     , testGroup "Encoding"       [ testGroup "RawVectorTile <-> VectorTile"         [ testCase "One Point" $ encodeIso onePoint         , testCase "One LineString" $ encodeIso oneLineString         , testCase "One Polygon" $ encodeIso onePolygon-        , testCase "roads.mvt" . encodeIso . fromRight $ decode rd+        , testCase "roads.mvt" . encodeIso . I.toProtobuf . fromRight $ tile rd         ]       ]-    , testGroup "Serialization Isomorphism"-      [ --testCase "onepoint.mvt <-> Raw.Tile" $ fromRaw op---      , testCase "linestring.mvt <-> Raw.Tile" $ fromRaw ls---      , testCase "polygon.mvt <-> Raw.Tile" $ fromRaw pl-      --    , testCase "roads.mvt <-> Raw.Tile" $ fromRaw rd-      testCase "testTile <-> protobuf bytes" testTileIso-      ]     ]   , testGroup "Geometries"-    [ testCase "Z-encoding Isomorphism" zencoding+    [ testCase "area" $ area poly @?= 1+    , testCase "surveyor - outer" . assert $ surveyor (polyPoints poly) > 0+    , testCase "surveyor - inner" . assert $ surveyor (U.reverse $ polyPoints poly) < 0+    , testCase "Z-encoding Isomorphism" zencoding     , testCase "Command Parsing" commandTest     , testCase "[Word32] <-> [Command]" commandIso     , testCase "[Word32] <-> V.Vector Point" pointIso@@ -73,49 +66,21 @@   ]  testOnePoint :: BS.ByteString -> Assertion-testOnePoint vt = case decodeIt vt of-                    Left e -> assertFailure e-                    Right t -> t @?= onePoint+testOnePoint bs = protobufDecode bs onePoint  testLineString :: BS.ByteString -> Assertion-testLineString vt = case decodeIt vt of-                      Left e -> assertFailure e-                      Right t -> t @?= oneLineString+testLineString bs = protobufDecode bs oneLineString  testPolygon :: BS.ByteString -> Assertion-testPolygon vt = case decodeIt vt of-                   Left e -> assertFailure e-                   Right t -> t @?= onePolygon+testPolygon bs = protobufDecode bs onePolygon --- | For testing is decoding succeeded in generally. Makes no guarantee--- about the quality of the content, only that the parse succeeded.-testDecode :: BS.ByteString -> Assertion-testDecode = assert . isRight . decodeIt+protobufDecode :: (ReflectDescriptor a, Wire a, Eq a, Show a) => BS.ByteString -> a -> Assertion+protobufDecode bs res = case messageGet $ BL.fromStrict bs of+                          Left e -> assertFailure e+                          Right (t, _) -> t @?= res  tileDecode :: BS.ByteString -> Assertion-tileDecode bs = case decodeIt bs of-  Left e -> assertFailure e-  Right t -> assert . isRight $ R.fromProtobuf t--fromRaw :: BS.ByteString -> Assertion-fromRaw vt = case decodeIt vt of-               Left e -> assertFailure e-               Right l -> hex (encodeIt l) @?= hex vt---               Right l -> if runPut (encodeMessage l) == vt---                          then assert True---                          else assertString "Isomorphism failed."--testTileIso :: Assertion-testTileIso = case decodeIt pb of-                 Right tl -> assertEqual "" tl testTile-                 Left e -> assertFailure e-  where pb = encodeIt testTile--decodeIt :: BS.ByteString -> Either String R.RawVectorTile-decodeIt = runGet decodeMessage--encodeIt :: R.RawVectorTile -> BS.ByteString-encodeIt = runPut . encodeMessage+tileDecode bs = assert . isRight $ tile bs  isRight :: Either a b -> Bool isRight (Right _) = True@@ -125,133 +90,113 @@ fromRight (Right b) = b fromRight _ = error "`Left` given to fromRight!" -rawTest :: IO (Either String R.RawVectorTile)-rawTest = decodeIt <$> BS.readFile "onepoint.mvt"--encodeIso :: R.RawVectorTile -> Assertion-encodeIso vt = assert . isRight . fmap R.toProtobuf $ R.fromProtobuf vt+encodeIso :: I.Tile -> Assertion+encodeIso vt = case I.fromProtobuf vt of+                 Left e  -> assertFailure $ T.unpack e+                 Right t -> I.toProtobuf t @?= vt -testTile :: R.RawVectorTile-testTile = R.RawVectorTile $ putField [l]-  where l = R.RawLayer { R._version = putField 2-                       , R._name = putField "testlayer"-                       , R._features = putField [f]-                       , R._keys = putField ["somekey"]-                       , R._values = putField [v]-                       , R._extent = putField $ Just 4096-                       }-        f = R.RawFeature { R._featureId = putField $ Just 0-                         , R._tags = putField [0,0]-                         , R._geom = putField $ Just R.Point-                         , R._geometries = putField [9, 50, 34]  -- MoveTo(+25,+17)-                         }-        v = R.RawVal { R._string = putField $ Just "Some Value"-                     , R._float = putField Nothing-                     , R._double = putField Nothing-                     , R._int64 = putField Nothing-                     , R._uint64 = putField Nothing-                     , R._sint = putField Nothing-                     , R._bool = putField Nothing-                     }+testTile :: I.Tile+testTile = I.Tile (Seq.singleton l) defaultValue+  where l = defaultValue { I.version  = 2+                         , I.name     = Utf8 "testlayer"+                         , I.features = Seq.singleton f+                         , I.keys     = Seq.singleton $ Utf8 "somekey"+                         , I.values   = Seq.singleton v+                         , I.extent   = Just 4096 }+        f = I.Feature { I.id    = Just 0+                      , I.tags  = Seq.fromList [0,0]+                      , I.type' = Just I.POINT+                      , I.geometry = Seq.fromList [9, 50, 34] }  -- MoveTo(+25,+17)+        v = defaultValue { I.string_value = Just $ Utf8 "Some Value" }  -- | Correct decoding of `onepoint.mvt`-onePoint :: R.RawVectorTile-onePoint = R.RawVectorTile $ putField [l]-  where l = R.RawLayer { R._version = putField 1-                       , R._name = putField "OnePoint"-                       , R._features = putField [f]-                       , R._keys = putField []-                       , R._values = putField []-                       , R._extent = putField $ Just 4096-                       }-        f = R.RawFeature { R._featureId = putField Nothing-                         , R._tags = putField []-                         , R._geom = putField $ Just R.Point-                         , R._geometries = putField [9, 10, 10]  -- MoveTo(+5,+5)-                         }+onePoint :: I.Tile+onePoint = I.Tile (Seq.singleton l) defaultValue+  where l = defaultValue { I.version   = 1+                         , I.name      = Utf8 "OnePoint"+                         , I.features  = Seq.singleton f+                         , I.keys      = Seq.Empty+                         , I.values    = Seq.Empty+                         , I.extent    = Just 4096 }+        f = I.Feature { I.id    = Just 0+                      , I.tags  = Seq.Empty+                      , I.type' = Just I.POINT+                      , I.geometry = Seq.fromList [9, 10, 10] }  -- MoveTo(+5,+5)  -- | Correct decoding of `linestring.mvt`-oneLineString :: R.RawVectorTile-oneLineString = R.RawVectorTile $ putField [l]-  where l = R.RawLayer { R._version = putField 1-                       , R._name = putField "OneLineString"-                       , R._features = putField [f]-                       , R._keys = putField []-                       , R._values = putField []-                       , R._extent = putField $ Just 4096-                       }-        f = R.RawFeature { R._featureId = putField Nothing-                         , R._tags = putField []-                         , R._geom = putField $ Just R.LineString-                         -- MoveTo(+5,+5), LineTo(+1195,+1195)-                         , R._geometries = putField [9, 10, 10, 10, 2390, 2390]-                         }+oneLineString :: I.Tile+oneLineString = I.Tile (Seq.singleton l) defaultValue+  where l = defaultValue { I.version   = 1+                         , I.name      = Utf8 "OneLineString"+                         , I.features  = Seq.singleton f+                         , I.keys      = Seq.Empty+                         , I.values    = Seq.Empty+                         , I.extent    = Just 4096 }+        f = I.Feature { I.id    = Just 0+                      , I.tags  = Seq.Empty+                      , I.type' = Just I.LINESTRING+                        -- MoveTo(+5,+5), LineTo(+1195,+1195)+                      , I.geometry = Seq.fromList [9, 10, 10, 10, 2390, 2390] }  -- | Correct decoding of `polygon.mvt`-onePolygon :: R.RawVectorTile-onePolygon = R.RawVectorTile $ putField [l]-  where l = R.RawLayer { R._version = putField 1-                       , R._name = putField "OnePolygon"-                       , R._features = putField [f]-                       , R._keys = putField []-                       , R._values = putField []-                       , R._extent = putField $ Just 4096-                       }-        f = R.RawFeature { R._featureId = putField Nothing-                         , R._tags = putField []-                         , R._geom = putField $ Just R.Polygon-                         -- MoveTo(+2,+2), LineTo(+3,+2), LineTo(-3,+2), ClosePath-                         , R._geometries = putField [9, 4, 4, 18, 6, 4, 5, 4, 15]-                         }+onePolygon :: I.Tile+onePolygon = I.Tile (Seq.singleton l) defaultValue+  where l = defaultValue { I.version   = 1+                         , I.name      = Utf8 "OnePolygon"+                         , I.features  = Seq.singleton f+                         , I.keys      = Seq.Empty+                         , I.values    = Seq.Empty+                         , I.extent    = Just 4096 }+        f = I.Feature { I.id    = Just 0+                      , I.tags  = Seq.Empty+                      , I.type' = Just I.POLYGON+                      -- MoveTo(+2,+2), LineTo(+3,+2), LineTo(-3,+2), ClosePath+                      , I.geometry = Seq.fromList [9, 4, 4, 18, 6, 4, 5, 4, 15] }  zencoding :: Assertion-zencoding = assert $ map (R.unzig . R.zig) vs @?= vs+zencoding = assert $ map (I.unzig . I.zig) vs @?= vs   where vs = [0,(-1),1,(-2),2,(-3),3,2147483647,(-2147483648)]  commandTest :: Assertion-commandTest = assert $ R.commands [9,4,4,18,6,4,5,4,15] @?= Right-  [ R.MoveTo $ U.singleton (2,2)-  , R.LineTo $ U.fromList [(3,2),(-3,2)]-  , R.ClosePath ]+commandTest = assert $ I.commands (Seq.fromList [9,4,4,18,6,4,5,4,15]) @?= Right (+  Seq.fromList [ I.MoveTo $ Seq.singleton (2,2)+               , I.LineTo $ Seq.fromList [(3,2),(-3,2)]+               , I.ClosePath ]+  )  commandIso :: Assertion-commandIso = assert $ (R.uncommands . fromRight $ R.commands cs) @?= cs-  where cs = [9,4,4,18,6,4,5,4,15]+commandIso = assert $ (I.uncommands . fromRight $ I.commands cs) @?= cs+  where cs = Seq.fromList [9,4,4,18,6,4,5,4,15]  pointIso :: Assertion pointIso = cs' @?= cs-  where cs = [25,4,4,6,6,3,3]-        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Point)+  where cs = Seq.fromList [25,4,4,6,6,3,3]+        cs' = fromRight $ I.uncommands . I.toCommands <$> (I.commands cs >>= I.fromCommands @Point)  linestringIso :: Assertion linestringIso = cs' @?= cs-  where cs = [9,4,4,18,6,4,5,4,9,4,4,18,6,4,5,4]-        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @LineString)+  where cs = Seq.fromList [9,4,4,18,6,4,5,4,9,4,4,18,6,4,5,4]+        cs' = fromRight $ I.uncommands . I.toCommands <$> (I.commands cs >>= I.fromCommands @LineString)  -- | Two solids polygonIso :: Assertion polygonIso = cs' @?= cs-  where cs = [9,4,4,18,6,4,5,4,15,9,4,4,18,6,4,5,4,15]-        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Polygon)+  where cs = Seq.fromList [9,4,4,18,6,4,5,4,15,9,4,4,18,6,4,5,4,15]+        cs' = fromRight $ I.uncommands . I.toCommands <$> (I.commands cs >>= I.fromCommands @Polygon)  -- | One holed polygonIso2 :: Assertion polygonIso2 = cs' @?= cs-  where cs = [9,4,4,26,6,0,0,6,5,0,15,9,2,3,26,0,2,2,0,0,1,15]-        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Polygon)+  where cs = Seq.fromList [9,4,4,26,6,0,0,6,5,0,15,9,2,3,26,0,2,2,0,0,1,15]+        cs' = fromRight $ I.uncommands . I.toCommands <$> (I.commands cs >>= I.fromCommands @Polygon)  -- | One Holed, one solid polygonIso3 :: Assertion polygonIso3 = cs' @?= cs-  where cs = [ 9, 4, 4, 26, 6, 0, 0, 6, 5, 0, 15, 9, 2, 3, 26, 0, 2, 2, 0, 0, 1, 15+  where cs = Seq.fromList [ 9, 4, 4, 26, 6, 0, 0, 6, 5, 0, 15, 9, 2, 3, 26, 0, 2, 2, 0, 0, 1, 15              , 9, 4, 4, 26, 6, 0, 0, 6, 5, 0, 15 ]-        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Polygon)--{-}-foo :: FilePath -> IO (Either Text VectorTile)-foo bs = do-  mvt <- BS.readFile bs-  pure $ R.decode mvt >>= tile+        cs' = fromRight $ I.uncommands . I.toCommands <$> (I.commands cs >>= I.fromCommands @Polygon) --- fmap (V.length . layers <$>) $ foo "roads.mvt"--}+poly :: Polygon+poly = Polygon ps mempty+  where ps = U.fromList [(0,0), (1,0), (1,1), (0,1), (0,0)]

@@ -1,31 +1,24 @@--- This file has been generated from package.yaml by hpack version 0.17.1.+-- This file has been generated from package.yaml by hpack version 0.21.2. -- -- see: https://github.com/sol/hpack+--+-- hash: f96750e12d765b16fd1c39222cb53517096cf37a3363913c0dd655e08e652bc9  name:           vectortiles-version:        1.2.0.6+version:        1.3.0 synopsis:       GIS Vector Tiles, as defined by Mapbox. description:    GIS Vector Tiles, as defined by Mapbox.-                .                 This library implements version 2.1 of the official Mapbox spec, as defined                 here: <https://github.com/mapbox/vector-tile-spec/tree/master/2.1>                 .                 Note that currently this library ignores top-level protobuf extensions,                 /Value/ extensions, and /UNKNOWN/ geometries.-                .-                The order in which to explore the modules of this library is as follows:-                .-                1. "Geography.VectorTile.VectorTile" (high-level types)-                .-                2. "Geography.VectorTile.Geometry" (typical GIS geometry types)-                .-                3. "Geography.VectorTile.Protobuf" (mid-level representation of parsed protobuf data with conversion functions)+category:       Geography homepage:       https://github.com/fosskers/vectortiles-license:        Apache-2.0-license-file:   LICENSE author:         Colin Woodbury-maintainer:     cwoodbury@azavea.com-category:       Geography+maintainer:     colingw@gmail.com+license:        BSD3+license-file:   LICENSE build-type:     Simple cabal-version:  >= 1.10 @@ -39,64 +32,81 @@     test/roads.mvt  library-  hs-source-dirs:-      lib   exposed-modules:       Geography.VectorTile+      Geography.VectorTile.Internal+  other-modules:       Geography.VectorTile.Geometry-      Geography.VectorTile.Protobuf-      Geography.VectorTile.Protobuf.Internal+      Geography.VectorTile.Protobuf.Internal.Vector_tile+      Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile+      Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Feature+      Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType+      Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Layer+      Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Value       Geography.VectorTile.Util       Geography.VectorTile.VectorTile+      Paths_vectortiles+  hs-source-dirs:+      lib+  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -fwarn-incomplete-patterns -Wincomplete-uni-patterns   build-depends:       base >=4.9 && <4.11     , bytestring-    , cereal >=0.5 && <0.6     , containers-    , protobuf >=0.2.1.1 && <0.3-    , text >=1.2 && <1.3-    , vector >=0.11 && <0.13     , deepseq >=1.4 && <1.5+    , hashable+    , protocol-buffers >=2.4 && <2.5+    , protocol-buffers-descriptor >=2.4 && <2.5+    , text >=1.2 && <1.3     , transformers >=0.5 && <0.6+    , unordered-containers+    , vector >=0.11 && <0.13   default-language: Haskell2010-  ghc-options: -fwarn-unused-imports -fwarn-unused-binds  test-suite vectortiles-test   type: exitcode-stdio-1.0+  main-is: Test.hs+  other-modules:+      Paths_vectortiles+  hs-source-dirs:+      test+  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -fwarn-incomplete-patterns -Wincomplete-uni-patterns -threaded   build-depends:       base >=4.9 && <4.11     , bytestring-    , cereal >=0.5 && <0.6     , containers-    , protobuf >=0.2.1.1 && <0.3-    , text >=1.2 && <1.3-    , vector >=0.11 && <0.13+    , hashable     , hex >=0.1 && <0.2+    , protocol-buffers >=2.4 && <2.5+    , protocol-buffers-descriptor >=2.4 && <2.5     , tasty >=0.10.1.2     , tasty-hunit >=0.9.2+    , text >=1.2 && <1.3+    , unordered-containers+    , vector >=0.11 && <0.13     , vectortiles-  hs-source-dirs:-      test-  main-is: Test.hs   default-language: Haskell2010-  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -threaded  benchmark vectortiles-bench   type: exitcode-stdio-1.0+  main-is: Bench.hs+  other-modules:+      Paths_vectortiles+  hs-source-dirs:+      bench+  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -fwarn-name-shadowing -fwarn-unused-matches -fwarn-incomplete-patterns -Wincomplete-uni-patterns -threaded -rtsopts -O2   build-depends:       base >=4.9 && <4.11     , bytestring-    , cereal >=0.5 && <0.6     , containers-    , protobuf >=0.2.1.1 && <0.3-    , text >=1.2 && <1.3-    , vector >=0.11 && <0.13-    , criterion >=1.1 && <1.3+    , criterion >=1.1 && <1.4+    , hashable     , microlens >=0.4 && <0.5     , microlens-platform >=0.3 && <0.4+    , protocol-buffers >=2.4 && <2.5+    , protocol-buffers-descriptor >=2.4 && <2.5+    , text >=1.2 && <1.3+    , unordered-containers+    , vector >=0.11 && <0.13     , vectortiles-  hs-source-dirs:-      bench-  main-is: Bench.hs   default-language: Haskell2010-  ghc-options: -fwarn-unused-imports -fwarn-unused-binds -threaded