module ClickHaskell.Statements where

-- Internal
import ClickHaskell.Primitive
import ClickHaskell.Protocol.Settings (DbSettings (..))

-- GHC included
import Data.ByteString.Builder (Builder, byteString)
import Data.ByteString.Char8 as BS8 (pack)
import Data.Kind (Type)
import Data.List (intersperse)
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import GHC.TypeLits


-- * Statements

tableName :: forall name . KnownSymbol name => Builder
tableName :: forall (name :: Symbol). KnownSymbol name => Builder
tableName = (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (String -> StrictByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack) (Proxy name -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy name -> String) -> Proxy name -> String
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)

class Statement statement where
  {- |
    Wrapper for settings passing
  -}
  passSettings :: (DbSettings -> DbSettings) -> statement -> statement

instance Statement (Select cols output) where
  passSettings :: (DbSettings -> DbSettings)
-> Select cols output -> Select cols output
passSettings DbSettings -> DbSettings
pass (MkSelect [(Builder, Builder)] -> ChString
mkQuery DbSettings
dbSettings) = ([(Builder, Builder)] -> ChString)
-> DbSettings -> Select cols output
forall (columns :: [*]) output.
([(Builder, Builder)] -> ChString)
-> DbSettings -> Select columns output
MkSelect [(Builder, Builder)] -> ChString
mkQuery (DbSettings -> DbSettings
pass DbSettings
dbSettings)

instance Statement (Insert cols input) where
  passSettings :: (DbSettings -> DbSettings)
-> Insert cols input -> Insert cols input
passSettings DbSettings -> DbSettings
pass (MkInsert [(Builder, Builder)] -> ChString
mkQuery DbSettings
dbSettings) = ([(Builder, Builder)] -> ChString)
-> DbSettings -> Insert cols input
forall (columns :: [*]) output.
([(Builder, Builder)] -> ChString)
-> DbSettings -> Insert columns output
MkInsert [(Builder, Builder)] -> ChString
mkQuery (DbSettings -> DbSettings
pass DbSettings
dbSettings)

instance Statement (Command) where
  passSettings :: (DbSettings -> DbSettings) -> Command -> Command
passSettings DbSettings -> DbSettings
pass (MkCommand ChString
query DbSettings
dbSettings) = ChString -> DbSettings -> Command
MkCommand ChString
query (DbSettings -> DbSettings
pass DbSettings
dbSettings)


-- ** Command

data Command
  where
  MkCommand :: ChString -> DbSettings -> Command

instance IsString Command where
  fromString :: String -> Command
fromString String
str = ChString -> DbSettings -> Command
MkCommand (String -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType String
str) ([DbSetting] -> DbSettings
MkDbSettings [])


-- ** SELECT

{-|
  SELECT statement abstraction
-}
data Select (columns :: [Type]) output
  where
  MkSelect :: ([(Builder, Builder)] -> ChString) -> DbSettings -> Select columns output

unsafeMkSelect :: ([(Builder, Builder)] -> Builder) -> Select columns output
unsafeMkSelect :: forall (columns :: [*]) output.
([(Builder, Builder)] -> Builder) -> Select columns output
unsafeMkSelect [(Builder, Builder)] -> Builder
s = ([(Builder, Builder)] -> ChString)
-> DbSettings -> Select columns output
forall (columns :: [*]) output.
([(Builder, Builder)] -> ChString)
-> DbSettings -> Select columns output
MkSelect (Builder -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType (Builder -> ChString)
-> ([(Builder, Builder)] -> Builder)
-> [(Builder, Builder)]
-> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Builder, Builder)] -> Builder
s) ([DbSetting] -> DbSettings
MkDbSettings [])

{-|
  Type-safe wrapper for statements like

  @SELECT ${columns} FROM ${table}@
-}
fromTable ::
  forall name columns output
  .
  KnownSymbol name
  =>
  Select columns output
fromTable :: forall (name :: Symbol) (columns :: [*]) output.
KnownSymbol name =>
Select columns output
fromTable = ([(Builder, Builder)] -> Builder) -> Select columns output
forall (columns :: [*]) output.
([(Builder, Builder)] -> Builder) -> Select columns output
unsafeMkSelect (([(Builder, Builder)] -> Builder) -> Select columns output)
-> ([(Builder, Builder)] -> Builder) -> Select columns output
forall a b. (a -> b) -> a -> b
$ \[(Builder, Builder)]
cols ->
  Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Builder, Builder)] -> Builder
forall {b}. [(Builder, b)] -> Builder
selectedColumns [(Builder, Builder)]
cols Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (name :: Symbol). KnownSymbol name => Builder
tableName @name
  where
  selectedColumns :: [(Builder, b)] -> Builder
selectedColumns =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([(Builder, b)] -> [Builder]) -> [(Builder, b)] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
", " ([Builder] -> [Builder])
-> ([(Builder, b)] -> [Builder]) -> [(Builder, b)] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Builder, b) -> Builder) -> [(Builder, b)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(Builder
name, b
_) -> Builder
name)

fromView ::
  forall name columns output params
  .
  KnownSymbol name
  =>
  (Parameters '[] -> Parameters params) -> Select columns output
fromView :: forall (name :: Symbol) (columns :: [*]) output (params :: [*]).
KnownSymbol name =>
(Parameters '[] -> Parameters params) -> Select columns output
fromView Parameters '[] -> Parameters params
interpreter = ([(Builder, Builder)] -> Builder) -> Select columns output
forall (columns :: [*]) output.
([(Builder, Builder)] -> Builder) -> Select columns output
unsafeMkSelect (([(Builder, Builder)] -> Builder) -> Select columns output)
-> ([(Builder, Builder)] -> Builder) -> Select columns output
forall a b. (a -> b) -> a -> b
$ \[(Builder, Builder)]
cols ->
  Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Builder, Builder)] -> Builder
forall {b}. [(Builder, b)] -> Builder
selectedColumns [(Builder, Builder)]
cols Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (name :: Symbol). KnownSymbol name => Builder
tableName @name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Parameters '[] -> Parameters params) -> Builder
forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters params
interpreter
  where
  selectedColumns :: [(Builder, b)] -> Builder
selectedColumns =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([(Builder, b)] -> [Builder]) -> [(Builder, b)] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
", " ([Builder] -> [Builder])
-> ([(Builder, b)] -> [Builder]) -> [(Builder, b)] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Builder, b) -> Builder) -> [(Builder, b)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(Builder
name, b
_) -> Builder
name)

fromGenerateRandom ::
  forall columns output
  .
  (UInt64, UInt64, UInt64) -> UInt64 -> Select columns output
fromGenerateRandom :: forall (columns :: [*]) output.
(UInt64, UInt64, UInt64) -> UInt64 -> Select columns output
fromGenerateRandom (UInt64
randomSeed, UInt64
maxStrLen, UInt64
maxArrayLen) UInt64
limit = Select columns output
query
  where
  query :: Select columns output
query = ([(Builder, Builder)] -> Builder) -> Select columns output
forall (columns :: [*]) output.
([(Builder, Builder)] -> Builder) -> Select columns output
unsafeMkSelect (([(Builder, Builder)] -> Builder) -> Select columns output)
-> ([(Builder, Builder)] -> Builder) -> Select columns output
forall a b. (a -> b) -> a -> b
$ \[(Builder, Builder)]
cols ->
    Builder
"SELECT * FROM generateRandom(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Builder, Builder)] -> Builder
columnsAndTypes [(Builder, Builder)]
cols Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
randomSeed Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
maxStrLen Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
maxArrayLen Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
")" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
" LIMIT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> UInt64 -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart UInt64
limit Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"

  columnsAndTypes :: [(Builder, Builder)] -> Builder
columnsAndTypes =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([(Builder, Builder)] -> [Builder])
-> [(Builder, Builder)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
", " ([Builder] -> [Builder])
-> ([(Builder, Builder)] -> [Builder])
-> [(Builder, Builder)]
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Builder, Builder) -> Builder)
-> [(Builder, Builder)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(Builder
name, Builder
tyype) -> Builder
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tyype)


-- ** INSERT

{-|
  INSERT statement generation abstraction
-}
data Insert (columns :: [Type]) output
  where
  MkInsert :: ([(Builder, Builder)] -> ChString) -> DbSettings -> Insert columns output

unsafeMkInsert :: ([(Builder, Builder)] -> Builder) -> Insert columns output
unsafeMkInsert :: forall (columns :: [*]) output.
([(Builder, Builder)] -> Builder) -> Insert columns output
unsafeMkInsert [(Builder, Builder)] -> Builder
s = ([(Builder, Builder)] -> ChString)
-> DbSettings -> Insert columns output
forall (columns :: [*]) output.
([(Builder, Builder)] -> ChString)
-> DbSettings -> Insert columns output
MkInsert (Builder -> ChString
forall chType userType.
ToChType chType userType =>
userType -> chType
toChType (Builder -> ChString)
-> ([(Builder, Builder)] -> Builder)
-> [(Builder, Builder)]
-> ChString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Builder, Builder)] -> Builder
s) ([DbSetting] -> DbSettings
MkDbSettings [])

intoTable ::
  forall name columns output
  .
  KnownSymbol name
  =>
  Insert columns output
intoTable :: forall (name :: Symbol) (columns :: [*]) output.
KnownSymbol name =>
Insert columns output
intoTable = ([(Builder, Builder)] -> Builder) -> Insert columns output
forall (columns :: [*]) output.
([(Builder, Builder)] -> Builder) -> Insert columns output
unsafeMkInsert [(Builder, Builder)] -> Builder
mkQuery
  where
  mkQuery :: [(Builder, Builder)] -> Builder
mkQuery [(Builder, Builder)]
cols =
    Builder
"INSERT INTO " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall (name :: Symbol). KnownSymbol name => Builder
tableName @name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
" (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [(Builder, Builder)] -> Builder
forall {c} {b}. (Monoid c, IsString c) => [(c, b)] -> c
mkInsertColumns [(Builder, Builder)]
cols Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") VALUES"
  mkInsertColumns :: [(c, b)] -> c
mkInsertColumns [(c, b)]
cols =
    ([c] -> c
forall a. Monoid a => [a] -> a
mconcat ([c] -> c) -> ([(c, b)] -> [c]) -> [(c, b)] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> [c] -> [c]
forall a. a -> [a] -> [a]
intersperse c
", " ([c] -> [c]) -> ([(c, b)] -> [c]) -> [(c, b)] -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c, b) -> c) -> [(c, b)] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map (\(c
name, b
_) -> c
name)) [(c, b)]
cols




-- * Parameters

type family KnownParameter param
  where
  KnownParameter (Parameter name parType) = (KnownSymbol name, IsChType parType, ToQueryPart parType)

data Parameter (name :: Symbol) (chType :: Type) = MkParamater chType

data Parameters parameters where
  NoParameters :: Parameters '[]
  AddParameter
    :: KnownParameter (Parameter name chType)
    => Parameter name chType
    -> Parameters parameters
    -> Parameters (Parameter name chType ': parameters)

{- |
>>> viewParameters (parameter @"a3" ("a3Val" :: ChString) . parameter @"a2" ("a2Val" :: ChString))
"(a3='a3Val', a2='a2Val')"
-}
viewParameters :: (Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters :: forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters passedParameters
interpreter = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Parameters passedParameters -> Builder
forall (params :: [*]). Parameters params -> Builder
renderParameters (Parameters '[] -> Parameters passedParameters
interpreter Parameters '[]
NoParameters) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

renderParameters :: Parameters params -> Builder
renderParameters :: forall (params :: [*]). Parameters params -> Builder
renderParameters Parameters params
NoParameters                      = Builder
""
renderParameters (AddParameter Parameter name chType
param Parameters parameters
NoParameters) = Parameter name chType -> Builder
forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter Parameter name chType
param
renderParameters (AddParameter Parameter name chType
param Parameters parameters
moreParams)   = Parameter name chType -> Builder
forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter Parameter name chType
param Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Parameters parameters -> Builder
forall (params :: [*]). Parameters params -> Builder
renderParameters Parameters parameters
moreParams


parameter
  :: KnownParameter (Parameter name t)
  => t -> Parameters params -> Parameters (Parameter name t ': params)
parameter :: forall (name :: Symbol) t (params :: [*]).
KnownParameter (Parameter name t) =>
t -> Parameters params -> Parameters (Parameter name t : params)
parameter t
val = Parameter name t
-> Parameters params -> Parameters (Parameter name t : params)
forall (name :: Symbol) chType (parameters :: [*]).
KnownParameter (Parameter name chType) =>
Parameter name chType
-> Parameters parameters
-> Parameters (Parameter name chType : parameters)
AddParameter (t -> Parameter name t
forall (name :: Symbol) chType. chType -> Parameter name chType
MkParamater t
val)

renderParameter :: forall name chType . KnownParameter (Parameter name chType) => Parameter name chType -> Builder
renderParameter :: forall (name :: Symbol) chType.
KnownParameter (Parameter name chType) =>
Parameter name chType -> Builder
renderParameter (MkParamater chType
chType) = (StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Proxy name -> StrictByteString) -> Proxy name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StrictByteString
BS8.pack (String -> StrictByteString)
-> (Proxy name -> String) -> Proxy name -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal @name) Proxy name
forall {k} (t :: k). Proxy t
Proxy Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> chType -> Builder
forall chType. ToQueryPart chType => chType -> Builder
toQueryPart chType
chType