-- | This module provides types and functions for PostgreSQL's @lquery@ https://www.postgresql.org/docs/current/ltree.html
--
-- You will want to use a specific implementation, e.g. @postgresql-simple-ltree@.
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.PostgreSQL.LQuery
  ( LQuery(..)
  , contains
  ) where

import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON))
import Data.Text (Text)

import qualified Database.PostgreSQL.LTree as LTree

-- | Wrapper for Postgres' @lquery@ (label tree query) type.
newtype LQuery = LQuery { LQuery -> Text
unLQuery :: Text }
  deriving newtype (Int -> LQuery -> ShowS
[LQuery] -> ShowS
LQuery -> String
(Int -> LQuery -> ShowS)
-> (LQuery -> String) -> ([LQuery] -> ShowS) -> Show LQuery
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, LQuery -> LQuery -> Bool
(LQuery -> LQuery -> Bool)
-> (LQuery -> LQuery -> Bool) -> Eq LQuery
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
Eq LQuery
-> (LQuery -> LQuery -> Ordering)
-> (LQuery -> LQuery -> Bool)
-> (LQuery -> LQuery -> Bool)
-> (LQuery -> LQuery -> Bool)
-> (LQuery -> LQuery -> Bool)
-> (LQuery -> LQuery -> LQuery)
-> (LQuery -> LQuery -> LQuery)
-> Ord 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
$cp1Ord :: Eq LQuery
Ord)

-- | Build an @lquery@ expression which matches any @ltree@ which contains
-- the given @label@.
contains :: LTree.Label -> LQuery
contains :: Label -> LQuery
contains Label
label = Text -> LQuery
LQuery (Text -> LQuery) -> Text -> LQuery
forall a b. (a -> b) -> a -> b
$ Text
"*." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
LTree.unLabel Label
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".*"

instance FromJSON LQuery where
  parseJSON :: Value -> Parser LQuery
parseJSON = (Text -> LQuery) -> Parser Text -> Parser LQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> LQuery
LQuery (Parser Text -> Parser LQuery)
-> (Value -> Parser Text) -> Value -> Parser LQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON LQuery where
  toJSON :: LQuery -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (LQuery -> Text) -> LQuery -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LQuery -> Text
unLQuery