{-|
Module: Squeal.PostgreSQL.LTree
Description: ltree
Copyright: (c) Eitan Chatav, 2020
Maintainer: eitan@morphism.tech
Stability: experimental

This module implements a data type ltree for representing
labels of data stored in a hierarchical tree-like structure.
-}

{-# LANGUAGE
    DataKinds
  , DeriveGeneric
  , DerivingStrategies
  , FlexibleInstances
  , GeneralizedNewtypeDeriving
  , MultiParamTypeClasses
  , OverloadedStrings
  , PolyKinds
  , TypeFamilies
  , TypeOperators
  , TypeSynonymInstances
  , UndecidableInstances
#-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Squeal.PostgreSQL.LTree
  ( -- * Definition
    createLTree
    -- * Types
  , LTree(..), LQuery(..), LTxtQuery(..)
  , PGltree, PGlquery, PGltxtquery
  , ltree, lquery, ltxtquery
    -- * Functions
  , subltree, subpath, subpathEnd
  , nlevel, indexLTree, indexOffset
  , text2ltree, ltree2text, lca
    -- * Operators
  , (%~), (~%), (%?), (?%), (%@), (@%)
  , (@>%), (%<@), (<@%), (%@>)
  , (&~), (~&), (&?), (?&), (&@), (@&)
  , (?@>), (?<@), (?~), (?@)
  ) where

import Control.Exception hiding (TypeError)
import Control.Monad (when)
import Control.Monad.Reader (ReaderT(ReaderT))
import Data.String
import Data.Text
import GHC.Generics
import GHC.TypeLits (ErrorMessage(Text), TypeError)
import Squeal.PostgreSQL
import Squeal.PostgreSQL.Render

import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Generics.SOP as SOP
import qualified PostgreSQL.Binary.Decoding as Decoding
import qualified PostgreSQL.Binary.Encoding as Encoding

-- | Postgres ltree type
type PGltree = 'UnsafePGType "ltree"
-- | Postgres lquery type
type PGlquery = 'UnsafePGType "lquery"
-- | Postgres ltxtquery type
type PGltxtquery = 'UnsafePGType "ltxtquery"

-- | Loads ltree extension into the current database.
createLTree :: Definition db db
createLTree :: forall (db :: SchemasType). Definition db db
createLTree = forall (db0 :: SchemasType) (db1 :: SchemasType).
ByteString -> Definition db0 db1
UnsafeDefinition ByteString
"CREATE EXTENSION \"ltree\";"

-- | Postgres ltree type expression
ltree :: TypeExpression db (null PGltree)
ltree :: forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null PGltree)
ltree = forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"ltree"

-- | Postgres lquery type expression
lquery :: TypeExpression db (null PGlquery)
lquery :: forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null PGlquery)
lquery = forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"lquery"

-- | Postgres ltxtquery type expression
ltxtquery :: TypeExpression db (null PGltxtquery)
ltxtquery :: forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null PGltxtquery)
ltxtquery = forall (db :: SchemasType) (ty :: NullType).
ByteString -> TypeExpression db ty
UnsafeTypeExpression ByteString
"ltxtquery"

instance PGTyped db PGltree where pgtype :: forall (null :: PGType -> NullType).
TypeExpression db (null PGltree)
pgtype = forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null PGltree)
ltree
instance PGTyped db PGlquery where pgtype :: forall (null :: PGType -> NullType).
TypeExpression db (null PGlquery)
pgtype = forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null PGlquery)
lquery
instance PGTyped db PGltxtquery where pgtype :: forall (null :: PGType -> NullType).
TypeExpression db (null PGltxtquery)
pgtype = forall (db :: SchemasType) (null :: PGType -> NullType).
TypeExpression db (null PGltxtquery)
ltxtquery

instance OidOf db PGltree where
  oidOf :: ReaderT (K Connection db) IO Oid
oidOf = forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
"oid" String
"ltree"
instance OidOf db PGlquery where
  oidOf :: ReaderT (K Connection db) IO Oid
oidOf = forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
"oid" String
"lquery"
instance OidOf db PGltxtquery where
  oidOf :: ReaderT (K Connection db) IO Oid
oidOf = forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
"oid" String
"ltxtquery"
instance OidOfArray db PGltree where
  oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
"typarray" String
"ltree"
instance OidOfArray db PGlquery where
  oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
"typarray" String
"lquery"
instance OidOfArray db PGltxtquery where
  oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
"typarray" String
"ltxtquery"

oidLtreeLookup
  :: String
  -> String
  -> ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
oidLtreeLookup :: forall {k} (db :: k).
String -> String -> ReaderT (K Connection db) IO Oid
oidLtreeLookup String
tyOrArr String
name = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \(SOP.K Connection
conn) -> do
  Maybe Result
resultMaybe <- Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
LibPQ.execParams Connection
conn ByteString
q [] Format
LibPQ.Binary
  case Maybe Result
resultMaybe of
    Maybe Result
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
oidErr
    Just Result
result -> do
      Row
numRows <- Result -> IO Row
LibPQ.ntuples Result
result
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Row
numRows forall a. Eq a => a -> a -> Bool
/= Row
1) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Row -> Row -> SquealException
RowsException Text
oidErr Row
1 Row
numRows
      Maybe ByteString
valueMaybe <- Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
0 Column
0
      case Maybe ByteString
valueMaybe of
        Maybe ByteString
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
oidErr
        Just ByteString
value -> case forall a. Value a -> ByteString -> Either Text a
Decoding.valueParser forall a. (Integral a, Bits a) => Value a
Decoding.int ByteString
value of
          Left Text
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
oidErr Text
err
          Right CUInt
oid' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
oid'
  where
    oidErr :: Text
oidErr = Text
"oidOf " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (String
name forall a. Semigroup a => a -> a -> a
<> String
tyOrArr)
    q :: ByteString
q = ByteString
"SELECT " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
tyOrArr
      forall a. Semigroup a => a -> a -> a
<> ByteString
" FROM pg_type WHERE typname = \'"
      forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
name forall a. Semigroup a => a -> a -> a
<> ByteString
"\';"

{- |
A label is a sequence of alphanumeric characters and underscores
(for example, in C locale the characters A-Za-z0-9_ are allowed).
Labels must be less than 256 bytes long.

@
Examples: 42, Personal_Services
@

A label path is a sequence of zero or more labels separated by dots,
for example L1.L2.L3, representing a path from the root of a
hierarchical tree to a particular node. The length of a label path
must be less than 65Kb, but keeping it under 2Kb is preferable.
In practice this is not a major limitation; for example,
the longest label path in the DMOZ catalogue
(http://www.dmoz.org) is about 240 bytes.

@
Example: Top.Countries.Europe.Russia
@

ltree stores a label path.
-}
newtype LTree = UnsafeLTree {LTree -> Text
getLTree :: Text}
  deriving stock (LTree -> LTree -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LTree -> LTree -> Bool
$c/= :: LTree -> LTree -> Bool
== :: LTree -> LTree -> Bool
$c== :: LTree -> LTree -> Bool
Eq,Eq LTree
LTree -> LTree -> Bool
LTree -> LTree -> Ordering
LTree -> LTree -> LTree
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
min :: LTree -> LTree -> LTree
$cmin :: LTree -> LTree -> LTree
max :: LTree -> LTree -> LTree
$cmax :: LTree -> LTree -> LTree
>= :: LTree -> LTree -> Bool
$c>= :: LTree -> LTree -> Bool
> :: LTree -> LTree -> Bool
$c> :: LTree -> LTree -> Bool
<= :: LTree -> LTree -> Bool
$c<= :: LTree -> LTree -> Bool
< :: LTree -> LTree -> Bool
$c< :: LTree -> LTree -> Bool
compare :: LTree -> LTree -> Ordering
$ccompare :: LTree -> LTree -> Ordering
Ord,Int -> LTree -> ShowS
[LTree] -> ShowS
LTree -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LTree] -> ShowS
$cshowList :: [LTree] -> ShowS
show :: LTree -> String
$cshow :: LTree -> String
showsPrec :: Int -> LTree -> ShowS
$cshowsPrec :: Int -> LTree -> ShowS
Show,ReadPrec [LTree]
ReadPrec LTree
Int -> ReadS LTree
ReadS [LTree]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LTree]
$creadListPrec :: ReadPrec [LTree]
readPrec :: ReadPrec LTree
$creadPrec :: ReadPrec LTree
readList :: ReadS [LTree]
$creadList :: ReadS [LTree]
readsPrec :: Int -> ReadS LTree
$creadsPrec :: Int -> ReadS LTree
Read,forall x. Rep LTree x -> LTree
forall x. LTree -> Rep LTree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LTree x -> LTree
$cfrom :: forall x. LTree -> Rep LTree x
Generic)
-- | `PGltree`
instance IsPG LTree where type PG LTree = PGltree
instance TypeError ('Text "LTree binary instances not yet implemented.")
  => FromPG LTree where
  fromPG :: StateT ByteString (Except Text) LTree
fromPG = Text -> LTree
UnsafeLTree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Text
Decoding.text_strict
instance TypeError ('Text "LTree binary instances not yet implemented.")
  => ToPG db LTree where
    toPG :: LTree -> ReaderT (K Connection db) IO Encoding
toPG = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
Encoding.text_strict forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTree -> Text
getLTree
instance Inline LTree where
  inline :: forall (null :: PGType -> NullType).
LTree -> Expr (null (PG LTree))
inline (UnsafeLTree Text
x)
    = forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
" :: ltree")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    forall a b. (a -> b) -> a -> b
$ Text
x

{- |
lquery represents a regular-expression-like pattern for matching ltree values.
A simple word matches that label within a path.
A star symbol (*) matches zero or more labels. For example:

@
foo         Match the exact label path foo
*.foo.*     Match any label path containing the label foo
*.foo       Match any label path whose last label is foo
@

Star symbols can also be quantified to restrict how many labels they can match:

@
*{n}        Match exactly n labels
*{n,}       Match at least n labels
*{n,m}      Match at least n but not more than m labels
*{,m}       Match at most m labels — same as  *{0,m}
@

There are several modifiers that can be put at the end of a non-star label
in lquery to make it match more than just the exact match:

@
\@           Match case-insensitively, for example a@ matches A
*           Match any label with this prefix, for example foo* matches foobar
%           Match initial underscore-separated words
@

The behavior of % is a bit complicated.
It tries to match words rather than the entire label.
For example foo_bar% matches foo_bar_baz but not foo_barbaz.
If combined with *, prefix matching applies to each word separately,
for example foo_bar%* matches foo1_bar2_baz but not foo1_br2_baz.

Also, you can write several possibly-modified labels separated with
| (OR) to match any of those labels,
and you can put ! (NOT) at the start to match any label
that doesn't match any of the alternatives.

Here's an annotated example of lquery:

@
Top.*{0,2}.sport*@.!football|tennis.Russ*|Spain
1.  2.     3.      4.               5.
@

This query will match any label path that:

1. begins with the label Top
2. and next has zero to two labels before
3. a label beginning with the case-insensitive prefix sport
4. then a label not matching football nor tennis
5. and then ends with a label beginning with Russ or exactly matching Spain.
-}
newtype LQuery = UnsafeLQuery {LQuery -> Text
getLQuery :: Text}
  deriving stock (LQuery -> LQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LQuery -> LQuery -> Bool
$c/= :: LQuery -> LQuery -> Bool
== :: LQuery -> LQuery -> Bool
$c== :: LQuery -> LQuery -> Bool
Eq,Eq LQuery
LQuery -> LQuery -> Bool
LQuery -> LQuery -> Ordering
LQuery -> LQuery -> LQuery
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
min :: LQuery -> LQuery -> LQuery
$cmin :: LQuery -> LQuery -> LQuery
max :: LQuery -> LQuery -> LQuery
$cmax :: LQuery -> LQuery -> LQuery
>= :: LQuery -> LQuery -> Bool
$c>= :: LQuery -> LQuery -> Bool
> :: LQuery -> LQuery -> Bool
$c> :: LQuery -> LQuery -> Bool
<= :: LQuery -> LQuery -> Bool
$c<= :: LQuery -> LQuery -> Bool
< :: LQuery -> LQuery -> Bool
$c< :: LQuery -> LQuery -> Bool
compare :: LQuery -> LQuery -> Ordering
$ccompare :: LQuery -> LQuery -> Ordering
Ord,Int -> LQuery -> ShowS
[LQuery] -> ShowS
LQuery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LQuery] -> ShowS
$cshowList :: [LQuery] -> ShowS
show :: LQuery -> String
$cshow :: LQuery -> String
showsPrec :: Int -> LQuery -> ShowS
$cshowsPrec :: Int -> LQuery -> ShowS
Show,ReadPrec [LQuery]
ReadPrec LQuery
Int -> ReadS LQuery
ReadS [LQuery]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LQuery]
$creadListPrec :: ReadPrec [LQuery]
readPrec :: ReadPrec LQuery
$creadPrec :: ReadPrec LQuery
readList :: ReadS [LQuery]
$creadList :: ReadS [LQuery]
readsPrec :: Int -> ReadS LQuery
$creadsPrec :: Int -> ReadS LQuery
Read,forall x. Rep LQuery x -> LQuery
forall x. LQuery -> Rep LQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LQuery x -> LQuery
$cfrom :: forall x. LQuery -> Rep LQuery x
Generic)
-- | `PGlquery`
instance IsPG LQuery where type PG LQuery = PGlquery
instance TypeError ('Text "LQuery binary instances not yet implemented.")
  => FromPG LQuery where
  fromPG :: StateT ByteString (Except Text) LQuery
fromPG = Text -> LQuery
UnsafeLQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Text
Decoding.text_strict
instance TypeError ('Text "LQuery binary instances not yet implemented.")
  => ToPG db LQuery where
  toPG :: LQuery -> ReaderT (K Connection db) IO Encoding
toPG = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
Encoding.text_strict forall b c a. (b -> c) -> (a -> b) -> a -> c
. LQuery -> Text
getLQuery
instance Inline LQuery where
  inline :: forall (null :: PGType -> NullType).
LQuery -> Expr (null (PG LQuery))
inline (UnsafeLQuery Text
x)
    = forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
" :: lquery")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    forall a b. (a -> b) -> a -> b
$ Text
x

{- |
ltxtquery represents a full-text-search-like pattern for matching ltree values.
An ltxtquery value contains words,
possibly with the modifiers @, *, % at the end;
the modifiers have the same meanings as in lquery.
Words can be combined with & (AND), | (OR), ! (NOT), and parentheses.
The key difference from lquery is that ltxtquery matches words
without regard to their position in the label path.

Here's an example ltxtquery:

@
Europe & Russia*@ & !Transportation
@

This will match paths that contain the label Europe and any label
beginning with Russia (case-insensitive), but not paths containing
the label Transportation. The location of these words within the
path is not important. Also, when % is used, the word can be matched
to any underscore-separated word within a label, regardless of position.

Note: ltxtquery allows whitespace between symbols, but ltree and lquery do not.
-}
newtype LTxtQuery = UnsafeLTxtQuery {LTxtQuery -> Text
getLTxtQuery :: Text}
  deriving stock (LTxtQuery -> LTxtQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LTxtQuery -> LTxtQuery -> Bool
$c/= :: LTxtQuery -> LTxtQuery -> Bool
== :: LTxtQuery -> LTxtQuery -> Bool
$c== :: LTxtQuery -> LTxtQuery -> Bool
Eq,Eq LTxtQuery
LTxtQuery -> LTxtQuery -> Bool
LTxtQuery -> LTxtQuery -> Ordering
LTxtQuery -> LTxtQuery -> LTxtQuery
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
min :: LTxtQuery -> LTxtQuery -> LTxtQuery
$cmin :: LTxtQuery -> LTxtQuery -> LTxtQuery
max :: LTxtQuery -> LTxtQuery -> LTxtQuery
$cmax :: LTxtQuery -> LTxtQuery -> LTxtQuery
>= :: LTxtQuery -> LTxtQuery -> Bool
$c>= :: LTxtQuery -> LTxtQuery -> Bool
> :: LTxtQuery -> LTxtQuery -> Bool
$c> :: LTxtQuery -> LTxtQuery -> Bool
<= :: LTxtQuery -> LTxtQuery -> Bool
$c<= :: LTxtQuery -> LTxtQuery -> Bool
< :: LTxtQuery -> LTxtQuery -> Bool
$c< :: LTxtQuery -> LTxtQuery -> Bool
compare :: LTxtQuery -> LTxtQuery -> Ordering
$ccompare :: LTxtQuery -> LTxtQuery -> Ordering
Ord,Int -> LTxtQuery -> ShowS
[LTxtQuery] -> ShowS
LTxtQuery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LTxtQuery] -> ShowS
$cshowList :: [LTxtQuery] -> ShowS
show :: LTxtQuery -> String
$cshow :: LTxtQuery -> String
showsPrec :: Int -> LTxtQuery -> ShowS
$cshowsPrec :: Int -> LTxtQuery -> ShowS
Show,ReadPrec [LTxtQuery]
ReadPrec LTxtQuery
Int -> ReadS LTxtQuery
ReadS [LTxtQuery]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LTxtQuery]
$creadListPrec :: ReadPrec [LTxtQuery]
readPrec :: ReadPrec LTxtQuery
$creadPrec :: ReadPrec LTxtQuery
readList :: ReadS [LTxtQuery]
$creadList :: ReadS [LTxtQuery]
readsPrec :: Int -> ReadS LTxtQuery
$creadsPrec :: Int -> ReadS LTxtQuery
Read,forall x. Rep LTxtQuery x -> LTxtQuery
forall x. LTxtQuery -> Rep LTxtQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LTxtQuery x -> LTxtQuery
$cfrom :: forall x. LTxtQuery -> Rep LTxtQuery x
Generic)
-- | `PGltxtquery`
instance IsPG LTxtQuery where type PG LTxtQuery = PGltxtquery
instance TypeError ('Text "LTxtQuery binary instances not yet implemented.")
  => FromPG LTxtQuery where
  fromPG :: StateT ByteString (Except Text) LTxtQuery
fromPG = Text -> LTxtQuery
UnsafeLTxtQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. Value x -> StateT ByteString (Except Text) x
devalue Value Text
Decoding.text_strict
instance TypeError ('Text "LTxtQuery binary instances not yet implemented.")
  => ToPG db LTxtQuery where
  toPG :: LTxtQuery -> ReaderT (K Connection db) IO Encoding
toPG = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
Encoding.text_strict forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTxtQuery -> Text
getLTxtQuery
instance Inline LTxtQuery where
  inline :: forall (null :: PGType -> NullType).
LTxtQuery -> Expr (null (PG LTxtQuery))
inline (UnsafeLTxtQuery Text
x)
    = forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
" :: ltxtquery")
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
escapeQuotedText
    forall a b. (a -> b) -> a -> b
$ Text
x

instance IsString
  (Expression grp lat with db params from (null PGltree)) where
    fromString :: String -> Expression grp lat with db params from (null PGltree)
fromString
      = forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
" :: ltree")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
escapeQuotedString
instance IsString
  (Expression grp lat with db params from (null PGlquery)) where
    fromString :: String -> Expression grp lat with db params from (null PGlquery)
fromString
      = forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
" :: lquery")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
escapeQuotedString
instance IsString
  (Expression grp lat with db params from (null PGltxtquery)) where
    fromString :: String -> Expression grp lat with db params from (null PGltxtquery)
fromString
      = forall (grp :: Grouping) (lat :: FromType) (with :: FromType)
       (db :: SchemasType) (params :: [NullType]) (from :: FromType)
       (ty :: NullType).
ByteString -> Expression grp lat with db params from ty
UnsafeExpression
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
parenthesized
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> ByteString
" :: ltxtquery")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
escapeQuotedString

-- | Returns subpath of ltree from position start to position end-1 (counting from 0).
subltree :: '[null PGltree, null 'PGint4, null 'PGint4] ---> null PGltree
subltree :: forall (null :: PGType -> NullType).
'[null PGltree, null 'PGint4, null 'PGint4] ---> null PGltree
subltree = forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"subltree"

-- | Returns subpath of ltree starting at position offset, with length len.
-- If offset is negative, subpath starts that far from the end of the path.
-- If len is negative, leaves that many labels off the end of the path.
subpath :: '[null PGltree, null 'PGint4, null 'PGint4] ---> null PGltree
subpath :: forall (null :: PGType -> NullType).
'[null PGltree, null 'PGint4, null 'PGint4] ---> null PGltree
subpath = forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"subpath"

-- | Returns subpath of ltree starting at position offset,
-- extending to end of path. If offset is negative,
-- subpath starts that far from the end of the path.
subpathEnd :: '[null PGltree, null 'PGint4] ---> null PGltree
subpathEnd :: forall (null :: PGType -> NullType).
'[null PGltree, null 'PGint4] ---> null PGltree
subpathEnd = forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"subpath"

-- | Returns number of labels in path.
nlevel :: null PGltree --> null 'PGint4
nlevel :: forall (null :: PGType -> NullType). null PGltree --> null 'PGint4
nlevel = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"nlevel"

-- | Returns position of first occurrence of b in a, or -1 if not found.
indexLTree :: '[null PGltree, null PGltree] ---> null 'PGint4
indexLTree :: forall (null :: PGType -> NullType).
'[null PGltree, null PGltree] ---> null 'PGint4
indexLTree = forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"index"

-- | Returns position of first occurrence of b in a, or -1 if not found.
-- The search starts at position offset;
-- negative offset means start -offset labels from the end of the path.
indexOffset :: '[null PGltree, null PGltree, null 'PGint4] ---> null 'PGint4
indexOffset :: forall (null :: PGType -> NullType).
'[null PGltree, null PGltree, null 'PGint4] ---> null 'PGint4
indexOffset = forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"index"

-- | Casts text to ltree.
text2ltree :: null 'PGtext --> null PGltree
text2ltree :: forall (null :: PGType -> NullType). null 'PGtext --> null PGltree
text2ltree = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"text2ltree"

-- | Casts ltree to text.
ltree2text :: null PGltree --> null 'PGtext
ltree2text :: forall (null :: PGType -> NullType). null PGltree --> null 'PGtext
ltree2text = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"ltree2text"

-- | Computes longest common ancestor of paths in array.
lca :: null ('PGvararray ('NotNull PGltree)) --> null PGltree
lca :: forall (null :: PGType -> NullType).
null ('PGvararray ('NotNull PGltree)) --> null PGltree
lca = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"lca"

{- |
`(@>)` Is left argument an ancestor of right (or equal)?

`(<@)` Is left argument a descendant of right (or equal)?
-}
instance PGSubset PGltree

-- | Does ltree match lquery?
(%~) :: Operator (null0 PGltree) (null1 PGlquery) ('Null 'PGbool)
%~ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator (null0 PGltree) (null1 PGlquery) ('Null 'PGbool)
(%~) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"~"
infix 4 %~

-- | Does ltree match lquery?
(~%) :: Operator (null1 PGlquery) (null0 PGltree) ('Null 'PGbool)
~% :: forall (null1 :: PGType -> NullType) (null0 :: PGType -> NullType).
Operator (null1 PGlquery) (null0 PGltree) ('Null 'PGbool)
(~%) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"~"
infix 4 ~%

-- | Does ltree match any lquery in array?
(%?) :: Operator
  (null0 PGltree) (null1 ('PGvararray ('NotNull PGlquery))) ('Null 'PGbool)
%? :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 PGltree)
  (null1 ('PGvararray ('NotNull PGlquery)))
  ('Null 'PGbool)
(%?) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?"
infix 4 %?

-- | Does ltree match any lquery in array?
(?%) :: Operator
  (null0 ('PGvararray ('NotNull PGlquery))) (null1 PGltree) ('Null 'PGbool)
?% :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGlquery)))
  (null1 PGltree)
  ('Null 'PGbool)
(?%) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?"
infix 4 ?%

-- | Does ltree match ltxtquery?
(%@) :: Operator (null0 PGltree) (null1 PGltxtquery) ('Null 'PGbool)
%@ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator (null0 PGltree) (null1 PGltxtquery) ('Null 'PGbool)
(%@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@"
infix 4 %@

-- | Does ltree match ltxtquery?
(@%) :: Operator (null0  PGltxtquery) (null1 PGltree) ('Null 'PGbool)
@% :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator (null0 PGltxtquery) (null1 PGltree) ('Null 'PGbool)
(@%) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@"
infix 4 @%

-- | `(<>)` Concatenates ltree paths.
instance Semigroup
  (Expression grp lat with db params from (null PGltree)) where
    <> :: Expression grp lat with db params from (null PGltree)
-> Expression grp lat with db params from (null PGltree)
-> Expression grp lat with db params from (null PGltree)
(<>) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"||"
instance Monoid
  (Expression grp lat with db params from (null PGltree)) where
    mempty :: Expression grp lat with db params from (null PGltree)
mempty = forall a. IsString a => String -> a
fromString String
""
    mappend :: Expression grp lat with db params from (null PGltree)
-> Expression grp lat with db params from (null PGltree)
-> Expression grp lat with db params from (null PGltree)
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Does array contain an ancestor of ltree?
(@>%) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGltree) ('Null 'PGbool)
@>% :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGltree)
  ('Null 'PGbool)
(@>%) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@>"
infix 4 @>%

-- | Does array contain an ancestor of ltree?
(%<@) :: Operator
  (null0 PGltree) (null1 ('PGvararray ('NotNull PGltree))) ('Null 'PGbool)
%<@ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 PGltree)
  (null1 ('PGvararray ('NotNull PGltree)))
  ('Null 'PGbool)
(%<@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"<@"
infix 4 %<@

-- | Does array contain a descendant of ltree?
(<@%) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGltree) ('Null 'PGbool)
<@% :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGltree)
  ('Null 'PGbool)
(<@%) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"<@"
infix 4 <@%

-- | Does array contain a descendant of ltree?
(%@>) :: Operator
  (null0 PGltree) (null1 ('PGvararray ('NotNull PGltree))) ('Null 'PGbool)
%@> :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 PGltree)
  (null1 ('PGvararray ('NotNull PGltree)))
  ('Null 'PGbool)
(%@>) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@>"
infix 4 %@>

-- | Does array contain any path matching lquery?
(&~) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGlquery) ('Null 'PGbool)
&~ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGlquery)
  ('Null 'PGbool)
(&~) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"~"
infix 4 &~

-- | Does array contain any path matching lquery?
(~&) :: Operator
  (null0 PGlquery) (null1 ('PGvararray ('NotNull PGltree))) ('Null 'PGbool)
~& :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 PGlquery)
  (null1 ('PGvararray ('NotNull PGltree)))
  ('Null 'PGbool)
(~&) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"~"
infix 4 ~&

-- | Does ltree array contain any path matching any lquery?
(&?) :: Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 ('PGvararray ('NotNull PGlquery)))
  ('Null 'PGbool)
&? :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 ('PGvararray ('NotNull PGlquery)))
  ('Null 'PGbool)
(&?) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?"
infix 4 &?

-- | Does ltree array contain any path matching any lquery?
(?&) :: Operator
  (null0 ('PGvararray ('NotNull PGlquery)))
  (null1 ('PGvararray ('NotNull PGltree)))
  ('Null 'PGbool)
?& :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGlquery)))
  (null1 ('PGvararray ('NotNull PGltree)))
  ('Null 'PGbool)
(?&) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?"
infix 4 ?&

-- | Does array contain any path matching ltxtquery?
(&@) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGltxtquery) ('Null 'PGbool)
&@ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGltxtquery)
  ('Null 'PGbool)
(&@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@"
infix 4 &@

-- | Does array contain any path matching ltxtquery?
(@&) :: Operator
  (null0 PGltxtquery) (null1 ('PGvararray ('NotNull PGltree))) ('Null 'PGbool)
@& :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 PGltxtquery)
  (null1 ('PGvararray ('NotNull PGltree)))
  ('Null 'PGbool)
(@&) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@"
infix 4 @&

-- | Returns first array entry that is an ancestor of ltree, or NULL if none.
(?@>) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGltree) ('Null PGltree)
?@> :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGltree)
  ('Null PGltree)
(?@>) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?@>"
infix 4 ?@>

-- | Returns first array entry that is a descendant of ltree, or NULL if none.
(?<@) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGltree) ('Null PGltree)
?<@ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGltree)
  ('Null PGltree)
(?<@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?<@"
infix 4 ?<@

-- | Returns first array entry that matches lquery, or NULL if none.
(?~) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGlquery) ('Null PGltree)
?~ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGlquery)
  ('Null PGltree)
(?~) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?~"
infix 4 ?~

-- | Returns first array entry that matches ltxtquery, or NULL if none.
(?@) :: Operator
  (null0 ('PGvararray ('NotNull PGltree))) (null1 PGltxtquery) ('Null PGltree)
?@ :: forall (null0 :: PGType -> NullType) (null1 :: PGType -> NullType).
Operator
  (null0 ('PGvararray ('NotNull PGltree)))
  (null1 PGltxtquery)
  ('Null PGltree)
(?@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"?@"
infix 4 ?@