{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE UndecidableInstances   #-}

module Database.Quibble
  ( Query
  , RowsOf
  , DBWhere(..), DBRender(..)
  , Expr(..)
  , SortExpr(..)
  , HasTable, HasColumn
  , Inline(..)
  , query, rowsOf
  , where_, orderBy, limit, offset
  , asc, desc
  , (.&&), (.||), (.==), (./=), true, false
  , isNull, isNotNull
  , module Reexport
  )
where

import Data.ByteString ( ByteString )
import Data.ByteString.Builder ( Builder )
import Data.Foldable ( fold )
import Data.Int ( Int16, Int32, Int64 )
import Data.Kind ( Type )
import Data.MonoTraversable ( MonoFoldable, Element, ofoldMap )
import Data.Proxy ( Proxy(..) )
import Data.Sequence ( Seq )
import Data.String ( IsString(..) )
import Data.Time ( UTCTime )
import Data.Time.Format.ISO8601 ( iso8601Show )
import Data.Text ( Text )
import Data.Text.Conversions ( convertText, UTF8(..) )
import Data.UUID ( UUID )
import Data.Word ( Word16, Word32, Word64 )
import Optics.Lens ( Lens', lens )
import Optics.Setter ( over )
import GHC.OverloadedLabels ( IsLabel(..) )
import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )

import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as BL
import qualified Data.Sequence as Seq
import qualified Data.Text.Lazy as TL
import qualified Data.UUID as UUID

import Data.Function as Reexport ( (&) )

-- | The constructor is exposed in case you need to unsafely construct
-- | expressions. But you shouldn't rely on it too much.
newtype Expr (ctx :: Type) (ty :: Type) =
  Expr { Expr ctx ty -> Builder
unExpr :: Builder }

-- | You can think of this as a wrapper around `Expr' that adds sorting direction.
-- | Unfortunately, we can't allow @ASC NULLS LAST@ or friends here because that's
-- | not portable across database.
data SortExpr (ctx :: Type)
  = Asc Builder
  | Desc Builder
  | CustomSort ByteString Builder

-- | Allows us to lookup table name by type.
class KnownSymbol tbl => HasTable (ctx :: Type) (tbl :: Symbol) | ctx -> tbl

-- | Allows us to infer the column type from the table type and column name.
class KnownSymbol col => HasColumn (ctx :: Type) (col :: Symbol) (ty :: Type) | ctx col -> ty

data Query (ctx :: Type) = Query
  { Query ctx -> Maybe (Expr ctx Bool)
qryWhereCond :: Maybe (Expr ctx Bool)
  , Query ctx -> Maybe Word64
qryLimit :: Maybe Word64
  , Query ctx -> Maybe Word64
qryOffset :: Maybe Word64
  , Query ctx -> Seq (SortExpr ctx)
qrySort :: Seq (SortExpr ctx)
  }

data RowsOf (ctx :: Type) = RowsOf
  { RowsOf ctx -> Maybe (Expr ctx Bool)
rowsWhereCond :: Maybe (Expr ctx Bool) }

sqlSortExpr :: SortExpr ctx -> Builder
sqlSortExpr :: SortExpr ctx -> Builder
sqlSortExpr SortExpr ctx
sort = case SortExpr ctx
sort of
  Asc Builder
expr -> Builder
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ASC"
  Desc Builder
expr -> Builder
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" DESC"
  CustomSort ByteString
sortDir Builder
expr -> Builder
expr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
sortDir

sqlQuery :: Query ctx -> ByteString
sqlQuery :: Query ctx -> ByteString
sqlQuery Query ctx
qry = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [ case Query ctx -> Maybe (Expr ctx Bool)
forall ctx. Query ctx -> Maybe (Expr ctx Bool)
qryWhereCond Query ctx
qry of
      Maybe (Expr ctx Bool)
Nothing -> Builder
forall a. Monoid a => a
mempty
      Just Expr ctx Bool
cond -> Builder
"\nWHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr ctx Bool -> Builder
forall ctx ty. Expr ctx ty -> Builder
unExpr Expr ctx Bool
cond
  , if Seq (SortExpr ctx) -> Bool
forall a. Seq a -> Bool
Seq.null (Query ctx -> Seq (SortExpr ctx)
forall ctx. Query ctx -> Seq (SortExpr ctx)
qrySort Query ctx
qry)
      then Builder
forall a. Monoid a => a
mempty
      else Builder
"\nORDER BY " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Seq Builder -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Builder -> Seq Builder -> Seq Builder
forall a. a -> Seq a -> Seq a
Seq.intersperse Builder
", " (Seq Builder -> Seq Builder) -> Seq Builder -> Seq Builder
forall a b. (a -> b) -> a -> b
$ (SortExpr ctx -> Builder) -> Seq (SortExpr ctx) -> Seq Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SortExpr ctx -> Builder
forall ctx. SortExpr ctx -> Builder
sqlSortExpr (Seq (SortExpr ctx) -> Seq Builder)
-> Seq (SortExpr ctx) -> Seq Builder
forall a b. (a -> b) -> a -> b
$ Query ctx -> Seq (SortExpr ctx)
forall ctx. Query ctx -> Seq (SortExpr ctx)
qrySort Query ctx
qry)
  , case Query ctx -> Maybe Word64
forall ctx. Query ctx -> Maybe Word64
qryLimit Query ctx
qry of
      Maybe Word64
Nothing -> Builder
forall a. Monoid a => a
mempty
      Just Word64
limit -> Builder
"\nLIMIT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
Builder.word64Dec Word64
limit
  , case Query ctx -> Maybe Word64
forall ctx. Query ctx -> Maybe Word64
qryOffset Query ctx
qry of
      Maybe Word64
Nothing -> Builder
forall a. Monoid a => a
mempty
      Just Word64
offset -> Builder
"\nOFFSET " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
Builder.word64Dec Word64
offset
  ]

sqlRowsOf :: RowsOf ctx -> ByteString
sqlRowsOf :: RowsOf ctx -> ByteString
sqlRowsOf RowsOf ctx
rows = case RowsOf ctx -> Maybe (Expr ctx Bool)
forall ctx. RowsOf ctx -> Maybe (Expr ctx Bool)
rowsWhereCond RowsOf ctx
rows of
  Maybe (Expr ctx Bool)
Nothing ->
    ByteString
""
  Just Expr ctx Bool
cond ->
    ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
      Builder
"WHERE " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Expr ctx Bool -> Builder
forall ctx ty. Expr ctx ty -> Builder
unExpr Expr ctx Bool
cond

asc :: Expr ctx ty -> SortExpr ctx
asc :: Expr ctx ty -> SortExpr ctx
asc (Expr Builder
bldr) = Builder -> SortExpr ctx
forall ctx. Builder -> SortExpr ctx
Asc Builder
bldr

desc :: Expr ctx ty -> SortExpr ctx
desc :: Expr ctx ty -> SortExpr ctx
desc (Expr Builder
bldr) = Builder -> SortExpr ctx
forall ctx. Builder -> SortExpr ctx
Desc Builder
bldr

-- | A `Query' is meant to represent everything in a @SELECT@ statement, other
-- | than the columns selection and the joined tables.
-- | This is meant to be used with @-XTypeApplications@, like @query \@Foo@.
query :: forall ctx. Query ctx
query :: Query ctx
query = Query :: forall ctx.
Maybe (Expr ctx Bool)
-> Maybe Word64 -> Maybe Word64 -> Seq (SortExpr ctx) -> Query ctx
Query
  { qryWhereCond :: Maybe (Expr ctx Bool)
qryWhereCond = Maybe (Expr ctx Bool)
forall a. Maybe a
Nothing
  , qryLimit :: Maybe Word64
qryLimit = Maybe Word64
forall a. Maybe a
Nothing
  , qryOffset :: Maybe Word64
qryOffset = Maybe Word64
forall a. Maybe a
Nothing
  , qrySort :: Seq (SortExpr ctx)
qrySort = Seq (SortExpr ctx)
forall a. Seq a
Seq.empty
  }

-- | A `RowsOf' is meant to represent the conditions of an @UPDATE@ or @DELETE@.
-- | This is meant to be used with @-XTypeApplications@, like @rowsOf \@Foo@.
rowsOf :: forall ctx. RowsOf ctx
rowsOf :: RowsOf ctx
rowsOf = RowsOf :: forall ctx. Maybe (Expr ctx Bool) -> RowsOf ctx
RowsOf
  { rowsWhereCond :: Maybe (Expr ctx Bool)
rowsWhereCond = Maybe (Expr ctx Bool)
forall a. Maybe a
Nothing
  }

class DBWhere qry ctx where
  whereCond :: Lens' qry (Maybe (Expr ctx Bool))

  -- | A convenience function for when the user doesn't want to specify any conditions.
  allRows :: qry

instance (ctx ~ ctx') => DBWhere (Query ctx) ctx' where
  whereCond :: Lens' (Query ctx) (Maybe (Expr ctx' Bool))
whereCond = (Query ctx -> Maybe (Expr ctx Bool))
-> (Query ctx -> Maybe (Expr ctx Bool) -> Query ctx)
-> Lens
     (Query ctx)
     (Query ctx)
     (Maybe (Expr ctx Bool))
     (Maybe (Expr ctx Bool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Query ctx -> Maybe (Expr ctx Bool)
forall ctx. Query ctx -> Maybe (Expr ctx Bool)
qryWhereCond (\Query ctx
qry Maybe (Expr ctx Bool)
cond -> Query ctx
qry { qryWhereCond :: Maybe (Expr ctx Bool)
qryWhereCond = Maybe (Expr ctx Bool)
cond })
  allRows :: Query ctx
allRows = Query ctx
forall ctx. Query ctx
query @ctx

instance (ctx ~ ctx') => DBWhere (RowsOf ctx) ctx' where
  whereCond :: Lens' (RowsOf ctx) (Maybe (Expr ctx' Bool))
whereCond = (RowsOf ctx -> Maybe (Expr ctx Bool))
-> (RowsOf ctx -> Maybe (Expr ctx Bool) -> RowsOf ctx)
-> Lens
     (RowsOf ctx)
     (RowsOf ctx)
     (Maybe (Expr ctx Bool))
     (Maybe (Expr ctx Bool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RowsOf ctx -> Maybe (Expr ctx Bool)
forall ctx. RowsOf ctx -> Maybe (Expr ctx Bool)
rowsWhereCond (\RowsOf ctx
rows Maybe (Expr ctx Bool)
cond -> RowsOf ctx
rows { rowsWhereCond :: Maybe (Expr ctx Bool)
rowsWhereCond = Maybe (Expr ctx Bool)
cond })
  allRows :: RowsOf ctx
allRows = RowsOf ctx
forall ctx. RowsOf ctx
rowsOf @ctx

class DBRender a where
  renderSQL :: a -> ByteString

instance DBRender (Query ctx) where
  renderSQL :: Query ctx -> ByteString
renderSQL = Query ctx -> ByteString
forall ctx. Query ctx -> ByteString
sqlQuery

instance DBRender (RowsOf ctx) where
  renderSQL :: RowsOf ctx -> ByteString
renderSQL = RowsOf ctx -> ByteString
forall ctx. RowsOf ctx -> ByteString
sqlRowsOf

-- | Add a condition to the `Query' or `RowsOf'. If @where_@ is used multiple times,
-- | the condition will be @AND@ed together.
-- |
-- | > rowsOf @Foo
-- | >   & where_ (...)
where_ :: DBWhere qry ctx => Expr ctx Bool -> qry -> qry
where_ :: Expr ctx Bool -> qry -> qry
where_ Expr ctx Bool
cond qry
qry =
  Optic
  A_Lens NoIx qry qry (Maybe (Expr ctx Bool)) (Maybe (Expr ctx Bool))
-> (Maybe (Expr ctx Bool) -> Maybe (Expr ctx Bool)) -> qry -> qry
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens NoIx qry qry (Maybe (Expr ctx Bool)) (Maybe (Expr ctx Bool))
forall qry ctx.
DBWhere qry ctx =>
Lens' qry (Maybe (Expr ctx Bool))
whereCond
    (\Maybe (Expr ctx Bool)
existing -> case Maybe (Expr ctx Bool)
existing of
      Maybe (Expr ctx Bool)
Nothing -> Expr ctx Bool -> Maybe (Expr ctx Bool)
forall a. a -> Maybe a
Just Expr ctx Bool
cond
      Just Expr ctx Bool
cond' -> Expr ctx Bool -> Maybe (Expr ctx Bool)
forall a. a -> Maybe a
Just (Expr ctx Bool
cond' Expr ctx Bool -> Expr ctx Bool -> Expr ctx Bool
forall ctx. Expr ctx Bool -> Expr ctx Bool -> Expr ctx Bool
.&& Expr ctx Bool
cond))
    qry
qry

-- | Set the number of rows specified by a @LIMIT@. If @limit@ is used multiple
-- | times, only the result of the last call matters.
-- |
-- | > query @Foo
-- | >   & limit 50
limit :: Word64 -> Query ctx -> Query ctx
limit :: Word64 -> Query ctx -> Query ctx
limit Word64
rows Query ctx
qry = Query ctx
qry
  { qryLimit :: Maybe Word64
qryLimit = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
rows
  }

-- | Set the number of rows specified by an @OFFSET@. If @offset@ is used
-- | multiple times, only the result of the last call matters.
-- |
-- | > query @Foo
-- | >   & offset 100
-- |
-- | Note that in the general case, your query will still pay the cost of
-- | looking up all the rows that were skipped! Be careful when using @OFFSET@.
offset :: Word64 -> Query ctx -> Query ctx
offset :: Word64 -> Query ctx -> Query ctx
offset Word64
rows Query ctx
qry = Query ctx
qry
  { qryOffset :: Maybe Word64
qryOffset = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
rows
  }

-- | Specify how the output should be sorted. If @orderBy@ is used multiple times,
-- | all sort expressions are concatenated together, with later calls having
-- | lower sort precedence.
-- |
-- | @-XOverloadedLists@ can help make specifying the list of sort expressions
-- | simpler.
-- |
-- | > query @Foo
-- | >   & orderBy [asc #col1, desc #col2]
orderBy :: Seq (SortExpr ctx) -> Query ctx -> Query ctx
orderBy :: Seq (SortExpr ctx) -> Query ctx -> Query ctx
orderBy Seq (SortExpr ctx)
sorts Query ctx
qry = Query ctx
qry
  { qrySort :: Seq (SortExpr ctx)
qrySort = Query ctx -> Seq (SortExpr ctx)
forall ctx. Query ctx -> Seq (SortExpr ctx)
qrySort Query ctx
qry Seq (SortExpr ctx) -> Seq (SortExpr ctx) -> Seq (SortExpr ctx)
forall a. Semigroup a => a -> a -> a
<> Seq (SortExpr ctx)
sorts
  }

escapeCharSeq :: (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq :: t -> Builder
escapeCharSeq t
t =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"E'", (Element t -> Builder) -> t -> Builder
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
ofoldMap Char -> Builder
Element t -> Builder
escapeChar t
t, Builder
"'"]
  where
    escapeChar :: Char -> Builder
    escapeChar :: Char -> Builder
escapeChar Char
'\\' = Builder
"\\\\"
    escapeChar Char
'\'' = Builder
"''"
    escapeChar Char
'?'  = Builder
"\\x3F"
    escapeChar Char
c | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
127 = Int32 -> Builder
Builder.int32HexFixed (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c)
    escapeChar Char
other = Char -> Builder
Builder.char7 Char
other

escapeByteString :: ByteString -> Builder
escapeByteString :: ByteString -> Builder
escapeByteString ByteString
bs =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"'\\x", ByteString -> Builder
Builder.byteStringHex ByteString
bs, Builder
"'"]

instance IsString (Expr ctx ByteString) where
  fromString :: String -> Expr ctx ByteString
fromString String
s =
    let UTF8 ByteString
bs = String -> UTF8 ByteString
forall a b. (ToText a, FromText b) => a -> b
convertText String
s
    in Builder -> Expr ctx ByteString
forall ctx ty. Builder -> Expr ctx ty
Expr (ByteString -> Builder
escapeByteString ByteString
bs)

instance IsString (Expr ctx BL.ByteString) where
  fromString :: String -> Expr ctx ByteString
fromString String
s =
    let UTF8 ByteString
bs = String -> UTF8 ByteString
forall a b. (ToText a, FromText b) => a -> b
convertText String
s
    in Builder -> Expr ctx ByteString
forall ctx ty. Builder -> Expr ctx ty
Expr (ByteString -> Builder
escapeByteString ByteString
bs)

instance IsString (Expr ctx Text) where
  fromString :: String -> Expr ctx Text
fromString String
s = Builder -> Expr ctx Text
forall ctx ty. Builder -> Expr ctx ty
Expr (String -> Builder
forall t. (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq String
s)

instance IsString (Expr ctx TL.Text) where
  fromString :: String -> Expr ctx Text
fromString String
s = Builder -> Expr ctx Text
forall ctx ty. Builder -> Expr ctx ty
Expr (String -> Builder
forall t. (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq String
s)

instance IsString (Expr ctx String) where
  fromString :: String -> Expr ctx String
fromString String
s = Builder -> Expr ctx String
forall ctx ty. Builder -> Expr ctx ty
Expr (String -> Builder
forall t. (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq String
s)

instance (Show a, Num a) => Num (Expr ctx a) where
  + :: Expr ctx a -> Expr ctx a -> Expr ctx a
(+) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"(", Builder
l, Builder
" + ", Builder
r, Builder
")"])
  (-) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"(", Builder
l, Builder
" - ", Builder
r, Builder
")"])
  * :: Expr ctx a -> Expr ctx a -> Expr ctx a
(*) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"(", Builder
l, Builder
" * ", Builder
r, Builder
")"])
  negate :: Expr ctx a -> Expr ctx a
negate (Expr Builder
l) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"-", Builder
l])
  abs :: Expr ctx a -> Expr ctx a
abs (Expr Builder
x) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"ABS(", Builder
x, Builder
")"])
  signum :: Expr ctx a -> Expr ctx a
signum (Expr Builder
x) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"SIGN(", Builder
x, Builder
")"])
  fromInteger :: Integer -> Expr ctx a
fromInteger Integer
i =
    let UTF8 ByteString
bs = String -> UTF8 ByteString
forall a b. (ToText a, FromText b) => a -> b
convertText (String -> UTF8 ByteString) -> String -> UTF8 ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i :: a)
    in Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr (ByteString -> Builder
Builder.byteString ByteString
bs)

instance (Show a, Fractional a) => Fractional (Expr ctx a) where
  / :: Expr ctx a -> Expr ctx a -> Expr ctx a
(/) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"(", Builder
l, Builder
" / ", Builder
r, Builder
")"])
  fromRational :: Rational -> Expr ctx a
fromRational Rational
r =
    let UTF8 ByteString
bs = String -> UTF8 ByteString
forall a b. (ToText a, FromText b) => a -> b
convertText (String -> UTF8 ByteString) -> String -> UTF8 ByteString
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show (Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
r :: a)
    in Builder -> Expr ctx a
forall ctx ty. Builder -> Expr ctx ty
Expr (ByteString -> Builder
Builder.byteString ByteString
bs)

-- This instance is not currently Unicode-aware, because we don't use
-- the quoted syntax for identifiers.
instance
  ( KnownSymbol tbl
  , HasTable ctx tbl
  , HasColumn ctx col ty
  ) => IsLabel col (Expr ctx ty) where
  fromLabel :: Expr ctx ty
fromLabel = Builder -> Expr ctx ty
forall ctx ty. Builder -> Expr ctx ty
Expr (Builder -> Expr ctx ty) -> Builder -> Expr ctx ty
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Builder
Builder.string7 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy tbl -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy tbl -> String) -> Proxy tbl -> String
forall a b. (a -> b) -> a -> b
$ Proxy tbl
forall k (t :: k). Proxy t
Proxy @tbl
    , Builder
"."
    , String -> Builder
Builder.string7 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Proxy col -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy col -> String) -> Proxy col -> String
forall a b. (a -> b) -> a -> b
$ Proxy col
forall k (t :: k). Proxy t
Proxy @col
    ]

true :: Expr ctx Bool
true :: Expr ctx Bool
true = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr Builder
"TRUE"

false :: Expr ctx Bool
false :: Expr ctx Bool
false = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr Builder
"FALSE"

isNull :: Expr ctx a -> Expr ctx Bool
isNull :: Expr ctx a -> Expr ctx Bool
isNull (Expr Builder
x) = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
x, Builder
" IS NULL"])

isNotNull :: Expr ctx a -> Expr ctx Bool
isNotNull :: Expr ctx a -> Expr ctx Bool
isNotNull (Expr Builder
x) = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
x, Builder
" IS NOT NULL"])

infixl 0 .&&
(.&&) :: Expr ctx Bool -> Expr ctx Bool -> Expr ctx Bool
.&& :: Expr ctx Bool -> Expr ctx Bool -> Expr ctx Bool
(.&&) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"(", Builder
l, Builder
" AND ", Builder
r, Builder
")"])

infixl 1 .||
(.||) :: Expr ctx Bool -> Expr ctx Bool -> Expr ctx Bool
.|| :: Expr ctx Bool -> Expr ctx Bool -> Expr ctx Bool
(.||) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
"(", Builder
l, Builder
" OR ", Builder
r, Builder
")"])

(./=) :: Expr ctx a -> Expr ctx a -> Expr ctx Bool
./= :: Expr ctx a -> Expr ctx a -> Expr ctx Bool
(./=) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
l, Builder
" <> ", Builder
r])

(.==) :: Expr ctx a -> Expr ctx a -> Expr ctx Bool
.== :: Expr ctx a -> Expr ctx a -> Expr ctx Bool
(.==) (Expr Builder
l) (Expr Builder
r) = Builder -> Expr ctx Bool
forall ctx ty. Builder -> Expr ctx ty
Expr ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder
l, Builder
" = ", Builder
r])

class Inline ty where
  inline :: ty -> Expr ctx ty

instance Inline ByteString where
  inline :: ByteString -> Expr ctx ByteString
inline ByteString
s = Builder -> Expr ctx ByteString
forall ctx ty. Builder -> Expr ctx ty
Expr (ByteString -> Builder
escapeByteString ByteString
s)
instance Inline BL.ByteString where
  inline :: ByteString -> Expr ctx ByteString
inline ByteString
s = Builder -> Expr ctx ByteString
forall ctx ty. Builder -> Expr ctx ty
Expr (ByteString -> Builder
escapeByteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict ByteString
s)
instance Inline Text where
  inline :: Text -> Expr ctx Text
inline Text
s = Builder -> Expr ctx Text
forall ctx ty. Builder -> Expr ctx ty
Expr (Text -> Builder
forall t. (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq Text
s)
instance Inline TL.Text where
  inline :: Text -> Expr ctx Text
inline Text
s = Builder -> Expr ctx Text
forall ctx ty. Builder -> Expr ctx ty
Expr (Text -> Builder
forall t. (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq Text
s)
instance Inline String where
  inline :: String -> Expr ctx String
inline String
s = Builder -> Expr ctx String
forall ctx ty. Builder -> Expr ctx ty
Expr (String -> Builder
forall t. (MonoFoldable t, Element t ~ Char) => t -> Builder
escapeCharSeq String
s)

instance Inline Bool where
  inline :: Bool -> Expr ctx Bool
inline Bool
b = if Bool
b then Expr ctx Bool
forall ctx. Expr ctx Bool
true else Expr ctx Bool
forall ctx. Expr ctx Bool
false

instance Inline Int16 where
  inline :: Int16 -> Expr ctx Int16
inline Int16
n = Builder -> Expr ctx Int16
forall ctx ty. Builder -> Expr ctx ty
Expr (Int16 -> Builder
Builder.int16Dec Int16
n)
instance Inline Int32 where
  inline :: Int32 -> Expr ctx Int32
inline Int32
n = Builder -> Expr ctx Int32
forall ctx ty. Builder -> Expr ctx ty
Expr (Int32 -> Builder
Builder.int32Dec Int32
n)
instance Inline Int64 where
  inline :: Int64 -> Expr ctx Int64
inline Int64
n = Builder -> Expr ctx Int64
forall ctx ty. Builder -> Expr ctx ty
Expr (Int64 -> Builder
Builder.int64Dec Int64
n)

instance Inline Word16 where
  inline :: Word16 -> Expr ctx Word16
inline Word16
n = Builder -> Expr ctx Word16
forall ctx ty. Builder -> Expr ctx ty
Expr (Word16 -> Builder
Builder.word16Dec Word16
n)
instance Inline Word32 where
  inline :: Word32 -> Expr ctx Word32
inline Word32
n = Builder -> Expr ctx Word32
forall ctx ty. Builder -> Expr ctx ty
Expr (Word32 -> Builder
Builder.word32Dec Word32
n)
instance Inline Word64 where
  inline :: Word64 -> Expr ctx Word64
inline Word64
n = Builder -> Expr ctx Word64
forall ctx ty. Builder -> Expr ctx ty
Expr (Word64 -> Builder
Builder.word64Dec Word64
n)

instance Inline UUID where
  inline :: UUID -> Expr ctx UUID
inline UUID
uuid = Builder -> Expr ctx UUID
forall ctx ty. Builder -> Expr ctx ty
Expr (Builder -> Expr ctx UUID) -> Builder -> Expr ctx UUID
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [Builder
"'", ByteString -> Builder
Builder.byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ UUID -> ByteString
UUID.toASCIIBytes UUID
uuid, Builder
"'"]

instance Inline UTCTime where
  inline :: UTCTime -> Expr ctx UTCTime
inline UTCTime
t = Builder -> Expr ctx UTCTime
forall ctx ty. Builder -> Expr ctx ty
Expr (Builder -> Expr ctx UTCTime) -> Builder -> Expr ctx UTCTime
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [Builder
"'", String -> Builder
Builder.string7 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
t, Builder
"'"]