git.iko.soy/rel8
on 2a89918 help sign in
rel8/src/Rel8/Query/SQL.hs
73 lines 2.4 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, Col(..) )
27import Rel8.Expr.Opaleye ( toPrimExpr )
28import Rel8.Query ( Query )
29import Rel8.Query.Opaleye ( toOpaleye )
30import Rel8.Schema.Name ( Selects, Col(..) )
31import Rel8.Schema.HTable ( htabulateA, hfield )
32import Rel8.Table ( Table, toColumns )
33import Rel8.Table.Name ( namesFromLabels )
36-- | Convert a query to a 'String' containing the query as a @SELECT@
37-- statement.
38showQuery :: Table Expr a => Query a -> String
39showQuery = fold . sqlForQuery
42sqlForQuery :: Table Expr a
43 => Query a -> Maybe String
44sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toColumns
47sqlForQueryWithNames :: Selects names exprs
48 => names -> Query exprs -> Maybe String
49sqlForQueryWithNames names query =
50 show . Opaleye.ppSql . selectFrom names exprs <$> optimize primQuery
51 where
52 (exprs, primQuery, _) =
53 Opaleye.runSimpleQueryArrStart (toOpaleye query) ()
56optimize :: Opaleye.PrimQuery' a -> Maybe (Opaleye.PrimQuery' Void)
57optimize = Opaleye.removeEmpty . Opaleye.optimize
60selectFrom :: Selects names exprs
61 => names -> exprs -> Opaleye.PrimQuery' Void -> Opaleye.Select
62selectFrom (toColumns -> names) (toColumns -> exprs) query =
63 Opaleye.SelectFrom $ Opaleye.newSelect
64 { Opaleye.attrs = Opaleye.SelectAttrs attributes
65 , Opaleye.tables = Opaleye.oneTable select
66 }
67 where
68 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query
69 attributes = getConst $ htabulateA $ \field -> case hfield names field of
70 NameCol name -> case hfield exprs field of
71 DB (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))
72 makeAttr label expr =
73 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))