{-# LANGUAGE
    OverloadedStrings
  , TypeFamilyDependencies
  , UndecidableInstances
#-}

module ClickHaskell.Parameters where

-- Internal
import ClickHaskell.DbTypes (ToQueryPart(..), ToChType(..))

-- GHC included
import Data.ByteString.Builder as BS (Builder, byteString)
import Data.ByteString.Char8   as BS8 (pack)
import Data.Data               (Proxy (Proxy))
import Data.Kind               (Type, Constraint)
import GHC.TypeLits            (TypeError, ErrorMessage (..), Symbol, KnownSymbol, symbolVal)
import Data.Type.Bool          (If)
import Data.Type.Equality      (type(==))

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

-- |
-- >>> parameters (parameter @"a3" @ChString ("a3Val" :: String) . parameter @"a2" @ChString ("a2Val" :: String))
-- "(a2='a2Val', a3='a3Val')"
parameters :: forall (params :: [Type]) . (Parameters '[] -> Parameters params) -> Builder
parameters :: forall (params :: [*]).
(Parameters '[] -> Parameters params) -> Builder
parameters Parameters '[] -> Parameters params
interpreter = Parameters params -> Builder
forall (parameters :: [*]). Parameters parameters -> Builder
renderParameters (Parameters params -> Builder) -> Parameters params -> Builder
forall a b. (a -> b) -> a -> b
$ Parameters '[] -> Parameters params
interpreter ([Builder] -> Parameters '[]
forall (parameters :: [*]). [Builder] -> Parameters parameters
MkParametersInterpreter [])

parameter
  :: forall name chType parameters userType
  . (InterpretableParameters parameters, ToChType chType userType, KnownSymbol name, ToQueryPart chType)
  => userType -> Parameters parameters -> WithPassedParameter (Parameter name chType) parameters
parameter :: forall (name :: Symbol) chType (parameters :: [*]) userType.
(InterpretableParameters parameters, ToChType chType userType,
 KnownSymbol name, ToQueryPart chType) =>
userType
-> Parameters parameters
-> WithPassedParameter (Parameter name chType) parameters
parameter = chType
-> Parameters parameters
-> WithPassedParameter (Parameter name chType) parameters
forall (ps :: [*]) (name :: Symbol) chType.
(InterpretableParameters ps, KnownSymbol name,
 ToQueryPart chType) =>
chType
-> Parameters ps -> WithPassedParameter (Parameter name chType) ps
forall (name :: Symbol) chType.
(KnownSymbol name, ToQueryPart chType) =>
chType
-> Parameters parameters
-> WithPassedParameter (Parameter name chType) parameters
interpretParameter (chType
 -> Parameters parameters
 -> WithPassedParameter (Parameter name chType) parameters)
-> (userType -> chType)
-> userType
-> Parameters parameters
-> WithPassedParameter (Parameter name chType) parameters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. userType -> chType
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType

renderParameters :: Parameters parameters -> Builder
renderParameters :: forall (parameters :: [*]). Parameters parameters -> Builder
renderParameters (MkParametersInterpreter (Builder
param:[Builder]
ps)) = Builder
"(" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Builder -> Builder -> Builder) -> Builder -> [Builder] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Builder
p1 Builder
p2 -> Builder
p1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
p2) Builder
param [Builder]
ps Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
renderParameters (MkParametersInterpreter [])         = Builder
""


{-# DEPRECATED ParametersInterpreter "This type would be removed in next major release. Use Parameters instead" #-}
type ParametersInterpreter a = Parameters a

newtype Parameters (parameters :: [Type]) =
  MkParametersInterpreter
    { forall (parameters :: [*]). Parameters parameters -> [Builder]
evaluatedParameters :: [Builder]
    }

class InterpretableParameters (ps :: [Type]) where
  type WithPassedParameter p ps = withPassedParameter | withPassedParameter -> ps p
  interpretParameter
    :: forall name chType
    . (KnownSymbol name, ToQueryPart chType)
    => chType -> (Parameters ps -> WithPassedParameter (Parameter name chType) ps)

instance InterpretableParameters '[]
  where
  type WithPassedParameter p '[] = Parameters '[p]
  interpretParameter
    :: forall name chType
    . (KnownSymbol name, ToQueryPart chType)
    => chType -> Parameters '[] -> WithPassedParameter (Parameter name chType) '[]
  interpretParameter :: forall (name :: Symbol) chType.
(KnownSymbol name, ToQueryPart chType) =>
chType
-> Parameters '[]
-> WithPassedParameter (Parameter name chType) '[]
interpretParameter chType
userType Parameters '[]
_ = [Builder] -> Parameters '[Parameter name chType]
forall (parameters :: [*]). [Builder] -> Parameters parameters
MkParametersInterpreter [forall (name :: Symbol) chType.
(KnownSymbol name, ToQueryPart chType) =>
chType -> Builder
renderParameter @name @chType chType
userType]

instance InterpretableParameters (x ': xs)
  where
  type WithPassedParameter p (x ': xs) = Parameters (p ': (x ': xs))
  interpretParameter
    :: forall name chType
    . (KnownSymbol name, ToQueryPart chType)
    => chType -> Parameters (x : xs) -> WithPassedParameter (Parameter name chType) (x : xs)
  interpretParameter :: forall (name :: Symbol) chType.
(KnownSymbol name, ToQueryPart chType) =>
chType
-> Parameters (x : xs)
-> WithPassedParameter (Parameter name chType) (x : xs)
interpretParameter chType
chType (MkParametersInterpreter{[Builder]
evaluatedParameters :: forall (parameters :: [*]). Parameters parameters -> [Builder]
evaluatedParameters :: [Builder]
evaluatedParameters}) =
    [Builder] -> Parameters (Parameter name chType : x : xs)
forall (parameters :: [*]). [Builder] -> Parameters parameters
MkParametersInterpreter ([Builder] -> Parameters (Parameter name chType : x : xs))
-> [Builder] -> Parameters (Parameter name chType : x : xs)
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol) chType.
(KnownSymbol name, ToQueryPart chType) =>
chType -> Builder
renderParameter @name @chType chType
chType Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
: [Builder]
evaluatedParameters

renderParameter :: forall name chType . (KnownSymbol name, ToQueryPart chType) => chType -> Builder
renderParameter :: forall (name :: Symbol) chType.
(KnownSymbol name, ToQueryPart chType) =>
chType -> Builder
renderParameter chType
chType = (ByteString -> Builder
BS.byteString (ByteString -> Builder)
-> (Proxy name -> ByteString) -> Proxy name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS8.pack (String -> ByteString)
-> (Proxy name -> String) -> Proxy name -> ByteString
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

type family CheckParameters
  (tableFunctionParams :: [Type])
  (passedParams :: [Type])
  :: Constraint
  where
  CheckParameters tfs ps = (CheckDuplicates ps, GoCheckParameters tfs ps '[] True)

type family CheckDuplicates
  (passedParams :: [Type])
  :: Constraint
  where
  CheckDuplicates '[] = ()
  CheckDuplicates (p ': ps) = (CheckParamDuplicates p ps, CheckDuplicates ps)

type family CheckParamDuplicates
  (param :: Type)
  (passedParams :: [Type])
  :: Constraint
  where
  CheckParamDuplicates _ '[] = ()
  CheckParamDuplicates (Parameter name1 chType) (Parameter name2 _ ': ps) = If
    (name1 == name2)
    (TypeError ('Text "Duplicated parameter \"" :<>: 'Text name1 :<>: 'Text "\" in passed parameters"))
    (CheckParamDuplicates (Parameter name1 chType) ps)

type family GoCheckParameters
  (tableFunctionParams :: [Type])
  (passedParams :: [Type])
  (acc :: [Type])
  (firstRound :: Bool)
  :: Constraint
  where
  GoCheckParameters '[] '[] '[] _ = ()
  GoCheckParameters (Parameter name _ ': _) '[] '[] _ = TypeError
    ('Text "Missing  \"" :<>: 'Text name :<>: 'Text "\" in passed parameters.")
  GoCheckParameters '[] (p ': _) _ _ =
    TypeError ('Text "More parameters passed than used in the view")
  GoCheckParameters '[] '[] (p ': _) _ =
    TypeError ('Text "More parameters passed than used in the view")
  GoCheckParameters (Parameter name1 _ ': ps) '[] (Parameter name2 _ ': ps') False =
    TypeError ('Text "Missing  \"" :<>: 'Text name1 :<>: 'Text "\" in passed parameters")
  GoCheckParameters (p ': ps) '[] (p' ': ps') True =
    GoCheckParameters (p ': ps) (p' ': ps') '[] False
  GoCheckParameters (Parameter name1 _ ': ps) (Parameter name1 _ ': ps') acc b =
    (GoCheckParameters ps ps' acc True)
  GoCheckParameters (Parameter name1 chType1 ': ps) (Parameter name2 chType2 ': ps') acc b =
    (GoCheckParameters (Parameter name1 chType1 ': ps) ps' (Parameter name2 chType2 ': acc) b)