{-# 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)
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)
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 /.
(+.) :: (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
(-.) :: (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
(*.) :: (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
(/.) :: (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
(#) :: (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
"#"
(##) :: (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
"##"
(<->) :: (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
"<->"
(&&) :: (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
"&&"
(<<) :: (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
"<<"
(>>) :: (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
">>"
(&<) :: (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
"&<"
(&>) :: (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
"&>"
(<<|) :: (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
"<<|"
(|>>) :: (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
"|>>"
(&<|) :: (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
"&<|"
(|&>) :: (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
"|&>"
(<^) :: (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
"<^"
(>^) :: (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
">^"
(?#) :: (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
"?#"
(?-) :: (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
"?-"
(?|) :: (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
"?|"
(?-|) :: (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
"?-|"
(?||) :: (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
"?||"
(@>) :: (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
"@>"
(<@) :: (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
"<@"
(~=) :: (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
"~="