git.iko.soy/rel8
on 00a36f5 help sign in
rel8/src/Rel8/Statement/View.hs
59 lines 1.6 kB history raw
1{-# language FlexibleContexts #-}
3module Rel8.Statement.View
4 ( createView
5 )
6where
8-- base
9import Control.Exception ( throwIO )
10import Control.Monad ( (>=>) )
11import Data.Foldable ( fold )
12import Data.Maybe ( fromMaybe )
13import Prelude
15-- hasql
16import Hasql.Connection ( Connection )
17import qualified Hasql.Decoders as Hasql
18import qualified Hasql.Encoders as Hasql
19import qualified Hasql.Session as Hasql
20import qualified Hasql.Statement as Hasql
22-- rel8
23import Rel8.Query ( Query )
24import Rel8.Query.SQL ( sqlForQueryWithNames )
25import Rel8.Schema.Table ( TableSchema( TableSchema ) )
26import Rel8.Table.Alternative ( emptyTable )
27import Rel8.Table.Recontextualize ( Selects )
29-- text
30import qualified Data.Text as Text
31import Data.Text.Encoding ( encodeUtf8 )
34createView :: Selects names exprs
35 => TableSchema names -> Query exprs -> Connection -> IO ()
36createView (TableSchema name mschema names) query =
37 Hasql.run session >=> either throwIO pure
38 where
39 session = Hasql.statement () statement
40 statement = Hasql.Statement bytes params decode prepare
41 bytes = encodeUtf8 (Text.pack sql)
42 params = Hasql.noParams
43 decode = Hasql.noResult
44 prepare = False
45 sql = "CREATE VIEW " <> title <> " WITH " <> select
46 where
47 title = case mschema of
48 Nothing -> quote name
49 Just schema -> quote schema <> "." <> quote name
50 select = fromMaybe fallback $ sqlForQueryWithNames names query
51 where
52 fallback = fold $ sqlForQueryWithNames names emptyTable
55quote :: String -> String
56quote string = "\"" <> concatMap go string <> "\""
57 where
58 go '"' = "\"\""
59 go c = [c]