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

module Rel8.Statement.View
  ( createView
  )
where

-- base
import Control.Exception ( throwIO )
import Control.Monad ( (>=>) )
import Data.Foldable ( fold )
import Data.Maybe ( fromMaybe )
import Prelude

-- hasql
import Hasql.Connection ( Connection )
import qualified Hasql.Decoders as Hasql
import qualified Hasql.Encoders as Hasql
import qualified Hasql.Session as Hasql
import qualified Hasql.Statement as Hasql

-- rel8
import Rel8.Query ( Query )
import Rel8.Query.SQL ( sqlForQueryWithNames )
import Rel8.Schema.Name ( Selects )
import Rel8.Schema.Table ( TableSchema( TableSchema ) )
import Rel8.Table.Alternative ( emptyTable )

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


-- | 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 -> Connection -> IO ()
createView :: TableSchema names -> Query exprs -> Connection -> IO ()
createView (TableSchema String
name Maybe String
mschema names
names) Query exprs
query =
  Session () -> Connection -> IO (Either QueryError ())
forall a. Session a -> Connection -> IO (Either QueryError a)
Hasql.run Session ()
session (Connection -> IO (Either QueryError ()))
-> (Either QueryError () -> IO ()) -> Connection -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (QueryError -> IO ())
-> (() -> IO ()) -> Either QueryError () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either QueryError -> IO ()
forall e a. Exception e => e -> IO a
throwIO () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    session :: Session ()
session = () -> Statement () () -> Session ()
forall params result.
params -> Statement params result -> Session result
Hasql.statement () Statement () ()
statement
    statement :: Statement () ()
statement = 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
    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 = String
"CREATE VIEW " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
title String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" AS " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
select
      where
        title :: String
title = case Maybe String
mschema of
          Maybe String
Nothing -> String -> String
quote String
name
          Just String
schema -> String -> String
quote String
schema String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
quote String
name
    select :: String
select = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
fallback (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ names -> Query exprs -> Maybe String
forall names exprs.
Selects names exprs =>
names -> Query exprs -> Maybe String
sqlForQueryWithNames names
names Query exprs
query
      where
        fallback :: String
fallback = Maybe String -> String
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ names -> Query exprs -> Maybe String
forall names exprs.
Selects names exprs =>
names -> Query exprs -> Maybe String
sqlForQueryWithNames names
names Query exprs
forall (f :: * -> *) a. (AlternativeTable f, Table Expr a) => f a
emptyTable


quote :: String -> String
quote :: String -> String
quote String
string = String
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
go String
string String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""
  where
    go :: Char -> String
go Char
'"' = String
"\"\""
    go Char
c = [Char
c]