{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Database.Groundhog.Postgresql.Geometry
  ( Point (..),
    Line (..),
    Lseg (..),
    Box (..),
    Path (..),
    Polygon (..),
    Circle (..),
    (+.),
    (-.),
    (*.),
    (/.),
    (#),
    (##),
    (<->),
    (&&),
    (<<),
    (>>),
    (&<),
    (&>),
    (<<|),
    (|>>),
    (&<|),
    (|&>),
    (<^),
    (>^),
    (?#),
    (?-),
    (?|),
    (?-|),
    (?||),
    (@>),
    (<@),
    (~=),
  )
where

import Control.Applicative
import Data.Attoparsec.ByteString.Char8
import Database.Groundhog.Core
import Database.Groundhog.Expression
import Database.Groundhog.Generic
import Database.Groundhog.Generic.Sql
import Database.Groundhog.Instances ()
import Prelude hiding ((&&), (>>))

data Point = Point Double Double deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show)

-- | It is not fully implemented in PostgreSQL yet. It is kept just to match all geometric types.
data Line = Line Point Point deriving (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

data Lseg = Lseg Point Point deriving (Lseg -> Lseg -> Bool
(Lseg -> Lseg -> Bool) -> (Lseg -> Lseg -> Bool) -> Eq Lseg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lseg -> Lseg -> Bool
$c/= :: Lseg -> Lseg -> Bool
== :: Lseg -> Lseg -> Bool
$c== :: Lseg -> Lseg -> Bool
Eq, Int -> Lseg -> ShowS
[Lseg] -> ShowS
Lseg -> String
(Int -> Lseg -> ShowS)
-> (Lseg -> String) -> ([Lseg] -> ShowS) -> Show Lseg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lseg] -> ShowS
$cshowList :: [Lseg] -> ShowS
show :: Lseg -> String
$cshow :: Lseg -> String
showsPrec :: Int -> Lseg -> ShowS
$cshowsPrec :: Int -> Lseg -> ShowS
Show)

data Box = Box Point Point deriving (Box -> Box -> Bool
(Box -> Box -> Bool) -> (Box -> Box -> Bool) -> Eq Box
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Box -> Box -> Bool
$c/= :: Box -> Box -> Bool
== :: Box -> Box -> Bool
$c== :: Box -> Box -> Bool
Eq, Int -> Box -> ShowS
[Box] -> ShowS
Box -> String
(Int -> Box -> ShowS)
-> (Box -> String) -> ([Box] -> ShowS) -> Show Box
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Box] -> ShowS
$cshowList :: [Box] -> ShowS
show :: Box -> String
$cshow :: Box -> String
showsPrec :: Int -> Box -> ShowS
$cshowsPrec :: Int -> Box -> ShowS
Show)

data Path
  = ClosedPath [Point]
  | OpenPath [Point]
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show)

newtype Polygon = Polygon [Point] deriving (Polygon -> Polygon -> Bool
(Polygon -> Polygon -> Bool)
-> (Polygon -> Polygon -> Bool) -> Eq Polygon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Polygon -> Polygon -> Bool
$c/= :: Polygon -> Polygon -> Bool
== :: Polygon -> Polygon -> Bool
$c== :: Polygon -> Polygon -> Bool
Eq, Int -> Polygon -> ShowS
[Polygon] -> ShowS
Polygon -> String
(Int -> Polygon -> ShowS)
-> (Polygon -> String) -> ([Polygon] -> ShowS) -> Show Polygon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Polygon] -> ShowS
$cshowList :: [Polygon] -> ShowS
show :: Polygon -> String
$cshow :: Polygon -> String
showsPrec :: Int -> Polygon -> ShowS
$cshowsPrec :: Int -> Polygon -> ShowS
Show)

data Circle = Circle Point Double deriving (Circle -> Circle -> Bool
(Circle -> Circle -> Bool)
-> (Circle -> Circle -> Bool) -> Eq Circle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Circle -> Circle -> Bool
$c/= :: Circle -> Circle -> Bool
== :: Circle -> Circle -> Bool
$c== :: Circle -> Circle -> Bool
Eq, Int -> Circle -> ShowS
[Circle] -> ShowS
Circle -> String
(Int -> Circle -> ShowS)
-> (Circle -> String) -> ([Circle] -> ShowS) -> Show Circle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Circle] -> ShowS
$cshowList :: [Circle] -> ShowS
show :: Circle -> String
$cshow :: Circle -> String
showsPrec :: Int -> Circle -> ShowS
$cshowsPrec :: Int -> Circle -> ShowS
Show)

-- select o.oprname, o.oprkind, tl.typname as oprleft, tr.typname as oprright, tres.typname as oprresult, o.oprcode, ocom.oprname as oprcom, oneg.oprname as oprnegate from pg_operator o inner join pg_type tl on o.oprleft = tl.oid inner join pg_type tr on o.oprright = tr.oid inner join pg_type tres on o.oprresult = tres.oid left join pg_operator ocom on o.oprcom = ocom.oid left join pg_operator oneg on o.oprnegate = oneg.oid where tl.typname in ('point', 'line', 'lseg', 'box', 'path', 'polygon', 'circle') order by o.oprname, oprleft;

parseHelper :: Parser a -> PersistValue -> a
parseHelper :: Parser a -> PersistValue -> a
parseHelper Parser a
p (PersistByteString ByteString
bs) = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error a -> a
forall a. a -> a
id (Either String a -> a) -> Either String a -> a
forall a b. (a -> b) -> a -> b
$ Parser a -> ByteString -> Either String a
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser a
p ByteString
bs
parseHelper Parser a
_ PersistValue
a = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"parseHelper: expected PersistByteString, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
a

pair :: (a -> a -> b) -> Char -> Char -> Parser a -> Parser b
pair :: (a -> a -> b) -> Char -> Char -> Parser a -> Parser b
pair a -> a -> b
f Char
open Char
close Parser a
p = a -> a -> b
f (a -> a -> b) -> Parser a -> Parser ByteString (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
open Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
',') Parser ByteString (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
p Parser b -> Parser Char -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
close

point :: Parser Point
point :: Parser Point
point = (Double -> Double -> Point)
-> Char -> Char -> Parser Double -> Parser Point
forall a b. (a -> a -> b) -> Char -> Char -> Parser a -> Parser b
pair Double -> Double -> Point
Point Char
'(' Char
')' Parser Double
double

points :: Parser [Point]
points :: Parser [Point]
points = Parser Point
point Parser Point -> Parser Char -> Parser [Point]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
','

instance PrimitivePersistField Point where
  toPrimitivePersistValue :: Point -> PersistValue
toPrimitivePersistValue (Point Double
x Double
y) = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> String
forall a. Show a => a -> String
show (Double
x, Double
y)
  fromPrimitivePersistValue :: PersistValue -> Point
fromPrimitivePersistValue = Parser Point -> PersistValue -> Point
forall a. Parser a -> PersistValue -> a
parseHelper Parser Point
point

instance PersistField Point where
  persistName :: Point -> String
persistName Point
_ = String
"Point"
  toPersistValues :: Point -> m ([PersistValue] -> [PersistValue])
toPersistValues = Point -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Point, [PersistValue])
fromPersistValues = [PersistValue] -> m (Point, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Point -> DbType
dbType proxy db
_ Point
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"point"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PrimitivePersistField Line where
  toPrimitivePersistValue :: Line -> PersistValue
toPrimitivePersistValue (Line (Point Double
x1 Double
y1) (Point Double
x2 Double
y2)) = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ ((Double, Double), (Double, Double)) -> String
forall a. Show a => a -> String
show ((Double
x1, Double
y1), (Double
x2, Double
y2))
  fromPrimitivePersistValue :: PersistValue -> Line
fromPrimitivePersistValue = String -> PersistValue -> Line
forall a. HasCallStack => String -> a
error String
"fromPrimitivePersistValue Line is not supported yet"

instance PersistField Line where
  persistName :: Line -> String
persistName Line
_ = String
"Line"
  toPersistValues :: Line -> m ([PersistValue] -> [PersistValue])
toPersistValues = Line -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Line, [PersistValue])
fromPersistValues = [PersistValue] -> m (Line, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Line -> DbType
dbType proxy db
_ Line
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"line"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PrimitivePersistField Lseg where
  toPrimitivePersistValue :: Lseg -> PersistValue
toPrimitivePersistValue (Lseg (Point Double
x1 Double
y1) (Point Double
x2 Double
y2)) = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ ((Double, Double), (Double, Double)) -> String
forall a. Show a => a -> String
show ((Double
x1, Double
y1), (Double
x2, Double
y2))
  fromPrimitivePersistValue :: PersistValue -> Lseg
fromPrimitivePersistValue = Parser Lseg -> PersistValue -> Lseg
forall a. Parser a -> PersistValue -> a
parseHelper (Parser Lseg -> PersistValue -> Lseg)
-> Parser Lseg -> PersistValue -> Lseg
forall a b. (a -> b) -> a -> b
$ (Point -> Point -> Lseg)
-> Char -> Char -> Parser Point -> Parser Lseg
forall a b. (a -> a -> b) -> Char -> Char -> Parser a -> Parser b
pair Point -> Point -> Lseg
Lseg Char
'[' Char
']' Parser Point
point

instance PersistField Lseg where
  persistName :: Lseg -> String
persistName Lseg
_ = String
"Lseg"
  toPersistValues :: Lseg -> m ([PersistValue] -> [PersistValue])
toPersistValues = Lseg -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Lseg, [PersistValue])
fromPersistValues = [PersistValue] -> m (Lseg, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Lseg -> DbType
dbType proxy db
_ Lseg
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"lseg"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PrimitivePersistField Box where
  toPrimitivePersistValue :: Box -> PersistValue
toPrimitivePersistValue (Box (Point Double
x1 Double
y1) (Point Double
x2 Double
y2)) = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ ((Double, Double), (Double, Double)) -> String
forall a. Show a => a -> String
show ((Double
x1, Double
y1), (Double
x2, Double
y2))
  fromPrimitivePersistValue :: PersistValue -> Box
fromPrimitivePersistValue = Parser Box -> PersistValue -> Box
forall a. Parser a -> PersistValue -> a
parseHelper (Parser Box -> PersistValue -> Box)
-> Parser Box -> PersistValue -> Box
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Box
Box (Point -> Point -> Box)
-> Parser Point -> Parser ByteString (Point -> Box)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Point
point Parser Point -> Parser Char -> Parser Point
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
',') Parser ByteString (Point -> Box) -> Parser Point -> Parser Box
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Point
point

instance PersistField Box where
  persistName :: Box -> String
persistName Box
_ = String
"Box"
  toPersistValues :: Box -> m ([PersistValue] -> [PersistValue])
toPersistValues = Box -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Box, [PersistValue])
fromPersistValues = [PersistValue] -> m (Box, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Box -> DbType
dbType proxy db
_ Box
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"box"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

showPath :: Char -> Char -> [Point] -> ShowS
showPath :: Char -> Char -> [Point] -> ShowS
showPath Char
open Char
close [] String
s = Char
open Char -> ShowS
forall a. a -> [a] -> [a]
: Char
close Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
showPath Char
open Char
close (Point
x : [Point]
xs) String
s = Char
open Char -> ShowS
forall a. a -> [a] -> [a]
: Point -> ShowS
showPoint Point
x ([Point] -> String
showl [Point]
xs)
  where
    showl :: [Point] -> String
showl [] = Char
close Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
    showl (Point
y : [Point]
ys) = Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: Point -> ShowS
showPoint Point
y ([Point] -> String
showl [Point]
ys)

showPoint :: Point -> ShowS
showPoint :: Point -> ShowS
showPoint (Point Double
x Double
y) = (Double, Double) -> ShowS
forall a. Show a => a -> ShowS
shows (Double
x, Double
y)

instance PrimitivePersistField Path where
  toPrimitivePersistValue :: Path -> PersistValue
toPrimitivePersistValue Path
path = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ case Path
path of
    ClosedPath [Point]
ps -> Char -> Char -> [Point] -> ShowS
showPath Char
'(' Char
')' [Point]
ps String
""
    OpenPath [Point]
ps -> Char -> Char -> [Point] -> ShowS
showPath Char
'[' Char
']' [Point]
ps String
""
  fromPrimitivePersistValue :: PersistValue -> Path
fromPrimitivePersistValue = Parser Path -> PersistValue -> Path
forall a. Parser a -> PersistValue -> a
parseHelper (Parser Path -> PersistValue -> Path)
-> Parser Path -> PersistValue -> Path
forall a b. (a -> b) -> a -> b
$ ([Point] -> Path) -> Char -> Char -> Parser Path
forall b. ([Point] -> b) -> Char -> Char -> Parser ByteString b
path' [Point] -> Path
ClosedPath Char
'(' Char
')' Parser Path -> Parser Path -> Parser Path
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Point] -> Path) -> Char -> Char -> Parser Path
forall b. ([Point] -> b) -> Char -> Char -> Parser ByteString b
path' [Point] -> Path
OpenPath Char
'[' Char
']'
    where
      path' :: ([Point] -> b) -> Char -> Char -> Parser ByteString b
path' [Point] -> b
f Char
open Char
close = [Point] -> b
f ([Point] -> b) -> Parser [Point] -> Parser ByteString b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
open Parser Char -> Parser [Point] -> Parser [Point]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Point]
points Parser [Point] -> Parser Char -> Parser [Point]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
close)

instance PersistField Path where
  persistName :: Path -> String
persistName Path
_ = String
"Path"
  toPersistValues :: Path -> m ([PersistValue] -> [PersistValue])
toPersistValues = Path -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Path, [PersistValue])
fromPersistValues = [PersistValue] -> m (Path, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Path -> DbType
dbType proxy db
_ Path
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"path"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PrimitivePersistField Polygon where
  toPrimitivePersistValue :: Polygon -> PersistValue
toPrimitivePersistValue (Polygon [Point]
ps) = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ Char -> Char -> [Point] -> ShowS
showPath Char
'(' Char
')' [Point]
ps String
""
  fromPrimitivePersistValue :: PersistValue -> Polygon
fromPrimitivePersistValue = Parser Polygon -> PersistValue -> Polygon
forall a. Parser a -> PersistValue -> a
parseHelper (Parser Polygon -> PersistValue -> Polygon)
-> Parser Polygon -> PersistValue -> Polygon
forall a b. (a -> b) -> a -> b
$ [Point] -> Polygon
Polygon ([Point] -> Polygon) -> Parser [Point] -> Parser Polygon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'(' Parser Char -> Parser [Point] -> Parser [Point]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Point]
points Parser [Point] -> Parser Char -> Parser [Point]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
')')

instance PersistField Polygon where
  persistName :: Polygon -> String
persistName Polygon
_ = String
"Polygon"
  toPersistValues :: Polygon -> m ([PersistValue] -> [PersistValue])
toPersistValues = Polygon -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Polygon, [PersistValue])
fromPersistValues = [PersistValue] -> m (Polygon, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Polygon -> DbType
dbType proxy db
_ Polygon
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"polygon"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

instance PrimitivePersistField Circle where
  toPrimitivePersistValue :: Circle -> PersistValue
toPrimitivePersistValue (Circle (Point Double
x1 Double
y1) Double
r) = String -> PersistValue
forall a. PrimitivePersistField a => a -> PersistValue
toPrimitivePersistValue (String -> PersistValue) -> String -> PersistValue
forall a b. (a -> b) -> a -> b
$ ((Double, Double), Double) -> String
forall a. Show a => a -> String
show ((Double
x1, Double
y1), Double
r)
  fromPrimitivePersistValue :: PersistValue -> Circle
fromPrimitivePersistValue = Parser Circle -> PersistValue -> Circle
forall a. Parser a -> PersistValue -> a
parseHelper (Parser Circle -> PersistValue -> Circle)
-> Parser Circle -> PersistValue -> Circle
forall a b. (a -> b) -> a -> b
$ Point -> Double -> Circle
Circle (Point -> Double -> Circle)
-> Parser Point -> Parser ByteString (Double -> Circle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'<' Parser Char -> Parser Point -> Parser Point
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Point
point) Parser ByteString (Double -> Circle)
-> Parser Char -> Parser ByteString (Double -> Circle)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
',' Parser ByteString (Double -> Circle)
-> Parser Double -> Parser Circle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double
double Parser Circle -> Parser Char -> Parser Circle
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'>'

instance PersistField Circle where
  persistName :: Circle -> String
persistName Circle
_ = String
"Circle"
  toPersistValues :: Circle -> m ([PersistValue] -> [PersistValue])
toPersistValues = Circle -> m ([PersistValue] -> [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
a -> m ([PersistValue] -> [PersistValue])
primToPersistValue
  fromPersistValues :: [PersistValue] -> m (Circle, [PersistValue])
fromPersistValues = [PersistValue] -> m (Circle, [PersistValue])
forall (m :: * -> *) a.
(PersistBackend m, PrimitivePersistField a) =>
[PersistValue] -> m (a, [PersistValue])
primFromPersistValue
  dbType :: proxy db -> Circle -> DbType
dbType proxy db
_ Circle
_ = DbTypePrimitive
-> Bool -> Maybe String -> Maybe ParentTableReference -> DbType
DbTypePrimitive (OtherTypeDef' String -> DbTypePrimitive
forall str. OtherTypeDef' str -> DbTypePrimitive' str
DbOther (OtherTypeDef' String -> DbTypePrimitive)
-> OtherTypeDef' String -> DbTypePrimitive
forall a b. (a -> b) -> a -> b
$ [Either String DbTypePrimitive] -> OtherTypeDef' String
forall str.
[Either str (DbTypePrimitive' str)] -> OtherTypeDef' str
OtherTypeDef [String -> Either String DbTypePrimitive
forall a b. a -> Either a b
Left String
"circle"]) Bool
False Maybe String
forall a. Maybe a
Nothing Maybe ParentTableReference
forall a. Maybe a
Nothing

class BoxLineLseg a

instance BoxLineLseg Box

instance BoxLineLseg Line

instance BoxLineLseg Lseg

class BoxCirclePolygon a

instance BoxCirclePolygon Box

instance BoxCirclePolygon Circle

instance BoxCirclePolygon Polygon

class BoxCirclePathPoint a

instance BoxCirclePathPoint Box

instance BoxCirclePathPoint Circle

instance BoxCirclePathPoint Path

instance BoxCirclePathPoint Point

class BoxCirclePointPolygon a

instance BoxCirclePointPolygon Box

instance BoxCirclePointPolygon Circle

instance BoxCirclePointPolygon Point

instance BoxCirclePointPolygon Polygon

class BoxPoint a

instance BoxPoint Box

instance BoxPoint Point

class LineLseg a

instance LineLseg Line

instance LineLseg Lseg

class Plus a b

instance Plus Box Point

instance Plus Circle Point

instance Plus Path Point

instance Plus Path Path

instance Plus Point Point

class Distance a b

instance Distance Box Box

instance Distance Circle Circle

instance Distance Circle Polygon

instance Distance Line Line

instance Distance Line Box

instance Distance Lseg Line

instance Distance Lseg Lseg

instance Distance Lseg Box

instance Distance Path Path

instance Distance Point Path

instance Distance Point Point

instance Distance Point Circle

instance Distance Point Line

instance Distance Point Box

instance Distance Point Lseg

instance Distance Polygon Polygon

class Contains a b

instance Contains Box Box

instance Contains Box Point

instance Contains Circle Circle

instance Contains Circle Point

instance Contains Path Point

instance Contains Polygon Polygon

instance Contains Polygon Point

class Contained a b

instance Contained Box Box

instance Contained Circle Circle

instance Contained Lseg Box

instance Contained Lseg Line

instance Contained Point Lseg

instance Contained Point Box

instance Contained Point Line

instance Contained Point Path

instance Contained Point Polygon

instance Contained Point Circle

instance Contained Polygon Polygon

class Closest a b

instance Closest Line Box

instance Closest Line Lseg

instance Closest Lseg Box

instance Closest Lseg Line

instance Closest Lseg Lseg

instance Closest Point Line

instance Closest Point Box

instance Closest Point Lseg

class Intersects a b

instance Intersects Box Box

instance Intersects Line Line

instance Intersects Line Box

instance Intersects Lseg Box

instance Intersects Lseg Line

instance Intersects Lseg Lseg

instance Intersects Path Path

psqlOperatorExpr :: (SqlDb db, Expression db r a, Expression db r b, PersistField c) => String -> a -> b -> Expr db r c
psqlOperatorExpr :: String -> a -> b -> Expr db r c
psqlOperatorExpr String
op a
x b
y = Snippet db r -> Expr db r c
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r c) -> Snippet db r -> Expr db r c
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> b -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
50 String
op a
x b
y

psqlOperatorCond :: (SqlDb db, Expression db r a, Expression db r b) => String -> a -> b -> Cond db r
psqlOperatorCond :: String -> a -> b -> Cond db r
psqlOperatorCond String
op a
x b
y = QueryRaw db r -> Cond db r
forall db r. QueryRaw db r -> Cond db r
CondRaw (QueryRaw db r -> Cond db r) -> QueryRaw db r -> Cond db r
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> b -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
50 String
op a
x b
y

infixl 6 +.

infixl 6 -.

infixl 7 *.

infixl 7 /.

-- | Translation
--
-- @box '((0,0),(1,1))' + point '(2.0,0)' = box '(3,1),(2,0)'@
(+.) :: (SqlDb db, Plus a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Expr db r a
x
x +. :: x -> y -> Expr db r a
+. y
y = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
60 String
"+" x
x y
y

-- | Translation
--
-- @box '((0,0),(1,1))' - point '(2.0,0)' = box '(-1,1),(-2,0)'@
(-.) :: (SqlDb db, BoxCirclePathPoint a, ExpressionOf db r x a, ExpressionOf db r y Point) => x -> y -> Expr db r a
x
x -. :: x -> y -> Expr db r a
-. y
y = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
60 String
"-" x
x y
y

-- | Scaling/rotation
--
-- @box '((0,0),(1,1))' * point '(2.0,0)' = box '(2,2),(0,0)'@
(*.) :: (SqlDb db, BoxCirclePathPoint a, ExpressionOf db r x a, ExpressionOf db r y Point) => x -> y -> Expr db r a
x
x *. :: x -> y -> Expr db r a
*. y
y = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
70 String
"*" x
x y
y

-- | Scaling/rotation
--
-- @box '((0,0),(2,2))' / point '(2.0,0)' = box '(1,1),(0,0)'@
(/.) :: (SqlDb db, BoxCirclePathPoint a, ExpressionOf db r x a, ExpressionOf db r y Point) => x -> y -> Expr db r a
x
x /. :: x -> y -> Expr db r a
/. y
y = Snippet db r -> Expr db r a
forall db r a.
(SqlDb db, PersistField a) =>
Snippet db r -> Expr db r a
mkExpr (Snippet db r -> Expr db r a) -> Snippet db r -> Expr db r a
forall a b. (a -> b) -> a -> b
$ Int -> String -> x -> y -> Snippet db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
Int -> String -> a -> b -> Snippet db r
operator Int
70 String
"/" x
x y
y

-- | Point or box of intersection
--
-- @lseg '((1,-1),(-1,1))' # '((1,1),(-1,-1))' = point '(0,0)'@
--
-- @box '((1,-1),(-1,1))' # '((1,1),(-1,-1))' = box '(1,1),(-1,-1)'@
(#) :: (SqlDb db, BoxLineLseg a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Expr db r a
# :: x -> y -> Expr db r a
(#) = String -> x -> y -> Expr db r a
forall db r a b c.
(SqlDb db, Expression db r a, Expression db r b, PersistField c) =>
String -> a -> b -> Expr db r c
psqlOperatorExpr String
"#"

-- | Closest point to first operand on second operand
--
-- @point '(0,0)' ## lseg '((2,0),(0,2))' = point '(1,1)'@
(##) :: (SqlDb db, Closest a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Expr db r Point
## :: x -> y -> Expr db r Point
(##) = String -> x -> y -> Expr db r Point
forall db r a b c.
(SqlDb db, Expression db r a, Expression db r b, PersistField c) =>
String -> a -> b -> Expr db r c
psqlOperatorExpr String
"##"

-- | Distance between
--
-- @circle '((0,0),1)' <-> circle '((5,0),1)' = 3@
(<->) :: (SqlDb db, Distance a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Expr db r Double
<-> :: x -> y -> Expr db r Double
(<->) = String -> x -> y -> Expr db r Double
forall db r a b c.
(SqlDb db, Expression db r a, Expression db r b, PersistField c) =>
String -> a -> b -> Expr db r c
psqlOperatorExpr String
"<->"

-- | Overlaps?
--
-- @box '((0,0),(1,1))' && box '((0,0),(2,2))' = true@
(&&) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
&& :: x -> y -> Cond db r
(&&) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"&&"

-- | Is strictly left of?
--
-- @circle '((0,0),1)' << circle '((5,0),1)' = true@
(<<) :: (SqlDb db, BoxCirclePointPolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
<< :: x -> y -> Cond db r
(<<) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"<<"

-- | Is strictly right of?
--
-- @circle '((5,0),1)' >> circle '((0,0),1)' = true@
(>>) :: (SqlDb db, BoxCirclePointPolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
>> :: x -> y -> Cond db r
(>>) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
">>"

-- | Does not extend to the right of? box '((0,0),(1,1))' &< box '((0,0),(2,2))' = t
(&<) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
&< :: x -> y -> Cond db r
(&<) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"&<"

-- | Does not extend to the left of?
--
-- @box '((0,0),(3,3))' &> box '((0,0),(2,2))' = true@
(&>) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
&> :: x -> y -> Cond db r
(&>) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"&>"

-- | Is strictly below?
--
-- @box '((0,0),(3,3))' <<| box '((3,4),(5,5))' = true@
(<<|) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
<<| :: x -> y -> Cond db r
(<<|) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"<<|"

-- | Is strictly above?
--
-- @box '((3,4),(5,5))' |>> box '((0,0),(3,3))'@
(|>>) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
|>> :: x -> y -> Cond db r
(|>>) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"|>>"

-- | Does not extend above?
--
-- @box '((0,0),(1,1))' &<| box '((0,0),(2,2))' = true@
(&<|) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
&<| :: x -> y -> Cond db r
(&<|) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"&<|"

-- | Does not extend below?
--
-- @box '((0,0),(3,3))' |&> box '((0,0),(2,2))' = true@
(|&>) :: (SqlDb db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
|&> :: x -> y -> Cond db r
(|&>) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"|&>"

-- | Is below (allows touching)?
--
-- @circle '((0,0),1)' <^ circle '((0,5),1)' = true@
(<^) :: (SqlDb db, BoxPoint a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
<^ :: x -> y -> Cond db r
(<^) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"<^"

-- | Is above (allows touching)?
--
-- @circle '((0,5),1)' >^ circle '((0,0),1)' = true@
(>^) :: (SqlDb db, BoxPoint a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
>^ :: x -> y -> Cond db r
(>^) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
">^"

-- | Intersects?
--
-- @lseg '((-1,0),(1,0))' ?# box '((-2,-2),(2,2))' = true@
(?#) :: (SqlDb db, Intersects a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Cond db r
?# :: x -> y -> Cond db r
(?#) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?#"

-- | Are horizontally aligned?
--
-- @point '(1,0)' ?- point '(0,0)' = true@
(?-) :: (SqlDb db, ExpressionOf db r x Point, ExpressionOf db r y Point) => x -> y -> Cond db r
?- :: x -> y -> Cond db r
(?-) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?-"

-- | Are vertically aligned?
--
-- @point '(0,1)' ?| point '(0,0)' = true@
(?|) :: (SqlDb db, ExpressionOf db r x Point, ExpressionOf db r y Point) => x -> y -> Cond db r
?| :: x -> y -> Cond db r
(?|) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?|"

-- | Is perpendicular?
--
-- @lseg '((0,0),(0,1))' ?-| lseg '((0,0),(1,0))' = true@
(?-|) :: (SqlDb db, LineLseg a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
?-| :: x -> y -> Cond db r
(?-|) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?-|"

-- | Are parallel?
--
-- @lseg '((-1,0),(1,0))' ?|| lseg '((-1,2),(1,2))' = true@
(?||) :: (SqlDb db, LineLseg a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
?|| :: x -> y -> Cond db r
(?||) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"?||"

-- | Contains?
--
-- @circle '((0,0),2)' \@> point '(1,1)' = true@
(@>) :: (SqlDb db, Contains a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Cond db r
@> :: x -> y -> Cond db r
(@>) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"@>"

-- | Contained in or on?
--
-- @point '(1,1)' <\@ circle '((0,0),2)' = true@
(<@) :: (SqlDb db, Contained a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Cond db r
<@ :: x -> y -> Cond db r
(<@) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"<@"

-- | Same as?
--
-- @polygon '((0,0),(1,1))' ~= polygon '((1,1),(0,0))' = true@
(~=) :: (SqlDb db, BoxCirclePointPolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
~= :: x -> y -> Cond db r
(~=) = String -> x -> y -> Cond db r
forall db r a b.
(SqlDb db, Expression db r a, Expression db r b) =>
String -> a -> b -> Cond db r
psqlOperatorCond String
"~="