Store.hs

module Positron.Store where

import Positron.Import

-- external modules

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Builder as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

-- local modules

import Positron.Binary
import Positron.UUID (UUID(..))
import Positron.Util

import qualified Positron.UUID as UUID

-- Convert the result from the database to a Haskell type.
class DBStorable c where
    dbStore :: c -> Builder
    dbUnstore :: ByteString -> c

instance DBStorable Int16 where
    dbStore = B.int16Dec
    dbUnstore = decimal
instance DBStorable Int32 where
    dbStore = B.int32Dec
    dbUnstore = decimal
instance DBStorable Int64 where
    dbStore = B.int64Dec
    dbUnstore = decimal
instance DBStorable Text where
    dbStore = T.encodeUtf8Builder . sanitize
      where
        sanitize = quote . escape
        quote = ("'" <>) . (<> "'")
        escape = T.replace "'" "''"
    dbUnstore = T.decodeUtf8

-- Encode a Haskell value to a data in PostgreSQL's binary format.
class BinaryStorable c where
    binaryStore :: c -> ByteString
    binaryUnstore :: ByteString -> c

instance BinaryStorable Int16 where
    binaryStore = toByteString . B.int16BE
    binaryUnstore = unsafeDecode
instance BinaryStorable Int32 where
    binaryStore = toByteString . B.int32BE
    binaryUnstore = unsafeDecode
instance BinaryStorable Int64 where
    binaryStore = toByteString . B.int64BE
    binaryUnstore = unsafeDecode
instance BinaryStorable Text where
    binaryStore = T.encodeUtf8
    binaryUnstore = T.decodeUtf8
instance BinaryStorable UUID where
    binaryStore = uuidByteString
    binaryUnstore = UUID.unsafeFromByteString

unsafeDecode :: BigEndian t => ByteString -> t
unsafeDecode = fromMaybe (error msg) . decode
  where
    msg = "ByteString decoding fail due to insufficient length " <>
        "(perhaps type mismatch?)"

decimal :: Integral n => ByteString -> n
-- Warning: This function is intentionally partial and should not be exposed
-- outside the library.
decimal = B.foldl' step 0 . B.takeWhile isDigit
  where step a c = a * 10 + fromIntegral (ord c - 48)