hssqlppp examples

1. Overview

These examples should be kept up to date, but if any are out of date, you can see the latest versions in the examples folder in the repo (the files there should definitely compile and run fine with the latest version of hssqlppp): https://github.com/JakeWheat/hssqlppp/tree/master/examples

TODO: This is a pretty bold claim…

2. Parsing

Here is a program to parse some SQL from a file and print the ast:

> import System.Environment

> import Database.HsSqlPpp.Parser

> main :: IO ()
> main = do
>   [f] <- getArgs
>   ast <- parseStatementsFromFile f
>   print ast

Given the SQL file x.sql:

select * from t;

the result is something like:

$ Parse x.sql
Right [QueryStatement (Annotation {asrc = Just ("x.sql",1,1), atype =
Nothing, errs = [], stType = Nothing, catUpd = [], fnProt = Nothing,
infType = Nothing}) (Select (Annotation {asrc = Just ("x.sql",1,1),
atype = Nothing, errs = [], stType = Nothing, catUpd = [], fnProt =
Nothing, infType = Nothing}) Dupes (SelectList (Annotation {asrc =
Just ("x.sql",1,8), atype = Nothing, errs = [], stType = Nothing,
catUpd = [], fnProt = Nothing, infType = Nothing}) [SelExp (Annotation
{asrc = Just ("x.sql",1,8), atype = Nothing, errs = [], stType =
Nothing, catUpd = [], fnProt = Nothing, infType = Nothing})
(Identifier (Annotation {asrc = Just ("x.sql",1,8), atype = Nothing,
errs = [], stType = Nothing, catUpd = [], fnProt = Nothing, infType =
Nothing}) "*")]) [Tref (Annotation {asrc = Just ("x.sql",1,15), atype
= Nothing, errs = [], stType = Nothing, catUpd = [], fnProt = Nothing,
infType = Nothing}) (SQIdentifier (Annotation {asrc = Just
("x.sql",1,15), atype = Nothing, errs = [], stType = Nothing, catUpd =
[], fnProt = Nothing, infType = Nothing}) ["t"]) (NoAlias (Annotation
{asrc = Just ("x.sql",1,16), atype = Nothing, errs = [], stType =
Nothing, catUpd = [], fnProt = Nothing, infType = Nothing}))] Nothing
[] Nothing [] Nothing Nothing)]

More readable output from this variation:

> import System.Environment

> import Language.Haskell.Exts
> import Data.Generics.Uniplate.Data

> import Database.HsSqlPpp.Parser

> main :: IO ()
> main = do
>   [f] <- getArgs
>   ast <- parseStatementsFromFile f
>   putStrLn $ showNoAnns ast

> showNoAnns :: Show a => a -> String
> showNoAnns = p stripA
>   where
>     stripA :: Exp -> Exp
>     stripA = transformBi $ \x ->
>                case x of
>                  (Paren (RecConstr (UnQual (Ident "Annotation")) _)) ->
>                           Con $ UnQual $ Ident "Ann"
>                  x1 -> x1
>     p f s =
>         case parseExp (show s) of
>           ParseOk ast -> prettyPrint (f ast)
>           x -> error $ show x

The annotation values have been replaced with the string 'Ann', and the output indented using haskell-src-exts:

$ Parse2 x.sql
Right
  [QueryStatement Ann
     (Select Ann Dupes
        (SelectList Ann [SelExp Ann (Identifier Ann "*")])
        [Tref Ann (SQIdentifier Ann ["t"]) (NoAlias Ann)]
        Nothing
        []
        Nothing
        []
        Nothing
        Nothing)]

You can see the various parsing functions in the haddock docs here: Database.HsSqlPpp.Parser

3. Typechecking

Here is a program which parses and typechecks a query and outputs the result type:

> import Database.HsSqlPpp.Parser
> import Database.HsSqlPpp.TypeChecker
> import Database.HsSqlPpp.Catalog
> import Database.HsSqlPpp.Types
> import Database.HsSqlPpp.Annotation
> import Database.HsSqlPpp.Ast

> main :: IO ()
> main = do
>   let query = "select * from t"
>       ast :: QueryExpr
>       Right ast = parseQueryExpr "" query
>       aast :: QueryExpr
>       aast = typeCheckQueryExpr cat ast
>       ann :: Annotation
>       ann = getAnnotation aast
>       ty :: Maybe Type
>       ty = atype ann
>   print ty
>   where
>     Right cat = updateCatalog defaultTemplate1Catalog
>                   [CatCreateTable "t" [("a", typeInt)
>                                       ,("b", typeInt)
>                                       ] []]

Running gives:

$ src-extra/examples/TypeCheck
Just (SetOfType (CompositeType [("a",ScalarType "int4"),("b",ScalarType "int4")]))

Typecheck against an existing database:

> import System.Environment

> import Database.HsSqlPpp.Parser
> import Database.HsSqlPpp.TypeChecker
> import Database.HsSqlPpp.Catalog
> import Database.HsSqlPpp.Types
> import Database.HsSqlPpp.Annotation
> import Database.HsSqlPpp.Ast

> import Database.HsSqlPpp.Utils.CatalogReader

> main :: IO ()
> main = do
>   [cs] <- getArgs
>   cus <- readCatalogFromDatabase cs
>   let Right cat = updateCatalog defaultCatalog cus
>       query = "select * from t"
>       ast :: QueryExpr
>       Right ast = parseQueryExpr "" query
>       aast :: QueryExpr
>       aast = typeCheckQueryExpr cat ast
>       ann :: Annotation
>       ann = getAnnotation aast
>       ty :: Maybe Type
>       ty = atype ann
>   print ty

Assume the database 'db' has the following table:

create table t (a int, b float);

$ TypeCheckDB "dbname=db"
Just (SetOfType (CompositeType [("a",ScalarType "int4"),("b",ScalarType "float8")]))

This uses some extra utils which are only available in the repo at the moment: CatalogReader

4. Show catalog

Bit rough at the moment:

> import System.Environment
> import Data.List
> import Text.Show.Pretty
> import Database.HsSqlPpp.Parser
> import Database.HsSqlPpp.TypeChecker
> import Database.HsSqlPpp.Catalog

> main :: IO ()
> main = do
>   [f] <- getArgs
>   Right ast <- parseStatementsFromFile f
>   let (cat,_) = typeCheckStatements defaultTemplate1Catalog ast
>       cc = deconstructCatalog cat \\ deconstructCatalog defaultTemplate1Catalog
>   putStrLn $ ppShow cc

Pass in the following sql file:

create table t (a int, b float);
create view v as select a from t;

$ ./ShowCatalog sc.sql
[CatCreateTable "t"
   [("a", ScalarType "int4"), ("b", ScalarType "float8")]
   [("tableoid", ScalarType "oid"), ("cmax", ScalarType "cid"),
    ("xmax", ScalarType "xid"), ("cmin", ScalarType "cid"),
    ("xmin", ScalarType "xid"), ("ctid", ScalarType "tid")],
 CatCreateView "v" [("a", ScalarType "int4")]]

5. Generating SQL

Here is a program which generates SQL:

> import Database.HsSqlPpp.Annotation
> import Database.HsSqlPpp.Ast
> import Database.HsSqlPpp.Pretty

> data MakeSelect = MakeSelect [String] String

> sqlGen :: MakeSelect -> QueryExpr
> sqlGen (MakeSelect cols tb) =
>   Select emptyAnnotation Dupes
>          sl tr
>          Nothing [] Nothing [] Nothing Nothing
>   where
>     sl = SelectList emptyAnnotation
>                     (map si cols)
>     tr = [Tref emptyAnnotation
>                (Name emptyAnnotation [Nmc tb])
>                (NoAlias emptyAnnotation)]
>     si i = SelExp emptyAnnotation
>                   (Identifier emptyAnnotation
>                               (Nmc i))

> main :: IO ()
> main = do
>   let s = MakeSelect ["a", "b"] "t"
>   putStrLn $ printQueryExpr $ sqlGen s

$ MakeSelect
select
    a, b
  from
    t;

TODO: add about use of helpers and approach in the parse test code

6. Using quasiquotes

> {-# LANGUAGE QuasiQuotes #-}
> import Database.HsSqlPpp.Ast
> import Database.HsSqlPpp.Quote
> import Database.HsSqlPpp.Annotation
> import Database.HsSqlPpp.Pretty

> test :: Statement
> test = [sqlStmt|
>
>   create table $(tablename) (
>    $(varname) $(typename)
>   );
>
>         |]
>   where
>     tablename = "my_table"
>     varname = "my_field"
>     typename = "text"

> main :: IO ()
> main = putStrLn $ printStatements [test]

The output is:

$ QQ
create table my_table (
  my_field text
);

7. Transforming SQL

The TPC-H qgen program generates the SQL queries for the TPC-H benchmarks and includes an option for SQL Server. For some reason, it doesn’t output the queries in syntax which SQL Server recognises. Here is a short program to take the qgen output and convert it into a format which SQL Server understands. (I haven’t checked carefully to see if the produced SQL is correct.)

Convert qgen output into sql server format

> {-# LANGUAGE QuasiQuotes #-}
> import Data.Generics.Uniplate.Data

> import System.Environment
> import Data.Data

> import Database.HsSqlPpp.Parser
> import Database.HsSqlPpp.Ast
> import Database.HsSqlPpp.Pretty
> import Database.HsSqlPpp.Quote
> import Database.HsSqlPpp.Annotation

> main :: IO ()
> main = do
>   [fn] <- getArgs
>   f <- readFile fn
>   putStrLn $ fixSql f

> fixSql :: String -> String
> fixSql sql =
>   let qe = either (error . show) id $ parseStatements "" sql
>       qe' = fixSqlAst qe
>   in printStatements qe'

> fixSqlAst :: Data a => a -> a
> fixSqlAst = fixDate . fixSubstring . fixExtract . fixIntervals

 dateadd(day, -90, ‘1998-12-01’)
Instead of:
 date ‘1998-12-01’ - interval ‘90’ day

> fixIntervals :: Data a => a -> a
> fixIntervals = transformBi $ \x -> case x of
>   [sqlExpr| $(a) + $(b) |] | Just (i,v,d) <- dateInfo a b ->
>      [sqlExpr| dateAdd($i(i),$(v),$s(d))|]
>   [sqlExpr| $(a) - $(b) |]| Just (i,v,d) <- dateInfo a b ->
>      [sqlExpr| dateAdd($i(i),-$(v),$s(d))|]
>   x' -> x'
>   where
>     dateInfo (TypedStringLit _ (SimpleTypeName _ "date") d)
>              (Interval _ v i _)
>              | Just i' <- lookup i [(IntervalDay,"day")
>                                    ,(IntervalMonth,"month")
>                                    ,(IntervalYear,"year")]
>              = Just (i',NumberLit emptyAnnotation v,d)
>     dateInfo _ _ = Nothing

 datepart(year,l_shipdate)
Instead of:
 extract(year from l_shipdate)

> fixExtract :: Data a => a -> a
> fixExtract = transformBi $ \x -> case x of
>   [sqlExpr| extract(year from $(expr) ) |] ->
>       [sqlExpr| datepart(year,$(expr)) |]
>   x' -> x'


 substring(c_phone,1,2)
Instead of:
 substring(c_phone from 1 for 2)

> fixSubstring :: Data a => a -> a
> fixSubstring = transformBi $ \x -> case x of
>   [sqlExpr| substring($(i) from $(a) for $(b)) |] ->
>       [sqlExpr| substring($(i),$(a),$(b)) |]
>   x' -> x'

 ‘1998-12-01’
Instead of:
 date ‘1998-12-01’

> fixDate :: Data a => a -> a
> fixDate = transformBi $ \x -> case x of
>    TypedStringLit a (SimpleTypeName _ "date") d -> StringLit a d
>    x' -> x'

Example, a Q1 query:

select
        l_returnflag,
        l_linestatus,
        sum(l_quantity) as sum_qty,
        sum(l_extendedprice) as sum_base_price,
        sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,
        sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,
        avg(l_quantity) as avg_qty,
        avg(l_extendedprice) as avg_price,
        avg(l_discount) as avg_disc,
        count(*) as count_order
from
        lineitem
where
        l_shipdate <= date '1998-12-01' - interval '63' day (3)
group by
        l_returnflag,
        l_linestatus
order by
        l_returnflag,
        l_linestatus;

Output from running the program on this sql:

select
    l_returnflag,
    l_linestatus,
    sum(l_quantity) as sum_qty,
    sum(l_extendedprice) as sum_base_price,
    sum((l_extendedprice * (1 - l_discount))) as sum_disc_price,
    sum(((l_extendedprice * (1 - l_discount)) * (1 + l_tax))) as sum_charge,
    avg(l_quantity) as avg_qty,
    avg(l_extendedprice) as avg_price,
    avg(l_discount) as avg_disc,
    count(*) as count_order
  from
    lineitem
  where
    (l_shipdate <= dateAdd(day,(- (63)),'1998-12-01'))
  group by
    l_returnflag, l_linestatus
  order by
    l_returnflag asc, l_linestatus asc;