git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Statement/Select.hs
147 lines 4.6 kB history raw
1{-# language DeriveTraversable #-}
2{-# language DerivingStrategies #-}
3{-# language FlexibleContexts #-}
4{-# language MonoLocalBinds #-}
5{-# language ScopedTypeVariables #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeApplications #-}
9module Rel8.Statement.Select
10 ( select
11 , ppSelect
13 , Optimized(..)
14 , ppPrimSelect
15 , ppRows
16 )
17where
19-- base
20import Data.Foldable ( toList )
21import Data.Kind ( Type )
22import Data.Void ( Void )
23import Prelude hiding ( undefined )
25-- hasql
26import qualified Hasql.Decoders as Hasql
27import qualified Hasql.Encoders as Hasql
28import qualified Hasql.Statement as Hasql
30-- opaleye
31import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
32import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
33import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
34import qualified Opaleye.Internal.PrimQuery as Opaleye
35import qualified Opaleye.Internal.Print as Opaleye
36import qualified Opaleye.Internal.Optimize as Opaleye
37import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
38import qualified Opaleye.Internal.Sql as Opaleye hiding ( Values )
39import qualified Opaleye.Internal.Tag as Opaleye
41-- pretty
42import Text.PrettyPrint ( Doc )
44-- rel8
45import Rel8.Expr ( Expr )
46import Rel8.Expr.Bool ( false )
47import Rel8.Expr.Opaleye ( toPrimExpr )
48import Rel8.Query ( Query )
49import Rel8.Query.Opaleye ( toOpaleye )
50import Rel8.Schema.Name ( Selects )
51import Rel8.Table ( Table )
52import Rel8.Table.Cols ( toCols )
53import Rel8.Table.Name ( namesFromLabels )
54import Rel8.Table.Opaleye ( castTable, exprsWithNames )
55import qualified Rel8.Table.Opaleye as T
56import Rel8.Table.Serialize ( Serializable, parse )
57import Rel8.Table.Undefined ( undefined )
59-- text
60import qualified Data.Text as Text
61import Data.Text.Encoding ( encodeUtf8 )
64-- | Run a @SELECT@ statement, returning all rows.
65select :: forall exprs a. Serializable exprs a
66 => Query exprs -> Hasql.Statement () [a]
67select query = Hasql.Statement bytes params decode prepare
68 where
69 bytes = encodeUtf8 (Text.pack sql)
70 params = Hasql.noParams
71 decode = Hasql.rowList (parse @exprs @a)
72 prepare = False
73 sql = show doc
74 doc = ppSelect query
77ppSelect :: Table Expr a => Query a -> Doc
78ppSelect query =
79 Opaleye.ppSql $ primSelectWith names (toCols exprs') primQuery'
80 where
81 names = namesFromLabels
82 (exprs, primQuery, _) =
83 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
84 (exprs', primQuery') = case optimize primQuery of
85 Empty -> (undefined, Opaleye.Product (pure (pure Opaleye.Unit)) never)
86 Unit -> (exprs, Opaleye.Unit)
87 Optimized pq -> (exprs, pq)
88 never = pure (toPrimExpr false)
91ppRows :: Table Expr a => Query a -> Doc
92ppRows query = case optimize primQuery of
93 -- Special case VALUES because we can't use DEFAULT inside a SELECT
94 Optimized (Opaleye.Values symbols rows)
95 | eqSymbols symbols (toList (T.exprs a)) ->
96 Opaleye.ppValues_ (map Opaleye.sqlExpr <$> toList rows)
97 _ -> ppSelect query
98 where
99 (a, primQuery, _) = Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
101 eqSymbols (symbol : symbols) (Opaleye.AttrExpr symbol' : exprs)
102 | eqSymbol symbol symbol' = eqSymbols symbols exprs
103 | otherwise = False
104 eqSymbols [] [] = True
105 eqSymbols _ _ = False
107 eqSymbol
108 (Opaleye.Symbol name (Opaleye.UnsafeTag tag))
109 (Opaleye.Symbol name' (Opaleye.UnsafeTag tag'))
110 = name == name' && tag == tag'
113ppPrimSelect :: Query a -> (Optimized Doc, a)
114ppPrimSelect query =
115 (Opaleye.ppSql . primSelect <$> optimize primQuery, a)
116 where
117 (a, primQuery, _) = Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
120type Optimized :: Type -> Type
121data Optimized a = Empty | Unit | Optimized a
122 deriving stock (Functor, Foldable, Traversable, Show)
125optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)
126optimize query = case Opaleye.removeEmpty (Opaleye.optimize query) of
127 Nothing -> Empty
128 Just Opaleye.Unit -> Unit
129 Just query' -> Optimized query'
132primSelect :: Opaleye.PrimQuery' Void -> Opaleye.Select
133primSelect = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator
136primSelectWith :: Selects names exprs
137 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
138primSelectWith names exprs query =
139 Opaleye.SelectFrom $ Opaleye.newSelect
140 { Opaleye.attrs = Opaleye.SelectAttrs attrs
141 , Opaleye.tables = Opaleye.oneTable (primSelect query)
142 }
143 where
144 attrs = makeAttr <$> exprsWithNames names (castTable exprs)
145 where
146 makeAttr (label, expr) =
147 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))