git.iko.soy/typeable/postgresql-simple
on master help sign in
Unquote data in the simple, un-nested case.
feadd8dJason Dusek
src/Database/PostgreSQL/Simple/Arrays.hs+41−22
compare with master
unifiedsplit
@@ -15,42 +15,42 @@
15module Database.PostgreSQL.Simple.Arrays where
15module Database.PostgreSQL.Simple.Arrays where
16
16
17import Control.Applicative (Applicative(..), Alternative(..), (<$>))
17import 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
19import Data.Monoid
20import Data.Monoid
20import Data.Attoparsec.Char8
21import Data.Attoparsec.Char8
21
22
22
23
23-- | Parse one of three primitive field formats: array, quoted and plain.
24-- | Parse one of three primitive field formats: array, quoted and plain.
24arrayFormat :: Char -> Parser ArrayFormat
25arrayFormat :: Char -> Parser ArrayFormat
25−arrayFormat delim = Array <$> array delim
26+arrayFormat delim = Array <$> array delim
26− <|> Bytes <$> plain delim
27+ <|> Plain <$> plain delim
27− <|> Bytes <$> quoted
28+ <|> Quoted <$> quoted
28
29
29−data ArrayFormat = Array [ArrayFormat] | Bytes ByteString
30+data ArrayFormat = Array [ArrayFormat]
31+ | Plain ByteString
32+ | Quoted ByteString
30− deriving (Eq, Show, Ord)
33+ deriving (Eq, Show, Ord)
31
34
32array :: Char -> Parser [ArrayFormat]
35array :: Char -> Parser [ArrayFormat]
33array delim = char '{' *> option [] (arrays <|> strings) <* char '}'
36array delim = char '{' *> option [] (arrays <|> strings) <* char '}'
34 where
37 where
35− strings = sepBy1 (Bytes <$> (quoted <|> plain delim)) (char delim)
38+ strings = sepBy1 (Quoted <$> quoted <|> Plain <$> plain delim) (char delim)
36 arrays = sepBy1 (Array <$> array delim) (char ',')
39 arrays = sepBy1 (Array <$> array delim) (char ',')
37 -- NB: Arrays seem to always be delimited by commas.
40 -- NB: Arrays seem to always be delimited by commas.
38
41
39−-- | Recognizes a quoted string. Doesn't parse it in the sense that no
42+-- | Recognizes a quoted string.
40−-- extraction occurs -- valid escape sequences and the delimiting quotes are
41−-- left in place. Makes a copy, because 'snoc' and 'cons' are used.
42quoted :: Parser ByteString
43quoted :: Parser ByteString
43−quoted = snoc <$> (cons <$> char '"' <*> option "" contents) <*> char '"'
44+quoted = char '"' *> option "" contents <* char '"'
44 where
45 where
45− esc = string "\\\\" <|> string "\\\""
46+ esc = char '\\' *> (char '\\' <|> char '"')
46 unQ = takeWhile1 (notInClass "\"\\")
47 unQ = takeWhile1 (notInClass "\"\\")
47− contents = mconcat <$> many (esc <|> unQ)
48+ contents = mconcat <$> many (unQ <|> B.singleton <$> esc)
48
49
49-- | Recognizes a plain string literal, not containing quotes or brackets and
50-- | Recognizes a plain string literal, not containing quotes or brackets and
50−-- not containing the delimiter character. Makes a copy, to be consistent
51+-- not containing the delimiter character.
51−-- with 'quoted', above.
52plain :: Char -> Parser ByteString
52plain :: Char -> Parser ByteString
53−plain delim = copy <$> takeWhile1 (notInClass (delim:"\"{}"))
53+plain delim = takeWhile1 (notInClass (delim:"\"{}"))
54
54
55-- Mutually recursive 'fmt' and 'delimit' separate out value formatting
55-- Mutually recursive 'fmt' and 'delimit' separate out value formatting
56-- from the subtleties of delimiting.
56-- from the subtleties of delimiting.
@@ -58,18 +58,37 @@ plain delim = copy <$> takeWhile1 (notInClass (delim:"\"{}"))
58-- | Format an array format item, using the delimiter character if the item is
58-- | Format an array format item, using the delimiter character if the item is
59-- itself an array.
59-- itself an array.
60fmt :: Char -> ArrayFormat -> ByteString
60fmt :: Char -> ArrayFormat -> ByteString
61−fmt c x = case x of
61+fmt = fmt' False
62− Array items -> '{' `cons` delimit c items `snoc` '}'
63− Bytes bytes -> bytes
64
62
65-- | Format a list of array format items, inserting the appropriate delimiter
63-- | Format a list of array format items, inserting the appropriate delimiter
66-- between them. When the items are arrays, they will be delimited with
64-- between them. When the items are arrays, they will be delimited with
67-- commas; otherwise, they are delimited with the passed-in-delimiter.
65-- commas; otherwise, they are delimited with the passed-in-delimiter.
68delimit :: Char -> [ArrayFormat] -> ByteString
66delimit :: Char -> [ArrayFormat] -> ByteString
69−delimit _ [] = ""
67+delimit _ [] = ""
70−delimit c [x] = fmt c x
68+delimit c [x] = fmt' True c x
71−delimit c (x:next:rem) = fmt c x `snoc` c' `mappend` delimit c (next:rem)
69+delimit c (x:y:z) = fmt' True c x `B.snoc` c' `mappend` delimit c (y:z)
72 where
70 where
73 c' | Array _ <- x = ','
71 c' | Array _ <- x = ','
74 | otherwise = c
72 | otherwise = c
75
73
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+