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