-- | 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 (f :: * -> *).
(forall a. Text -> f a)
-> NamedField a -> AdhocTable (NamedField a) f
mkAdhocField forall a. Text -> f a
mk (NamedField Text
nm) = 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 (f :: * -> *).
(forall a. Text -> f a) -> (a, b) -> AdhocTable (a, b) f
mkAdhocField forall a. Text -> f a
mk (a
a, b
b) = (forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, 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 (f :: * -> *).
(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 structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, 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 (f :: * -> *).
(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 structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, 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 (f :: * -> *).
(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 structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, 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 (f :: * -> *).
(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 structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e, 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 (f :: * -> *).
(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 structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk f
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 (f :: * -> *).
(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 structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk a
a, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk b
b, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk c
c, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk d
d, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk e
e, forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> f a
mk f
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 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_ :: forall be (db :: (* -> *) -> *) structure s.
(Adhoc structure, BeamSqlBackend be,
 Projectible be (AdhocTable structure (QExpr be s))) =>
Maybe Text
-> Text
-> structure
-> Q be db s (AdhocTable structure (QExpr be s))
table_ Maybe Text
schemaNm Text
tblNm structure
tbl =
  forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (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
_ -> forall from.
IsSql92FromSyntax from =>
Sql92FromTableSourceSyntax from
-> Maybe (Text, Maybe [Text]) -> from
fromTable (forall tblSource.
IsSql92TableSourceSyntax tblSource =>
Sql92TableSourceTableNameSyntax tblSource -> tblSource
tableNamed (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
schemaNm Text
tblNm)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, forall a. Maybe a
Nothing))
                  (\Text
tblNm' -> let mk :: forall a. T.Text -> QExpr be s a
                                  mk :: forall a. Text -> QExpr be s a
mk Text
nm = forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
tblNm' Text
nm))
                              in forall structure (f :: * -> *).
Adhoc structure =>
(forall a. Text -> f a) -> structure -> AdhocTable structure f
mkAdhocField forall a. Text -> QExpr be s a
mk structure
tbl)
                  (\AdhocTable structure (QExpr be s)
_ -> forall a. Maybe a
Nothing) 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_ :: forall a. Text -> NamedField a
field_ = forall a. Text -> NamedField a
NamedField