diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs index 13a4dc7..cb97a05 100644 --- a/Language/SQL/SimpleSQL/Parser.lhs +++ b/Language/SQL/SimpleSQL/Parser.lhs @@ -327,7 +327,13 @@ that SQL supports. > <$ try (keyword_ "double" <* keyword_ "precision") > ,TypeName "character varying" > <$ try (keyword_ "character" <* keyword_ "varying") -> ,TypeName <$> identifierString] +> ,TypeName <$> identifierString] >>= optionSuffix precision +> where +> precision t = try (parens (commaSep integerLiteral)) >>= makeWrap t +> makeWrap (TypeName t) [a] = return $ PrecTypeName t a +> makeWrap (TypeName t) [a,b] = return $ Prec2TypeName t a b +> makeWrap _ _ = fail "there must be one or two precision components" + == scalar parens and row ctor diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs index 56b9a24..9313bac 100644 --- a/Language/SQL/SimpleSQL/Pretty.lhs +++ b/Language/SQL/SimpleSQL/Pretty.lhs @@ -128,13 +128,13 @@ > <+> text "then" <+> nest 5 (scalarExpr t1) > e el = text "else" <+> nest 5 (scalarExpr el) > scalarExpr (Parens e) = parens $ scalarExpr e -> scalarExpr (Cast e (TypeName tn)) = +> scalarExpr (Cast e tn) = > text "cast" <> parens (sep [scalarExpr e > ,text "as" -> ,text tn]) +> ,typeName tn]) -> scalarExpr (TypedLit (TypeName tn) s) = -> text tn <+> quotes (text s) +> scalarExpr (TypedLit tn s) = +> typeName tn <+> quotes (text s) > scalarExpr (SubQueryExpr ty qe) = > (case ty of @@ -162,6 +162,13 @@ > name (QName n) = doubleQuotes $ text n > name (Name n) = text n +> typeName :: TypeName -> Doc +> typeName (TypeName t) = text t +> typeName (PrecTypeName t a) = text t <+> parens (text $ show a) +> typeName (Prec2TypeName t a b) = +> text t <+> parens (text (show a) <+> comma <+> text (show b)) + + = query expressions > queryExpr :: QueryExpr -> Doc diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs index ae11d3a..3d489ef 100644 --- a/Language/SQL/SimpleSQL/Syntax.lhs +++ b/Language/SQL/SimpleSQL/Syntax.lhs @@ -121,7 +121,10 @@ > deriving (Eq,Show,Read) > -- | Represents a type name, used in casts. -> data TypeName = TypeName String deriving (Eq,Show,Read) +> data TypeName = TypeName String +> | PrecTypeName String Int +> | Prec2TypeName String Int Int +> deriving (Eq,Show,Read) > -- | Used for 'expr in (scalar expression list)', and 'expr in diff --git a/tools/Language/SQL/SimpleSQL/GroupBy.lhs b/tools/Language/SQL/SimpleSQL/GroupBy.lhs index 2dc1db9..82eddb2 100644 --- a/tools/Language/SQL/SimpleSQL/GroupBy.lhs +++ b/tools/Language/SQL/SimpleSQL/GroupBy.lhs @@ -220,13 +220,13 @@ sure which sql version they were introduced, 1999 or 2003 I think). > \(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\ > \ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-} -- as group - needs more subtle keyword blacklisting -> {-,"SELECT MONTH(SALES_DATE) AS MONTH,\n\ +> ,"SELECT MONTH(SALES_DATE) AS MONTH,\n\ > \REGION,\n\ > \SUM(SALES) AS UNITS_SOLD,\n\ > \MAX(SALES) AS BEST_SALE,\n\ > \CAST(ROUND(AVG(DECIMAL(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\ > \FROM SALES\n\ > \GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\ -> \ORDER BY MONTH, REGION" -} -- needs typenames with precision +> \ORDER BY MONTH, REGION" > ] diff --git a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs index 2cefd2a..5f358ba 100644 --- a/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs +++ b/tools/Language/SQL/SimpleSQL/ScalarExprs.lhs @@ -141,6 +141,13 @@ Tests for parsing scalar expressions > ,("cast('1' as double precision)" > ,Cast (StringLit "1") $ TypeName "double precision") +> ,("cast('1' as float(8))" +> ,Cast (StringLit "1") $ PrecTypeName "float" 8) + +> ,("cast('1' as decimal(15,2))" +> ,Cast (StringLit "1") $ Prec2TypeName "decimal" 15 2) + + > ,("double precision '3'" > ,TypedLit (TypeName "double precision") "3") > ]