{-|
Module: Squeal.PostgreSQL.Expression.Range
Description: range types and functions
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

range types and functions
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , DeriveAnyClass
  , DeriveGeneric
  , DeriveFoldable
  , DerivingStrategies
  , DeriveTraversable
  , FlexibleContexts
  , FlexibleInstances
  , LambdaCase
  , MultiParamTypeClasses
  , OverloadedLabels
  , OverloadedStrings
  , PatternSynonyms
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Expression.Range
  ( -- * Range
    Range (..)
  , (<=..<=), (<..<), (<=..<), (<..<=)
  , moreThan, atLeast, lessThan, atMost
  , singleton, whole
  , Bound (..)
    -- * Range Function
    -- ** Range Construction
  , range
    -- ** Range Operator
  , (.<@)
  , (@>.)
  , (<<@)
  , (@>>)
  , (&<)
  , (&>)
  , (-|-)
  , (@+)
  , (@*)
  , (@-)
    -- ** Range Function
  , lowerBound
  , upperBound
  , isEmpty
  , lowerInc
  , lowerInf
  , upperInc
  , upperInf
  , rangeMerge
  ) where

import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP

import Squeal.PostgreSQL.Expression
import Squeal.PostgreSQL.Expression.Type hiding (bool)
import Squeal.PostgreSQL.Type.PG
import Squeal.PostgreSQL.Render
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL (tstzrange, numrange, int4range, now, printSQL)

-- | Construct a `range`
--
-- >>> printSQL $ range tstzrange (atLeast now)
-- tstzrange(now(), NULL, '[)')
-- >>> printSQL $ range numrange (0 <=..< 2*pi)
-- numrange((0.0 :: numeric), ((2.0 :: numeric) * pi()), '[)')
-- >>> printSQL $ range int4range Empty
-- ('empty' :: int4range)
range
  :: TypeExpression db (null ('PGrange ty))
  -- ^ range type
  -> Range (Expression grp lat with db params from ('NotNull ty))
  -- ^ range of values
  -> Expression grp lat with db params from (null ('PGrange ty))
range :: forall (db :: SchemasType) (null :: PGType -> NullType)
       (ty :: PGType) (grp :: Grouping) (lat :: FromType)
       (with :: FromType) (params :: [NullType]) (from :: FromType).
TypeExpression db (null ('PGrange ty))
-> Range (Expression grp lat with db params from ('NotNull ty))
-> Expression grp lat with db params from (null ('PGrange ty))
range TypeExpression db (null ('PGrange ty))
ty = \case
  Range (Expression grp lat with db params from ('NotNull ty))
Empty -> 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 a b. (a -> b) -> a -> b
$ ByteString -> ByteString
parenthesized
    (ByteString
emp ByteString -> ByteString -> ByteString
<+> ByteString
"::" ByteString -> ByteString -> ByteString
<+> forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db (null ('PGrange ty))
ty)
  NonEmpty Bound (Expression grp lat with db params from ('NotNull ty))
l Bound (Expression grp lat with db params from ('NotNull ty))
u -> 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 a b. (a -> b) -> a -> b
$ forall sql. RenderSQL sql => sql -> ByteString
renderSQL TypeExpression db (null ('PGrange ty))
ty forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
parenthesized
    ([ByteString] -> ByteString
commaSeparated (Bound (Expression grp lat with db params from ('NotNull ty))
-> Bound (Expression grp lat with db params from ('NotNull ty))
-> [ByteString]
args Bound (Expression grp lat with db params from ('NotNull ty))
l Bound (Expression grp lat with db params from ('NotNull ty))
u))
  where
    emp :: ByteString
emp = ByteString
singleQuote forall a. Semigroup a => a -> a -> a
<> ByteString
"empty" forall a. Semigroup a => a -> a -> a
<> ByteString
singleQuote
    args :: Bound (Expression grp lat with db params from ('NotNull ty))
-> Bound (Expression grp lat with db params from ('NotNull ty))
-> [ByteString]
args Bound (Expression grp lat with db params from ('NotNull ty))
l Bound (Expression grp lat with db params from ('NotNull ty))
u = [Bound (Expression grp lat with db params from ('NotNull ty))
-> ByteString
arg Bound (Expression grp lat with db params from ('NotNull ty))
l, Bound (Expression grp lat with db params from ('NotNull ty))
-> ByteString
arg Bound (Expression grp lat with db params from ('NotNull ty))
u, ByteString
singleQuote forall a. Semigroup a => a -> a -> a
<> forall {x}. Bound x -> ByteString
bra Bound (Expression grp lat with db params from ('NotNull ty))
l forall a. Semigroup a => a -> a -> a
<> forall {x}. Bound x -> ByteString
ket Bound (Expression grp lat with db params from ('NotNull ty))
u forall a. Semigroup a => a -> a -> a
<> ByteString
singleQuote]
    singleQuote :: ByteString
singleQuote = ByteString
"\'"
    arg :: Bound (Expression grp lat with db params from ('NotNull ty))
-> ByteString
arg = \case
      Bound (Expression grp lat with db params from ('NotNull ty))
Infinite -> ByteString
"NULL"; Closed Expression grp lat with db params from ('NotNull ty)
x -> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('NotNull ty)
x; Open Expression grp lat with db params from ('NotNull ty)
x -> forall sql. RenderSQL sql => sql -> ByteString
renderSQL Expression grp lat with db params from ('NotNull ty)
x
    bra :: Bound x -> ByteString
bra = \case Bound x
Infinite -> ByteString
"("; Closed x
_ -> ByteString
"["; Open x
_ -> ByteString
"("
    ket :: Bound x -> ByteString
ket = \case Bound x
Infinite -> ByteString
")"; Closed x
_ -> ByteString
"]"; Open x
_ -> ByteString
")"

-- | The type of `Bound` for a `Range`.
data Bound x
  = Infinite -- ^ unbounded
  | Closed x -- ^ inclusive
  | Open x -- ^ exclusive
  deriving
    ( Bound x -> Bound x -> Bool
forall x. Eq x => Bound x -> Bound x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bound x -> Bound x -> Bool
$c/= :: forall x. Eq x => Bound x -> Bound x -> Bool
== :: Bound x -> Bound x -> Bool
$c== :: forall x. Eq x => Bound x -> Bound x -> Bool
Eq, Bound x -> Bound x -> Bool
Bound x -> Bound x -> Ordering
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
forall {x}. Ord x => Eq (Bound x)
forall x. Ord x => Bound x -> Bound x -> Bool
forall x. Ord x => Bound x -> Bound x -> Ordering
forall x. Ord x => Bound x -> Bound x -> Bound x
min :: Bound x -> Bound x -> Bound x
$cmin :: forall x. Ord x => Bound x -> Bound x -> Bound x
max :: Bound x -> Bound x -> Bound x
$cmax :: forall x. Ord x => Bound x -> Bound x -> Bound x
>= :: Bound x -> Bound x -> Bool
$c>= :: forall x. Ord x => Bound x -> Bound x -> Bool
> :: Bound x -> Bound x -> Bool
$c> :: forall x. Ord x => Bound x -> Bound x -> Bool
<= :: Bound x -> Bound x -> Bool
$c<= :: forall x. Ord x => Bound x -> Bound x -> Bool
< :: Bound x -> Bound x -> Bool
$c< :: forall x. Ord x => Bound x -> Bound x -> Bool
compare :: Bound x -> Bound x -> Ordering
$ccompare :: forall x. Ord x => Bound x -> Bound x -> Ordering
Ord, Int -> Bound x -> ShowS
forall x. Show x => Int -> Bound x -> ShowS
forall x. Show x => [Bound x] -> ShowS
forall x. Show x => Bound x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bound x] -> ShowS
$cshowList :: forall x. Show x => [Bound x] -> ShowS
show :: Bound x -> String
$cshow :: forall x. Show x => Bound x -> String
showsPrec :: Int -> Bound x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> Bound x -> ShowS
Show, ReadPrec [Bound x]
ReadPrec (Bound x)
ReadS [Bound x]
forall x. Read x => ReadPrec [Bound x]
forall x. Read x => ReadPrec (Bound x)
forall x. Read x => Int -> ReadS (Bound x)
forall x. Read x => ReadS [Bound x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bound x]
$creadListPrec :: forall x. Read x => ReadPrec [Bound x]
readPrec :: ReadPrec (Bound x)
$creadPrec :: forall x. Read x => ReadPrec (Bound x)
readList :: ReadS [Bound x]
$creadList :: forall x. Read x => ReadS [Bound x]
readsPrec :: Int -> ReadS (Bound x)
$creadsPrec :: forall x. Read x => Int -> ReadS (Bound x)
Read, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (Bound x) x -> Bound x
forall x x. Bound x -> Rep (Bound x) x
$cto :: forall x x. Rep (Bound x) x -> Bound x
$cfrom :: forall x x. Bound x -> Rep (Bound x) x
GHC.Generic
    , forall a b. a -> Bound b -> Bound a
forall a b. (a -> b) -> Bound a -> Bound b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Bound b -> Bound a
$c<$ :: forall a b. a -> Bound b -> Bound a
fmap :: forall a b. (a -> b) -> Bound a -> Bound b
$cfmap :: forall a b. (a -> b) -> Bound a -> Bound b
Functor, forall a. Eq a => a -> Bound a -> Bool
forall a. Num a => Bound a -> a
forall a. Ord a => Bound a -> a
forall m. Monoid m => Bound m -> m
forall a. Bound a -> Bool
forall a. Bound a -> Int
forall a. Bound a -> [a]
forall a. (a -> a -> a) -> Bound a -> a
forall m a. Monoid m => (a -> m) -> Bound a -> m
forall b a. (b -> a -> b) -> b -> Bound a -> b
forall a b. (a -> b -> b) -> b -> Bound a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Bound a -> a
$cproduct :: forall a. Num a => Bound a -> a
sum :: forall a. Num a => Bound a -> a
$csum :: forall a. Num a => Bound a -> a
minimum :: forall a. Ord a => Bound a -> a
$cminimum :: forall a. Ord a => Bound a -> a
maximum :: forall a. Ord a => Bound a -> a
$cmaximum :: forall a. Ord a => Bound a -> a
elem :: forall a. Eq a => a -> Bound a -> Bool
$celem :: forall a. Eq a => a -> Bound a -> Bool
length :: forall a. Bound a -> Int
$clength :: forall a. Bound a -> Int
null :: forall a. Bound a -> Bool
$cnull :: forall a. Bound a -> Bool
toList :: forall a. Bound a -> [a]
$ctoList :: forall a. Bound a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Bound a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Bound a -> a
foldr1 :: forall a. (a -> a -> a) -> Bound a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Bound a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Bound a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Bound a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Bound a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Bound a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Bound a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Bound a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Bound a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Bound a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Bound a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Bound a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Bound a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Bound a -> m
fold :: forall m. Monoid m => Bound m -> m
$cfold :: forall m. Monoid m => Bound m -> m
Foldable, Functor Bound
Foldable Bound
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a)
forall (f :: * -> *) a. Applicative f => Bound (f a) -> f (Bound a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bound a -> m (Bound b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound a -> f (Bound b)
sequence :: forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a)
$csequence :: forall (m :: * -> *) a. Monad m => Bound (m a) -> m (Bound a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bound a -> m (Bound b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bound a -> m (Bound b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Bound (f a) -> f (Bound a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Bound (f a) -> f (Bound a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound a -> f (Bound b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bound a -> f (Bound b)
Traversable )

-- | A `Range` datatype that comprises connected subsets of
-- the real line.
data Range x = Empty | NonEmpty (Bound x) (Bound x)
  deriving
    ( Range x -> Range x -> Bool
forall x. Eq x => Range x -> Range x -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range x -> Range x -> Bool
$c/= :: forall x. Eq x => Range x -> Range x -> Bool
== :: Range x -> Range x -> Bool
$c== :: forall x. Eq x => Range x -> Range x -> Bool
Eq, Range x -> Range x -> Bool
Range x -> Range x -> Ordering
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
forall {x}. Ord x => Eq (Range x)
forall x. Ord x => Range x -> Range x -> Bool
forall x. Ord x => Range x -> Range x -> Ordering
forall x. Ord x => Range x -> Range x -> Range x
min :: Range x -> Range x -> Range x
$cmin :: forall x. Ord x => Range x -> Range x -> Range x
max :: Range x -> Range x -> Range x
$cmax :: forall x. Ord x => Range x -> Range x -> Range x
>= :: Range x -> Range x -> Bool
$c>= :: forall x. Ord x => Range x -> Range x -> Bool
> :: Range x -> Range x -> Bool
$c> :: forall x. Ord x => Range x -> Range x -> Bool
<= :: Range x -> Range x -> Bool
$c<= :: forall x. Ord x => Range x -> Range x -> Bool
< :: Range x -> Range x -> Bool
$c< :: forall x. Ord x => Range x -> Range x -> Bool
compare :: Range x -> Range x -> Ordering
$ccompare :: forall x. Ord x => Range x -> Range x -> Ordering
Ord, Int -> Range x -> ShowS
forall x. Show x => Int -> Range x -> ShowS
forall x. Show x => [Range x] -> ShowS
forall x. Show x => Range x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Range x] -> ShowS
$cshowList :: forall x. Show x => [Range x] -> ShowS
show :: Range x -> String
$cshow :: forall x. Show x => Range x -> String
showsPrec :: Int -> Range x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> Range x -> ShowS
Show, ReadPrec [Range x]
ReadPrec (Range x)
ReadS [Range x]
forall x. Read x => ReadPrec [Range x]
forall x. Read x => ReadPrec (Range x)
forall x. Read x => Int -> ReadS (Range x)
forall x. Read x => ReadS [Range x]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Range x]
$creadListPrec :: forall x. Read x => ReadPrec [Range x]
readPrec :: ReadPrec (Range x)
$creadPrec :: forall x. Read x => ReadPrec (Range x)
readList :: ReadS [Range x]
$creadList :: forall x. Read x => ReadS [Range x]
readsPrec :: Int -> ReadS (Range x)
$creadsPrec :: forall x. Read x => Int -> ReadS (Range x)
Read, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x x. Rep (Range x) x -> Range x
forall x x. Range x -> Rep (Range x) x
$cto :: forall x x. Rep (Range x) x -> Range x
$cfrom :: forall x x. Range x -> Rep (Range x) x
GHC.Generic
    , forall a b. a -> Range b -> Range a
forall a b. (a -> b) -> Range a -> Range b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Range b -> Range a
$c<$ :: forall a b. a -> Range b -> Range a
fmap :: forall a b. (a -> b) -> Range a -> Range b
$cfmap :: forall a b. (a -> b) -> Range a -> Range b
Functor, forall a. Eq a => a -> Range a -> Bool
forall a. Num a => Range a -> a
forall a. Ord a => Range a -> a
forall m. Monoid m => Range m -> m
forall a. Range a -> Bool
forall a. Range a -> Int
forall a. Range a -> [a]
forall a. (a -> a -> a) -> Range a -> a
forall m a. Monoid m => (a -> m) -> Range a -> m
forall b a. (b -> a -> b) -> b -> Range a -> b
forall a b. (a -> b -> b) -> b -> Range a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Range a -> a
$cproduct :: forall a. Num a => Range a -> a
sum :: forall a. Num a => Range a -> a
$csum :: forall a. Num a => Range a -> a
minimum :: forall a. Ord a => Range a -> a
$cminimum :: forall a. Ord a => Range a -> a
maximum :: forall a. Ord a => Range a -> a
$cmaximum :: forall a. Ord a => Range a -> a
elem :: forall a. Eq a => a -> Range a -> Bool
$celem :: forall a. Eq a => a -> Range a -> Bool
length :: forall a. Range a -> Int
$clength :: forall a. Range a -> Int
null :: forall a. Range a -> Bool
$cnull :: forall a. Range a -> Bool
toList :: forall a. Range a -> [a]
$ctoList :: forall a. Range a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Range a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Range a -> a
foldr1 :: forall a. (a -> a -> a) -> Range a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Range a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Range a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Range a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Range a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Range a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Range a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Range a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Range a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Range a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Range a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Range a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Range a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Range a -> m
fold :: forall m. Monoid m => Range m -> m
$cfold :: forall m. Monoid m => Range m -> m
Foldable, Functor Range
Foldable Range
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Range (m a) -> m (Range a)
forall (f :: * -> *) a. Applicative f => Range (f a) -> f (Range a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Range a -> m (Range b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Range a -> f (Range b)
sequence :: forall (m :: * -> *) a. Monad m => Range (m a) -> m (Range a)
$csequence :: forall (m :: * -> *) a. Monad m => Range (m a) -> m (Range a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Range a -> m (Range b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Range a -> m (Range b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Range (f a) -> f (Range a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Range (f a) -> f (Range a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Range a -> f (Range b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Range a -> f (Range b)
Traversable )
  deriving anyclass (forall {x}. All SListI (Code (Range x))
forall a.
All SListI (Code a) -> (a -> Rep a) -> (Rep a -> a) -> Generic a
forall x. Rep (Range x) -> Range x
forall x. Range x -> Rep (Range x)
to :: Rep (Range x) -> Range x
$cto :: forall x. Rep (Range x) -> Range x
from :: Range x -> Rep (Range x)
$cfrom :: forall x. Range x -> Rep (Range x)
SOP.Generic, forall x. Generic (Range x)
forall a.
Generic a
-> (forall (proxy :: * -> *). proxy a -> DatatypeInfo (Code a))
-> HasDatatypeInfo a
forall x (proxy :: * -> *).
proxy (Range x) -> DatatypeInfo (Code (Range x))
datatypeInfo :: forall (proxy :: * -> *).
proxy (Range x) -> DatatypeInfo (Code (Range x))
$cdatatypeInfo :: forall x (proxy :: * -> *).
proxy (Range x) -> DatatypeInfo (Code (Range x))
SOP.HasDatatypeInfo)
-- | `PGrange` @(@`PG` @hask)@
instance IsPG hask => IsPG (Range hask) where
  type PG (Range hask) = 'PGrange (PG hask)

-- | Finite `Range` constructor
(<=..<=), (<..<), (<=..<), (<..<=) :: x -> x -> Range x
infix 4 <=..<=, <..<, <=..<, <..<=
x
x <=..<= :: forall x. x -> x -> Range x
<=..<= x
y = forall x. Bound x -> Bound x -> Range x
NonEmpty (forall x. x -> Bound x
Closed x
x) (forall x. x -> Bound x
Closed x
y)
x
x <..< :: forall x. x -> x -> Range x
<..< x
y = forall x. Bound x -> Bound x -> Range x
NonEmpty (forall x. x -> Bound x
Open x
x) (forall x. x -> Bound x
Open x
y)
x
x <=..< :: forall x. x -> x -> Range x
<=..< x
y = forall x. Bound x -> Bound x -> Range x
NonEmpty (forall x. x -> Bound x
Closed x
x) (forall x. x -> Bound x
Open x
y)
x
x <..<= :: forall x. x -> x -> Range x
<..<= x
y = forall x. Bound x -> Bound x -> Range x
NonEmpty (forall x. x -> Bound x
Open x
x) (forall x. x -> Bound x
Closed x
y)

-- | Half-infinite `Range` constructor
moreThan, atLeast, lessThan, atMost :: x -> Range x
moreThan :: forall x. x -> Range x
moreThan x
x = forall x. Bound x -> Bound x -> Range x
NonEmpty (forall x. x -> Bound x
Open x
x) forall x. Bound x
Infinite
atLeast :: forall x. x -> Range x
atLeast x
x = forall x. Bound x -> Bound x -> Range x
NonEmpty (forall x. x -> Bound x
Closed x
x) forall x. Bound x
Infinite
lessThan :: forall x. x -> Range x
lessThan x
x = forall x. Bound x -> Bound x -> Range x
NonEmpty forall x. Bound x
Infinite (forall x. x -> Bound x
Open x
x)
atMost :: forall x. x -> Range x
atMost x
x = forall x. Bound x -> Bound x -> Range x
NonEmpty forall x. Bound x
Infinite (forall x. x -> Bound x
Closed x
x)

-- | A point on the line
singleton :: x -> Range x
singleton :: forall x. x -> Range x
singleton x
x = x
x forall x. x -> x -> Range x
<=..<= x
x

-- | The `whole` line
whole :: Range x
whole :: forall x. Range x
whole = forall x. Bound x -> Bound x -> Range x
NonEmpty forall x. Bound x
Infinite forall x. Bound x
Infinite

-- | range is contained by
(.<@) :: Operator (null0 ty) (null1 ('PGrange ty)) ('Null 'PGbool)
.<@ :: forall (null0 :: PGType -> NullType) (ty :: PGType)
       (null1 :: PGType -> NullType).
Operator (null0 ty) (null1 ('PGrange ty)) ('Null 'PGbool)
(.<@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"<@"

-- | contains range
(@>.) :: Operator (null0 ('PGrange ty)) (null1 ty) ('Null 'PGbool)
@>. :: forall (null0 :: PGType -> NullType) (ty :: PGType)
       (null1 :: PGType -> NullType).
Operator (null0 ('PGrange ty)) (null1 ty) ('Null 'PGbool)
(@>.) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"@>"

-- | strictly left of,
-- return false when an empty range is involved
(<<@) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
<<@ :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
(<<@) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"<<"

-- | strictly right of,
-- return false when an empty range is involved
(@>>) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
@>> :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
(@>>) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
">>"

-- | does not extend to the right of,
-- return false when an empty range is involved
(&<) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
&< :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
(&<) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"&<"

-- | does not extend to the left of,
-- return false when an empty range is involved
(&>) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
&> :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
(&>) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"&>"

-- | is adjacent to, return false when an empty range is involved
(-|-) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
-|- :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator (null ('PGrange ty)) (null ('PGrange ty)) ('Null 'PGbool)
(-|-) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"-|-"

-- | union, will fail if the resulting range would
-- need to contain two disjoint sub-ranges
(@+) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
@+ :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator
  (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
(@+) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"+"

-- | intersection
(@*) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
@* :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator
  (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
(@*) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"*"

-- | difference, will fail if the resulting range would
-- need to contain two disjoint sub-ranges
(@-) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
@- :: forall (null :: PGType -> NullType) (ty :: PGType).
Operator
  (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
(@-) = forall (ty0 :: NullType) (ty1 :: NullType) (ty2 :: NullType).
ByteString -> Operator ty0 ty1 ty2
unsafeBinaryOp ByteString
"-"

-- | lower bound of range
lowerBound :: null ('PGrange ty) --> 'Null ty
lowerBound :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null ty
lowerBound = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"lower"

-- | upper bound of range
upperBound :: null ('PGrange ty) --> 'Null ty
upperBound :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null ty
upperBound = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"upper"

-- | is the range empty?
isEmpty :: null ('PGrange ty) --> 'Null 'PGbool
isEmpty :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null 'PGbool
isEmpty = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"isempty"

-- | is the lower bound inclusive?
lowerInc :: null ('PGrange ty) --> 'Null 'PGbool
lowerInc :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null 'PGbool
lowerInc = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"lower_inc"

-- | is the lower bound infinite?
lowerInf :: null ('PGrange ty) --> 'Null 'PGbool
lowerInf :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null 'PGbool
lowerInf = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"lower_inf"

-- | is the upper bound inclusive?
upperInc :: null ('PGrange ty) --> 'Null 'PGbool
upperInc :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null 'PGbool
upperInc = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"upper_inc"

-- | is the upper bound infinite?
upperInf :: null ('PGrange ty) --> 'Null 'PGbool
upperInf :: forall (null :: PGType -> NullType) (ty :: PGType).
null ('PGrange ty) --> 'Null 'PGbool
upperInf = forall (x :: NullType) (y :: NullType). ByteString -> x --> y
unsafeFunction ByteString
"upper_inf"

-- | the smallest range which includes both of the given ranges
rangeMerge ::
  '[null ('PGrange ty), null ('PGrange ty)]
  ---> null ('PGrange ty)
rangeMerge :: forall (null :: PGType -> NullType) (ty :: PGType).
'[null ('PGrange ty), null ('PGrange ty)] ---> null ('PGrange ty)
rangeMerge = forall (xs :: [NullType]) (y :: NullType).
SListI xs =>
ByteString -> xs ---> y
unsafeFunctionN ByteString
"range_merge"