1
Fork 0

modify basic typenames to support dotted names in the syntax

add syntax for most of the other kinds of typenames
add pretty printing for these
todo: the parsing and the tests
This commit is contained in:
Jake Wheat 2014-04-18 17:55:56 +03:00
parent 438e3383e4
commit fbdcacc604
4 changed files with 120 additions and 22 deletions
Language/SQL/SimpleSQL

View file

@ -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"

View file

@ -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

View file

@ -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