git.iko.soy/rel8
on e6b7de2 help sign in
rel8/src/Rel8/Statement/View.hs
62 lines 1.8 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.Name ( Selects )
26import Rel8.Schema.Table ( TableSchema( TableSchema ) )
27import Rel8.Table.Alternative ( emptyTable )
29-- text
30import qualified Data.Text as Text
31import Data.Text.Encoding ( encodeUtf8 )
34-- | Given a 'TableSchema' and 'Query', @createView@ runs a @CREATE VIEW@
35-- statement that will save the given query as a view. This can be useful if
36-- you want to share Rel8 queries with other applications.
37createView :: Selects names exprs
38 => TableSchema names -> Query exprs -> Connection -> IO ()
39createView (TableSchema name mschema names) query =
40 Hasql.run session >=> either throwIO pure
41 where
42 session = Hasql.statement () statement
43 statement = Hasql.Statement bytes params decode prepare
44 bytes = encodeUtf8 (Text.pack sql)
45 params = Hasql.noParams
46 decode = Hasql.noResult
47 prepare = False
48 sql = "CREATE VIEW " <> title <> " WITH " <> select
49 where
50 title = case mschema of
51 Nothing -> quote name
52 Just schema -> quote schema <> "." <> quote name
53 select = fromMaybe fallback $ sqlForQueryWithNames names query
54 where
55 fallback = fold $ sqlForQueryWithNames names emptyTable
58quote :: String -> String
59quote string = "\"" <> concatMap go string <> "\""
60 where
61 go '"' = "\"\""
62 go c = [c]