module Hasql.TH ( -- * Statements -- | -- Quasiquoters in this category produce Hasql `Statement`s, -- checking the correctness of SQL at compile-time. -- -- To extract the information about parameters and results of the statement, -- the quoter requires you to explicitly specify the Postgres types for placeholders and results. -- -- Here's an example of how to use it: -- -- >selectUserDetails :: Statement Int32 (Maybe (Text, Text, Maybe Text)) -- >selectUserDetails = -- > [maybeStatement| -- > select name :: text, email :: text, phone :: text? -- > from "user" -- > where id = $1 :: int4 -- > |] -- -- As you can see, it completely eliminates the need to mess with codecs. -- The quasiquoters directly produce `Statement`, -- which you can then `Data.Profunctor.dimap` over using its `Data.Profunctor.Profunctor` instance to get to your domain types. -- -- == Type mappings -- -- === Primitives -- -- Following is a list of supported Postgres types and their according types on the Haskell end. -- -- - @bool@ - `Bool` -- - @int2@ - `Int16` -- - @int4@ - `Int32` -- - @int8@ - `Int64` -- - @float4@ - `Float` -- - @float8@ - `Double` -- - @numeric@ - `Data.Scientific.Scientific` -- - @char@ - `Char` -- - @text@ - `Data.Text.Text` -- - @bytea@ - `Data.ByteString.ByteString` -- - @date@ - `Data.Time.Day` -- - @timestamp@ - `Data.Time.LocalTime` -- - @timestamptz@ - `Data.Time.UTCTime` -- - @time@ - `Data.Time.TimeOfDay` -- - @timetz@ - @(`Data.Time.TimeOfDay`, `Data.Time.TimeZone`)@ -- - @interval@ - `Data.Time.DiffTime` -- - @uuid@ - `Data.UUID.UUID` -- - @inet@ - @(`Network.IP.Addr.NetAddr` `Network.IP.Addr.IP`)@ -- - @json@ - `Data.Aeson.Value` -- - @jsonb@ - `Data.Aeson.Value` -- -- === Arrays -- -- Array mappings are also supported. -- They are specified according to Postgres syntax: by appending one or more @[]@ to the primitive type, -- depending on how many dimensions the array has. -- On the Haskell end array is mapped to generic `Data.Vector.Generic.Vector`, -- allowing you to choose which particular vector implementation to map to. -- -- === Nulls -- -- As you might have noticed in the example, -- we introduce one change to the Postgres syntax in the way -- the typesignatures are parsed: -- we interpret question-marks in them as specification of nullability. -- Here's more examples of that: -- -- >>> :t [singletonStatement| select a :: int4? |] -- ... -- :: Statement () (Maybe Int32) -- -- You can use it to specify the nullability of array elements: -- -- >>> :t [singletonStatement| select a :: int4?[] |] -- ... -- :: Data.Vector.Generic.Base.Vector v (Maybe Int32) => -- Statement () (v (Maybe Int32)) -- -- And of arrays themselves: -- -- >>> :t [singletonStatement| select a :: int4?[]? |] -- ... -- :: Data.Vector.Generic.Base.Vector v (Maybe Int32) => -- Statement () (Maybe (v (Maybe Int32))) -- ** Row-parsing statements singletonStatement, maybeStatement, vectorStatement, foldStatement, -- ** Row-ignoring statements resultlessStatement, rowsAffectedStatement, -- * SQL ByteStrings -- | -- ByteString-producing quasiquoters. -- -- For now they perform no compile-time checking. uncheckedSql, uncheckedSqlFile, ) where import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Vector (Vector) import Hasql.Statement (Statement) import qualified Hasql.TH.Construction.Exp as Exp import qualified Hasql.TH.Extraction.Exp as ExpExtraction import Hasql.TH.Prelude hiding (exp) import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax import qualified PostgresqlSyntax.Ast as Ast import qualified PostgresqlSyntax.Parsing as Parsing -- * Helpers exp :: (String -> Q Exp) -> QuasiQuoter exp :: (String -> Q Exp) -> QuasiQuoter exp = let _unsupported :: p -> m a _unsupported p _ = forall (m :: * -> *) a. MonadFail m => String -> m a fail String "Unsupported" in \String -> Q Exp _exp -> (String -> Q Exp) -> (String -> Q Pat) -> (String -> Q Type) -> (String -> Q [Dec]) -> QuasiQuoter QuasiQuoter String -> Q Exp _exp forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a _unsupported forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a _unsupported forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a _unsupported expParser :: (Text -> Either Text Exp) -> QuasiQuoter expParser :: (Text -> Either Text Exp) -> QuasiQuoter expParser Text -> Either Text Exp _parser = (String -> Q Exp) -> QuasiQuoter exp forall a b. (a -> b) -> a -> b $ \String _inputString -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall (m :: * -> *) a. MonadFail m => String -> m a fail forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Text -> String Text.unpack) forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ Text -> Either Text Exp _parser forall a b. (a -> b) -> a -> b $ forall a. IsString a => String -> a fromString String _inputString expPreparableStmtAstParser :: (Ast.PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser :: (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser PreparableStmt -> Either Text Exp _parser = (Text -> Either Text Exp) -> QuasiQuoter expParser forall a b. (a -> b) -> a -> b $ \Text _input -> do PreparableStmt _ast <- forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first forall a. IsString a => String -> a fromString forall a b. (a -> b) -> a -> b $ forall a. Parser a -> Text -> Either String a Parsing.run (forall a. Parser a -> Parser a Parsing.atEnd Parser PreparableStmt Parsing.preparableStmt) Text _input PreparableStmt -> Either Text Exp _parser PreparableStmt _ast -- * Statement -- | -- @ -- :: `Statement` params row -- @ -- -- Statement producing exactly one result row. -- -- Will cause the running session to fail with the -- `Hasql.Session.UnexpectedAmountOfRows` error if it's any other. -- -- === __Examples__ -- -- >>> :t [singletonStatement|select 1 :: int2|] -- ... :: Statement () Int16 -- -- >>> :{ -- :t [singletonStatement| -- insert into "user" (email, name) -- values ($1 :: text, $2 :: text) -- returning id :: int4 -- |] -- :} -- ... -- ... :: Statement (Text, Text) Int32 -- -- Incorrect SQL: -- -- >>> :t [singletonStatement|elect 1|] -- ... -- | -- 1 | elect 1 -- | ^ -- ... singletonStatement :: QuasiQuoter singletonStatement :: QuasiQuoter singletonStatement = (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser ((Exp -> Exp) -> PreparableStmt -> Either Text Exp ExpExtraction.undecodedStatement Exp -> Exp Exp.singleRowResultDecoder) -- | -- @ -- :: `Statement` params (Maybe row) -- @ -- -- Statement producing one row or none. -- -- === __Examples__ -- -- >>> :t [maybeStatement|select 1 :: int2|] -- ... :: Statement () (Maybe Int16) maybeStatement :: QuasiQuoter maybeStatement :: QuasiQuoter maybeStatement = (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser ((Exp -> Exp) -> PreparableStmt -> Either Text Exp ExpExtraction.undecodedStatement Exp -> Exp Exp.rowMaybeResultDecoder) -- | -- @ -- :: `Statement` params (`Vector` row) -- @ -- -- Statement producing a vector of rows. -- -- === __Examples__ -- -- >>> :t [vectorStatement|select 1 :: int2|] -- ... :: Statement () (Vector Int16) vectorStatement :: QuasiQuoter vectorStatement :: QuasiQuoter vectorStatement = (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser ((Exp -> Exp) -> PreparableStmt -> Either Text Exp ExpExtraction.undecodedStatement Exp -> Exp Exp.rowVectorResultDecoder) -- | -- @ -- :: `Fold` row folding -> `Statement` params folding -- @ -- -- Function from `Fold` over rows to a statement producing the result of folding. -- Use this when you need to aggregate rows customly. -- -- === __Examples__ -- -- >>> :t [foldStatement|select 1 :: int2|] -- ... :: Fold Int16 b -> Statement () b foldStatement :: QuasiQuoter foldStatement :: QuasiQuoter foldStatement = (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser PreparableStmt -> Either Text Exp ExpExtraction.foldStatement -- | -- @ -- :: `Statement` params () -- @ -- -- Statement producing no results. -- -- === __Examples__ -- -- >>> :t [resultlessStatement|insert into "user" (name, email) values ($1 :: text, $2 :: text)|] -- ... -- ... :: Statement (Text, Text) () resultlessStatement :: QuasiQuoter resultlessStatement :: QuasiQuoter resultlessStatement = (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser ((Exp -> Exp) -> PreparableStmt -> Either Text Exp ExpExtraction.undecodedStatement (forall a b. a -> b -> a const Exp Exp.noResultResultDecoder)) -- | -- @ -- :: `Statement` params Int64 -- @ -- -- Statement counting the rows it affects. -- -- === __Examples__ -- -- >>> :t [rowsAffectedStatement|delete from "user" where password is null|] -- ... -- ... :: Statement () Int64 rowsAffectedStatement :: QuasiQuoter rowsAffectedStatement :: QuasiQuoter rowsAffectedStatement = (PreparableStmt -> Either Text Exp) -> QuasiQuoter expPreparableStmtAstParser ((Exp -> Exp) -> PreparableStmt -> Either Text Exp ExpExtraction.undecodedStatement (forall a b. a -> b -> a const Exp Exp.rowsAffectedResultDecoder)) -- * SQL ByteStrings -- | -- Quoter of a multiline Unicode SQL string, -- which gets converted into a format ready to be used for declaration of statements. uncheckedSql :: QuasiQuoter uncheckedSql :: QuasiQuoter uncheckedSql = (String -> Q Exp) -> QuasiQuoter exp forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. Monad m => a -> m a return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . ByteString -> Exp Exp.byteString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . Text -> ByteString Text.encodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . forall a. IsString a => String -> a fromString -- | -- Read an SQL-file, containing multiple statements, -- and produce an expression of type `ByteString`. -- -- Allows to store plain SQL in external files and read it at compile time. -- -- E.g., -- -- >migration1 :: Hasql.Session.Session () -- >migration1 = Hasql.Session.sql [uncheckedSqlFile|migrations/1.sql|] uncheckedSqlFile :: QuasiQuoter uncheckedSqlFile :: QuasiQuoter uncheckedSqlFile = QuasiQuoter -> QuasiQuoter quoteFile QuasiQuoter uncheckedSql -- * Tests -- $ -- >>> :t [maybeStatement| select (password = $2 :: bytea) :: bool, id :: int4 from "user" where "email" = $1 :: text |] -- ... -- ... Statement (Text, ByteString) (Maybe (Bool, Int32)) -- -- >>> :t [maybeStatement| select id :: int4 from application where pub_key = $1 :: uuid and sec_key_pt1 = $2 :: int8 and sec_key_pt2 = $3 :: int8 |] -- ... -- ... Statement (UUID, Int64, Int64) (Maybe Int32) -- -- >>> :t [singletonStatement| select 1 :: int4 from a left join b on b.id = a.id |] -- ... -- ... Statement () Int32