packages feed

groundhog-postgresql 0.4.1 → 0.4.2

raw patch · 4 files changed

+341/−42 lines, 4 filesdep ~groundhog

Dependency ranges changed: groundhog

Files

Database/Groundhog/Postgresql.hs view
@@ -57,27 +57,35 @@   backendName _ = "postgresql"  instance SqlDb Postgresql where-  append a b = Expr $ operator 50 "||" a b+  append a b = mkExpr $ operator 50 "||" a b+  signum' x = mkExpr $ function "sign" [toExpr x]+  quotRem' x y = (mkExpr $ operator 70 "/" x y, mkExpr $ operator 70 "%" x y)+  equalsOperator a b = a <> " IS NOT DISTINCT FROM " <> b+  notEqualsOperator a b = a <> " IS DISTINCT FROM " <> b +instance FloatingSqlDb Postgresql where+  log' x = mkExpr $ function "ln" [toExpr x]+  logBase' b x = log (liftExpr x) / log (liftExpr b)+ instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => PersistBackend (DbPersist Postgresql m) where   type PhantomDb (DbPersist Postgresql m) = Postgresql   insert v = insert' v   insert_ v = insert_' v-  insertBy u v = H.insertBy escapeS queryRawTyped' True u v-  insertByAll v = H.insertByAll escapeS queryRawTyped' True v-  replace k v = H.replace escapeS queryRawTyped' executeRaw' (insertIntoConstructorTable False) k v-  replaceBy k v = H.replaceBy escapeS executeRaw' k v-  select options = H.select escapeS queryRawTyped' "" renderCond' options-  selectAll = H.selectAll escapeS queryRawTyped'-  get k = H.get escapeS queryRawTyped' k-  getBy k = H.getBy escapeS queryRawTyped' k-  update upds cond = H.update escapeS executeRaw' renderCond' upds cond-  delete cond = H.delete escapeS executeRaw' renderCond' cond-  deleteBy k = H.deleteBy escapeS executeRaw' k-  deleteAll v = H.deleteAll escapeS executeRaw' v-  count cond = H.count escapeS queryRawTyped' renderCond' cond-  countAll fakeV = H.countAll escapeS queryRawTyped' fakeV-  project p options = H.project escapeS queryRawTyped' "" renderCond' p options+  insertBy u v = H.insertBy renderConfig queryRaw' True u v+  insertByAll v = H.insertByAll renderConfig queryRaw' True v+  replace k v = H.replace renderConfig queryRaw' executeRaw' (insertIntoConstructorTable False) k v+  replaceBy k v = H.replaceBy renderConfig executeRaw' k v+  select options = H.select renderConfig queryRaw' "" options+  selectAll = H.selectAll renderConfig queryRaw'+  get k = H.get renderConfig queryRaw' k+  getBy k = H.getBy renderConfig queryRaw' k+  update upds cond = H.update renderConfig executeRaw' upds cond+  delete cond = H.delete renderConfig executeRaw' cond+  deleteBy k = H.deleteBy renderConfig executeRaw' k+  deleteAll v = H.deleteAll renderConfig executeRaw' v+  count cond = H.count renderConfig queryRaw' cond+  countAll fakeV = H.countAll renderConfig queryRaw' fakeV+  project p options = H.project renderConfig queryRaw' "" p options   migrate fakeV = migrate' fakeV    executeRaw _ query ps = executeRaw' (fromString query) ps@@ -247,10 +255,10 @@     _ <- PG.execute conn stmt (map P vals)     return () -renderCond' :: Cond Postgresql r -> Maybe (RenderS Postgresql r)-renderCond' = renderCond escapeS renderEquals renderNotEquals where-  renderEquals a b = a <> " IS NOT DISTINCT FROM " <> b-  renderNotEquals a b = a <> " IS DISTINCT FROM " <> b+renderConfig :: RenderConfig+renderConfig = RenderConfig {+    esc = escapeS+}  escapeS :: Utf8 -> Utf8 escapeS a = let q = fromChar '"' in q <> a <> q@@ -629,9 +637,6 @@ getStatement :: Utf8 -> PG.Query getStatement sql = PG.Query $ fromUtf8 sql -queryRawTyped' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [DbType] -> [PersistValue] -> (RowPopper (DbPersist Postgresql m) -> DbPersist Postgresql m a) -> DbPersist Postgresql m a-queryRawTyped' query _ vals f = queryRaw' query vals f- queryRaw' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> (RowPopper (DbPersist Postgresql m) -> DbPersist Postgresql m a) -> DbPersist Postgresql m a queryRaw' query vals f = do   $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals@@ -755,4 +760,4 @@  -- | Casts expression to a type. @castType value \"INT\"@ results in @value::INT@. castType :: Expression Postgresql r a => a -> String -> Expr Postgresql r a-castType a t = Expr $ Snippet $ \esc _ -> ["(" <> renderExpr esc (toExpr a) <> ")::" <> fromString t] where+castType a t = mkExpr $ Snippet $ \conf _ -> ["(" <> renderExpr conf (toExpr a) <> ")::" <> fromString t] where
Database/Groundhog/Postgresql/Array.hs view
@@ -125,54 +125,54 @@ parseArr p = Array <$> (char '{' *> parseElem p `sepBy` char ',' <* char '}')
 
 (!) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b Int) => a -> b -> Expr Postgresql r elem
-(!) arr i = Expr $ Snippet $ \esc _ -> [renderExpr esc (toExpr arr) <> "[" <> renderExpr esc (toExpr i) <> "]"]
+(!) arr i = mkExpr $ Snippet $ \conf _ -> [renderExpr conf (toExpr arr) <> "[" <> renderExpr conf (toExpr i) <> "]"]
 
 (!:) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r i1 Int, ExpressionOf Postgresql r i2 Int) => a -> (i1, i2) -> Expr Postgresql r (Array elem)
-(!:) arr (i1, i2) = Expr $ Snippet $ \esc _ -> [renderExpr esc (toExpr arr) <> "[" <> renderExpr esc (toExpr i1) <> ":" <> renderExpr esc (toExpr i2) <> "]"]
+(!:) arr (i1, i2) = mkExpr $ Snippet $ \conf _ -> [renderExpr conf (toExpr arr) <> "[" <> renderExpr conf (toExpr i1) <> ":" <> renderExpr conf (toExpr i2) <> "]"]
 
 prepend :: (ExpressionOf Postgresql r a elem, ExpressionOf Postgresql r b (Array elem)) => a -> b -> Expr Postgresql r (Array elem)
-prepend a b = Expr $ function "array_prepend" [toExpr a, toExpr b]
+prepend a b = mkExpr $ function "array_prepend" [toExpr a, toExpr b]
 
 append :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b elem) => a -> b -> Expr Postgresql r (Array elem)
-append a b = Expr $ function "array_append" [toExpr a, toExpr b]
+append a b = mkExpr $ function "array_append" [toExpr a, toExpr b]
 
 arrayCat :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Expr Postgresql r (Array elem)
-arrayCat a b = Expr $ function "array_cat" [toExpr a, toExpr b]
+arrayCat a b = mkExpr $ function "array_cat" [toExpr a, toExpr b]
 
 arrayDims :: (ExpressionOf Postgresql r a (Array elem)) => a -> Expr Postgresql r String
-arrayDims arr = Expr $ function "array_dims" [toExpr arr]
+arrayDims arr = mkExpr $ function "array_dims" [toExpr arr]
 
 arrayNDims :: (ExpressionOf Postgresql r a (Array elem)) => a -> Expr Postgresql r Int
-arrayNDims arr = Expr $ function "array_ndims" [toExpr arr]
+arrayNDims arr = mkExpr $ function "array_ndims" [toExpr arr]
 
 arrayLower :: (ExpressionOf Postgresql r a (Array elem)) => a -> Int -> Expr Postgresql r Int
-arrayLower arr dim = Expr $ function "array_lower" [toExpr arr, toExpr dim]
+arrayLower arr dim = mkExpr $ function "array_lower" [toExpr arr, toExpr dim]
 
 arrayUpper :: (ExpressionOf Postgresql r a (Array elem)) => a -> Int -> Expr Postgresql r Int
-arrayUpper arr dim = Expr $ function "array_upper" [toExpr arr, toExpr dim]
+arrayUpper arr dim = mkExpr $ function "array_upper" [toExpr arr, toExpr dim]
 
 arrayLength :: (ExpressionOf Postgresql r a (Array elem)) => a -> Int -> Expr Postgresql r Int
-arrayLength arr dim = Expr $ function "array_length" [toExpr arr, toExpr dim]
+arrayLength arr dim = mkExpr $ function "array_length" [toExpr arr, toExpr dim]
 
 -- | Concatenates array elements using supplied delimiter. array_to_string(ARRAY[1, 2, 3], '~^~') = 1~^~2~^~3
 arrayToString :: (ExpressionOf Postgresql r a (Array elem)) => a -> String -> Expr Postgresql r String
-arrayToString arr sep = Expr $ function "array_to_string" [toExpr arr, toExpr sep]
+arrayToString arr sep = mkExpr $ function "array_to_string" [toExpr arr, toExpr sep]
 
 -- | Splits string into array elements using supplied delimiter. string_to_array('xx~^~yy~^~zz', '~^~') = {xx,yy,zz}
 stringToArray :: (ExpressionOf Postgresql r a String) => a -> String -> Expr Postgresql r (Array String)
-stringToArray arr sep = Expr $ function "string_to_array" [toExpr arr, toExpr sep]
+stringToArray arr sep = mkExpr $ function "string_to_array" [toExpr arr, toExpr sep]
 
 any :: (ExpressionOf Postgresql r a elem, ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
-any a arr = CondRaw $ Snippet $ \esc _ -> [renderExprPriority esc 37 (toExpr a) <> "=ANY" <> fromChar '(' <> renderExpr esc (toExpr arr) <> fromChar ')']
+any a arr = CondRaw $ Snippet $ \conf _ -> [renderExprPriority conf 37 (toExpr a) <> "=ANY" <> fromChar '(' <> renderExpr conf (toExpr arr) <> fromChar ')']
 
 all :: (ExpressionOf Postgresql r a elem, ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
-all a arr = CondRaw $ Snippet $ \esc _ -> [renderExprPriority esc 37 (toExpr a) <> "=ALL" <> fromChar '(' <> renderExpr esc (toExpr arr) <> fromChar ')']
+all a arr = CondRaw $ Snippet $ \conf _ -> [renderExprPriority conf 37 (toExpr a) <> "=ALL" <> fromChar '(' <> renderExpr conf (toExpr arr) <> fromChar ')']
 
--- | Contains. ARRAY[1,4,3] @> ARRAY[3,1] = t
+-- | Contains. ARRAY[1,4,3] \@> ARRAY[3,1] = t
 (@>) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
 (@>) a b = CondRaw $ operator 50 "@>" a b
 
--- | Is contained by. ARRAY[2,7] <@ ARRAY[1,7,4,2,6] = t
+-- | Is contained by. ARRAY[2,7] <\@ ARRAY[1,7,4,2,6] = t
 (<@) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b (Array elem)) => a -> b -> Cond Postgresql r
 (<@) a b = CondRaw $ operator 50 "<@" a b
Database/Groundhog/Postgresql/Geometry.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses #-}
 module Database.Groundhog.Postgresql.Geometry
   (
     Point(..)
@@ -7,10 +8,40 @@   , Path(..)
   , Polygon(..)
   , Circle(..)
+  , (+.)
+  , (-.)
+  , (*.)
+  , (/.)
+  , (#)
+  , (##)
+  , (<->)
+  , (&&)
+  , (<<)
+  , (>>)
+  , (&<)
+  , (&>)
+  , (<<|)
+  , (|>>)
+  , (&<|)
+  , (|&>)
+  , (<^)
+  , (>^)
+  , (?#)
+  , (?-)
+  , (?|)
+  , (?-|)
+  , (?||)
+  , (@>)
+  , (<@)
+  , (~=)
   ) where
 
+import Prelude hiding ((&&), (>>))
+
 import Database.Groundhog.Core
+import Database.Groundhog.Expression
 import Database.Groundhog.Generic
+import Database.Groundhog.Generic.Sql
 import Database.Groundhog.Instances ()
 
 import Control.Applicative
@@ -123,3 +154,266 @@   toPersistValues = primToPersistValue
   fromPersistValues = primFromPersistValue
   dbType _ = DbTypePrimitive (DbOther $ OtherTypeDef $ const "circle") False Nothing 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, QueryRaw db ~ Snippet db, Expression db r a, Expression db r b) => String -> a -> b -> Expr db r c
+psqlOperatorExpr op x y = mkExpr $ operator 50 op x y
+
+psqlOperatorCond :: (SqlDb db, QueryRaw db ~ Snippet db, Expression db r a, Expression db r b) => String -> a -> b -> Cond db r
+psqlOperatorCond op x y = CondRaw $ operator 50 op x 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, QueryRaw db ~ Snippet db, Plus a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Expr db r a
+x +. y = mkExpr $ operator 60 "+" x y
+
+-- | Translation
+-- 
+-- @box '((0,0),(1,1))' - point '(2.0,0)' = box '(-1,1),(-2,0)'@
+(-.) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePathPoint a, ExpressionOf db r x a, ExpressionOf db r y Point) => x -> y -> Expr db r a
+x -. y = mkExpr $ operator 60 "-" x y
+
+-- | Scaling/rotation
+-- 
+-- @box '((0,0),(1,1))' * point '(2.0,0)' = box '(2,2),(0,0)'@
+(*.) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePathPoint a, ExpressionOf db r x a, ExpressionOf db r y Point) => x -> y -> Expr db r a
+x *. y = mkExpr $ operator 70 "*" x y
+
+-- | Scaling/rotation
+-- 
+-- @box '((0,0),(2,2))' / point '(2.0,0)' = box '(1,1),(0,0)'@
+(/.) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePathPoint a, ExpressionOf db r x a, ExpressionOf db r y Point) => x -> y -> Expr db r a
+x /. y = mkExpr $ operator 70 "/" x 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, QueryRaw db ~ Snippet db, BoxLineLseg a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Expr db r a
+(#) = psqlOperatorExpr "#"
+
+-- | Closest point to first operand on second operand
+-- 
+-- @point '(0,0)' ## lseg '((2,0),(0,2))' = point '(1,1)'@
+(##) :: (SqlDb db, QueryRaw db ~ Snippet db, Closest a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Expr db r Point
+(##) = psqlOperatorExpr "##"
+
+-- | Distance between
+-- 
+-- @circle '((0,0),1)' <-> circle '((5,0),1)' = 3@
+(<->) :: (SqlDb db, QueryRaw db ~ Snippet db, Distance a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Expr db r Double
+(<->) = psqlOperatorExpr "<->"
+
+-- | Overlaps?
+-- 
+-- @box '((0,0),(1,1))' && box '((0,0),(2,2))' = true@
+(&&) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(&&) = psqlOperatorCond "&&"
+
+-- | Is strictly left of?
+-- 
+-- @circle '((0,0),1)' << circle '((5,0),1)' = true@
+(<<) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePointPolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(<<) = psqlOperatorCond "<<"
+
+-- | Is strictly right of?
+-- 
+-- @circle '((5,0),1)' >> circle '((0,0),1)' = true@
+(>>) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePointPolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(>>) = psqlOperatorCond ">>"
+
+-- | Does not extend to the right of? box '((0,0),(1,1))' &< box '((0,0),(2,2))' = t
+(&<) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(&<) = psqlOperatorCond "&<"
+
+-- | Does not extend to the left of?
+-- 
+-- @box '((0,0),(3,3))' &> box '((0,0),(2,2))' = true@
+(&>) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(&>) = psqlOperatorCond "&>"
+
+-- | Is strictly below?
+-- 
+-- @box '((0,0),(3,3))' <<| box '((3,4),(5,5))' = true@
+(<<|) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(<<|) = psqlOperatorCond "<<|"
+
+-- | Is strictly above?
+-- 
+-- @box '((3,4),(5,5))' |>> box '((0,0),(3,3))'@
+(|>>):: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(|>>) = psqlOperatorCond "|>>"
+
+-- | Does not extend above?
+-- 
+-- @box '((0,0),(1,1))' &<| box '((0,0),(2,2))' = true@
+(&<|):: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(&<|) = psqlOperatorCond "&<|"
+
+-- | Does not extend below?
+-- 
+-- @box '((0,0),(3,3))' |&> box '((0,0),(2,2))' = true@
+(|&>) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(|&>) = psqlOperatorCond "|&>"
+
+-- | Is below (allows touching)?
+-- 
+-- @circle '((0,0),1)' <^ circle '((0,5),1)' = true@
+(<^) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxPoint a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(<^) = psqlOperatorCond "<^"
+
+-- | Is above (allows touching)?
+-- 
+-- @circle '((0,5),1)' >^ circle '((0,0),1)' = true@
+(>^) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxPoint a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(>^) = psqlOperatorCond ">^"
+
+-- | Intersects?
+-- 
+-- @lseg '((-1,0),(1,0))' ?# box '((-2,-2),(2,2))' = true@
+(?#) :: (SqlDb db, QueryRaw db ~ Snippet db, Intersects a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Cond db r
+(?#) = psqlOperatorCond "?#"
+
+-- | Are horizontally aligned?
+-- 
+-- @point '(1,0)' ?- point '(0,0)' = true@
+(?-) :: (SqlDb db, QueryRaw db ~ Snippet db, ExpressionOf db r x Point, ExpressionOf db r y Point) => x -> y -> Cond db r
+(?-) = psqlOperatorCond "?-"
+
+-- | Are vertically aligned?
+-- 
+-- @point '(0,1)' ?| point '(0,0)' = true@
+(?|) :: (SqlDb db, QueryRaw db ~ Snippet db, ExpressionOf db r x Point, ExpressionOf db r y Point) => x -> y -> Cond db r
+(?|) = psqlOperatorCond "?|"
+
+-- | Is perpendicular?
+-- 
+-- @lseg '((0,0),(0,1))' ?-| lseg '((0,0),(1,0))' = true@
+(?-|) :: (SqlDb db, QueryRaw db ~ Snippet db, LineLseg a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(?-|) = psqlOperatorCond "?-|"
+
+-- | Are parallel?
+-- 
+-- @lseg '((-1,0),(1,0))' ?|| lseg '((-1,2),(1,2))' = true@
+(?||) :: (SqlDb db, QueryRaw db ~ Snippet db, LineLseg a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(?||) = psqlOperatorCond "?||"
+
+-- | Contains?
+-- 
+-- @circle '((0,0),2)' \@> point '(1,1)' = true@
+(@>) :: (SqlDb db, QueryRaw db ~ Snippet db, Contains a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Cond db r
+(@>) = psqlOperatorCond "@>"
+
+-- | Contained in or on?
+-- 
+-- @point '(1,1)' <\@ circle '((0,0),2)' = true@
+(<@) :: (SqlDb db, QueryRaw db ~ Snippet db, Contained a b, ExpressionOf db r x a, ExpressionOf db r y b) => x -> y -> Cond db r
+(<@) = psqlOperatorCond "<@"
+
+-- | Same as?
+-- 
+-- @polygon '((0,0),(1,1))' ~= polygon '((1,1),(0,0))' = true@
+(~=) :: (SqlDb db, QueryRaw db ~ Snippet db, BoxCirclePointPolygon a, ExpressionOf db r x a, ExpressionOf db r y a) => x -> y -> Cond db r
+(~=) = psqlOperatorCond "~="
groundhog-postgresql.cabal view
@@ -1,5 +1,5 @@ name:            groundhog-postgresql-version:         0.4.1+version:         0.4.2 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -18,7 +18,7 @@                    , bytestring              >= 0.9                    , blaze-builder           >= 0.3.0.0                    , transformers            >= 0.2.1-                   , groundhog               >= 0.4.1     && < 0.5.0+                   , groundhog               >= 0.4.2     && < 0.5.0                    , monad-control           >= 0.3                    , monad-logger            >= 0.3                    , containers              >= 0.2