Types.hs

{-# 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 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

-- | 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"
  ]