vectortiles-1.4.0: GIS Vector Tiles, as defined by Mapbox.

Copyright(c) Colin Woodbury 2016 - 2018
LicenseBSD3
MaintainerColin Woodbury <colingw@gmail.com>
Safe HaskellNone
LanguageHaskell2010

Geography.VectorTile.Internal

Contents

Description

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.

Synopsis

Types

Protobuf Conversion

type family Protobuf a = pb | pb -> a Source #

A family of data types which can associated with concrete underlying Protobuf types.

class Protobuffable a where Source #

A type which can be converted to and from an underlying Protobuf type, according to the Protobuf type family.

Minimal complete definition

fromProtobuf, toProtobuf

class ProtobufGeom g where Source #

Any classical type considered a GIS "geometry". These must be able to convert between an encodable list of Commands.

Minimal complete definition

fromCommands, toCommands

Methods

fromCommands :: [Command] -> Either Text (GeomVec g) Source #

toCommands :: GeomVec g -> [Command] Source #

Instances

ProtobufGeom Polygon Source #

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.

Methods

fromCommands :: [Command] -> Either Text (GeomVec Polygon) Source #

toCommands :: GeomVec Polygon -> [Command] Source #

ProtobufGeom LineString Source #

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.

ProtobufGeom Point Source #

A valid RawFeature of points must contain a single MoveTo command with a count greater than 0.

Methods

fromCommands :: [Command] -> Either Text (GeomVec Point) Source #

toCommands :: GeomVec Point -> [Command] Source #

Decoded Middle-Types

data Tile Source #

Constructors

Tile !(Seq Layer) !ExtField 

Instances

Eq Tile Source # 

Methods

(==) :: Tile -> Tile -> Bool #

(/=) :: Tile -> Tile -> Bool #

Data Tile Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Tile -> c Tile #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Tile #

toConstr :: Tile -> Constr #

dataTypeOf :: Tile -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Tile) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Tile) #

gmapT :: (forall b. Data b => b -> b) -> Tile -> Tile #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Tile -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Tile -> r #

gmapQ :: (forall d. Data d => d -> u) -> Tile -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Tile -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Tile -> m Tile #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Tile -> m Tile #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Tile -> m Tile #

Ord Tile Source # 

Methods

compare :: Tile -> Tile -> Ordering #

(<) :: Tile -> Tile -> Bool #

(<=) :: Tile -> Tile -> Bool #

(>) :: Tile -> Tile -> Bool #

(>=) :: Tile -> Tile -> Bool #

max :: Tile -> Tile -> Tile #

min :: Tile -> Tile -> Tile #

Show Tile Source # 

Methods

showsPrec :: Int -> Tile -> ShowS #

show :: Tile -> String #

showList :: [Tile] -> ShowS #

Generic Tile Source # 

Associated Types

type Rep Tile :: * -> * #

Methods

from :: Tile -> Rep Tile x #

to :: Rep Tile x -> Tile #

ExtendMessage Tile Source # 
GPB Tile Source # 
Wire Tile Source # 
TextMsg Tile Source # 

Methods

textPut :: Tile -> Output #

textGet :: Stream s Identity Char => Parsec s () Tile #

TextType Tile Source # 

Methods

tellT :: String -> Tile -> Output #

getT :: Stream s Identity Char => String -> Parsec s () Tile #

ReflectDescriptor Tile Source # 
Mergeable Tile Source # 

Methods

mergeAppend :: Tile -> Tile -> Tile #

mergeConcat :: Foldable t => t Tile -> Tile #

Default Tile Source # 

Methods

defaultValue :: Tile #

MessageAPI msg' (msg' -> Tile) Tile Source # 

Methods

getVal :: msg' -> (msg' -> Tile) -> Tile #

isSet :: msg' -> (msg' -> Tile) -> Bool #

type Rep Tile Source # 
type Rep Tile = D1 * (MetaData "Tile" "Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile" "vectortiles-1.4.0-iZtYyRUeWHFkccoCuStVj" False) (C1 * (MetaCons "Tile" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "layers") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * (Seq Layer))) (S1 * (MetaSel (Just Symbol "ext'field") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * ExtField))))

data Layer Source #

Constructors

Layer !Word32 !Utf8 !(Seq Feature) !(Seq Utf8) !(Seq Value) !(Maybe Word32) !ExtField 

Instances

Eq Layer Source # 

Methods

(==) :: Layer -> Layer -> Bool #

(/=) :: Layer -> Layer -> Bool #

Data Layer Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Layer -> c Layer #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Layer #

toConstr :: Layer -> Constr #

dataTypeOf :: Layer -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Layer) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Layer) #

gmapT :: (forall b. Data b => b -> b) -> Layer -> Layer #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Layer -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Layer -> r #

gmapQ :: (forall d. Data d => d -> u) -> Layer -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Layer -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Layer -> m Layer #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Layer -> m Layer #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Layer -> m Layer #

Ord Layer Source # 

Methods

compare :: Layer -> Layer -> Ordering #

(<) :: Layer -> Layer -> Bool #

(<=) :: Layer -> Layer -> Bool #

(>) :: Layer -> Layer -> Bool #

(>=) :: Layer -> Layer -> Bool #

max :: Layer -> Layer -> Layer #

min :: Layer -> Layer -> Layer #

Show Layer Source # 

Methods

showsPrec :: Int -> Layer -> ShowS #

show :: Layer -> String #

showList :: [Layer] -> ShowS #

Generic Layer Source # 

Associated Types

type Rep Layer :: * -> * #

Methods

from :: Layer -> Rep Layer x #

to :: Rep Layer x -> Layer #

ExtendMessage Layer Source # 
GPB Layer Source # 
Wire Layer Source # 
TextMsg Layer Source # 

Methods

textPut :: Layer -> Output #

textGet :: Stream s Identity Char => Parsec s () Layer #

TextType Layer Source # 

Methods

tellT :: String -> Layer -> Output #

getT :: Stream s Identity Char => String -> Parsec s () Layer #

ReflectDescriptor Layer Source # 
Mergeable Layer Source # 
Default Layer Source # 

Methods

defaultValue :: Layer #

MessageAPI msg' (msg' -> Layer) Layer Source # 

Methods

getVal :: msg' -> (msg' -> Layer) -> Layer #

isSet :: msg' -> (msg' -> Layer) -> Bool #

type Rep Layer Source # 

data Feature Source #

Constructors

Feature 

Fields

Instances

Eq Feature Source # 

Methods

(==) :: Feature -> Feature -> Bool #

(/=) :: Feature -> Feature -> Bool #

Data Feature Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Feature -> c Feature #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Feature #

toConstr :: Feature -> Constr #

dataTypeOf :: Feature -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Feature) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Feature) #

gmapT :: (forall b. Data b => b -> b) -> Feature -> Feature #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Feature -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Feature -> r #

gmapQ :: (forall d. Data d => d -> u) -> Feature -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Feature -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Feature -> m Feature #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Feature -> m Feature #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Feature -> m Feature #

Ord Feature Source # 
Show Feature Source # 
Generic Feature Source # 

Associated Types

type Rep Feature :: * -> * #

Methods

from :: Feature -> Rep Feature x #

to :: Rep Feature x -> Feature #

GPB Feature Source # 
Wire Feature Source # 
TextMsg Feature Source # 

Methods

textPut :: Feature -> Output #

textGet :: Stream s Identity Char => Parsec s () Feature #

TextType Feature Source # 

Methods

tellT :: String -> Feature -> Output #

getT :: Stream s Identity Char => String -> Parsec s () Feature #

ReflectDescriptor Feature Source # 
Mergeable Feature Source # 
Default Feature Source # 
MessageAPI msg' (msg' -> Feature) Feature Source # 

Methods

getVal :: msg' -> (msg' -> Feature) -> Feature #

isSet :: msg' -> (msg' -> Feature) -> Bool #

type Rep Feature Source # 
type Rep Feature = D1 * (MetaData "Feature" "Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.Feature" "vectortiles-1.4.0-iZtYyRUeWHFkccoCuStVj" False) (C1 * (MetaCons "Feature" PrefixI True) ((:*:) * ((:*:) * (S1 * (MetaSel (Just Symbol "id") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * (Maybe Word64))) (S1 * (MetaSel (Just Symbol "tags") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * (Seq Word32)))) ((:*:) * (S1 * (MetaSel (Just Symbol "type'") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * (Maybe GeomType))) (S1 * (MetaSel (Just Symbol "geometry") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * (Seq Word32))))))

data Value Source #

Instances

Eq Value Source # 

Methods

(==) :: Value -> Value -> Bool #

(/=) :: Value -> Value -> Bool #

Data Value Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Value -> c Value #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Value #

toConstr :: Value -> Constr #

dataTypeOf :: Value -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Value) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value) #

gmapT :: (forall b. Data b => b -> b) -> Value -> Value #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r #

gmapQ :: (forall d. Data d => d -> u) -> Value -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Value -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Value -> m Value #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Value -> m Value #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Value -> m Value #

Ord Value Source # 

Methods

compare :: Value -> Value -> Ordering #

(<) :: Value -> Value -> Bool #

(<=) :: Value -> Value -> Bool #

(>) :: Value -> Value -> Bool #

(>=) :: Value -> Value -> Bool #

max :: Value -> Value -> Value #

min :: Value -> Value -> Value #

Show Value Source # 

Methods

showsPrec :: Int -> Value -> ShowS #

show :: Value -> String #

showList :: [Value] -> ShowS #

Generic Value Source # 

Associated Types

type Rep Value :: * -> * #

Methods

from :: Value -> Rep Value x #

to :: Rep Value x -> Value #

ExtendMessage Value Source # 
GPB Value Source # 
Wire Value Source # 
TextMsg Value Source # 

Methods

textPut :: Value -> Output #

textGet :: Stream s Identity Char => Parsec s () Value #

TextType Value Source # 

Methods

tellT :: String -> Value -> Output #

getT :: Stream s Identity Char => String -> Parsec s () Value #

ReflectDescriptor Value Source # 
Mergeable Value Source # 
Default Value Source # 

Methods

defaultValue :: Value #

MessageAPI msg' (msg' -> Value) Value Source # 

Methods

getVal :: msg' -> (msg' -> Value) -> Value #

isSet :: msg' -> (msg' -> Value) -> Bool #

type Rep Value Source # 

data GeomType Source #

Constructors

UNKNOWN 
POINT 
LINESTRING 
POLYGON 

Instances

Bounded GeomType Source # 
Enum GeomType Source # 
Eq GeomType Source # 
Data GeomType Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> GeomType -> c GeomType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c GeomType #

toConstr :: GeomType -> Constr #

dataTypeOf :: GeomType -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c GeomType) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GeomType) #

gmapT :: (forall b. Data b => b -> b) -> GeomType -> GeomType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> GeomType -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> GeomType -> r #

gmapQ :: (forall d. Data d => d -> u) -> GeomType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> GeomType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> GeomType -> m GeomType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> GeomType -> m GeomType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> GeomType -> m GeomType #

Ord GeomType Source # 
Read GeomType Source # 
Show GeomType Source # 
Generic GeomType Source # 

Associated Types

type Rep GeomType :: * -> * #

Methods

from :: GeomType -> Rep GeomType x #

to :: Rep GeomType x -> GeomType #

GPB GeomType Source # 
Wire GeomType Source # 
TextType GeomType Source # 

Methods

tellT :: String -> GeomType -> Output #

getT :: Stream s Identity Char => String -> Parsec s () GeomType #

ReflectEnum GeomType Source # 
Mergeable GeomType Source # 
Default GeomType Source # 
MessageAPI msg' (msg' -> GeomType) GeomType Source # 

Methods

getVal :: msg' -> (msg' -> GeomType) -> GeomType #

isSet :: msg' -> (msg' -> GeomType) -> Bool #

type Rep GeomType Source # 
type Rep GeomType = D1 * (MetaData "GeomType" "Geography.VectorTile.Protobuf.Internal.Vector_tile.Tile.GeomType" "vectortiles-1.4.0-iZtYyRUeWHFkccoCuStVj" False) ((:+:) * ((:+:) * (C1 * (MetaCons "UNKNOWN" PrefixI False) (U1 *)) (C1 * (MetaCons "POINT" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "LINESTRING" PrefixI False) (U1 *)) (C1 * (MetaCons "POLYGON" PrefixI False) (U1 *))))

Commands

data Command Source #

The possible commands, and the values they hold.

commands :: [Word32] -> [Command] Source #

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

uncommands :: [Command] -> Seq Word32 Source #

Convert a list of parsed Commands back into their original Command and Z-encoded Parameter integer forms.

Z-Encoding

zig :: Int -> Word32 Source #

Z-encode a 64-bit Int.

unzig :: Word32 -> Int Source #

Decode a Z-encoded Word32 into a 64-bit Int.

Protobuf Conversions

Due to Protobuf Layers and Features having their data coupled, we can't define a Protobuffable instance for Features, and instead must use the two functions below.

feats :: Seq ByteString -> Seq Value -> Seq Feature -> Either Text Feats Source #

Convert a list of RawFeatures of parsed protobuf data into Vectors of each of the three legal ProtobufGeom types.

The long type signature is due to two things:

  1. Features 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. RawLayers and RawFeatures are strongly coupled at the protobuf level. In order to achieve higher compression ratios, RawLayers contain all metadata in key/value lists to be shared across their RawFeatures, while those RawFeatures 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.

unfeats :: ProtobufGeom g => HashMap ByteString Int -> HashMap Val Int -> GeomType -> Feature (GeomVec g) -> Feature Source #

Encode a high-level Feature back into its mid-level RawFeature form.