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