module Sqel.Query.Fragments where
import Data.Composition ((.:))
import qualified Exon
import Exon (exon)
import Sqel.Data.Codec (ColumnName (ColumnName))
import Sqel.Data.Dd (QOp (QAnd, QOr))
import Sqel.Data.FragType (FragType (Where))
import Sqel.Data.Sel (Sel (SelAuto, SelSymbol, SelUnused), SelW (SelWSymbol))
import Sqel.Data.Sql (Sql, sql)
import Sqel.Names (ddName)
import Sqel.Sql.Prepared (dollar)
import Sqel.Text.DbIdentifier (quotedDbId)
parens :: Sql -> Sql
parens :: Sql -> Sql
parens Sql
s =
[sql|(#{s})|]
joinOp :: QOp -> [Sql] -> Sql
joinOp :: QOp -> [Sql] -> Sql
joinOp =
Sql -> Sql
parens forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall a (t :: * -> *). (Monoid a, Foldable t) => a -> t a -> a
Exon.intercalate forall b c a. (b -> c) -> (a -> b) -> a -> c
. QOp -> Sql
sep
where
sep :: QOp -> Sql
sep = \case
QOp
QAnd -> Sql
" and "
QOp
QOr -> Sql
" or "
joinFrag :: QOp -> FragType -> [Sql] -> Sql
joinFrag :: QOp -> FragType -> [Sql] -> Sql
joinFrag QOp
op = \case
FragType
Where ->
QOp -> [Sql] -> Sql
joinOp QOp
op
FragType
_ ->
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
head
guardCon :: Int -> Int -> Sql -> Sql
guardCon :: Int -> Int -> Sql -> Sql
guardCon Int
index Int
con Sql
code =
[exon|(#{dollar index} = #{show con} and #{code})|]
joinSum :: Int -> FragType -> [Sql] -> Sql
joinSum :: Int -> FragType -> [Sql] -> Sql
joinSum Int
index FragType
Where =
QOp -> [Sql] -> Sql
joinOp QOp
QOr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Int -> Sql -> Sql
guardCon Int
index)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
joinSum Int
_ FragType
_ =
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
head
data ColumnPrefix =
NoPrefix
|
BasePrefix Text
|
TypePrefix Text
deriving stock (ColumnPrefix -> ColumnPrefix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnPrefix -> ColumnPrefix -> Bool
$c/= :: ColumnPrefix -> ColumnPrefix -> Bool
== :: ColumnPrefix -> ColumnPrefix -> Bool
$c== :: ColumnPrefix -> ColumnPrefix -> Bool
Eq, Int -> ColumnPrefix -> ShowS
[ColumnPrefix] -> ShowS
ColumnPrefix -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnPrefix] -> ShowS
$cshowList :: [ColumnPrefix] -> ShowS
show :: ColumnPrefix -> String
$cshow :: ColumnPrefix -> String
showsPrec :: Int -> ColumnPrefix -> ShowS
$cshowsPrec :: Int -> ColumnPrefix -> ShowS
Show)
addPrefix ::
ColumnName ->
ColumnPrefix ->
ColumnPrefix
addPrefix :: ColumnName -> ColumnPrefix -> ColumnPrefix
addPrefix (ColumnName Text
segment) = \case
ColumnPrefix
NoPrefix -> Text -> ColumnPrefix
BasePrefix (Text -> Text
quotedDbId Text
segment)
BasePrefix Text
name -> Text -> ColumnPrefix
TypePrefix [exon|(#{name}).#{quotedDbId segment}|]
TypePrefix Text
prefix -> Text -> ColumnPrefix
TypePrefix [exon|#{prefix}.#{quotedDbId segment}|]
prefixed :: Text -> ColumnPrefix -> Text
prefixed :: Text -> ColumnPrefix -> Text
prefixed Text
name = \case
ColumnPrefix
NoPrefix -> Text -> Text
quotedDbId Text
name
BasePrefix Text
prefix -> [exon|(#{prefix}).#{quotedDbId name}|]
TypePrefix Text
prefix -> [exon|#{prefix}.#{quotedDbId name}|]
class QFragmentPrefix sel where
qfragmentPrefix :: SelW sel -> ColumnPrefix -> ColumnPrefix
instance QFragmentPrefix ('SelSymbol n) where
qfragmentPrefix :: SelW ('SelSymbol n) -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix (SelWSymbol Proxy name
_) = ColumnName -> ColumnPrefix -> ColumnPrefix
addPrefix (forall (n :: Symbol). KnownSymbol n => ColumnName
ddName @n)
instance QFragmentPrefix 'SelAuto where
qfragmentPrefix :: SelW 'SelAuto -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix SelW 'SelAuto
_ = forall a. a -> a
id
instance QFragmentPrefix 'SelUnused where
qfragmentPrefix :: SelW 'SelUnused -> ColumnPrefix -> ColumnPrefix
qfragmentPrefix SelW 'SelUnused
_ = forall a. a -> a
id