@@ -0,0 +1,77 @@
1+{-# LANGUAGE PatternGuards #-}
2+
3+------------------------------------------------------------------------------
4+-- |
5+-- Module: Database.PostgreSQL.Simple.Arrays
6+-- Copyright: (c) 2012 Leon P Smith
7+-- License: BSD3
8+-- Maintainer: Leon P Smith <leon@melding-monads.com>
9+-- Stability: experimental
10+-- Portability: portable
11+--
12+-- A Postgres array parser and pretty-printer.
13+------------------------------------------------------------------------------
14+
15+module Database.PostgreSQL.Simple.Arrays where
16+
17+import Control.Applicative (Applicative(..), Alternative(..), (<$>))
18+import Data.ByteString.Char8 (ByteString, snoc, cons, copy)
19+import Data.Monoid
20+import Data.Attoparsec.Char8
21+import Database.PostgreSQL.Simple.FromField
22+
23+
24+-- | Parse one of three primitive field formats: array, quoted and plain.
25+arrayFormat :: Char -> Parser ArrayFormat
26+arrayFormat delim = Array <$> bracketed delim
27+ <|> Bytes <$> plain delim
28+ <|> Bytes <$> quoted
29+
30+data ArrayFormat = Array [ArrayFormat] | Bytes ByteString
31+ deriving (Eq, Show, Ord)
32+
33+bracketed :: Char -> Parser [ArrayFormat]
34+bracketed delim = char '{' *> option [] (arrays <|> strings) <* char '}'
35+ where
36+ strings = sepBy (Bytes <$> (quoted <|> plain delim)) (char delim)
37+ arrays = sepBy (Array <$> bracketed delim) (char ',')
38+ -- NB: Arrays seem to always be delimited by commas.
39+
40+-- | Recognizes a quoted string. Doesn't parse it in the sense that no
41+-- extraction occurs -- valid escape sequences and the delimiting quotes are
42+-- left in place. Makes a copy, because 'snoc' and 'cons' are used.
43+quoted :: Parser ByteString
44+quoted = snoc <$> (cons <$> char '"' <*> option "" contents) <*> char '"'
45+ where
46+ esc = string "\\\\" <|> string "\\\""
47+ unQ = takeWhile1 (notInClass "\"\\")
48+ contents = mconcat <$> many (esc <|> unQ)
49+
50+-- | Recognizes a plain string literal, not containing quotes or brackets and
51+-- not containing the delimiter character. Makes a copy, to be consistent
52+-- with 'quoted', above.
53+plain :: Char -> Parser ByteString
54+plain delim = copy <$> takeWhile1 (notInClass (delim:"\"{}"))
55+
56+-- Mutually recursive 'fmt' and 'delimit' separate out value formatting
57+-- from the subtleties of delimiting.
58+
59+-- | Format an array format item, using the delimiter character if the item is
60+-- itself an array.
61+fmt :: Char -> ArrayFormat -> ByteString
62+fmt c x =
63+ case x of
64+ Array items -> '{' `cons` delimit c items `snoc` '}'
65+ Bytes bytes -> bytes
66+
67+-- | Format a list of array format items, inserting the appropriate delimiter
68+-- between them. When the items are arrays, they will be delimited with
69+-- commas; otherwise, they are delimited with the passed-in-delimiter.
70+delimit :: Char -> [ArrayFormat] -> ByteString
71+delimit _ [] = ""
72+delimit c [x] = fmt c x
73+delimit c (x:next:rem) = fmt c x `snoc` c' `mappend` delimit c (next:rem)
74+ where
75+ c' | Array _ <- x = ','
76+ | otherwise = c
77+