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

import Prelude hiding (map, null)

import Database.PostgreSQL.LTree

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 LTree where
  toField :: LTree -> Action
toField = Text -> Action
forall a. ToField a => a -> Action
toField (Text -> Action) -> (LTree -> Text) -> LTree -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTree -> Text
render

instance FromField LTree where
  fromField :: FieldParser LTree
fromField Field
fld Maybe ByteString
mbs = do
    -- There might be a more efficient way to check this, need to see
    -- if the @ltree@ 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 @label@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
"ltree") (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 ltree, 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 LTree
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
""
      -- Since this is coming from postgres and we've confirmed the type matches
      -- @ltree@, it is safe to use 'unsafeUncheckedParse' here.
      Just ByteString
bs -> LTree -> Conversion LTree
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LTree -> Conversion LTree) -> LTree -> Conversion LTree
forall a b. (a -> b) -> a -> b
$ Text -> LTree
unsafeUncheckedParse (Text -> LTree) -> Text -> LTree
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
Text.decodeUtf8 ByteString
bs