git.iko.soy/rel8
on eb180fa help sign in
rel8/src/Rel8/Query/SQL.hs
75 lines 2.5 kB history raw
1{-# language FlexibleContexts #-}
2{-# language TypeFamilies #-}
3{-# language ViewPatterns #-}
5module Rel8.Query.SQL
6 ( showQuery
7 , sqlForQuery, sqlForQueryWithNames
8 )
9where
11-- base
12import Data.Foldable ( fold )
13import Data.Functor.Const ( Const( Const ), getConst )
14import Data.Void ( Void )
15import Prelude
17-- opaleye
18import qualified Opaleye.Internal.HaskellDB.Sql as Opaleye
19import qualified Opaleye.Internal.PrimQuery as Opaleye
20import qualified Opaleye.Internal.Print as Opaleye
21import qualified Opaleye.Internal.Optimize as Opaleye
22import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
23import qualified Opaleye.Internal.Sql as Opaleye
25-- rel8
26import Rel8.Expr ( Expr )
27import Rel8.Expr.Opaleye ( toPrimExpr )
28import Rel8.Query ( Query )
29import Rel8.Query.Opaleye ( toOpaleye )
30import qualified Rel8.Query.Optimize as Rel8 ( optimize )
31import Rel8.Schema.Context ( Col'(..), Name( Name ) )
32import Rel8.Schema.HTable ( htabulateA, hfield )
33import Rel8.Table ( Table, toColumns )
34import Rel8.Table.Name ( namesFromLabels )
35import Rel8.Table.Recontextualize ( Selects )
38-- | Convert a query to a 'String' containing the query as a @SELECT@
39-- statement.
40showQuery :: Table Expr a => Query a -> String
41showQuery = fold . sqlForQuery
44sqlForQuery :: Table Expr a
45 => Query a -> Maybe String
46sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toColumns
49sqlForQueryWithNames :: Selects names exprs
50 => names -> Query exprs -> Maybe String
51sqlForQueryWithNames names query =
52 show . Opaleye.ppSql . selectFrom names exprs <$> optimize primQuery
53 where
54 (exprs, primQuery, _) =
55 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
58optimize :: Opaleye.PrimQuery' a -> Maybe (Opaleye.PrimQuery' Void)
59optimize = Opaleye.removeEmpty . Rel8.optimize . Opaleye.optimize
62selectFrom :: Selects names exprs
63 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
64selectFrom (toColumns -> names) (toColumns -> exprs) query =
65 Opaleye.SelectFrom $ Opaleye.newSelect
66 { Opaleye.attrs = Opaleye.SelectAttrs attributes
67 , Opaleye.tables = Opaleye.oneTable select
68 }
69 where
70 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query
71 attributes = getConst $ htabulateA $ \field -> case hfield names field of
72 Col (Name name) -> case hfield exprs field of
73 DB (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))
74 makeAttr label expr =
75 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))