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
type MbtilesMeta = M.HashMap Text Text
data MbtilesData = MbtilesData {
r :: !Statement
, conn :: !Connection
, meta :: !MbtilesMeta
}
data MBTilesError = DoesNotExist
| InvalidSchema
| InvalidMetadata
| InvalidTiles
deriving (Show, Eq)
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 MbtilesIO a = MbtilesT IO a
newtype Z = Z Int deriving ToField
newtype X = X Int deriving ToField
newtype Y = Y Int deriving ToField
data Tile a = Tile {
tileColumn :: Int
, tileRow :: Int
, zoomlevel :: Int
, tileData :: a
}
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)
newtype TileStream = TileStream Statement
class ToTile a where
toTile :: a -> BL.ByteString
instance ToTile BS.ByteString where
toTile = BL.fromStrict
instance ToTile BL.ByteString where
toTile = id
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"
]