@@ -15,42 +15,42 @@
1515module Database.PostgreSQL.Simple.Arrays where
1616
1717import Control.Applicative (Applicative(..), Alternative(..), (<$>))
18−import Data.ByteString.Char8 (ByteString, snoc, cons, copy)
18+import Data.ByteString.Char8 (ByteString)
19+import qualified Data.ByteString.Char8 as B
1920import Data.Monoid
2021import Data.Attoparsec.Char8
2122
2223
2324-- | Parse one of three primitive field formats: array, quoted and plain.
2425arrayFormat :: Char -> Parser ArrayFormat
25−arrayFormat delim = Array <$> array delim
26− <|> Bytes <$> plain delim
27− <|> Bytes <$> quoted
26+arrayFormat delim = Array <$> array delim
27+ <|> Plain <$> plain delim
28+ <|> Quoted <$> quoted
2829
29−data ArrayFormat = Array [ArrayFormat] | Bytes ByteString
30− deriving (Eq, Show, Ord)
30+data ArrayFormat = Array [ArrayFormat]
31+ | Plain ByteString
32+ | Quoted ByteString
33+ deriving (Eq, Show, Ord)
3134
3235array :: Char -> Parser [ArrayFormat]
3336array delim = char '{' *> option [] (arrays <|> strings) <* char '}'
3437 where
35− strings = sepBy1 (Bytes <$> (quoted <|> plain delim)) (char delim)
38+ strings = sepBy1 (Quoted <$> quoted <|> Plain <$> plain delim) (char delim)
3639 arrays = sepBy1 (Array <$> array delim) (char ',')
3740 -- NB: Arrays seem to always be delimited by commas.
3841
39−-- | Recognizes a quoted string. Doesn't parse it in the sense that no
40−-- extraction occurs -- valid escape sequences and the delimiting quotes are
41−-- left in place. Makes a copy, because 'snoc' and 'cons' are used.
42+-- | Recognizes a quoted string.
4243quoted :: Parser ByteString
43−quoted = snoc <$> (cons <$> char '"' <*> option "" contents) <*> char '"'
44+quoted = char '"' *> option "" contents <* char '"'
4445 where
45− esc = string "\\\\" <|> string "\\\""
46+ esc = char '\\' *> (char '\\' <|> char '"')
4647 unQ = takeWhile1 (notInClass "\"\\")
47− contents = mconcat <$> many (esc <|> unQ)
48+ contents = mconcat <$> many (unQ <|> B.singleton <$> esc)
4849
4950-- | Recognizes a plain string literal, not containing quotes or brackets and
50−-- not containing the delimiter character. Makes a copy, to be consistent
51−-- with 'quoted', above.
51+-- not containing the delimiter character.
5252plain :: Char -> Parser ByteString
53−plain delim = copy <$> takeWhile1 (notInClass (delim:"\"{}"))
53+plain delim = takeWhile1 (notInClass (delim:"\"{}"))
5454
5555-- Mutually recursive 'fmt' and 'delimit' separate out value formatting
5656-- from the subtleties of delimiting.
@@ -58,18 +58,37 @@ plain delim = copy <$> takeWhile1 (notInClass (delim:"\"{}"))
5858-- | Format an array format item, using the delimiter character if the item is
5959-- itself an array.
6060fmt :: Char -> ArrayFormat -> ByteString
61−fmt c x = case x of
62− Array items -> '{' `cons` delimit c items `snoc` '}'
63− Bytes bytes -> bytes
61+fmt = fmt' False
6462
6563-- | Format a list of array format items, inserting the appropriate delimiter
6664-- between them. When the items are arrays, they will be delimited with
6765-- commas; otherwise, they are delimited with the passed-in-delimiter.
6866delimit :: Char -> [ArrayFormat] -> ByteString
69−delimit _ [] = ""
70−delimit c [x] = fmt c x
71−delimit c (x:next:rem) = fmt c x `snoc` c' `mappend` delimit c (next:rem)
67+delimit _ [] = ""
68+delimit c [x] = fmt' True c x
69+delimit c (x:y:z) = fmt' True c x `B.snoc` c' `mappend` delimit c (y:z)
7270 where
7371 c' | Array _ <- x = ','
7472 | otherwise = c
7573
74+-- | Format an array format item, using the delimiter character if the item is
75+-- itself an array, optionally applying quoting rules. Creates copies for
76+-- safety when used in 'FromField' instances.
77+fmt' :: Bool -> Char -> ArrayFormat -> ByteString
78+fmt' quoting c x =
79+ case x of
80+ Array items -> '{' `B.cons` delimit c items `B.snoc` '}'
81+ Plain bytes -> B.copy bytes
82+ Quoted q | quoting -> '"' `B.cons` esc q `B.snoc` '"'
83+ | otherwise -> B.copy q
84+ -- NB: The 'snoc' and 'cons' functions always copy.
85+
86+-- | Escape a string according to Postgres double-quoted string format.
87+esc :: ByteString -> ByteString
88+esc = B.concatMap f
89+ where
90+ f '"' = "\\\""
91+ f '\\' = "\\\\"
92+ f c = B.singleton c
93+ -- TODO: Implement easy performance improvements with unfoldr.
94+