mbtiles 0.4.0.0 → 0.6.0.0

raw patch · 5 files changed

+100/−8 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• mbtiles.cabal +1/−1
• src/Database/Mbtiles.hs +35/−5
• src/Database/Mbtiles/Query.hs +10/−2
• src/Database/Mbtiles/Types.hs +44/−0
• src/Database/Mbtiles/Utility.hs +10/−0

@@ -1,5 +1,5 @@ name:                mbtiles-version:             0.4.0.0+version:             0.6.0.0 synopsis:            Haskell MBTiles client. description:         Read and manipulate MBTiles files and associated metadata. homepage:            https://github.com/caneroj1/mbtiles#readme

@@ -8,11 +8,11 @@ Portability : POSIX  This module provides support for reading, writing, and updating-an mbtiles database. There is also functionality for reading+an mbtiles database, as well as reading metadata from the database. -There is also functionality for creating a pool of connections to-an mbtiles database.+There is also support for creating a pool of connections to+an mbtiles database and streaming tiles.  See the associated README.md for basic usage examples. -}@@ -31,6 +31,7 @@ , Z(..) , X(..) , Y(..)+, Tile(..)    -- * Typeclasses , ToTile(..)@@ -59,6 +60,12 @@ , getVersion , getDescription , getFormat++  -- * Streaming tiles+, TileStream+, startTileStream+, endTileStream+, nextTile ) where  import           Control.Monad@@ -159,12 +166,33 @@ getTile (Z z) (X x) (Y y) = MbtilesT $ do   rs <- r <$> ask   fmap unwrapTile <$> liftIO (do-    bindNamed rs [":zoom" := z, ":col" := x, ":row" := y]+    bindNamed rs [":zoom" := z, ":col" := x, ":row" := y']     res <- nextRow rs     reset rs     return res)   where unwrapTile (Only bs) = fromTile bs+        y' = wrapYTMS (Z z) (Y y) +-- | Create a 'TileStream' data type that will be used to stream tiles+-- from the MBTiles database. When streaming is complete, you must+-- call 'endTileStream' to clean up the 'TileStream' resource. Tiles are streamed+-- from the database in an ordered fashion, where they are sorted by zoom level,+-- then tile column, then tile row, in ascending order.+startTileStream :: (MonadIO m) => MbtilesT m TileStream+startTileStream = MbtilesT $ asks conn >>= liftIO . openTileStream++-- | Close a given 'TileStream' when streaming is complete.+endTileStream :: (MonadIO m) => TileStream -> MbtilesT m ()+endTileStream = liftIO . closeTileStream++-- | Reset a 'TileStream' and prepare it to return results via 'nextTile' again.+resetTileStream :: (MonadIO m) => TileStream -> MbtilesT m ()+resetTileStream (TileStream ts) = liftIO $ reset ts++-- | Receive the next 'Tile' from the 'TileStream'.+nextTile :: (MonadIO m, FromTile a) => TileStream -> MbtilesT m (Maybe (Tile a))+nextTile (TileStream ts) = liftIO $ nextRow ts+ -- | Returns the 'MbtilesMeta' that was found in the MBTiles file. -- This returns all of the currently available metadata for the MBTiles database. getMetadata :: (MonadIO m) => MbtilesT m MbtilesMeta@@ -210,12 +238,14 @@ updateTiles :: (MonadIO m, ToTile a) => [(Z, X, Y, a)] -> MbtilesT m () updateTiles = execQueryOnTiles updateTileQuery +-- execute a query on an array of tile coordinates.+-- need to wrap the Y coordinate, since mbtiles are in TMS. execQueryOnTiles :: (MonadIO m, ToTile a) => Query -> [(Z, X, Y, a)] -> MbtilesT m () execQueryOnTiles q ts = MbtilesT $ do   c <- conn <$> ask   liftIO $     executeMany c q $-      map (\(z, x, y, t) -> (z, z, y, toTile t)) ts+      map (\(z, x, y, t) -> (z, x, wrapYTMS z y, toTile t)) ts  findMeta :: Text -> MbtilesMeta -> Text findMeta t m = m ! t

@@ -12,6 +12,14 @@                \ and   tile_column = :col    \                \ and   tile_row    = :row" +allTilesQuery :: Query+allTilesQuery = " select tile_column,    \+                \ tile_row,              \+                \ zoom_level,            \+                \ tile_data from tiles   \+                \ order by zoom_level,   \+                \ tile_column, tile_row  "+ updateTileQuery :: Query updateTileQuery = " update tiles          \                   \ set tile_data = ?     \@@ -20,8 +28,8 @@                   \ and   tile_row    = ?"  newTileQuery :: Query-newTileQuery = " insert into tiles                                         \-               \ (zoom_level, tile_column, tile_row, tile_data)            \+newTileQuery = " insert into tiles                              \+               \ (zoom_level, tile_column, tile_row, tile_data) \                \ values (?, ?, ?, ?) "  tableExistsQuery :: Query

@@ -9,6 +9,7 @@ import qualified Data.ByteString                as BS import qualified Data.ByteString.Lazy           as BL import qualified Data.HashMap.Strict            as M+import           Data.Monoid import           Data.Text                      (Text) import           Database.SQLite.Simple         (Connection, Statement) import           Database.SQLite.Simple.FromRow@@ -51,6 +52,49 @@  -- | Newtype wrapper around a tile's y-coordinate. newtype Y = Y Int deriving ToField++-- | Data type that represents an entire row+-- from an MBTiles database.+data Tile a = Tile {+    tileColumn :: Int -- ^ The column of this tile.+  , tileRow    :: Int -- ^ The row of this tile.+  , zoomlevel  :: Int -- ^ The zoom level of this tile.+  , tileData   :: a   -- ^ The data associated with this tile.+  }++instance (Show a) => Show (Tile a) where+  show (Tile tc tr zl td) = "Tile " +++                            show zl ++ "/" +++                            show tc ++ "/" +++                            show tr ++ " " +++                            show td++instance (Eq a) => Eq (Tile a) where+  (Tile c1 r1 z1 d1) == (Tile c2 r2 z2 d2) = c1 == c2 &&+                                             r1 == r2 &&+                                             z1 == z2 &&+                                             d1 == d2++instance (Ord a) => Ord (Tile a) where+  (Tile c1 r1 z1 d1) `compare` (Tile c2 r2 z2 d2) = compare z1 z2 <>+                                                    compare c1 c2 <>+                                                    compare r1 r2 <>+                                                    compare d1 d2++instance Functor Tile where+  fmap f (Tile c r z d) = Tile c r z $ f d++instance (FromTile a) => FromRow (Tile a) where+  fromRow = Tile <$>+              field <*>+              field <*>+              field <*>+              (fromTile <$> field)++-- | A 'TileStream' data type contains information about how to+-- stream tiles from the MBTiles database and is used in the same+-- manner as an SQLite prepared statement.+newtype TileStream = TileStream Statement  -- | Typeclass representing data types that can be turned -- into a lazy ByteString and stored as tile data.

@@ -1,6 +1,7 @@ module Database.Mbtiles.Utility where  import           Control.Monad.IO.Class+import           Data.Bits import qualified Data.HashMap.Strict    as M import           Data.List import           Data.Text              (Text)@@ -54,3 +55,12 @@  getDBMetadata :: (MonadIO m) => Connection -> m MbtilesMeta getDBMetadata conn = M.fromList <$> liftIO (query_ conn getMetadataQuery)++openTileStream :: (MonadIO m) => Connection -> m TileStream+openTileStream conn = TileStream <$> openStmt conn allTilesQuery++closeTileStream :: (MonadIO m) => TileStream -> m ()+closeTileStream (TileStream s) = closeStmt s++wrapYTMS :: Z -> Y -> Y+wrapYTMS (Z z) (Y y) = Y $ (1 `shift` z) - 1 - y