hasql QueryPart

QueryPart.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Hasql.Extras.QueryPart where

import Data.Functor.Compose
import Data.String (IsString (..))
import qualified Hasql.Decoders as HD
import qualified Hasql.Encoders as HE
import qualified Hasql.Statement as HQ
import Protolude

-- | SQL builder + column name prefixing capability + decoder.
--
-- Takes most of the pain out of decoder reuse.
--
-- Not an ORM, not \"type safe\", just a helper.
--
-- Example:
--
-- > getIds :: QueryPart Int64
-- > getIds = "SELECT " *> "id" `as` HD.int8 <* " FROM my_table WHERE condition"
--
-- = How did we arrive here?
--
-- == Problem statement
--
-- Well first there's the problem we're trying to solve, which is the duplication
-- that arises when multiple queries decode the same relation or joins of those.
-- With just hasql (around 1.3.0.3 at least) you'll need to write the SQL and the
-- decoder separately, which is prone to errors and takes effort to write and
-- maintain.
--
-- == Deriving this solution
--
-- There is a clear structure that we have already identified:
-- The SQL, in particular the \"projection\" part between @SELECT@ and @FROM@.
-- If we could define these simultaneously, that not only takes away a bunch of
-- eye movement to match up the columns and decoders, it lets us pass around
-- a representation of the relation as a single composable unit.
--
-- Let's represent the information we want as a type
--
-- > (ByteString, HD.Row a)
--
-- This lets us combine the Row decoder with the SQL that generates such rows.
-- We can define a concatenation operator that concatenates the SQL and uses
-- 'Applicative' on 'HD.Row'. That operator will itself be of the Applicative
-- form.
--
-- What about 'Monad', you may think; we could use a WriterT here! Well, we
-- kind of could, but we can't really implement the monadic bind operator
-- because doing so would have the SQL depend on the output of the decoder,
-- which is impossible to implement.
-- Instead we can avoid the complexity of monad transformers and stick with
-- the conceptually simpler 'Compose' type. @Compose f g a@ is really just
-- @f (g a)@ and it just works, without all the transformer baggage.
--
-- So let's pretend that @Compose@ is a type alias instead of a @newtype@:
--
-- >    (ByteString, HD.Row a)
-- >  =
-- >    (,) ByteString (HD.Row a)
-- >  =
-- >    ((,) ByteString) (HD.Row a)
-- >  =
-- >    Compose ((,) ByteString) HD.Row a
--
-- == Now what
--
-- Ok, so now we can define the corresponding SQL and decoders together, but
-- is that a decent abstraction?
--
-- Actually no, because SQL is rather complex. Pasting SQL together isn't
-- really something you should want to do. So you'll still have to be careful
-- and think in terms of the SQL itself when writing queries.
-- At least with @QueryPart@ you'll have an easier time if you need to define
-- many queries that return the same type of data in their joins.
--
-- Also, one more thing we can add is a nice way to prefix the column names
-- with their aliases. We can do this by making the type for the SQL a
-- function that takes the current prefix as argument.
--
-- To run a @QueryPart@ you'll need to turn it into a complete statement.
-- This is where the '<$', '<*' and '*>' operators come in handy. They let you
-- ignore @QueryPart@s that don't return anything useful, such as SQL that
-- does not result in a column. With these operators, you can extend the SQL
-- text without decoding anything. There's even a (safe) @IsString@ instance
-- to make this easy.
--
-- == Conclusion
--
-- This lets you pass around decoders more easily because they carry a bit
-- the SQL that you need in order to use them. Just don't forget you're
-- still writing SQL. It's just not a query DSL.
newtype QueryPart a = QueryPart
  { fromQueryPart :: Compose ((,) (ByteString -> ByteString)) HD.Row a
  }
  deriving (Functor, Applicative)

-- | For the parts of the query that don't immediately produce values,
-- like @"SELECT "@ and @" WHERE id = $1 "@
--
-- See the note /IsString String/ on
-- http://hackage.haskell.org/package/base-4.11.1.0/docs/src/Data.String.html#line-43
-- describing the exact same situation that occurs for @[Char]@. In
-- the case of @QueryPart@, an ambiguation occurs often when the inner
-- type of a fromString @QueryPart@ is ignored by '<$' and friends.
instance (a ~ ()) => IsString (QueryPart a) where
  fromString s = rawSql (encodeUtf8 (toS s))

-- | The effect of writing some SQL verbatim to the query being constructed.
rawSql :: ByteString -> QueryPart ()
rawSql bs = QueryPart $ Compose (\_pfx -> bs, pure ())
{-# INLINE rawSql #-}

-- | The effect of inserting the current prefix into the sql string of the query being constructed.
thePrefix :: QueryPart ()
thePrefix = QueryPart $ Compose (identity, pure ())
{-# INLINE thePrefix #-}

-- | The effect of inserting an `HD.Row` parser into the parser that is being constructed for the query.
--
-- The parsing happens in the same order as the @rowPart@ effects.
--
-- Typically you want this to be close to the 'rawSql' that actually generates the columns being parsed.
-- In many cases this is achieved by calling 'as', which combines the effects for the purpose of
-- returning a table column verbatim.
rowPart :: HD.Row a -> QueryPart a
rowPart r = QueryPart $ Compose $ pure r
{-# INLINE rowPart #-}

-- | For use as an infix operator.
as ::
  -- | Column name, to be prefixed if wrapped by 'prefix'
  ByteString ->
  -- | Row decoder
  HD.Row a ->
  QueryPart a
as columnName r = thePrefix *> rawSql columnName *> rowPart r
{-# INLINE as #-}

-- | Prefixes column names in a query for disambiguation.
prefix ::
  -- | Prefix
  ByteString ->
  -- | Query part with field names
  QueryPart a ->
  -- | Query part with the field names prefixed by the prefix and a dot
  QueryPart a
prefix p (QueryPart (Compose (f, r))) = QueryPart $ Compose (f', r)
  where
    f' pp = f (p <> "." <> pp)

runQuery :: QueryPart a -> (ByteString, HD.Row a)
runQuery (QueryPart (Compose (f, r))) = (f "", r)

-- | See 'Hasql.Statement.Statement'
statement ::
  HE.Params a ->
  QueryPart b ->
  (HD.Row b -> HD.Result c) ->
  Bool ->
  HQ.Statement a c
statement params e how prepare =
  let (sql, decoder) = runQuery e
   in HQ.Statement sql params (how decoder) prepare