{-# language FlexibleContexts #-}
{-# language MonoLocalBinds #-}

module Rel8.Statement.View
  ( createView
  , createOrReplaceView
  )
where

-- base
import Prelude

-- hasql
import qualified Hasql.Decoders as Hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Statement as Hasql

-- opaleye
import qualified Opaleye.Internal.Tag as Opaleye

-- pretty
import Text.PrettyPrint ( Doc, (<+>), ($$), text )

-- rel8
import Rel8.Query ( Query )
import Rel8.Schema.Name ( Selects )
import Rel8.Schema.Table ( TableSchema )
import Rel8.Statement.Insert ( ppInto )
import Rel8.Statement.Select ( ppSelect )

-- text
import qualified Data.Text as Text
import Data.Text.Encoding ( encodeUtf8 )

-- transformers
import Control.Monad.Trans.State.Strict (evalState)


data CreateView = Create | CreateOrReplace


-- | Given a 'TableSchema' and 'Query', @createView@ runs a @CREATE VIEW@
-- statement that will save the given query as a view. This can be useful if
-- you want to share Rel8 queries with other applications.
createView :: Selects names exprs
  => TableSchema names -> Query exprs -> Hasql.Statement () ()
createView :: forall names exprs.
Selects names exprs =>
TableSchema names -> Query exprs -> Statement () ()
createView =
  CreateView -> TableSchema names -> Query exprs -> Statement () ()
forall names exprs.
Selects names exprs =>
CreateView -> TableSchema names -> Query exprs -> Statement () ()
createViewGeneric CreateView
Create


-- | Given a 'TableSchema' and 'Query', @createOrReplaceView@ runs a
-- @CREATE OR REPLACE VIEW@ statement that will save the given query
-- as a view, replacing the current view definition if it exists and
-- adheres to the restrictions in place for replacing a view in
-- PostgreSQL.
createOrReplaceView :: Selects names exprs
  => TableSchema names -> Query exprs -> Hasql.Statement () ()
createOrReplaceView :: forall names exprs.
Selects names exprs =>
TableSchema names -> Query exprs -> Statement () ()
createOrReplaceView =
  CreateView -> TableSchema names -> Query exprs -> Statement () ()
forall names exprs.
Selects names exprs =>
CreateView -> TableSchema names -> Query exprs -> Statement () ()
createViewGeneric CreateView
CreateOrReplace


createViewGeneric :: Selects names exprs
  => CreateView -> TableSchema names -> Query exprs -> Hasql.Statement () ()
createViewGeneric :: forall names exprs.
Selects names exprs =>
CreateView -> TableSchema names -> Query exprs -> Statement () ()
createViewGeneric CreateView
replace TableSchema names
schema Query exprs
query =
  ByteString -> Params () -> Result () -> Bool -> Statement () ()
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
Hasql.Statement ByteString
bytes Params ()
params Result ()
decode Bool
prepare
  where
    bytes :: ByteString
bytes = Text -> ByteString
encodeUtf8 (String -> Text
Text.pack String
sql)
    params :: Params ()
params = Params ()
Hasql.noParams
    decode :: Result ()
decode = Result ()
Hasql.noResult
    prepare :: Bool
prepare = Bool
False
    sql :: String
sql = Doc -> String
forall a. Show a => a -> String
show Doc
doc
    doc :: Doc
doc = TableSchema names -> Query exprs -> CreateView -> Doc
forall names exprs.
Selects names exprs =>
TableSchema names -> Query exprs -> CreateView -> Doc
ppCreateView TableSchema names
schema Query exprs
query CreateView
replace


ppCreateView :: Selects names exprs
  => TableSchema names -> Query exprs -> CreateView -> Doc
ppCreateView :: forall names exprs.
Selects names exprs =>
TableSchema names -> Query exprs -> CreateView -> Doc
ppCreateView TableSchema names
schema Query exprs
query CreateView
replace =
  CreateView -> Doc
createOrReplace CreateView
replace Doc -> Doc -> Doc
<+>
  TableSchema names -> Doc
forall a. Table Name a => TableSchema a -> Doc
ppInto TableSchema names
schema Doc -> Doc -> Doc
$$
  String -> Doc
text String
"AS" Doc -> Doc -> Doc
<+>
  State Tag Doc -> Tag -> Doc
forall s a. State s a -> s -> a
evalState (Query exprs -> State Tag Doc
forall a. Table Expr a => Query a -> State Tag Doc
ppSelect Query exprs
query) Tag
Opaleye.start
  where
    createOrReplace :: CreateView -> Doc
createOrReplace CreateView
Create = String -> Doc
text String
"CREATE VIEW"
    createOrReplace CreateView
CreateOrReplace = String -> Doc
text String
"CREATE OR REPLACE VIEW"