-- | This module contains support for defining "ad-hoc" queries. That
-- is queries on tables that do not necessarily have corresponding
-- 'Beamable' table types.
module Database.Beam.Query.Adhoc
  ( Adhoc(..)

  , NamedField
  , table_, field_
  ) where

import           Database.Beam.Query.Internal
import           Database.Beam.Backend.SQL

import           Control.Monad.Free.Church

import           Data.Kind (Type)
import qualified Data.Text as T

class Adhoc structure where
  type AdhocTable structure (f :: Type -> Type) :: Type

  mkAdhocField :: (forall a. T.Text -> f a) -> structure -> AdhocTable structure f

newtype NamedField a = NamedField T.Text

instance Adhoc (NamedField a) where
  type AdhocTable (NamedField a) f = f a

  mkAdhocField :: (forall a. Text -> f a)
-> NamedField a -> AdhocTable (NamedField a) f
mkAdhocField forall a. Text -> f a
mk (NamedField Text
nm) = Text -> f a
forall a. Text -> f a
mk Text
nm

instance (Adhoc a, Adhoc b) => Adhoc (a, b) where
  type AdhocTable (a, b) y = (AdhocTable a y, AdhocTable b y)
  mkAdhocField :: (forall a. Text -> f a) -> (a, b) -> AdhocTable (a, b) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b)

instance (Adhoc a, Adhoc b, Adhoc c) => Adhoc (a, b, c) where
  type AdhocTable (a, b, c) y = (AdhocTable a y, AdhocTable b y, AdhocTable c y)
  mkAdhocField :: (forall a. Text -> f a) -> (a, b, c) -> AdhocTable (a, b, c) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b, c
c) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, (forall a. Text -> f a) -> c -> AdhocTable c f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c)

instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d) => Adhoc (a, b, c, d) where
  type AdhocTable (a, b, c, d) y = (AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y)
  mkAdhocField :: (forall a. Text -> f a)
-> (a, b, c, d) -> AdhocTable (a, b, c, d) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b, c
c, d
d) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, (forall a. Text -> f a) -> c -> AdhocTable c f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, (forall a. Text -> f a) -> d -> AdhocTable d f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d)

instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e) => Adhoc (a, b, c, d, e) where
  type AdhocTable (a, b, c, d, e) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y
                                      , AdhocTable e y )
  mkAdhocField :: (forall a. Text -> f a)
-> (a, b, c, d, e) -> AdhocTable (a, b, c, d, e) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b, c
c, d
d, e
e) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, (forall a. Text -> f a) -> c -> AdhocTable c f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, (forall a. Text -> f a) -> d -> AdhocTable d f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, (forall a. Text -> f a) -> e -> AdhocTable e f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e)

instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e, Adhoc f) => Adhoc (a, b, c, d, e, f) where
  type AdhocTable (a, b, c, d, e, f) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y
                                         , AdhocTable e y, AdhocTable f y )
  mkAdhocField :: (forall a. Text -> f a)
-> (a, b, c, d, e, f) -> AdhocTable (a, b, c, d, e, f) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b, c
c, d
d, e
e, f
f) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, (forall a. Text -> f a) -> c -> AdhocTable c f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, (forall a. Text -> f a) -> d -> AdhocTable d f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, (forall a. Text -> f a) -> e -> AdhocTable e f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e, (forall a. Text -> f a) -> f -> AdhocTable f f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk f
f)

instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e, Adhoc f, Adhoc g) => Adhoc (a, b, c, d, e, f, g) where
  type AdhocTable (a, b, c, d, e, f, g) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y
                                            , AdhocTable e y, AdhocTable f y, AdhocTable g y )
  mkAdhocField :: (forall a. Text -> f a)
-> (a, b, c, d, e, f, g) -> AdhocTable (a, b, c, d, e, f, g) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b, c
c, d
d, e
e, f
f, g
g) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, (forall a. Text -> f a) -> c -> AdhocTable c f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, (forall a. Text -> f a) -> d -> AdhocTable d f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, (forall a. Text -> f a) -> e -> AdhocTable e f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e, (forall a. Text -> f a) -> f -> AdhocTable f f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk f
f, (forall a. Text -> f a) -> g -> AdhocTable g f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk g
g)

instance (Adhoc a, Adhoc b, Adhoc c, Adhoc d, Adhoc e, Adhoc f, Adhoc g, Adhoc h) =>
  Adhoc (a, b, c, d, e, f, g, h) where
  type AdhocTable (a, b, c, d, e, f, g, h) y = ( AdhocTable a y, AdhocTable b y, AdhocTable c y, AdhocTable d y
                                               , AdhocTable e y, AdhocTable f y, AdhocTable g y, AdhocTable h y )
  mkAdhocField :: (forall a. Text -> f a)
-> (a, b, c, d, e, f, g, h)
-> AdhocTable (a, b, c, d, e, f, g, h) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) = ((forall a. Text -> f a) -> a -> AdhocTable a f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, (forall a. Text -> f a) -> b -> AdhocTable b f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, (forall a. Text -> f a) -> c -> AdhocTable c f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, (forall a. Text -> f a) -> d -> AdhocTable d f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, (forall a. Text -> f a) -> e -> AdhocTable e f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e, (forall a. Text -> f a) -> f -> AdhocTable f f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk f
f, (forall a. Text -> f a) -> g -> AdhocTable g f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk g
g, (forall a. Text -> f a) -> h -> AdhocTable h f
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk h
h)

-- | Introduce a table into a query without using the 'Beamable' and 'Database' machinery.
--
-- The first argument is the optional name of the schema the table is in and the second is the name
-- of the table to source from.
--
-- The third argument is a tuple (or any nesting of tuples) where each value is of type 'NamedField'
-- (use 'field_' to construct).
--
-- The return value is a tuple (or any nesting of tuples) of the same shape as @structure@ but where
-- each value is a 'QExpr'.
--
-- For example, to source from the table @Table1@, with fields @Field1@ (A boolean), @Field2@ (a
-- timestamp), and @Field3@ (a string)
--
-- > table_ Nothing "Table1" ( field_ @Bool "Field1", field_ @UTCTime "Field2", field_ @Text "Field3" )
--
table_ :: forall be db structure s
        . (Adhoc structure, BeamSqlBackend be, Projectible be (AdhocTable structure (QExpr be s)))
       => Maybe T.Text -> T.Text -> structure -> Q be db s (AdhocTable structure (QExpr be s))
table_ :: Maybe Text
-> Text
-> structure
-> Q be db s (AdhocTable structure (QExpr be s))
table_ Maybe Text
schemaNm Text
tblNm structure
tbl =
  QM be db s (AdhocTable structure (QExpr be s))
-> Q be db s (AdhocTable structure (QExpr be s))
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (QM be db s (AdhocTable structure (QExpr be s))
 -> Q be db s (AdhocTable structure (QExpr be s)))
-> QM be db s (AdhocTable structure (QExpr be s))
-> Q be db s (AdhocTable structure (QExpr be s))
forall a b. (a -> b) -> a -> b
$ QF be db s (AdhocTable structure (QExpr be s))
-> QM be db s (AdhocTable structure (QExpr be s))
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Text -> Text -> BeamSqlBackendFromSyntax be)
-> (Text -> AdhocTable structure (QExpr be s))
-> (AdhocTable structure (QExpr be s)
    -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))
-> ((Text, AdhocTable structure (QExpr be s))
    -> AdhocTable structure (QExpr be s))
-> QF be db s (AdhocTable structure (QExpr be s))
forall be r next (db :: (* -> *) -> *) s.
Projectible be r =>
(Text -> Text -> BeamSqlBackendFromSyntax be)
-> (Text -> r)
-> (r
    -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))
-> ((Text, r) -> next)
-> QF be db s next
QAll (\Text
_ -> Sql92FromTableSourceSyntax (BeamSqlBackendFromSyntax be)
-> Maybe (Text, Maybe [Text]) -> BeamSqlBackendFromSyntax be
forall from.
IsSql92FromSyntax from =>
Sql92FromTableSourceSyntax from
-> Maybe (Text, Maybe [Text]) -> from
fromTable (Sql92TableSourceTableNameSyntax
  (Sql92FromTableSourceSyntax (BeamSqlBackendFromSyntax be))
-> Sql92FromTableSourceSyntax (BeamSqlBackendFromSyntax be)
forall tblSource.
IsSql92TableSourceSyntax tblSource =>
Sql92TableSourceTableNameSyntax tblSource -> tblSource
tableNamed (Maybe Text
-> Text
-> Sql92TableSourceTableNameSyntax
     (Sql92FromTableSourceSyntax (BeamSqlBackendFromSyntax be))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
schemaNm Text
tblNm)) (Maybe (Text, Maybe [Text]) -> BeamSqlBackendFromSyntax be)
-> (Text -> Maybe (Text, Maybe [Text]))
-> Text
-> BeamSqlBackendFromSyntax be
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Maybe [Text]) -> Maybe (Text, Maybe [Text])
forall a. a -> Maybe a
Just ((Text, Maybe [Text]) -> Maybe (Text, Maybe [Text]))
-> (Text -> (Text, Maybe [Text]))
-> Text
-> Maybe (Text, Maybe [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Maybe [Text]
forall a. Maybe a
Nothing))
                  (\Text
tblNm' -> let mk :: forall a. T.Text -> QExpr be s a
                                  mk :: Text -> QExpr be s a
mk Text
nm = WithExprContext (BeamSqlBackendExpressionSyntax be) -> QExpr be s a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> Sql92ExpressionFieldNameSyntax
  (Sql92UpdateExpressionSyntax
     (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> Sql92UpdateExpressionSyntax
     (Sql92UpdateSyntax (BeamSqlBackendSyntax be))
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text
-> Text
-> Sql92ExpressionFieldNameSyntax
     (Sql92InsertValuesExpressionSyntax
        (Sql92InsertValuesSyntax
           (Sql92InsertSyntax (BeamSqlBackendSyntax be))))
forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
tblNm' Text
nm))
                              in (forall a. Text -> QGenExpr QValueContext be s a)
-> structure -> AdhocTable structure (QExpr be s)
forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> QGenExpr QValueContext be s a
mk structure
tbl)
                  (\AdhocTable structure (QExpr be s)
_ -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be))
forall a. Maybe a
Nothing) (Text, AdhocTable structure (QExpr be s))
-> AdhocTable structure (QExpr be s)
forall a b. (a, b) -> b
snd)

-- | Used to construct 'NamedField's, most often with an explicitly applied type.
--
-- The type can be omitted if the value is used unambiguously elsewhere.
field_ :: forall a. T.Text -> NamedField a
field_ :: Text -> NamedField a
field_ = Text -> NamedField a
forall a. Text -> NamedField a
NamedField