{-# LANGUAGE OverloadedStrings #-}

-- | Postgres-specific types, functions, and operators
module Database.Beam.Sqlite.SqliteSpecific
    ( -- * Sqlite functions and aggregates
      sqliteGroupConcat
    , sqliteGroupConcatOver
    )
where

import           Database.Beam
import           Database.Beam.Backend.SQL
import           Database.Beam.Query.Internal
import           Database.Beam.Sqlite.Connection
import           Database.Beam.Sqlite.Syntax
#if !MIN_VERSION_base(4, 11, 0)
import           Data.Semigroup
#endif

-- | The SQLite @group_concat@ function.
-- Joins the value in each row of the first argument, using the second
-- argument as a delimiter. See 'sqliteGroupConcatOver' if you want to provide
-- explicit quantification.
sqliteGroupConcat
    :: ( BeamSqlBackendCanSerialize Sqlite a
       , BeamSqlBackendIsString Sqlite str
       , BeamSqlBackendIsString Sqlite str2 )
    => QExpr Sqlite s a
    -> QExpr Sqlite s str
    -> QAgg Sqlite s (Maybe str2)
sqliteGroupConcat :: forall a str str2 s.
(BeamSqlBackendCanSerialize Sqlite a,
 BeamSqlBackendIsString Sqlite str,
 BeamSqlBackendIsString Sqlite str2) =>
QExpr Sqlite s a
-> QExpr Sqlite s str -> QAgg Sqlite s (Maybe str2)
sqliteGroupConcat QExpr Sqlite s a
v QExpr Sqlite s str
delim = forall a str s str2.
(BeamSqlBackendCanSerialize Sqlite a,
 BeamSqlBackendIsString Sqlite str) =>
Maybe SqliteAggregationSetQuantifierSyntax
-> QExpr Sqlite s a
-> Maybe (QExpr Sqlite s str2)
-> QAgg Sqlite s (Maybe str)
_sqliteGroupConcatOver forall s. IsSql92AggregationSetQuantifierSyntax s => Maybe s
allInGroup_ QExpr Sqlite s a
v (forall a. a -> Maybe a
Just QExpr Sqlite s str
delim)


-- | The SQLite @group_concat@ function.
-- Joins the value in each row of the first argument using ','.
-- See 'sqliteGroupConcat' if you want to change the delimiter.
-- Choosing a custom delimiter and quantification isn't allowed by SQLite.
sqliteGroupConcatOver
    :: ( BeamSqlBackendCanSerialize Sqlite a
       , BeamSqlBackendIsString Sqlite str )
    => Maybe SqliteAggregationSetQuantifierSyntax
    -> QExpr Sqlite s a
    -> QAgg Sqlite s (Maybe str)
sqliteGroupConcatOver :: forall a str s.
(BeamSqlBackendCanSerialize Sqlite a,
 BeamSqlBackendIsString Sqlite str) =>
Maybe SqliteAggregationSetQuantifierSyntax
-> QExpr Sqlite s a -> QAgg Sqlite s (Maybe str)
sqliteGroupConcatOver Maybe SqliteAggregationSetQuantifierSyntax
quantifier QExpr Sqlite s a
v = forall a str s str2.
(BeamSqlBackendCanSerialize Sqlite a,
 BeamSqlBackendIsString Sqlite str) =>
Maybe SqliteAggregationSetQuantifierSyntax
-> QExpr Sqlite s a
-> Maybe (QExpr Sqlite s str2)
-> QAgg Sqlite s (Maybe str)
_sqliteGroupConcatOver Maybe SqliteAggregationSetQuantifierSyntax
quantifier QExpr Sqlite s a
v forall a. Maybe a
Nothing

-- SQLite doesn't allow DISTINCT and a custom delimiter
_sqliteGroupConcatOver
    :: ( BeamSqlBackendCanSerialize Sqlite a
       , BeamSqlBackendIsString Sqlite str )
    => Maybe SqliteAggregationSetQuantifierSyntax
    -> QExpr Sqlite s a
    -> Maybe (QExpr Sqlite s str2)
    -> QAgg Sqlite s (Maybe str)
_sqliteGroupConcatOver :: forall a str s str2.
(BeamSqlBackendCanSerialize Sqlite a,
 BeamSqlBackendIsString Sqlite str) =>
Maybe SqliteAggregationSetQuantifierSyntax
-> QExpr Sqlite s a
-> Maybe (QExpr Sqlite s str2)
-> QAgg Sqlite s (Maybe str)
_sqliteGroupConcatOver Maybe SqliteAggregationSetQuantifierSyntax
quantifier (QExpr TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
v) Maybe (QExpr Sqlite s str2)
delim =
    forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr forall a b. (a -> b) -> a -> b
$ \TablePrefix
tbl -> SqliteSyntax -> SqliteExpressionSyntax
SqliteExpressionSyntax forall a b. (a -> b) -> a -> b
$
    ByteString -> SqliteSyntax
emit ByteString
"group_concat" forall a. Semigroup a => a -> a -> a
<>
    SqliteSyntax -> SqliteSyntax
parens ( forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\SqliteAggregationSetQuantifierSyntax
q -> SqliteAggregationSetQuantifierSyntax -> SqliteSyntax
fromSqliteAggregationSetQuantifier SqliteAggregationSetQuantifierSyntax
q forall a. Semigroup a => a -> a -> a
<> ByteString -> SqliteSyntax
emit ByteString
" ") Maybe SqliteAggregationSetQuantifierSyntax
quantifier forall a. Semigroup a => a -> a -> a
<>
             SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression (TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
v TablePrefix
tbl) forall a. Semigroup a => a -> a -> a
<>
             forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (\(QExpr TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
d) -> ByteString -> SqliteSyntax
emit ByteString
", " forall a. Semigroup a => a -> a -> a
<> SqliteExpressionSyntax -> SqliteSyntax
fromSqliteExpression (TablePrefix -> BeamSqlBackendExpressionSyntax Sqlite
d TablePrefix
tbl)) Maybe (QExpr Sqlite s str2)
delim)