mbtiles (empty) → 0.1.0.0
raw patch · 10 files changed
+538/−0 lines, 10 filesdep +HUnitdep +basedep +bytestringsetup-changed
Dependencies added: HUnit, base, bytestring, directory, mbtiles, mtl, sqlite-simple, text, transformers, unordered-containers
Files
- LICENSE +30/−0
- README.md +48/−0
- Setup.hs +2/−0
- mbtiles.cabal +45/−0
- src/Database/Mbtiles.hs +167/−0
- src/Database/Mbtiles/Query.hs +37/−0
- src/Database/Mbtiles/Types.hs +107/−0
- src/Database/Mbtiles/Utility.hs +56/−0
- test/Spec.hs +15/−0
- test/Validation.hs +31/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Joe Canero (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Joe Canero nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,48 @@+# mbtiles++Haskell library for interfacing with MapBox [MBTiles](https://github.com/mapbox/mbtiles-spec) files.++## Functionality+* Getting tiles by zoom, x, and y.+* Writing new tiles by zoom, x, and y.+* Updating existing tiles by zoom, x, and y.+* Accessing metadata from the mbtiles file.++## Basic Usage++Reading, writing, and updating tiles:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Lazy as BL+import Database.Mbtiles++main = do+ let myData = "myTileData" :: BL.ByteString+ runMbtiles "my/path/to/file.mbtiles" $ do+ maybeTileData <- getTile (Z 0) (X 0) (Y 0)+ case maybeTileData of+ Nothing -> writeTile (Z 0) (X 0) (Y 0) myData+ (Just d) -> updateTile (Z 0) (X 0) (Y 0) $ BL.init d+```++Getting metadata:++```haskell++import Control.Monad.IO.Class+import Database.Mbtiles++main = do+ runMbtiles "my/path/to/file.mbtiles" $ do+ liftIO . print =<< getName+ liftIO . print =<< getType+ liftIO . print =<< getFormat++```++## Future Work+* Improve database error handling.+* Investigate usage as a performant tile server.+* Add tests.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mbtiles.cabal view
@@ -0,0 +1,45 @@+name: mbtiles+version: 0.1.0.0+synopsis: Haskell MBTiles client+description: Reads MBTiles files.+homepage: https://github.com/caneroj1/mbtiles#readme+license: BSD3+license-file: LICENSE+author: Joe Canero+maintainer: jmc41493@gmail.com+copyright: Copyright: (c) 2017 Joe Canero+category: Database+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ other-modules: Database.Mbtiles.Query+ , Database.Mbtiles.Types+ , Database.Mbtiles.Utility+ exposed-modules: Database.Mbtiles+ build-depends: base >= 4.7 && < 5+ , sqlite-simple+ , bytestring+ , directory+ , mtl+ , text+ , transformers+ , unordered-containers+ default-language: Haskell2010++test-suite mbtiles-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ other-modules: Validation+ main-is: Spec.hs+ build-depends: base+ , mbtiles+ , HUnit+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/caneroj1/mbtiles
+ src/Database/Mbtiles.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Mbtiles+(+ -- * Types+ MbtilesT+, Mbtiles+, MbtilesMeta+, MBTilesError(..)+, Z(..)+, X(..)+, Y(..)++ -- * The MbtilesT monad transformer+, runMbtilesT+, runMbtiles++ -- * Mbtiles read/write functionality+, getTile+, writeTile+, writeTiles+, updateTile+, updateTiles++ -- * Mbtiles metadata functionality+, getMetadata+, getName+, getType+, getVersion+, getDescription+, getFormat+) where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Reader+import qualified Data.ByteString.Lazy as BL+import Data.HashMap.Strict ((!))+import qualified Data.HashMap.Strict as M hiding ((!))+import Data.Monoid+import Data.Text (Text)+import Database.Mbtiles.Query+import Database.Mbtiles.Types+import Database.Mbtiles.Utility+import Database.SQLite.Simple+import System.Directory++-- | Given a path to an MBTiles file, run the 'MbtilesT' action.+-- This will open a connection to the MBTiles file, run the action,+-- and then close the connection.+-- Some validation will be performed first. Of course, we will check if the+-- MBTiles file actually exists. If it does, we need to validate its schema according+-- to the MBTiles spec.+runMbtilesT :: (MonadIO m) => FilePath -> MbtilesT m a -> m (Either MBTilesError a)+runMbtilesT mbtilesPath mbt = do+ m <- validateMBTiles mbtilesPath+ either (return . Left) processMbt m+ where+ processMbt (c, d) = do+ m <- mkMbtilesData c d+ v <- runReaderT (unMbtilesT mbt) m+ closeAll m+ return $ Right v+ mkMbtilesData c d =+ MbtilesData <$>+ openStmt c getTileQuery <*>+ pure c <*>+ pure d+ closeAll MbtilesData{r = rs, conn = c} =+ closeStmt rs >> closeConn c++type ValidationResult = (Connection, MbtilesMeta)++validateMBTiles :: (MonadIO m) => FilePath -> m (Either MBTilesError ValidationResult)+validateMBTiles mbtilesPath = liftIO $+ doesFileExist mbtilesPath >>=+ ifExistsOpen >>=+ validator schema >>=+ validator metadata >>=+ validator tiles >>=+ validator metadataValues+ where+ ifExistsOpen False = return $ Left DoesNotExist+ ifExistsOpen True = Right <$> open mbtilesPath++ schema c = do+ valid <- mconcat $ map (fmap All) [doesTableExist c tilesTable, doesTableExist c metadataTable]+ if getAll valid then return $ Right c else return $ Left InvalidSchema++ metadata = columnChecker metadataTable metadataColumns InvalidMetadata+ tiles = columnChecker tilesTable tilesColumns InvalidTiles+ metadataValues c = do+ m <- getDBMetadata c+ if all (`M.member` m) requiredMeta+ then return $ Right (c, m)+ else return $ Left InvalidMetadata++-- | Specialized version of 'runMbtilesT' to run in the IO monad.+runMbtiles :: FilePath -> Mbtiles a -> IO (Either MBTilesError a)+runMbtiles = runMbtilesT++-- | Given a 'Z', 'X', and 'Y' parameters, return the corresponding tile data,+-- if it exists.+getTile :: (MonadIO m, FromTile a) => Z -> X -> Y -> MbtilesT m (Maybe a)+getTile (Z z) (X x) (Y y) = MbtilesT $ do+ rs <- r <$> ask+ fmap unwrapTile <$> liftIO (do+ bindNamed rs [":zoom" := z, ":col" := x, ":row" := y]+ res <- nextRow rs+ reset rs+ return res)+ where unwrapTile (Only bs) = fromTile bs++-- | 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+getMetadata = MbtilesT $ reader meta++-- | Helper function for getting the specified name of the MBTiles from metadata.+getName :: (MonadIO m) => MbtilesT m Text+getName = findMeta "name" <$> getMetadata++-- | Helper function for getting the type of the MBTiles from metadata.+getType :: (MonadIO m) => MbtilesT m Text+getType = findMeta "type" <$> getMetadata++-- | Helper function for getting the version of the MBTiles from metadata.+getVersion :: (MonadIO m) => MbtilesT m Text+getVersion = findMeta "version" <$> getMetadata++-- | Helper function for getting the description of the MBTiles from metadata.+getDescription :: (MonadIO m) => MbtilesT m Text+getDescription = findMeta "description" <$> getMetadata++-- | Helper function for getting the format of the MBTiles from metadata.+getFormat :: (MonadIO m) => MbtilesT m Text+getFormat = findMeta "format" <$> getMetadata++-- | Write new tile data to the tile at the specified 'Z', 'X', and 'Y' parameters.+-- This function assumes that the tile does not already exist.+writeTile :: (MonadIO m, ToTile a) => Z -> X -> Y -> a -> MbtilesT m ()+writeTile z x y t = writeTiles [(z, x, y, t)]++-- | Batch write new tile data to the tile at the specified 'Z', 'X', and 'Y' parameters.+-- This function assumes that the tiles do not already exist.+writeTiles :: (MonadIO m, ToTile a) => [(Z, X, Y, a)] -> MbtilesT m ()+writeTiles = execQueryOnTiles newTileQuery++-- | Update existing tile data for the tile at the specified 'Z', 'X', and 'Y' parameters.+-- This function assumes that the tile does already exist.+updateTile :: (MonadIO m, ToTile a) => Z -> X -> Y -> a -> MbtilesT m ()+updateTile z x y t = updateTiles [(z, x, y, t)]++-- | Batch update tile data for the tiles at the specified 'Z', 'X', and 'Y' parameters.+-- This function assumes that the tiles do already exist.+updateTiles :: (MonadIO m, ToTile a) => [(Z, X, Y, a)] -> MbtilesT m ()+updateTiles = execQueryOnTiles updateTileQuery++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++findMeta :: Text -> MbtilesMeta -> Text+findMeta t m = m ! t
+ src/Database/Mbtiles/Query.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.Mbtiles.Query where++import Data.Monoid+import Data.Text (Text)+import Database.SQLite.Simple++getTileQuery :: Query+getTileQuery = " select tile_data from tiles \+ \ where zoom_level = :zoom \+ \ and tile_column = :col \+ \ and tile_row = :row"++updateTileQuery :: Query+updateTileQuery = " update tiles \+ \ set tile_data = ? \+ \ where zoom_level = ? \+ \ and tile_column = ? \+ \ and tile_row = ?"++newTileQuery :: Query+newTileQuery = " insert into tiles \+ \ (zoom_level, tile_column, tile_row, tile_data) \+ \ values (?, ?, ?, ?) "++tableExistsQuery :: Query+tableExistsQuery = " select count(name) from sqlite_master \+ \ where type='table' AND name=?"++tableInfoQuery :: Text -> Query+tableInfoQuery t = "PRAGMA table_info(" <>+ Query t <>+ ")"++getMetadataQuery :: Query+getMetadataQuery = "select name, value from metadata"
+ src/Database/Mbtiles/Types.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Database.Mbtiles.Types where++import Control.Monad.IO.Class+import Control.Monad.Reader+import Control.Monad.Trans.Class+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.HashMap.Strict as M+import Data.Text (Text)+import Database.SQLite.Simple (Connection, Statement)+import Database.SQLite.Simple.FromRow+import Database.SQLite.Simple.ToField++-- | MBTiles files contain metadata in one of their tables. This is+-- a type alias for a mapping between the metadata key and the metadata value.+type MbtilesMeta = M.HashMap Text Text++data MbtilesData = MbtilesData {+ r :: !Statement+ , conn :: !Connection+ , meta :: !MbtilesMeta+ }++-- | Data type representing various errors that could occur+-- when opening and validating an MBTiles file.+data MBTilesError = DoesNotExist -- ^ The MBTiles file does not exist.+ | InvalidSchema -- ^ The MBTiles schema is invalid according to the spec.+ | InvalidMetadata -- ^ The MBTiles 'metadata' table is invalid.+ | InvalidTiles -- ^ The MBTiles 'tiles' table is invaid.+ deriving (Show, Eq)++-- | MbtilesT monad that will run actions on an MBTiles file.+newtype MbtilesT m a = MbtilesT {+ unMbtilesT :: ReaderT MbtilesData m a+ } deriving (Functor, Applicative, Monad, MonadTrans)++instance (MonadIO m) => MonadIO (MbtilesT m) where+ liftIO = MbtilesT . liftIO++-- | Type specialization 'MbtilesT' to IO.+type Mbtiles a = MbtilesT IO a++-- | Newtype wrapper around map zoom level.+newtype Z = Z Int deriving ToField++-- | Newtype wrapper around a tile's x-coordinate.+newtype X = X Int deriving ToField++-- | Newtype wrapper around a tile's y-coordinate.+newtype Y = Y Int deriving ToField++-- | Typeclass representing data types that can be turned+-- into a lazy ByteString and stored as tile data.+class ToTile a where+ toTile :: a -> BL.ByteString++instance ToTile BS.ByteString where+ toTile = BL.fromStrict++instance ToTile BL.ByteString where+ toTile = id++-- | Typeclass representing data types intp which raw tile data can+-- be converted.+class FromTile a where+ fromTile :: BL.ByteString -> a++instance FromTile BS.ByteString where+ fromTile = BL.toStrict++instance FromTile BL.ByteString where+ fromTile = id++newtype ColumnInfo = ColumnInfo {+ unCI :: (Int, Text, Text, Bool, Maybe Int, Int)+ }++instance FromRow ColumnInfo where+ fromRow = ColumnInfo <$> fromRow++metadataTable, tilesTable :: Text+metadataTable = "metadata"+tilesTable = "tiles"++metadataColumns, tilesColumns, requiredMeta :: [Text]+metadataColumns = [+ "name"+ , "value"+ ]++tilesColumns = [+ "tile_column"+ , "tile_data"+ , "tile_row"+ , "zoom_level"+ ]++requiredMeta = [+ "name"+ , "type"+ , "version"+ , "description"+ , "format"+ ]
+ src/Database/Mbtiles/Utility.hs view
@@ -0,0 +1,56 @@+module Database.Mbtiles.Utility where++import Control.Monad.IO.Class+import qualified Data.HashMap.Strict as M+import Data.List+import Data.Text (Text)+import Database.Mbtiles.Query+import Database.Mbtiles.Types+import Database.SQLite.Simple++openStmt :: (MonadIO m) => Connection -> Query -> m Statement+openStmt c = liftIO . openStatement c++closeStmt :: (MonadIO m) => Statement -> m ()+closeStmt = liftIO . closeStatement++openConn :: (MonadIO m) => FilePath -> m Connection+openConn = liftIO . open++closeConn :: (MonadIO m) => Connection -> m ()+closeConn = liftIO . close++doesTableExist :: (MonadIO m) => Connection -> Text -> m Bool+doesTableExist conn tableName =+ checkResults <$> liftIO tableQuery+ where tableQuery :: IO [Only Int]+ tableQuery = query conn tableExistsQuery (Only tableName)+ checkResults [] = False+ checkResults (Only r : ls) = r > 0++getColumnNames :: (MonadIO m) => Connection -> Text -> m [Text]+getColumnNames conn tableName =+ sort . map (snd6 . unCI) <$> liftIO columnInfoQuery+ where columnInfoQuery = query_ conn $ tableInfoQuery tableName++snd6 :: (a, b, c, d, e, f) -> b+snd6 (_, b, _, _, _, _) = b++validator :: (MonadIO m)+ => (Connection -> m (Either MBTilesError a))+ -> Either MBTilesError Connection+ -> m (Either MBTilesError a)+validator = either (return . Left)++columnChecker :: (MonadIO m)+ => Text+ -> [Text]+ -> MBTilesError+ -> Connection+ -> m (Either MBTilesError Connection)+columnChecker tableName cols err conn = do+ cs <- getColumnNames conn tableName+ if cs /= cols then return $ Left err else return $ Right conn++getDBMetadata :: (MonadIO m) => Connection -> m MbtilesMeta+getDBMetadata conn = M.fromList <$> liftIO (query_ conn getMetadataQuery)
+ test/Spec.hs view
@@ -0,0 +1,15 @@+module Main where++import Control.Monad+import Test.HUnit.Base+import Test.HUnit.Text+import Validation++main :: IO ()+main = void $ runTestTT $ TestList [+ TestCase validateFileDetection+ , TestCase validateSchema+ , TestCase validateMetadata+ , TestCase validateTiles+ , TestCase validateMetadataValues+ ]
+ test/Validation.hs view
@@ -0,0 +1,31 @@+module Validation where++import Database.Mbtiles+import Test.HUnit.Base++-- sanity check to make sure we realize when a file doesn't exist.+validateFileDetection :: Assertion+validateFileDetection = do+ e <- runMbtiles "./non-existent-file.mbtiles" (return ())+ Left DoesNotExist @=? e++-- invalid.mbtiles is missing the "metadata" table.+validateSchema :: Assertion+validateSchema = do+ e <- runMbtiles "./mbtiles/invalid.mbtiles" (return ())+ Left InvalidSchema @=? e++validateMetadata :: Assertion+validateMetadata = do+ e <- runMbtiles "./mbtiles/invalid_metadata.mbtiles" (return ())+ Left InvalidMetadata @=? e++validateTiles :: Assertion+validateTiles = do+ e <- runMbtiles "./mbtiles/invalid_tiles.mbtiles" (return ())+ Left InvalidTiles @=? e++validateMetadataValues :: Assertion+validateMetadataValues = do+ e <- runMbtiles "./mbtiles/missing_metadata.mbtiles" (return ())+ Left InvalidMetadata @=? e