{-# LANGUAGE OverloadedStrings #-}

module Hasql.Interpolate.Internal.Sql
  ( Sql (..),
  )
where

import Control.Monad.Trans.State.Strict
import Data.ByteString.Builder
import Data.String (IsString (..))
import Hasql.Encoders

-- | A SQL string with interpolated expressions.
data Sql = Sql
  { -- | The sql string. It is stateful over an 'Int' in order to
    -- assign the postgresql parameter placeholders (e.g. @$1@, @$2@)
    Sql -> State Int Builder
sqlTxt :: State Int Builder,
    -- | The encoders associated with the sql string. Already applied
    -- to their parameters.
    Sql -> Params ()
encoder :: Params ()
  }

instance IsString Sql where
  fromString :: String -> Sql
fromString String
str = State Int Builder -> Params () -> Sql
Sql (Builder -> State Int Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Builder
stringUtf8 String
str)) Params ()
forall a. Monoid a => a
mempty

instance Semigroup Sql where
  Sql
a <> :: Sql -> Sql -> Sql
<> Sql
b =
    Sql :: State Int Builder -> Params () -> Sql
Sql
      { sqlTxt :: State Int Builder
sqlTxt =
          ( Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> State Int Builder -> StateT Int Identity (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sql -> State Int Builder
sqlTxt Sql
a StateT Int Identity (Builder -> Builder)
-> State Int Builder -> State Int Builder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sql -> State Int Builder
sqlTxt Sql
b
          ),
        encoder :: Params ()
encoder = Sql -> Params ()
encoder Sql
a Params () -> Params () -> Params ()
forall a. Semigroup a => a -> a -> a
<> Sql -> Params ()
encoder Sql
b
      }
  {-# INLINE (<>) #-}

instance Monoid Sql where
  mempty :: Sql
mempty =
    Sql :: State Int Builder -> Params () -> Sql
Sql
      { sqlTxt :: State Int Builder
sqlTxt = Builder -> State Int Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty,
        encoder :: Params ()
encoder = Params ()
forall a. Monoid a => a
mempty
      }
  {-# INLINE mempty #-}