git.iko.soy/rel8
on 75d7b32 help sign in
rel8/src/Rel8/Statement/Select.hs
117 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 Data.Void ( Void )
19import Prelude hiding ( undefined )
21-- hasql
22import qualified Hasql.Decoders as Hasql
23import qualified Hasql.Encoders as Hasql
24import qualified Hasql.Statement as Hasql
26-- opaleye
27import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
28import qualified Opaleye.Internal.PrimQuery as Opaleye
29import qualified Opaleye.Internal.Print as Opaleye
30import qualified Opaleye.Internal.Optimize as Opaleye
31import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
32import qualified Opaleye.Internal.Sql as Opaleye
34-- pretty
35import Text.PrettyPrint ( Doc )
37-- rel8
38import Rel8.Expr ( Expr )
39import Rel8.Expr.Bool ( false )
40import Rel8.Expr.Opaleye ( toPrimExpr )
41import Rel8.Query ( Query )
42import Rel8.Query.Opaleye ( toOpaleye )
43import Rel8.Schema.Name ( Selects )
44import Rel8.Table ( Table )
45import Rel8.Table.Cols ( toCols )
46import Rel8.Table.Name ( namesFromLabels )
47import Rel8.Table.Opaleye ( castTable, exprsWithNames )
48import Rel8.Table.Serialize ( Serializable, parse )
49import Rel8.Table.Undefined ( undefined )
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 => Query exprs -> Hasql.Statement () [a]
59select query = Hasql.Statement bytes params decode prepare
60 where
61 bytes = encodeUtf8 (Text.pack sql)
62 params = Hasql.noParams
63 decode = Hasql.rowList (parse @exprs @a)
64 prepare = False
65 sql = show doc
66 doc = ppSelect query
69ppSelect :: Table Expr a => Query a -> Doc
70ppSelect query =
71 Opaleye.ppSql $ primSelectWith names (toCols exprs') primQuery'
72 where
73 names = namesFromLabels
74 (exprs, primQuery, _) =
75 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
76 (exprs', primQuery') = case optimize primQuery of
77 Empty -> (undefined, Opaleye.Product (pure (pure Opaleye.Unit)) never)
78 Unit -> (exprs, Opaleye.Unit)
79 Optimized pq -> (exprs, pq)
80 never = pure (toPrimExpr false)
83ppPrimSelect :: Query a -> (Optimized Doc, a)
84ppPrimSelect query =
85 (Opaleye.ppSql . primSelect <$> optimize primQuery, a)
86 where
87 (a, primQuery, _) =
88 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
91data Optimized a = Empty | Unit | Optimized a
92 deriving stock (Functor, Foldable, Traversable)
95optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)
96optimize query = case Opaleye.removeEmpty (Opaleye.optimize query) of
97 Nothing -> Empty
98 Just Opaleye.Unit -> Unit
99 Just query' -> Optimized query'
102primSelect :: Opaleye.PrimQuery' Void -> Opaleye.Select
103primSelect = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator
106primSelectWith :: Selects names exprs
107 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
108primSelectWith names exprs query =
109 Opaleye.SelectFrom $ Opaleye.newSelect
110 { Opaleye.attrs = Opaleye.SelectAttrs attrs
111 , Opaleye.tables = Opaleye.oneTable (primSelect query)
112 }
113 where
114 attrs = makeAttr <$> exprsWithNames names (castTable exprs)
115 where
116 makeAttr (label, expr) =
117 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))