{-# LANGUAGE OverloadedStrings #-}

-- | PostgreSQL array literal formatting for the text wire format.
module Arbiter.Orville.Array
  ( fmtArray
  , fmtNullableArray
  ) where

import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BSC

-- | Format a list of values as a PostgreSQL array literal.
fmtArray :: [ByteString] -> ByteString
fmtArray :: [ByteString] -> ByteString
fmtArray = ByteString -> ByteString
braces (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BSC.intercalate ByteString
"," ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
quoted

-- | Format a nullable list as a PostgreSQL array literal. Nothing becomes NULL.
fmtNullableArray :: [Maybe ByteString] -> ByteString
fmtNullableArray :: [Maybe ByteString] -> ByteString
fmtNullableArray = ByteString -> ByteString
braces (ByteString -> ByteString)
-> ([Maybe ByteString] -> ByteString)
-> [Maybe ByteString]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BSC.intercalate ByteString
"," ([ByteString] -> ByteString)
-> ([Maybe ByteString] -> [ByteString])
-> [Maybe ByteString]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> ByteString)
-> [Maybe ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"NULL" ByteString -> ByteString
quoted)

braces :: ByteString -> ByteString
braces :: ByteString -> ByteString
braces ByteString
body = ByteString
"{" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
body ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"}"

quoted :: ByteString -> ByteString
quoted :: ByteString -> ByteString
quoted ByteString
bytes = ByteString
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (Char -> ByteString) -> ByteString -> ByteString
BSC.concatMap Char -> ByteString
escape ByteString
bytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
  where
    escape :: Char -> ByteString
escape Char
'"' = ByteString
"\\\""
    escape Char
'\\' = ByteString
"\\\\"
    escape Char
c = Char -> ByteString
BSC.singleton Char
c