SqlBuilder.hs

module Database.PostgreSQL.Query.SqlBuilder
       ( -- * Types
         SqlBuilder(..)
       , ToSqlBuilder(..)
       , Qp(..)
         -- * SqlBuilder helpers
       , emptyB
       , runSqlBuilder
       , mkIdent
       , mkValue
       , sqlBuilderPure
       , sqlBuilderFromField
       ) where

import Prelude

import Blaze.ByteString.Builder
    ( Builder, toByteString )
import Control.Applicative
import Data.ByteString ( ByteString )
import Data.Monoid
import Data.String
import Data.Text ( Text )
import Data.Typeable ( Typeable )
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Internal
    ( buildAction )
import Database.PostgreSQL.Simple.ToField
import Database.PostgreSQL.Simple.Types
    ( Query(..), Identifier(..) )
import GHC.Generics ( Generic )

import qualified Blaze.ByteString.Builder.ByteString as BB
import qualified Blaze.ByteString.Builder.Char.Utf8 as BB
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

{- $setup
>>> c <- connect defaultConnectInfo
-}

-- | Things which always can be transformed to 'SqlBuilder'
class ToSqlBuilder a where
    toSqlBuilder :: a -> SqlBuilder

-- | Special constructor to perform old-style query interpolation
data Qp = forall row. (ToRow row) => Qp Query row

instance ToSqlBuilder Qp where
    toSqlBuilder (Qp q row) = SqlBuilder $ \c ->
        BB.fromByteString <$> formatQuery c q row


-- | Builder wich can be effectively concatenated. Requires 'Connection'
-- inside for string quoting implemented in __libpq__
newtype SqlBuilder =
    SqlBuilder
    { sqlBuild :: Connection -> IO Builder }
    deriving (Typeable, Generic)

-- | Typed synonym of 'mempty'
emptyB :: SqlBuilder
emptyB = mempty

{- | Performs parameters interpolation and return ready to execute query

>>> let val = 10
>>> let name = "field"
>>> runSqlBuilder c $ "SELECT * FROM tbl WHERE " <> mkIdent name <> " = " <> mkValue val
"SELECT * FROM tbl WHERE \"field\" = 10"

-}

runSqlBuilder :: Connection -> SqlBuilder -> IO Query
runSqlBuilder con (SqlBuilder bld) =
    (Query . toByteString) <$> bld con

instance IsString SqlBuilder where
    fromString s =
        let b = fromString s :: ByteString
        in toSqlBuilder b

instance ToSqlBuilder SqlBuilder where
    toSqlBuilder = id
instance ToSqlBuilder Builder where
    toSqlBuilder = sqlBuilderPure
instance ToSqlBuilder ByteString where
    toSqlBuilder = sqlBuilderPure . BB.fromByteString
instance ToSqlBuilder BL.ByteString where
    toSqlBuilder = sqlBuilderPure . BB.fromLazyByteString
instance ToSqlBuilder String where
    toSqlBuilder = sqlBuilderPure . BB.fromString
instance ToSqlBuilder T.Text where
    toSqlBuilder = sqlBuilderPure . BB.fromText
instance ToSqlBuilder TL.Text where
    toSqlBuilder = sqlBuilderPure . BB.fromLazyText

{- | Shorthand function to convert identifier name to builder

>>> runSqlBuilder c $ mkIdent "simple\"ident"
"\"simple\"\"ident\""

Note correct string quoting made by __libpq__
-}

mkIdent :: Text -> SqlBuilder
mkIdent t = sqlBuilderFromField "mkident a" $ Identifier t

{- | Shorthand function to convert single value to builder

>>> runSqlBuilder c $ mkValue "some ' value"
"'some '' value'"

Note correct string quoting
-}

mkValue :: (ToField a) => a -> SqlBuilder
mkValue a = sqlBuilderFromField "mkValue a" a

-- | Lift pure bytestring builder to 'SqlBuilder'
sqlBuilderPure :: Builder -> SqlBuilder
sqlBuilderPure b = SqlBuilder $ const $ pure b

sqlBuilderFromField :: (ToField a) => Query -> a -> SqlBuilder
sqlBuilderFromField q a =
    SqlBuilder $ \c -> buildAction c q [] $ toField a --  FIXME: pass something as parameters string

instance Monoid SqlBuilder where
    mempty = sqlBuilderPure mempty
    mappend (SqlBuilder a) (SqlBuilder b) =
        SqlBuilder $ \c -> mappend <$> (a c) <*> (b c)