{-# 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.Monoid 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 of 'MbtilesT' to IO. type MbtilesIO 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 -- | 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. 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 into 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" ]