git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Statement/View.hs
63 lines 1.9 kB history raw
1{-# language FlexibleContexts #-}
2{-# language MonoLocalBinds #-}
4module Rel8.Statement.View
5 ( createView
6 )
7where
9-- base
10import Control.Exception ( throwIO )
11import Control.Monad ( (>=>) )
12import Data.Foldable ( fold )
13import Data.Maybe ( fromMaybe )
14import Prelude
16-- hasql
17import Hasql.Connection ( Connection )
18import qualified Hasql.Decoders as Hasql
19import qualified Hasql.Encoders as Hasql
20import qualified Hasql.Session as Hasql
21import qualified Hasql.Statement as Hasql
23-- rel8
24import Rel8.Query ( Query )
25import Rel8.Query.SQL ( sqlForQueryWithNames )
26import Rel8.Schema.Name ( Selects )
27import Rel8.Schema.Table ( TableSchema( TableSchema ) )
28import Rel8.Table.Alternative ( emptyTable )
30-- text
31import qualified Data.Text as Text
32import Data.Text.Encoding ( encodeUtf8 )
35-- | Given a 'TableSchema' and 'Query', @createView@ runs a @CREATE VIEW@
36-- statement that will save the given query as a view. This can be useful if
37-- you want to share Rel8 queries with other applications.
38createView :: Selects names exprs
39 => TableSchema names -> Query exprs -> Connection -> IO ()
40createView (TableSchema name mschema names) query =
41 Hasql.run session >=> either throwIO pure
42 where
43 session = Hasql.statement () statement
44 statement = Hasql.Statement bytes params decode prepare
45 bytes = encodeUtf8 (Text.pack sql)
46 params = Hasql.noParams
47 decode = Hasql.noResult
48 prepare = False
49 sql = "CREATE VIEW " <> title <> " AS " <> select
50 where
51 title = case mschema of
52 Nothing -> quote name
53 Just schema -> quote schema <> "." <> quote name
54 select = fromMaybe fallback $ sqlForQueryWithNames names query
55 where
56 fallback = fold $ sqlForQueryWithNames names emptyTable
59quote :: String -> String
60quote string = "\"" <> concatMap go string <> "\""
61 where
62 go '"' = "\"\""
63 go c = [c]