git.iko.soy/rel8
on 8de0eec help sign in
rel8/src/Rel8/Statement/Select.hs
119 lines 3.5 kB history raw
1{-# language DeriveTraversable #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleContexts #-}
4{-# language MonoLocalBinds #-}
5{-# language ScopedTypeVariables #-}
6{-# language TypeApplications #-}
8module Rel8.Statement.Select
9 ( select
10 , ppSelect
12 , Optimized(..)
13 , ppPrimSelect
14 )
15where
17-- base
18import Control.Exception ( throwIO )
19import Data.Void ( Void )
20import Prelude
22-- hasql
23import Hasql.Connection ( Connection )
24import qualified Hasql.Decoders as Hasql
25import qualified Hasql.Encoders as Hasql
26import qualified Hasql.Session as Hasql
27import qualified Hasql.Statement as Hasql
29-- opaleye
30import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
31import qualified Opaleye.Internal.PrimQuery as Opaleye
32import qualified Opaleye.Internal.Print as Opaleye
33import qualified Opaleye.Internal.Optimize as Opaleye
34import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
35import qualified Opaleye.Internal.Sql as Opaleye
37-- pretty
38import Text.PrettyPrint ( Doc )
40-- rel8
41import Rel8.Expr ( Expr )
42import Rel8.Query ( Query )
43import Rel8.Query.Opaleye ( toOpaleye )
44import Rel8.Schema.Name ( Selects )
45import Rel8.Table ( Table )
46import Rel8.Table.Cols ( toCols )
47import Rel8.Table.Name ( namesFromLabels )
48import Rel8.Table.Opaleye ( castTable, exprsWithNames )
49import Rel8.Table.Serialize ( Serializable, parse )
51-- text
52import qualified Data.Text as Text
53import Data.Text.Encoding ( encodeUtf8 )
56-- | Run a @SELECT@ statement, returning all rows.
57select :: forall exprs a. Serializable exprs a
58 => Connection -> Query exprs -> IO [a]
59select c query = case ppSelect query of
60 Nothing -> pure []
61 Just doc -> Hasql.run session c >>= either throwIO pure
62 where
63 session = Hasql.statement () statement
64 statement = Hasql.Statement bytes params decode prepare
65 bytes = encodeUtf8 (Text.pack sql)
66 params = Hasql.noParams
67 decode = Hasql.rowList (parse @exprs @a)
68 prepare = False
69 sql = show doc
72ppSelect :: Table Expr a => Query a -> Maybe Doc
73ppSelect query = do
74 primQuery' <- case optimize primQuery of
75 Empty -> Nothing
76 Unit -> Just Opaleye.Unit
77 Optimized primQuery' -> Just primQuery'
78 pure $ Opaleye.ppSql $ primSelectWith names (toCols exprs) primQuery'
79 where
80 names = namesFromLabels
81 (exprs, primQuery, _) =
82 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
85ppPrimSelect :: Query a -> (Optimized Doc, a)
86ppPrimSelect query =
87 (Opaleye.ppSql . primSelect <$> optimize primQuery, a)
88 where
89 (a, primQuery, _) =
90 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
93data Optimized a = Empty | Unit | Optimized a
94 deriving stock (Functor, Foldable, Traversable)
97optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)
98optimize query = case Opaleye.removeEmpty (Opaleye.optimize query) of
99 Nothing -> Empty
100 Just Opaleye.Unit -> Unit
101 Just query' -> Optimized query'
104primSelect :: Opaleye.PrimQuery' Void -> Opaleye.Select
105primSelect = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator
108primSelectWith :: Selects names exprs
109 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
110primSelectWith names exprs query =
111 Opaleye.SelectFrom $ Opaleye.newSelect
112 { Opaleye.attrs = Opaleye.SelectAttrs attrs
113 , Opaleye.tables = Opaleye.oneTable (primSelect query)
114 }
115 where
116 attrs = makeAttr <$> exprsWithNames names (castTable exprs)
117 where
118 makeAttr (label, expr) =
119 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))