add haddock, reorder the fields in binop and jointref to be more natural

Language/SQL/SimpleSQL/Parser.lhs

@@ -1,6 +1,5 @@
 
-The parser code
+> -- | This is the module with the parser functions.
-
 > module Language.SQL.SimpleSQL.Parser
 >     (parseQueryExpr
 >     ,parseScalarExpr
@@ -363,7 +362,7 @@ associativity.
 
 > binaryOperatorSuffix :: Bool -> ScalarExpr -> P ScalarExpr
 > binaryOperatorSuffix bExpr e0 =
->     BinOp <$> opSymbol <*> return e0 <*> factor
+>     BinOp e0 <$> opSymbol <*> factor
 >   where
 >     opSymbol = choice
 >         (map (try . symbol) binOpSymbolNames
@@ -492,17 +491,16 @@ tref
 >         in option j (JoinAlias j <$> try tableAlias <*> try columnAliases)
 >     joinTrefSuffix t = (do
 >          nat <- option False $ try (True <$ (try $ keyword_ "natural"))
->          JoinTableRef <$> joinType
+>          JoinTableRef t <$> joinType
->                       <*> return t
 >                         <*> nonJoinTref
 >                         <*> optionMaybe (joinCondition nat))
 >         >>= optionSuffix joinTrefSuffix
 >     joinType = choice
->                [Cross <$ try (keyword_ "cross")
+>                [JCross <$ try (keyword_ "cross")
->                ,Inner <$ try (keyword_ "inner")
+>                ,JInner <$ try (keyword_ "inner")
 >                ,choice [JLeft <$ try (keyword_ "left")
 >                        ,JRight <$ try (keyword_ "right")
->                        ,Full <$ try (keyword_ "full")]
+>                        ,JFull <$ try (keyword_ "full")]
 >                 <* optional (try $ keyword_ "outer")]
 >                <* keyword "join"
 >     joinCondition nat =

Language/SQL/SimpleSQL/Pretty.lhs

@@ -2,6 +2,7 @@
 This is the pretty printer code which takes AST values and turns them
 back into SQL source text. It attempts to format the output nicely.
 
+> -- | These is the pretty printing functions, which produce SQL source from ASTs. The code attempts to format the output in a readable way.
 > module Language.SQL.SimpleSQL.Pretty
 >     (prettyQueryExpr
 >     ,prettyScalarExpr
@@ -12,14 +13,17 @@ back into SQL source text. It attempts to format the output nicely.
 > import Text.PrettyPrint
 > import Data.Maybe
 
+> -- | Convert a query expr ast to concrete syntax.
 > prettyQueryExpr :: QueryExpr -> String
 > prettyQueryExpr = render . queryExpr
 
+> -- | Convert a scalar expr ast to concrete syntax.
 > prettyScalarExpr :: ScalarExpr -> String
 > prettyScalarExpr = render . scalarExpr
 
+> -- | Convert a list of query exprs to concrete syntax. A semi colon is inserted following each query expr.
 > prettyQueryExprs :: [QueryExpr] -> String
-> prettyQueryExprs = render . vcat . map ((<> text ";") . queryExpr)
+> prettyQueryExprs = render . vcat . map ((<> text ";\n") . queryExpr)
 
 = scalar expressions
 
@@ -75,9 +79,9 @@ back into SQL source text. It attempts to format the output nicely.
 
 > scalarExpr (PrefixOp f e) = text f <+> scalarExpr e
 > scalarExpr (PostfixOp f e) = scalarExpr e <+> text f
-> scalarExpr (BinOp "and" e0 e1) =
+> scalarExpr (BinOp e0 "and" e1) =
 >     sep [scalarExpr e0, text "and" <+> scalarExpr e1]
-> scalarExpr (BinOp f e0 e1) =
+> scalarExpr (BinOp e0 f e1) =
 >     scalarExpr e0 <+> text f <+> scalarExpr e1
 
 > scalarExpr (Case t ws els) =
@@ -171,7 +175,7 @@ back into SQL source text. It attempts to format the output nicely.
 >         <+> maybe empty (parens . commaSep . map text) cs
 >     tr (JoinParens t) = parens $ tr t
 >     tr (JoinQueryExpr q) = parens $ queryExpr q
->     tr (JoinTableRef jt t0 t1 jc) =
+>     tr (JoinTableRef t0 jt t1 jc) =
 >        sep [tr t0
 >            ,joinText jt jc
 >            ,tr t1
@@ -181,11 +185,11 @@ back into SQL source text. It attempts to format the output nicely.
 >               Just JoinNatural -> text "natural"
 >               _ -> empty
 >           ,case jt of
->               Inner -> text "inner"
+>               JInner -> text "inner"
 >               JLeft -> text "left"
 >               JRight -> text "right"
->               Full -> text "full"
+>               JFull -> text "full"
->               Cross -> text "cross"
+>               JCross -> text "cross"
 >           ,text "join"]
 >     joinCond (Just (JoinOn e)) = text "on" <+> scalarExpr e
 >     joinCond (Just (JoinUsing es)) = text "using" <+> parens (commaSep $ map text es)

Language/SQL/SimpleSQL/Syntax.lhs

@@ -1,21 +1,25 @@
 
+> -- | The AST for SQL queries
 > module Language.SQL.SimpleSQL.Syntax
->     (ScalarExpr(..)
+>     (-- * Scalar expressions
+>      ScalarExpr(..)
 >     ,TypeName(..)
->     ,SubQueryExprType(..)
->     ,InThing(..)
->     ,QueryExpr(..)
->     ,makeSelect
 >     ,Duplicates(..)
 >     ,Direction(..)
+>     ,InThing(..)
+>     ,SubQueryExprType(..)
+>      -- * Query expressions
+>     ,QueryExpr(..)
+>     ,makeSelect
 >     ,CombineOp(..)
 >     ,Corresponding(..)
+>      -- ** From
 >     ,TableRef(..)
 >     ,JoinType(..)
 >     ,JoinCondition(..)
 >     ) where
 
-
+> -- | Represents a scalar expression
 > data ScalarExpr = NumLit String
 >                 | StringLit String
 >                 | IntervalLit String -- text of interval
@@ -34,7 +38,7 @@
 >                   -- are used for symbol and keyword operators
 >                   -- these are used even for the multiple keyword
 >                   -- operators
->                 | BinOp String ScalarExpr ScalarExpr
+>                 | BinOp ScalarExpr String ScalarExpr
 >                 | PrefixOp String ScalarExpr
 >                 | PostfixOp String ScalarExpr
 >                   -- the special op is used for ternary, mixfix and other non orthodox operators
@@ -51,13 +55,23 @@
 >                   deriving (Eq,Show)
 
 > data TypeName = TypeName String deriving (Eq,Show)
+
+
+> -- Represents 'expr in (scalar expression list)', and 'expr in
+> -- (subquery)' syntax
 > data InThing = InList [ScalarExpr]
 >              | InQueryExpr QueryExpr
 >              deriving (Eq,Show)
 
+> -- | A subquery in a scalar expression
 > data SubQueryExprType = SqExists | SqSq | SqAll | SqSome | SqAny
 >                         deriving (Eq,Show)
 
+> -- | Represents a query expression, which can be a select, a 'set
+> -- operator' (union/except/intersect), a common table expression
+> -- (with), a values expression (not yet supported) or the table
+> -- syntax - 'table t', shorthand for 'select * from t' (not yet
+> -- supported).
 > data QueryExpr
 >     = Select
 >       {qeDuplicates :: Duplicates
@@ -84,11 +98,20 @@ TODO: add queryexpr parens to deal with e.g.
 (select 1 union select 2) union select 3
 I'm not sure if this is valid syntax or not
 
+
+> -- | represents the Distinct or All keywords, which can be used
+> -- before a select list, in an aggregate/window function
+> -- application, or in a query expression 'set operator'
 > data Duplicates = Distinct | All deriving (Eq,Show)
+
+> -- | The direction for a column in order by.
 > data Direction = Asc | Desc deriving (Eq,Show)
+> -- | Query expression 'set operators'
 > data CombineOp = Union | Except | Intersect deriving (Eq,Show)
+> -- | Corresponding, an option for the 'set operators'
 > data Corresponding = Corresponding | Respectively deriving (Eq,Show)
 
+> -- | helper/'default' value for query exprs to make creating query expr values a little easier
 > makeSelect :: QueryExpr
 > makeSelect = Select {qeDuplicates = All
 >                     ,qeSelectList = []
@@ -100,21 +123,22 @@ I'm not sure if this is valid syntax or not
 >                     ,qeLimit = Nothing
 >                     ,qeOffset = Nothing}
 
-
+> -- | Represents a entry in the csv of tables in the from clause.
-> data TableRef = SimpleTableRef String
+> data TableRef = SimpleTableRef String -- from t
->               | JoinTableRef JoinType TableRef TableRef (Maybe JoinCondition)
+>               | JoinTableRef TableRef JoinType TableRef (Maybe JoinCondition) -- from a join b
->               | JoinParens TableRef
+>               | JoinParens TableRef -- from (a)
->               | JoinAlias TableRef String (Maybe [String])
+>               | JoinAlias TableRef String (Maybe [String]) -- from a as b(c,d)
->               | JoinQueryExpr QueryExpr
+>               | JoinQueryExpr QueryExpr -- from (query expr)
 >                 deriving (Eq,Show)
 
 TODO: add function table ref
 
-
+> -- | The type of a join
-> data JoinType = Inner | JLeft | JRight | Full | Cross
+> data JoinType = JInner | JLeft | JRight | JFull | JCross
 >                 deriving (Eq,Show)
 
-> data JoinCondition = JoinOn ScalarExpr
+> -- | The join condition.
->                    | JoinUsing [String]
+> data JoinCondition = JoinOn ScalarExpr -- ^ on expr
->                    | JoinNatural
+>                    | JoinUsing [String] -- ^ using (column list)
+>                    | JoinNatural -- ^ natural join was specified
 >                      deriving (Eq,Show)

PrettyIt.lhs

@@ -12,6 +12,6 @@
 >       [f] -> do
 >              src <- readFile f
 >              either (error . peFormattedError)
->                     (putStrLn . intercalate "\n" . map prettyQueryExpr)
+>                     (putStrLn . prettyQueryExprs)
 >                     $ parseQueryExprs f Nothing src
 >       _ -> error "please pass filename to prettify"

TODO

@@ -2,13 +2,12 @@
 
 first release:
 
-tests for the queryexprs parser
 check the pretty printer on the tpch queries
 fix the fixity issue
 add automated tests to cabal
 do code documentation and haddock
   check the order of exports, imports and functions/cases in the files
-fix up the import namespaces/explicit names nicelyx
+fix up the import namespaces/explicit names nicely
 do some tests for parse errors?
 website with haddock and table of parsing tests
 

Tests.lhs

@@ -78,8 +78,8 @@
 >      ,Case (Just $ Iden "a") [(NumLit "1", NumLit "2")
 >                                    ,(NumLit "3", NumLit "4")] (Just $ NumLit "5"))
 >     ,("case when a=1 then 2 when a=3 then 4 else 5 end"
->      ,Case Nothing [(BinOp "=" (Iden "a") (NumLit "1"), NumLit "2")
+>      ,Case Nothing [(BinOp (Iden "a") "=" (NumLit "1"), NumLit "2")
->                    ,(BinOp "=" (Iden "a") (NumLit "3"), NumLit "4")]
+>                    ,(BinOp (Iden "a") "=" (NumLit "3"), NumLit "4")]
 >                    (Just $ NumLit "5"))
 >     ]
 
@@ -92,7 +92,7 @@
 
 > binaryOperators :: TestItem
 > binaryOperators = Group "binaryOperators" $ map (uncurry TestScalarExpr)
->     [("a + b", BinOp "+" (Iden "a") (Iden "b"))
+>     [("a + b", BinOp (Iden "a") "+" (Iden "b"))
 >      -- sanity check fixities
 >      -- todo: add more fixity checking
 >     {-,("a + b * c"
@@ -134,11 +134,11 @@
 >     ,("a not in (select a from t)"
 >      ,In False (Iden "a") (InQueryExpr ms))
 >     ,("a > all (select a from t)"
->      ,BinOp ">" (Iden "a") (SubQueryExpr SqAll ms))
+>      ,BinOp (Iden "a") ">" (SubQueryExpr SqAll ms))
 >     ,("a = some (select a from t)"
->      ,BinOp "=" (Iden "a") (SubQueryExpr SqSome ms))
+>      ,BinOp (Iden "a") "=" (SubQueryExpr SqSome ms))
 >     ,("a <= any (select a from t)"
->      ,BinOp "<=" (Iden "a") (SubQueryExpr SqAny ms))
+>      ,BinOp (Iden "a") "<=" (SubQueryExpr SqAny ms))
 >     ]
 >   where
 >     ms = makeSelect
@@ -164,13 +164,15 @@
 >     ,("a is not false", PostfixOp "is not false" (Iden "a"))
 >     ,("a is unknown", PostfixOp "is unknown" (Iden "a"))
 >     ,("a is not unknown", PostfixOp "is not unknown" (Iden "a"))
->     ,("a is distinct from b", BinOp "is distinct from" (Iden "a") (Iden "b"))
+>     ,("a is distinct from b", BinOp (Iden "a") "is distinct from"(Iden "b"))
->     ,("a is not distinct from b", BinOp "is not distinct from" (Iden "a") (Iden "b"))
+>     ,("a is not distinct from b"
->     ,("a like b", BinOp "like" (Iden "a") (Iden "b"))
+>      ,BinOp (Iden "a") "is not distinct from" (Iden "b"))
->     ,("a not like b", BinOp "not like" (Iden "a") (Iden "b"))
+>     ,("a like b", BinOp (Iden "a") "like" (Iden "b"))
->     ,("a is similar to b", BinOp "is similar to" (Iden "a") (Iden "b"))
+>     ,("a not like b", BinOp (Iden "a") "not like" (Iden "b"))
->     ,("a is not similar to b", BinOp "is not similar to" (Iden "a") (Iden "b"))
+>     ,("a is similar to b", BinOp (Iden "a") "is similar to" (Iden "b"))
->     ,("a overlaps b", BinOp "overlaps" (Iden "a") (Iden "b"))
+>     ,("a is not similar to b"
+>      ,BinOp (Iden "a") "is not similar to" (Iden "b"))
+>     ,("a overlaps b", BinOp (Iden "a") "overlaps" (Iden "b"))
 >     ,("extract(day from t)", SpecialOp "extract" [Iden "day", Iden "t"])
 >     ,("substring(x from 1 for 2)"
 >      ,SpecialOp "substring" [Iden "x", NumLit "1", NumLit "2"])
@@ -208,7 +210,7 @@
 > parens :: TestItem
 > parens = Group "parens" $ map (uncurry TestScalarExpr)
 >     [("(a)", Parens (Iden "a"))
->     ,("(a + b)", Parens (BinOp "+" (Iden "a") (Iden "b")))
+>     ,("(a + b)", Parens (BinOp (Iden "a") "+" (Iden "b")))
 >     ]
 
 > queryExprParserTests :: TestItem
@@ -251,8 +253,8 @@
 >                                  ,(Nothing,Iden "b")]})
 >     ,("select 1+2,3+4"
 >      ,makeSelect {qeSelectList =
->                      [(Nothing,BinOp "+" (NumLit "1") (NumLit "2"))
+>                      [(Nothing,BinOp (NumLit "1") "+" (NumLit "2"))
->                      ,(Nothing,BinOp "+" (NumLit "3") (NumLit "4"))]})
+>                      ,(Nothing,BinOp (NumLit "3") "+" (NumLit "4"))]})
 >     ,("select a as a, /*comment*/ b as b"
 >      ,makeSelect {qeSelectList = [(Just "a", Iden "a")
 >                                  ,(Just "b", Iden "b")]})
@@ -268,25 +270,25 @@
 >     ,("select a from t,u"
 >      ,ms [SimpleTableRef "t", SimpleTableRef "u"])
 >     ,("select a from t inner join u on expr"
->      ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u")
+>      ,ms [JoinTableRef (SimpleTableRef "t") JInner (SimpleTableRef "u")
 >                        (Just $ JoinOn $ Iden "expr")])
 >     ,("select a from t left join u on expr"
->      ,ms [JoinTableRef JLeft (SimpleTableRef "t") (SimpleTableRef "u")
+>      ,ms [JoinTableRef (SimpleTableRef "t") JLeft (SimpleTableRef "u")
 >                        (Just $ JoinOn $ Iden "expr")])
 >     ,("select a from t right join u on expr"
->      ,ms [JoinTableRef JRight (SimpleTableRef "t") (SimpleTableRef "u")
+>      ,ms [JoinTableRef (SimpleTableRef "t") JRight (SimpleTableRef "u")
 >                        (Just $ JoinOn $ Iden "expr")])
 >     ,("select a from t full join u on expr"
->      ,ms [JoinTableRef Full (SimpleTableRef "t") (SimpleTableRef "u")
+>      ,ms [JoinTableRef (SimpleTableRef "t") JFull (SimpleTableRef "u")
 >                        (Just $ JoinOn $ Iden "expr")])
 >     ,("select a from t cross join u"
->      ,ms [JoinTableRef Cross (SimpleTableRef "t")
+>      ,ms [JoinTableRef (SimpleTableRef "t")
->                             (SimpleTableRef "u") Nothing])
+>                        JCross (SimpleTableRef "u") Nothing])
 >     ,("select a from t natural inner join u"
->      ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u")
+>      ,ms [JoinTableRef (SimpleTableRef "t") JInner (SimpleTableRef "u")
 >                        (Just JoinNatural)])
 >     ,("select a from t inner join u using(a,b)"
->      ,ms [JoinTableRef Inner (SimpleTableRef "t") (SimpleTableRef "u")
+>      ,ms [JoinTableRef (SimpleTableRef "t") JInner (SimpleTableRef "u")
 >                        (Just $ JoinUsing ["a", "b"])])
 >     ,("select a from (select a from t)"
 >      ,ms [JoinQueryExpr $ ms [SimpleTableRef "t"]])
@@ -297,16 +299,17 @@
 >     ,("select a from t u(b)"
 >      ,ms [JoinAlias (SimpleTableRef "t") "u" $ Just ["b"]])
 >     ,("select a from (t cross join u) as u"
->      ,ms [JoinAlias (JoinParens $ JoinTableRef Cross (SimpleTableRef "t")
+>      ,ms [JoinAlias (JoinParens $
->                             (SimpleTableRef "u") Nothing) "u" Nothing])
+>                      JoinTableRef (SimpleTableRef "t")
+>                                   JCross
+>                                   (SimpleTableRef "u") Nothing)
+>                     "u" Nothing])
 >      -- todo: not sure if the associativity is correct
 >     ,("select a from t cross join u cross join v",
->        ms [JoinTableRef Cross
+>        ms [JoinTableRef
->            (JoinTableRef Cross (SimpleTableRef "t")
+>            (JoinTableRef (SimpleTableRef "t")
->                                (SimpleTableRef "u")
+>                          JCross (SimpleTableRef "u") Nothing)
->                                Nothing)
+>            JCross (SimpleTableRef "v") Nothing])
->            (SimpleTableRef "v")
->            Nothing])
 >     ]
 >   where
 >     ms f = makeSelect {qeSelectList = [(Nothing,Iden "a")]
@@ -317,7 +320,7 @@
 >     [("select a from t where a = 5"
 >      ,makeSelect {qeSelectList = [(Nothing,Iden "a")]
 >                  ,qeFrom = [SimpleTableRef "t"]
->                  ,qeWhere = Just $ BinOp "=" (Iden "a") (NumLit "5")})
+>                  ,qeWhere = Just $ BinOp (Iden "a") "=" (NumLit "5")})
 >     ]
 
 > groupByClause :: TestItem
@@ -344,7 +347,8 @@
 >                                  ,(Nothing, App "sum" [Iden "b"])]
 >                  ,qeFrom = [SimpleTableRef "t"]
 >                  ,qeGroupBy = [Iden "a"]
->                  ,qeHaving = Just $ BinOp ">" (App "sum" [Iden "b"]) (NumLit "5")
+>                  ,qeHaving = Just $ BinOp (App "sum" [Iden "b"])
+>                                           ">" (NumLit "5")
 >                  })
 >     ]
 
@@ -437,13 +441,14 @@
 >       \  order by s"
 >      ,makeSelect
 >       {qeSelectList = [(Nothing, Iden "a")
->                       ,(Just "s", App "sum" [BinOp "+" (Iden "c")
+>                       ,(Just "s"
->                                                        (Iden "d")])]
+>                        ,App "sum" [BinOp (Iden "c")
+>                                          "+" (Iden "d")])]
 >       ,qeFrom = [SimpleTableRef "t", SimpleTableRef "u"]
->       ,qeWhere = Just $ BinOp ">" (Iden "a") (NumLit "5")
+>       ,qeWhere = Just $ BinOp (Iden "a") ">" (NumLit "5")
 >       ,qeGroupBy = [Iden "a"]
->       ,qeHaving = Just $ BinOp ">" (App "count" [NumLit "1"])
+>       ,qeHaving = Just $ BinOp (App "count" [NumLit "1"])
->                                    (NumLit "5")
+>                                ">" (NumLit "5")
 >       ,qeOrderBy = [(Iden "s", Asc)]
 >       }
 >      )