{-# language FlexibleContexts #-}
{-# language TypeFamilies #-}
{-# language ViewPatterns #-}

module Rel8.Query.SQL
  ( showQuery
  , sqlForQuery, sqlForQueryWithNames
  )
where

-- base
import Data.Foldable ( fold )
import Data.Functor.Const ( Const( Const ), getConst )
import Data.Void ( Void )
import Prelude

-- opaleye
import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
import qualified Opaleye.Internal.PrimQuery as Opaleye
import qualified Opaleye.Internal.Print as Opaleye
import qualified Opaleye.Internal.Optimize as Opaleye
import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
import qualified Opaleye.Internal.Sql as Opaleye

-- rel8
import Rel8.Expr ( Expr, Col( E ) )
import Rel8.Expr.Opaleye ( toPrimExpr )
import Rel8.Query ( Query )
import Rel8.Query.Opaleye ( toOpaleye )
import Rel8.Schema.Name ( Name( Name ), Selects, Col( N ) )
import Rel8.Schema.HTable ( htabulateA, hfield )
import Rel8.Table ( Table, toColumns )
import Rel8.Table.Name ( namesFromLabels )
import Rel8.Table.Opaleye ( castTable )


-- | Convert a query to a 'String' containing the query as a @SELECT@
-- statement.
showQuery :: Table Expr a => Query a -> String
showQuery :: Query a -> String
showQuery = Maybe String -> String
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe String -> String)
-> (Query a -> Maybe String) -> Query a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query a -> Maybe String
forall a. Table Expr a => Query a -> Maybe String
sqlForQuery


sqlForQuery :: Table Expr a
  => Query a -> Maybe String
sqlForQuery :: Query a -> Maybe String
sqlForQuery = Columns a (Col Name)
-> Query (Columns a (Col Expr)) -> Maybe String
forall names exprs.
Selects names exprs =>
names -> Query exprs -> Maybe String
sqlForQueryWithNames Columns a (Col Name)
forall a. Table Name a => a
namesFromLabels (Query (Columns a (Col Expr)) -> Maybe String)
-> (Query a -> Query (Columns a (Col Expr)))
-> Query a
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Columns a (Col Expr))
-> Query a -> Query (Columns a (Col Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Columns a (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns


sqlForQueryWithNames :: Selects names exprs
  => names -> Query exprs -> Maybe String
sqlForQueryWithNames :: names -> Query exprs -> Maybe String
sqlForQueryWithNames names
names Query exprs
query =
  Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (PrimQuery' Void -> Doc) -> PrimQuery' Void -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Select -> Doc
Opaleye.ppSql (Select -> Doc)
-> (PrimQuery' Void -> Select) -> PrimQuery' Void -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. names -> exprs -> PrimQuery' Void -> Select
forall names exprs.
Selects names exprs =>
names -> exprs -> PrimQuery' Void -> Select
selectFrom names
names exprs
exprs (PrimQuery' Void -> String)
-> Maybe (PrimQuery' Void) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrimQuery' () -> Maybe (PrimQuery' Void)
forall a. PrimQuery' a -> Maybe (PrimQuery' Void)
optimize PrimQuery' ()
primQuery
  where
    (exprs
exprs, PrimQuery' ()
primQuery, Tag
_) =
      QueryArr () exprs -> () -> (exprs, PrimQuery' (), Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery' (), Tag)
Opaleye.runSimpleQueryArrStart (Query exprs -> QueryArr () exprs
forall a. Query a -> Select a
toOpaleye Query exprs
query) ()


optimize :: Opaleye.PrimQuery' a -> Maybe (Opaleye.PrimQuery' Void)
optimize :: PrimQuery' a -> Maybe (PrimQuery' Void)
optimize = PrimQuery' a -> Maybe (PrimQuery' Void)
forall a b. PrimQuery' a -> Maybe (PrimQuery' b)
Opaleye.removeEmpty (PrimQuery' a -> Maybe (PrimQuery' Void))
-> (PrimQuery' a -> PrimQuery' a)
-> PrimQuery' a
-> Maybe (PrimQuery' Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimQuery' a -> PrimQuery' a
forall a. PrimQuery' a -> PrimQuery' a
Opaleye.optimize


selectFrom :: Selects names exprs
  => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
selectFrom :: names -> exprs -> PrimQuery' Void -> Select
selectFrom (names -> Columns names (Col Name)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns -> Columns names (Col Name)
names) (exprs -> Columns exprs (Col Expr)
forall (context :: Context) a.
Table context a =>
a -> Columns a (Col context)
toColumns (exprs -> Columns exprs (Col Expr))
-> (exprs -> exprs) -> exprs -> Columns exprs (Col Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. exprs -> exprs
forall a. Table Expr a => a -> a
castTable -> Columns exprs (Col Expr)
exprs) PrimQuery' Void
query =
  From -> Select
Opaleye.SelectFrom (From -> Select) -> From -> Select
forall a b. (a -> b) -> a -> b
$ From
Opaleye.newSelect
    { attrs :: SelectAttrs
Opaleye.attrs = NonEmpty (SqlExpr, Maybe SqlColumn) -> SelectAttrs
Opaleye.SelectAttrs NonEmpty (SqlExpr, Maybe SqlColumn)
attributes
    , tables :: [(Lateral, Select)]
Opaleye.tables = Select -> [(Lateral, Select)]
forall t. t -> [(Lateral, t)]
Opaleye.oneTable Select
select
    }
  where
    select :: Select
select = PrimQueryFold' Void Select -> PrimQuery' Void -> Select
forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
Opaleye.foldPrimQuery PrimQueryFold' Void Select
Opaleye.sqlQueryGenerator PrimQuery' Void
query
    attributes :: NonEmpty (SqlExpr, Maybe SqlColumn)
attributes = Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Columns exprs Any)
-> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a k (b :: k). Const a b -> a
getConst (Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Columns exprs Any)
 -> NonEmpty (SqlExpr, Maybe SqlColumn))
-> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Columns exprs Any)
-> NonEmpty (SqlExpr, Maybe SqlColumn)
forall a b. (a -> b) -> a -> b
$ (forall (spec :: Spec).
 HField (Columns exprs) spec
 -> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Any spec))
-> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Columns exprs Any)
forall (t :: HTable) (m :: * -> *) (context :: HContext).
(HTable t, Apply m) =>
(forall (spec :: Spec). HField t spec -> m (context spec))
-> m (t context)
htabulateA ((forall (spec :: Spec).
  HField (Columns exprs) spec
  -> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Any spec))
 -> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Columns exprs Any))
-> (forall (spec :: Spec).
    HField (Columns exprs) spec
    -> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Any spec))
-> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Columns exprs Any)
forall a b. (a -> b) -> a -> b
$ \HField (Columns exprs) spec
field -> case Columns exprs (Col Name)
-> HField (Columns exprs) spec -> Col Name spec
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns names (Col Name)
Columns exprs (Col Name)
names HField (Columns exprs) spec
field of
      N (Name name) -> case Columns exprs (Col Expr)
-> HField (Columns exprs) ('Spec labels a)
-> Col Expr ('Spec labels a)
forall (t :: HTable) (context :: HContext) (spec :: Spec).
HTable t =>
t context -> HField t spec -> context spec
hfield Columns exprs (Col Expr)
exprs HField (Columns exprs) spec
HField (Columns exprs) ('Spec labels a)
field of
        E (toPrimExpr -> expr) -> NonEmpty (SqlExpr, Maybe SqlColumn)
-> Const (NonEmpty (SqlExpr, Maybe SqlColumn)) (Any spec)
forall k a (b :: k). a -> Const a b
Const ((SqlExpr, Maybe SqlColumn) -> NonEmpty (SqlExpr, Maybe SqlColumn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> PrimExpr -> (SqlExpr, Maybe SqlColumn)
makeAttr String
name PrimExpr
expr))
    makeAttr :: String -> PrimExpr -> (SqlExpr, Maybe SqlColumn)
makeAttr String
label PrimExpr
expr =
      (PrimExpr -> SqlExpr
Opaleye.sqlExpr PrimExpr
expr, SqlColumn -> Maybe SqlColumn
forall a. a -> Maybe a
Just (String -> SqlColumn
Opaleye.SqlColumn String
label))