Merge pull request #21 from stefan-hoeck/as

[ new ] named expressions in queries

src/Sqlite3/Cmd.idr

@@ -207,6 +207,44 @@ record OrderingTerm (s : Schema) where
   coll : Collation tpe
   asc  : AscDesc
 
+public export
+record GroupingTerm (s : Schema) where
+  constructor G
+  {0 tpe : SqliteType}
+  expr : Expr s tpe
+  coll : Collation tpe
+
+public export %inline
+ord : GroupingTerm s -> OrderingTerm s
+ord (G x c) = O x c NoAsc
+
+public export
+record NamedExpr (s : Schema) (t : SqliteType) where
+  constructor AS
+  expr : Expr s t
+  name : String
+
+public export %inline
+fromString :
+     {s        : Schema}
+  -> (col      : String)
+  -> {auto 0 p : IsJust (FindSchemaCol col s)}
+  -> NamedExpr s (SchemaColType col s)
+fromString col = C col `AS` ""
+
+public export
+ExprColumns : {ts : _} -> LAll (NamedExpr s) ts -> List Column
+ExprColumns             []              = []
+ExprColumns             (AS _ "" :: xs) = ExprColumns xs
+ExprColumns {ts = t::_} (AS _ n  :: xs) = C n t :: ExprColumns xs
+
+public export
+ExprSchema : {s : _} -> {ts : _} -> LAll (NamedExpr s) ts -> Schema
+ExprSchema xs =
+  case ExprColumns xs of
+    [] => s
+    cs => s :< T "" "" cs
+
 ||| Different types of `SELECT` commands.
 public export
 record Query (t : Type) where
@@ -215,11 +253,11 @@ record Query (t : Type) where
   {auto asRow : AsRow t}
   schema      : Schema
   from        : From schema
-  columns     : LAll (Expr schema) (RowTypes t)
-  where_      : Expr schema BOOL
-  having      : Expr schema BOOL
-  group_by    : List (OrderingTerm schema)
-  order_by    : List (OrderingTerm schema)
+  columns     : LAll (NamedExpr schema) (RowTypes t)
+  where_      : Expr (ExprSchema columns) BOOL
+  having      : Expr (ExprSchema columns) BOOL
+  group_by    : List (GroupingTerm (ExprSchema columns))
+  order_by    : List (OrderingTerm (ExprSchema columns))
   limit       : Maybe Nat
   offset      : Nat
 
@@ -234,23 +272,23 @@ LQuery = Query . HList
 infixl 7 `GROUP_BY`,`ORDER_BY`,`WHERE`, `LIMIT`, `OFFSET`, `HAVING`
 
 public export %inline
-SELECT : {s : _} -> AsRow t => LAll (Expr s) (RowTypes t) -> From s -> Query t
+SELECT : {s : _} -> AsRow t => LAll (NamedExpr s) (RowTypes t) -> From s -> Query t
 SELECT xs from = Q s from xs TRUE TRUE [] [] Nothing 0
 
 public export %inline
-GROUP_BY : (q : Query t) -> List (OrderingTerm q.schema) -> Query t
-GROUP_BY q os = {group_by := os} q
+GROUP_BY : (q : Query t) -> List (GroupingTerm $ ExprSchema q.columns) -> Query t
+GROUP_BY q gs = {group_by := gs} q
 
 public export %inline
-WHERE : (q : Query t) -> Expr q.schema BOOL -> Query t
+WHERE : (q : Query t) -> Expr (ExprSchema q.columns) BOOL -> Query t
 WHERE q p = {where_ := p} q
 
 public export %inline
-HAVING : (q : Query t) -> Expr q.schema BOOL -> Query t
+HAVING : (q : Query t) -> Expr (ExprSchema q.columns) BOOL -> Query t
 HAVING q p = {having := p} q
 
 public export %inline
-ORDER_BY : (q : Query t) -> List (OrderingTerm q.schema) -> Query t
+ORDER_BY : (q : Query t) -> List (OrderingTerm (ExprSchema q.columns)) -> Query t
 ORDER_BY q os = {order_by := os} q
 
 public export %inline

src/Sqlite3/Parameter.idr

@@ -204,6 +204,13 @@ exprs sc (c::cs) = do
   s <- encodeExprP c
   exprs (sc :< s) cs
 
+namedExprs : SnocList String -> LAll (NamedExpr s) ts -> ParamStmt
+namedExprs sc []      = pure $ commaSep id (sc <>> [])
+namedExprs sc (AS c n::cs) = do
+  s <- encodeExprP c
+  let s2 := if n == "" then s else "\{s} AS \{n}"
+  namedExprs (sc :< s2) cs
+
 updateVals : SnocList String -> List (Val t) -> ParamStmt
 updateVals sc []        = pure $ commaSep id (sc <>> [])
 updateVals sc (x :: xs) = do
@@ -312,10 +319,10 @@ encodeHaving x    = do
 export
 encodeQuery : Query ts -> ParamStmt
 encodeQuery (Q _ from vs where_ having group_by order_by lim off) = do
-  vstr <- exprs [<] vs
+  vstr <- namedExprs [<] vs
   fstr <- encodeFrom from
   wh   <- encodeExprP where_
   hav  <- encodeHaving having
-  grp  <- encodeOrd "GROUP BY" group_by
+  grp  <- encodeOrd "GROUP BY" (map ord group_by)
   ord  <- encodeOrd "ORDER BY" order_by
   pure "SELECT \{vstr} \{fstr} WHERE \{wh} \{grp} \{hav} \{ord} \{limit lim off}"

src/Sqlite3/Table.idr

@@ -111,20 +111,22 @@ FindSchemaCol2 t c [<]       = Nothing
 FindSchemaCol2 t c (sx :< x) =
   if x.as == t then FindCol c x.cols else FindSchemaCol2 t c sx
 
+public export
+FindSchemaCol1 : String -> Schema -> Maybe SqliteType
+FindSchemaCol1 n [< t]           = FindCol n t.cols
+FindSchemaCol1 n (_:<T "" "" cs) = FindCol n cs
+FindSchemaCol1 n _               = Nothing
+
 ||| Looks up a table and column name in a schema.
 |||
 ||| In case the schema has only one table, a column can be
 ||| looked up just by its name, otherwise in needs to be
 ||| prefixed by the table name separated by a dot.
 public export
 FindSchemaCol : String -> Schema -> Maybe SqliteType
-FindSchemaCol str [<tbl] =
-  case split ('.' ==) str of
-    n:::[]  => FindCol n tbl.cols
-    t:::[n] => FindSchemaCol2 t n [<tbl]
-    _       => Nothing
 FindSchemaCol str s =
   case split ('.' ==) str of
+    n:::[]  => FindSchemaCol1 n s
     t:::[n] => FindSchemaCol2 t n s
     _       => Nothing
 

test/src/Schema.idr

@@ -194,13 +194,18 @@ export
 unitStats : LQuery [String,Bits32,Double,Double,Double]
 unitStats =
   SELECT
-    ["u.name", Count "e.name", Avg "e.salary", Min "e.salary", Max "e.salary"]
+    [ "u.name"
+    ,  Count "e.name" `AS` "num_employees"
+    ,  Avg "e.salary" `AS` "average_salary"
+    ,  Min "e.salary" `AS` "min_salary"
+    ,  Max "e.salary" `AS` "max_salary"
+    ]
     [< FROM (Employees `AS` "e")
     ,  JOIN (Units `AS` "u") `USING` ["unit_id"]
     ]
-    `GROUP_BY` [O "e.unit_id" None NoAsc]
-    `HAVING`   (Count "e.name" > 3)
-    `ORDER_BY` [O (Avg "e.salary") None ASC]
+    `GROUP_BY` [G "e.unit_id" None]
+    `HAVING`   ("num_employees" > 3)
+    `ORDER_BY` [O "average_salary" None ASC]
 
 export
 heads : Query (OrgUnit String)