diff --git a/Language/SQL/SimpleSQL/Parser.lhs b/Language/SQL/SimpleSQL/Parser.lhs
index 2eea14b..769856b 100644
--- a/Language/SQL/SimpleSQL/Parser.lhs
+++ b/Language/SQL/SimpleSQL/Parser.lhs
@@ -121,7 +121,7 @@ which parses as a typed literal
> ((,) <$> identifierBlacklist blacklist
> <*> optionMaybe (parens unsignedInteger))
> where
-> mkIt val Nothing = TypedLit (TypeName "interval") val
+> mkIt val Nothing = TypedLit (TypeName [Name "interval"]) val
> mkIt val (Just (a,b)) = IntervalLit val a b
> characterSetLiteral :: Parser ValueExpr
@@ -514,12 +514,13 @@ that SQL supports.
> typeName :: Parser TypeName
> typeName =
-> (choice [multiWordParsers
-> ,TypeName <$> identifierBlacklist blacklist]
+> (choice [try multiWordParsers
+> ,mktn <$> identifierBlacklist blacklist]
> >>= optionSuffix precision
> ) <?> "typename"
> where
-> multiWordParsers = (TypeName . unwords) <$> makeKeywordTree
+> mktn = TypeName . (:[]) . Name
+> multiWordParsers = mktn . unwords <$> makeKeywordTree
> ["double precision"
> ,"character varying"
> ,"char varying"
diff --git a/Language/SQL/SimpleSQL/Pretty.lhs b/Language/SQL/SimpleSQL/Pretty.lhs
index 4ab6166..a31ac7e 100644
--- a/Language/SQL/SimpleSQL/Pretty.lhs
+++ b/Language/SQL/SimpleSQL/Pretty.lhs
@@ -208,10 +208,53 @@ which have been changed to try to improve the layout of the output.
> names ns = hcat $ punctuate (text ".") $ map name ns
> typeName :: TypeName -> Doc
-> typeName (TypeName t) = text t
-> typeName (PrecTypeName t a) = text t <+> parens (text $ show a)
+> typeName (TypeName t) = names t
+> typeName (PrecTypeName t a) = names t <+> parens (text $ show a)
> typeName (PrecScaleTypeName t a b) =
-> text t <+> parens (text (show a) <+> comma <+> text (show b))
+> names t <+> parens (text (show a) <+> comma <+> text (show b))
+> typeName (LobTypeName t i m u) =
+> names t
+> <> parens (text (show i)
+> <> me (\x -> case x of
+> LobK -> text "K"
+> LobM -> text "M"
+> LobG -> text "G") m)
+> <+> me (\x -> case x of
+> LobCharacters -> text "CHARACTERS"
+> LobCodeUnits -> text "CODE_UNITS"
+> LobOctets -> text "OCTETS") u
+> typeName (CharTypeName t i cs col) =
+> names t
+> <> me (\x -> parens (text $ show x)) i
+> <+> (if null cs
+> then empty
+> else text "character set" <+> names cs)
+> <+> me (\x -> text "collate" <+> name x) col
+> typeName (TimeTypeName t i tz) =
+> names t
+> <> me (\x -> parens (text $ show x)) i
+> <+> text (if tz
+> then "with time zone"
+> else "without time zone")
+> typeName (RowTypeName cs) =
+> text "row" <> parens (commaSep $ map f cs)
+> where
+> f (n,t) = name n <+> typeName t
+> typeName (IntervalTypeName f t) =
+> text "interval"
+> <+> it f
+> <+> me (\x -> text "to" <+> it x) t
+> where
+> it (Itf n p) =
+> text n
+> <+> me (\(x,x1) -> parens (text (show x)
+> <+> me (\y -> (sep [comma,text (show y)])) x1)) p
+
+> typeName (ArrayType tn sz) =
+> typeName tn <+> text "array" <+> me (text . show) sz
+
+> typeName (MultisetType tn) =
+> typeName tn <+> text "multiset"
= query expressions
diff --git a/Language/SQL/SimpleSQL/Syntax.lhs b/Language/SQL/SimpleSQL/Syntax.lhs
index bb71af7..5c22ad9 100644
--- a/Language/SQL/SimpleSQL/Syntax.lhs
+++ b/Language/SQL/SimpleSQL/Syntax.lhs
@@ -6,6 +6,9 @@
> ValueExpr(..)
> ,Name(..)
> ,TypeName(..)
+> ,IntervalTypeField(..)
+> ,LobMultiplier(..)
+> ,LobUnits(..)
> ,SetQuantifier(..)
> ,SortSpec(..)
> ,Direction(..)
@@ -151,10 +154,31 @@
> | QName String
> deriving (Eq,Show,Read,Data,Typeable)
+TODO: add ref and scope, any others?
+
> -- | Represents a type name, used in casts.
-> data TypeName = TypeName String
-> | PrecTypeName String Integer
-> | PrecScaleTypeName String Integer Integer
+> data TypeName
+> = TypeName [Name]
+> | PrecTypeName [Name] Integer
+> | PrecScaleTypeName [Name] Integer Integer
+> | LobTypeName [Name] Int (Maybe LobMultiplier) (Maybe LobUnits)
+> -- precision, characterset, collate
+> | CharTypeName [Name] (Maybe Integer) [Name] (Maybe Name)
+> | TimeTypeName [Name] (Maybe Integer) Bool -- true == with time zone
+> | RowTypeName [(Name,TypeName)]
+> | IntervalTypeName IntervalTypeField (Maybe IntervalTypeField)
+> | ArrayType TypeName (Maybe Integer)
+> | MultisetType TypeName
+> deriving (Eq,Show,Read,Data,Typeable)
+
+> data IntervalTypeField = Itf String (Maybe (Int, Maybe Int))
+> deriving (Eq,Show,Read,Data,Typeable)
+
+> data LobMultiplier = LobK | LobM | LobG
+> deriving (Eq,Show,Read,Data,Typeable)
+> data LobUnits = LobCharacters
+> | LobCodeUnits
+> | LobOctets
> deriving (Eq,Show,Read,Data,Typeable)
> -- | Used for 'expr in (value expression list)', and 'expr in
diff --git a/tools/Language/SQL/SimpleSQL/SQL2003.lhs b/tools/Language/SQL/SimpleSQL/SQL2003.lhs
index 8fc670c..a59335f 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2003.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2003.lhs
@@ -21,10 +21,10 @@ large amount of the SQL.
> ,unicodeStringLiterals
> ,binaryStringLiterals
> ,numericLiterals
-> ,dateAndTimeLiterals
+> --,dateAndTimeLiterals
> ,booleanLiterals
> --,identifiers
-> --,typeNames
+> ,typeNameTests
> --,parenthesizedValueExpression
> ,targetSpecification
> ,contextuallyTypeValueSpec
@@ -657,11 +657,12 @@ TODO: separator stuff for all the string literals?
<datetime value> ::= <unsigned integer>
-All these date literals are just like a restricted version of string
-literals. This parser doesn't check the format inside these literals
-at this time.
+TODO: interval literals
++ consider whether to support date and time literals better
+(e.g. parse the literal string), at the moment they are treated as
+normal typed literals
-> dateAndTimeLiterals :: TestItem
+> {-dateAndTimeLiterals :: TestItem
> dateAndTimeLiterals = Group "date and time literals" $ map (uncurry TestValueExpr)
> [("date 'date literal'"
> ,TypedLit (TypeName "date") "date literal")
@@ -669,7 +670,7 @@ at this time.
> ,TypedLit (TypeName "time") "time literal")
> ,("timestamp 'timestamp literal'"
> ,TypedLit (TypeName "timestamp") "timestamp literal")
-> ]
+> ]-}
TODO: intervals + more date and time literals
@@ -924,9 +925,38 @@ TODO: module stuff
<multiset type> ::= <data type> MULTISET
-TODO: review this list better and fill in lots of missing bits:
+create a list of type name variations:
-> typeNames :: TestItem
+> typeNames :: [(String,TypeName)]
+> typeNames =
+> [-- example of every standard type name
+> ("character", TypeName "character")
+> -- 1 single prec + 1 with multiname
+> -- 1 scale + with multiname
+> -- lob prec + with multiname
+> -- 1 with and without tz
+> -- chars: (single/multiname) x prec x charset x collate
+> -- single row field, two row field
+> -- interval each type raw
+> -- one type with single suff
+> -- one type with double suff
+> -- a to b with raw
+> -- a to b with single suff
+> ]
+
+Now test each variation in both cast expression and typed literal
+expression
+
+> typeNameTests :: TestItem
+> typeNameTests = Group "type names" $ map (uncurry TestValueExpr)
+> $ concatMap makeTests typeNames
+> where
+> makeTests (ctn, stn) =
+> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "test") stn)
+> ,(ctn ++ " 'test'", TypedLit stn "test")
+> ]
+
+> {-typeNames :: TestItem
> typeNames = Group "type names" $ map (uncurry TestValueExpr)
> [("cast('test' as character(5))", undefined)
> ,("cast('test' as character)", undefined)
@@ -966,7 +996,7 @@ TODO: review this list better and fill in lots of missing bits:
> ,("cast('01-01-99' as timestamp(3))", undefined)
> ,("cast('01-01-99' as timestamp with time zone)", undefined)
> ,("cast('01-01-99' as time(3) with time zone)", undefined)
-> ]
+> ]-}
@@ -975,7 +1005,7 @@ TODO: review this list better and fill in lots of missing bits:
<field definition> ::= <field name> <data type> [ <reference scope check> ]
-This is used when e.g. casting to a row type. TODO
+This is used when e.g. casting to a row type.
@@ -1108,7 +1138,7 @@ for or how it works
<default specification> ::= DEFAULT
> contextuallyTypeValueSpec :: TestItem
-> contextuallyTypeValueSpec = Group "ontextually typed value specification" $ map (uncurry TestValueExpr)
+> contextuallyTypeValueSpec = Group "contextually typed value specification" $ map (uncurry TestValueExpr)
> [("null", Iden "null")
> ,("array[]", Array (Iden "array") [])
> --,("multiset[]", undefined)