Skip to content

Instantly share code, notes, and snippets.

Created April 16, 2022 18:57
Show Gist options
  • Save roberth/0fb67ef680c7d6eea0c458c02e01cf1d to your computer and use it in GitHub Desktop.
Save roberth/0fb67ef680c7d6eea0c458c02e01cf1d to your computer and use it in GitHub Desktop.
hasql QueryPart
{-# 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 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
-- 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)
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment