module Database.PostgreSQL.PQTypes.XML
  ( XML (..)
  ) where

import Data.ByteString.Char8 qualified as BSC
import Data.Text

import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.FromSQL
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.ToSQL

-- | Representation of SQL XML types as 'Text'.  Users of hpqtypes may
-- want to add conversion instances for their favorite XML type around 'XML'.
newtype XML = XML {XML -> Text
unXML :: Text}
  deriving (XML -> XML -> Bool
(XML -> XML -> Bool) -> (XML -> XML -> Bool) -> Eq XML
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XML -> XML -> Bool
== :: XML -> XML -> Bool
$c/= :: XML -> XML -> Bool
/= :: XML -> XML -> Bool
Eq, Eq XML
Eq XML =>
(XML -> XML -> Ordering)
-> (XML -> XML -> Bool)
-> (XML -> XML -> Bool)
-> (XML -> XML -> Bool)
-> (XML -> XML -> Bool)
-> (XML -> XML -> XML)
-> (XML -> XML -> XML)
-> Ord XML
XML -> XML -> Bool
XML -> XML -> Ordering
XML -> XML -> XML
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: XML -> XML -> Ordering
compare :: XML -> XML -> Ordering
$c< :: XML -> XML -> Bool
< :: XML -> XML -> Bool
$c<= :: XML -> XML -> Bool
<= :: XML -> XML -> Bool
$c> :: XML -> XML -> Bool
> :: XML -> XML -> Bool
$c>= :: XML -> XML -> Bool
>= :: XML -> XML -> Bool
$cmax :: XML -> XML -> XML
max :: XML -> XML -> XML
$cmin :: XML -> XML -> XML
min :: XML -> XML -> XML
Ord, ReadPrec [XML]
ReadPrec XML
Int -> ReadS XML
ReadS [XML]
(Int -> ReadS XML)
-> ReadS [XML] -> ReadPrec XML -> ReadPrec [XML] -> Read XML
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS XML
readsPrec :: Int -> ReadS XML
$creadList :: ReadS [XML]
readList :: ReadS [XML]
$creadPrec :: ReadPrec XML
readPrec :: ReadPrec XML
$creadListPrec :: ReadPrec [XML]
readListPrec :: ReadPrec [XML]
Read, Int -> XML -> ShowS
[XML] -> ShowS
XML -> String
(Int -> XML -> ShowS)
-> (XML -> String) -> ([XML] -> ShowS) -> Show XML
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XML -> ShowS
showsPrec :: Int -> XML -> ShowS
$cshow :: XML -> String
show :: XML -> String
$cshowList :: [XML] -> ShowS
showList :: [XML] -> ShowS
Show)

instance PQFormat XML where
  pqFormat :: ByteString
pqFormat = String -> ByteString
BSC.pack String
"%xml"

instance FromSQL XML where
  type PQBase XML = PGbytea
  fromSQL :: Maybe (PQBase XML) -> IO XML
fromSQL = (Text -> XML) -> IO Text -> IO XML
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> XML
XML (IO Text -> IO XML)
-> (Maybe PGbytea -> IO Text) -> Maybe PGbytea -> IO XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PGbytea -> IO Text
Maybe (PQBase Text) -> IO Text
forall t. FromSQL t => Maybe (PQBase t) -> IO t
fromSQL

instance ToSQL XML where
  type PQDest XML = PGbytea
  toSQL :: forall r.
XML -> ParamAllocator -> (Ptr (PQDest XML) -> IO r) -> IO r
toSQL = Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r
Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
forall r.
Text -> ParamAllocator -> (Ptr (PQDest Text) -> IO r) -> IO r
forall t r.
ToSQL t =>
t -> ParamAllocator -> (Ptr (PQDest t) -> IO r) -> IO r
toSQL (Text -> ParamAllocator -> (Ptr PGbytea -> IO r) -> IO r)
-> (XML -> Text)
-> XML
-> ParamAllocator
-> (Ptr PGbytea -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XML -> Text
unXML