-- | This module is a wrapper for PostgreSQL's @lquery@ https://www.postgresql.org/docs/current/ltree.html
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Database.PostgreSQL.Simple.LQuery
  ( module Database.PostgreSQL.LQuery
  ) where

import Prelude

import Database.PostgreSQL.LQuery

import Control.Monad (when)
import Database.PostgreSQL.Simple.FromField
  ( FromField(fromField), ResultError(Incompatible, UnexpectedNull), returnError, typename
  )
import Database.PostgreSQL.Simple.ToField (ToField(toField))

import qualified Data.Text.Encoding as Text

instance ToField LQuery where
  toField :: LQuery -> Action
toField = Text -> Action
forall a. ToField a => a -> Action
toField (Text -> Action) -> (LQuery -> Text) -> LQuery -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LQuery -> Text
unLQuery

instance FromField LQuery where
  fromField :: FieldParser LQuery
fromField Field
fld Maybe ByteString
mbs = do
    -- There might be a more efficient way to check this, need to see
    -- if the @lquery@ type has a stable typoid or not.
    ByteString
typ <- Field -> Conversion ByteString
typename Field
fld
    -- Ensure we don't accidentally deserialize a @text@ field which
    -- would produce corrupted @lquery@s.
    Bool -> Conversion () -> Conversion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
typ ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"lquery") (Conversion () -> Conversion ()) -> Conversion () -> Conversion ()
forall a b. (a -> b) -> a -> b
$
      (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion ()
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
Incompatible Field
fld (String -> Conversion ()) -> String -> Conversion ()
forall a b. (a -> b) -> a -> b
$ String
"Expected type lquery, got: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
typ
    case Maybe ByteString
mbs of
      Maybe ByteString
Nothing -> (String -> Maybe Oid -> String -> String -> String -> ResultError)
-> Field -> String -> Conversion LQuery
forall a err.
(Typeable a, Exception err) =>
(String -> Maybe Oid -> String -> String -> String -> err)
-> Field -> String -> Conversion a
returnError String -> Maybe Oid -> String -> String -> String -> ResultError
UnexpectedNull Field
fld String
""
      Just ByteString
bs -> LQuery -> Conversion LQuery
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LQuery -> Conversion LQuery) -> LQuery -> Conversion LQuery
forall a b. (a -> b) -> a -> b
$ Text -> LQuery
LQuery (Text -> LQuery) -> Text -> LQuery
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 ByteString
bs