git.iko.soy/rel8
on a8f61ac help sign in
rel8/src/Rel8/Statement/Select.hs
145 lines 4.6 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 , ppRows
15 )
16where
18-- base
19import Data.Foldable ( toList )
20import Data.List.NonEmpty ( NonEmpty( (:|) ) )
21import Data.Void ( Void )
22import Prelude hiding ( undefined )
24-- hasql
25import qualified Hasql.Decoders as Hasql
26import qualified Hasql.Encoders as Hasql
27import qualified Hasql.Statement as Hasql
29-- opaleye
30import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
32import qualified Opaleye.Internal.HaskellDB.Sql.Print as Opaleye
33import qualified Opaleye.Internal.PrimQuery as Opaleye
34import qualified Opaleye.Internal.Print as Opaleye
35import qualified Opaleye.Internal.Optimize as Opaleye
36import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
37import qualified Opaleye.Internal.Sql as Opaleye hiding ( Values )
38import qualified Opaleye.Internal.Tag as Opaleye
40-- pretty
41import Text.PrettyPrint ( Doc )
43-- rel8
44import Rel8.Expr ( Expr )
45import Rel8.Expr.Bool ( false )
46import Rel8.Expr.Opaleye ( toPrimExpr )
47import Rel8.Query ( Query )
48import Rel8.Query.Opaleye ( toOpaleye )
49import Rel8.Schema.Name ( Selects )
50import Rel8.Table ( Table )
51import Rel8.Table.Cols ( toCols )
52import Rel8.Table.Name ( namesFromLabels )
53import Rel8.Table.Opaleye ( castTable, exprsWithNames )
54import qualified Rel8.Table.Opaleye as T
55import Rel8.Table.Serialize ( Serializable, parse )
56import Rel8.Table.Undefined ( undefined )
58-- text
59import qualified Data.Text as Text
60import Data.Text.Encoding ( encodeUtf8 )
63-- | Run a @SELECT@ statement, returning all rows.
64select :: forall exprs a. Serializable exprs a
65 => Query exprs -> Hasql.Statement () [a]
66select query = Hasql.Statement bytes params decode prepare
67 where
68 bytes = encodeUtf8 (Text.pack sql)
69 params = Hasql.noParams
70 decode = Hasql.rowList (parse @exprs @a)
71 prepare = False
72 sql = show doc
73 doc = ppSelect query
76ppSelect :: Table Expr a => Query a -> Doc
77ppSelect query =
78 Opaleye.ppSql $ primSelectWith names (toCols exprs') primQuery'
79 where
80 names = namesFromLabels
81 (exprs, primQuery, _) =
82 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
83 (exprs', primQuery') = case optimize primQuery of
84 Empty -> (undefined, Opaleye.Product (pure (pure Opaleye.Unit)) never)
85 Unit -> (exprs, Opaleye.Unit)
86 Optimized pq -> (exprs, pq)
87 never = pure (toPrimExpr false)
90ppRows :: Table Expr a => Query a -> Doc
91ppRows query = case optimize primQuery of
92 -- Special case VALUES because we can't use DEFAULT inside a SELECT
93 Optimized (Opaleye.Product ((_, Opaleye.Values symbols rows) :| []) [])
94 | eqSymbols symbols (toList (T.exprs a)) ->
95 Opaleye.ppValues_ (map Opaleye.sqlExpr <$> toList rows)
96 _ -> ppSelect query
97 where
98 (a, primQuery, _) = Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
100 eqSymbols (symbol : symbols) (Opaleye.AttrExpr symbol' : exprs)
101 | eqSymbol symbol symbol' = eqSymbols symbols exprs
102 | otherwise = False
103 eqSymbols [] [] = True
104 eqSymbols _ _ = False
106 eqSymbol
107 (Opaleye.Symbol name (Opaleye.UnsafeTag tag))
108 (Opaleye.Symbol name' (Opaleye.UnsafeTag tag'))
109 = name == name' && tag == tag'
112ppPrimSelect :: Query a -> (Optimized Doc, a)
113ppPrimSelect query =
114 (Opaleye.ppSql . primSelect <$> optimize primQuery, a)
115 where
116 (a, primQuery, _) = Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
119data Optimized a = Empty | Unit | Optimized a
120 deriving stock (Functor, Foldable, Traversable)
123optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)
124optimize query = case Opaleye.removeEmpty (Opaleye.optimize query) of
125 Nothing -> Empty
126 Just Opaleye.Unit -> Unit
127 Just query' -> Optimized query'
130primSelect :: Opaleye.PrimQuery' Void -> Opaleye.Select
131primSelect = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator
134primSelectWith :: Selects names exprs
135 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
136primSelectWith names exprs query =
137 Opaleye.SelectFrom $ Opaleye.newSelect
138 { Opaleye.attrs = Opaleye.SelectAttrs attrs
139 , Opaleye.tables = Opaleye.oneTable (primSelect query)
140 }
141 where
142 attrs = makeAttr <$> exprsWithNames names (castTable exprs)
143 where
144 makeAttr (label, expr) =
145 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))