packages feed

opaleye 0.5.0.0 → 0.5.1.0

raw patch · 35 files changed

+756/−262 lines, 35 filesdep ~aesonPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson

API changes (from Hackage documentation)

- Opaleye.Internal.HaskellDB.PrimQuery: OpAsg :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpBitAnd :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpBitNot :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpBitOr :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpBitXor :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpCat :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpDiv :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpEq :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpGt :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpGtEq :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpLt :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpLtEq :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpMinus :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpMul :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpNotEq :: BinOp
- Opaleye.Internal.HaskellDB.PrimQuery: OpPlus :: BinOp
- Opaleye.Internal.Join: extractLeftJoinFields :: Int -> Tag -> PrimExpr -> PM [(Symbol, PrimExpr)] PrimExpr
+ Opaleye.Internal.HaskellDB.PrimQuery: (:#>) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:#>>) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:&) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:*) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:+) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:-) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:->) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:->>) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:/) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:<) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:<=) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:<>) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:<@) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:=) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:==) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:>) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:>=) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:?&) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:?) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:?|) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:@>) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:^) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:|) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:||) :: BinOp
+ Opaleye.Internal.HaskellDB.PrimQuery: (:~) :: BinOp
+ Opaleye.Internal.Helpers: infixr 8 .::.
+ Opaleye.Internal.Join: joinExplicit :: (columnsA -> returnedColumnsA) -> (columnsB -> returnedColumnsB) -> JoinType -> Query columnsA -> Query columnsB -> ((columnsA, columnsB) -> Column PGBool) -> Query (returnedColumnsA, returnedColumnsB)
+ Opaleye.Internal.Operators: RelExprMaker :: ViewColumnMaker a c -> ColumnMaker c b -> RelExprMaker a b
+ Opaleye.Internal.Operators: [relExprCM] :: RelExprMaker a b -> ColumnMaker c b
+ Opaleye.Internal.Operators: [relExprVCM] :: RelExprMaker a b -> ViewColumnMaker a c
+ Opaleye.Internal.Operators: data RelExprMaker a b
+ Opaleye.Internal.Operators: infix 4 .==
+ Opaleye.Internal.Operators: infixr 3 .&&
+ Opaleye.Internal.Operators: instance Data.Profunctor.Product.Class.ProductProfunctor Opaleye.Internal.Operators.RelExprMaker
+ Opaleye.Internal.Operators: instance Data.Profunctor.Product.Default.Class.Default Opaleye.Internal.Operators.RelExprMaker GHC.Base.String (Opaleye.Internal.Column.Column a)
+ Opaleye.Internal.Operators: instance Data.Profunctor.Unsafe.Profunctor Opaleye.Internal.Operators.RelExprMaker
+ Opaleye.Internal.Operators: relExprColumn :: RelExprMaker String (Column a)
+ Opaleye.Internal.Operators: relationValuedExpr :: Default RelExprMaker strings columns => strings -> (a -> PrimExpr) -> QueryArr a columns
+ Opaleye.Internal.Operators: relationValuedExprExplicit :: RelExprMaker strings columns -> strings -> (a -> PrimExpr) -> QueryArr a columns
+ Opaleye.Internal.Operators: runRelExprMaker :: RelExprMaker strings columns -> Tag -> strings -> (columns, [(Symbol, PrimExpr)])
+ Opaleye.Internal.PrimQuery: FullJoin :: JoinType
+ Opaleye.Internal.PrimQuery: RelExpr :: PrimExpr -> [(Symbol, PrimExpr)] -> PrimQuery' a
+ Opaleye.Internal.PrimQuery: RightJoin :: JoinType
+ Opaleye.Internal.PrimQuery: [relExpr] :: PrimQueryFold' a p -> PrimExpr -> [(Symbol, PrimExpr)] -> p
+ Opaleye.Internal.Sql: FullJoin :: JoinType
+ Opaleye.Internal.Sql: RelExpr :: SqlExpr -> Select
+ Opaleye.Internal.Sql: RightJoin :: JoinType
+ Opaleye.Internal.Sql: relExpr :: PrimExpr -> [(Symbol, PrimExpr)] -> Select
+ Opaleye.Join: fullJoin :: (Default Unpackspec columnsA columnsA, Default Unpackspec columnsB columnsB, Default NullMaker columnsA nullableColumnsA, Default NullMaker columnsB nullableColumnsB) => Query columnsA -> Query columnsB -> ((columnsA, columnsB) -> Column PGBool) -> Query (nullableColumnsA, nullableColumnsB)
+ Opaleye.Join: fullJoinExplicit :: Unpackspec columnsA columnsA -> Unpackspec columnsB columnsB -> NullMaker columnsA nullableColumnsA -> NullMaker columnsB nullableColumnsB -> Query columnsA -> Query columnsB -> ((columnsA, columnsB) -> Column PGBool) -> Query (nullableColumnsA, nullableColumnsB)
+ Opaleye.Join: rightJoin :: (Default Unpackspec columnsA columnsA, Default Unpackspec columnsB columnsB, Default NullMaker columnsA nullableColumnsA) => Query columnsA -> Query columnsB -> ((columnsA, columnsB) -> Column PGBool) -> Query (nullableColumnsA, columnsB)
+ Opaleye.Join: rightJoinExplicit :: Unpackspec columnsA columnsA -> Unpackspec columnsB columnsB -> NullMaker columnsA nullableColumnsA -> Query columnsA -> Query columnsB -> ((columnsA, columnsB) -> Column PGBool) -> Query (nullableColumnsA, columnsB)
+ Opaleye.Operators: (.#>) :: (PGIsJson a) => Column (Nullable a) -> Column (PGArray PGText) -> Column (Nullable a)
+ Opaleye.Operators: (.#>>) :: (PGIsJson a) => Column (Nullable a) -> Column (PGArray PGText) -> Column (Nullable PGText)
+ Opaleye.Operators: (.->) :: (PGIsJson a, PGJsonIndex k) => Column (Nullable a) -> Column k -> Column (Nullable a)
+ Opaleye.Operators: (.->>) :: (PGIsJson a, PGJsonIndex k) => Column (Nullable a) -> Column k -> Column (Nullable PGText)
+ Opaleye.Operators: (.<@) :: Column PGJsonb -> Column PGJsonb -> Column PGBool
+ Opaleye.Operators: (.?&) :: Column PGJsonb -> Column (PGArray PGText) -> Column PGBool
+ Opaleye.Operators: (.?) :: Column PGJsonb -> Column PGText -> Column PGBool
+ Opaleye.Operators: (.?|) :: Column PGJsonb -> Column (PGArray PGText) -> Column PGBool
+ Opaleye.Operators: (.@>) :: Column PGJsonb -> Column PGJsonb -> Column PGBool
+ Opaleye.Operators: class PGIsJson a
+ Opaleye.Operators: class PGJsonIndex a
+ Opaleye.Operators: infix 4 .?&
+ Opaleye.Operators: infixl 8 .#>>
+ Opaleye.Operators: infixr 2 .||
+ Opaleye.Operators: infixr 3 .&&
+ Opaleye.Operators: instance Opaleye.Operators.PGIsJson Opaleye.PGTypes.PGJson
+ Opaleye.Operators: instance Opaleye.Operators.PGIsJson Opaleye.PGTypes.PGJsonb
+ Opaleye.Operators: instance Opaleye.Operators.PGJsonIndex Opaleye.PGTypes.PGInt4
+ Opaleye.Operators: instance Opaleye.Operators.PGJsonIndex Opaleye.PGTypes.PGInt8
+ Opaleye.Operators: instance Opaleye.Operators.PGJsonIndex Opaleye.PGTypes.PGText
+ Opaleye.RunQuery: fieldParserQueryRunnerColumn :: FieldParser haskell -> QueryRunnerColumn pgType haskell
- Opaleye.Internal.HaskellDB.Sql: CaseSqlExpr :: [(SqlExpr, SqlExpr)] -> SqlExpr -> SqlExpr
+ Opaleye.Internal.HaskellDB.Sql: CaseSqlExpr :: (NonEmpty (SqlExpr, SqlExpr)) -> SqlExpr -> SqlExpr
- Opaleye.Internal.Operators: (.==) :: Default EqPP columns columns => columns -> columns -> Column PGBool
+ Opaleye.Internal.Operators: (.==) :: forall columns. Default EqPP columns columns => columns -> columns -> Column PGBool
- Opaleye.Internal.PrimQuery: PrimQueryFold :: p -> (a -> p) -> (TableIdentifier -> [(Symbol, PrimExpr)] -> p) -> (NonEmpty p -> [PrimExpr] -> p) -> ([(Symbol, (Maybe (AggrOp, [OrderExpr]), PrimExpr))] -> p -> p) -> ([OrderExpr] -> p -> p) -> (LimitOp -> p -> p) -> (JoinType -> PrimExpr -> p -> p -> p) -> ([Symbol] -> (NonEmpty [PrimExpr]) -> p) -> (BinOp -> [(Symbol, (PrimExpr, PrimExpr))] -> (p, p) -> p) -> (String -> p -> p) -> PrimQueryFold' a p
+ Opaleye.Internal.PrimQuery: PrimQueryFold :: p -> (a -> p) -> (TableIdentifier -> [(Symbol, PrimExpr)] -> p) -> (NonEmpty p -> [PrimExpr] -> p) -> ([(Symbol, (Maybe (AggrOp, [OrderExpr]), PrimExpr))] -> p -> p) -> ([OrderExpr] -> p -> p) -> (LimitOp -> p -> p) -> (JoinType -> PrimExpr -> p -> p -> p) -> ([Symbol] -> (NonEmpty [PrimExpr]) -> p) -> (BinOp -> [(Symbol, (PrimExpr, PrimExpr))] -> (p, p) -> p) -> (String -> p -> p) -> (PrimExpr -> [(Symbol, PrimExpr)] -> p) -> PrimQueryFold' a p
- Opaleye.Internal.RunQuery: fieldParserQueryRunnerColumn :: FieldParser haskell -> QueryRunnerColumn coltype haskell
+ Opaleye.Internal.RunQuery: fieldParserQueryRunnerColumn :: FieldParser haskell -> QueryRunnerColumn pgType haskell
- Opaleye.Internal.RunQuery: fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn coltype haskell
+ Opaleye.Internal.RunQuery: fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn pgType haskell
- Opaleye.PGTypes: pgArray :: IsSqlType b => (a -> Column b) -> [a] -> Column (PGArray b)
+ Opaleye.PGTypes: pgArray :: forall a b. IsSqlType b => (a -> Column b) -> [a] -> Column (PGArray b)
- Opaleye.RunQuery: fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn coltype haskell
+ Opaleye.RunQuery: fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn pgType haskell
- Opaleye.Sql: showSqlForPostgres :: Default Unpackspec columns columns => Query columns -> Maybe String
+ Opaleye.Sql: showSqlForPostgres :: forall columns. Default Unpackspec columns columns => Query columns -> Maybe String
- Opaleye.Sql: showSqlForPostgresUnopt :: Default Unpackspec columns columns => Query columns -> Maybe String
+ Opaleye.Sql: showSqlForPostgresUnopt :: forall columns. Default Unpackspec columns columns => Query columns -> Maybe String

Files

CHANGELOG.md view
@@ -1,3 +1,10 @@+## 0.5.1.0++* Added+    * support for JSON operators+    * Many improvements to the Haddocks+    * RIGHT and FULL OUTER joins+ ## 0.5.0.0  * Added
Doc/Tutorial/TutorialManipulation.lhs view
@@ -61,10 +61,14 @@ > insertNothing = arrangeInsertManySql table (return (Nothing, 2, 3, P.pgString "Hello"))  ghci> putStrLn insertNothing-INSERT INTO tablename (x,-                       y)-VALUES (2.0,-        3.0)+INSERT INTO "tablename" ("id",+                         "x",+                         "y",+                         "s")+VALUES (DEFAULT,+        2.0,+        3.0,+        E'Hello')   If we'd like to pass a value into the insertion function, we can't@@ -74,7 +78,7 @@ > insertNonLiteral i = >   arrangeInsertManySql table (return (Nothing, 2, C.constant i, P.pgString "Hello")) -ghci> > putStrLn $ insertNonLiteral 12.0+ghci> putStrLn $ insertNonLiteral 12.0 INSERT INTO "tablename" ("id",                          "x",                          "y",@@ -91,12 +95,14 @@ > insertJust = arrangeInsertManySql table (return (Just 1, 2, 3, P.pgString "Hello"))  ghci> putStrLn insertJust-INSERT INTO tablename (id,-                       x,-                       y)+INSERT INTO "tablename" ("id",+                         "x",+                         "y",+                         "s") VALUES (1,         2.0,-        3.0)+        3.0,+        E'Hello')   An update takes an update function from the read type to the write@@ -109,10 +115,11 @@ >                                 (\(id_, _, _, _) -> id_ .== 5)  ghci> putStrLn update-UPDATE tablename-SET x = (x) + (y),-    y = (x) - (y)-WHERE ((id) = 5)+SET "id" = DEFAULT,+    "x" = ("x") + ("y"),+    "y" = ("x") - ("y"),+    "s" = "s"+WHERE (("id") = 5)   Sometimes when we insert a row with an automatically generated field@@ -129,11 +136,15 @@ >         def' = def  ghci> putStrLn insertReturning-INSERT INTO tablename (x,-                       y)-VALUES (4.0,-        5.0)-RETURNING id+INSERT INTO "tablename" ("id",+                         "x",+                         "y",+                         "s")+VALUES (DEFAULT,+        4.0,+        5.0,+        E'Bye')+RETURNING "id"   Running the queries
Test/QuickCheck.hs view
@@ -109,9 +109,9 @@  instance TQ.Arbitrary ArbitraryColumns where     arbitrary = do-    l <- TQ.listOf (TQ.oneof (map (return . Left) [-1, 0, 1]-                             ++ map (return . Right) [False, True]))-    return (ArbitraryColumns l)+      l <- TQ.listOf (TQ.oneof (map (return . Left) [-1, 0, 1]+                               ++ map (return . Right) [False, True]))+      return (ArbitraryColumns l)  instance TQ.Arbitrary ArbitraryColumnsList where   -- We don't want to choose very big lists because we take
Test/Test.hs view
@@ -19,6 +19,8 @@ import           Data.Monoid ((<>)) import qualified Data.String as String import qualified Data.Time   as Time+import qualified Data.Aeson as Json+import qualified Data.Text as T  import qualified System.Exit as Exit import qualified System.Environment as Environment@@ -149,6 +151,12 @@ table7 :: O.Table (Column O.PGText, Column O.PGText) (Column O.PGText, Column O.PGText) table7 = O.Table "table7" (PP.p2 (O.required "column1", O.required "column2")) +table8 :: O.Table (Column O.PGJson) (Column O.PGJson)+table8 = O.Table "table8" (O.required "column1")++table9 :: O.Table (Column O.PGJsonb) (Column O.PGJsonb)+table9 = O.Table "table9" (O.required "column1")+ tableKeywordColNames :: O.Table (Column O.PGInt4, Column O.PGInt4)                                 (Column O.PGInt4, Column O.PGInt4) tableKeywordColNames = O.Table "keywordtable" (PP.p2 (O.required "column", O.required "where"))@@ -168,6 +176,12 @@ table7Q :: Query (Column O.PGText, Column O.PGText) table7Q = O.queryTable table7 +table8Q :: Query (Column O.PGJson)+table8Q = O.queryTable table8++table9Q :: Query (Column O.PGJsonb)+table9Q = O.queryTable table9+ table1dataG :: Num a => [(a, a)] table1dataG = [ (1, 100)               , (1, 100)@@ -221,6 +235,20 @@ table7columndata :: [(Column O.PGText, Column O.PGText)] table7columndata = map (O.pgString *** O.pgString) table7data +table8data :: [Json.Value]+table8data = [ Json.object+               [ "a" Json..= ([10,20..100] :: [Int])+               , "b" Json..= Json.object ["x" Json..= (42 :: Int)]+               , "c" Json..= (21 :: Int)+               ]+             ]++table8columndata :: [Column O.PGJson]+table8columndata = map O.pgValueJSON table8data++table9columndata :: [Column O.PGJsonb]+table9columndata = map O.pgValueJSONB table8data+ -- We have to quote the table names here because upper case letters in -- table names are treated as lower case unless the name is quoted! dropAndCreateTable :: String -> (String, [String]) -> PGS.Query@@ -247,6 +275,12 @@         integer c = ("\"" ++ c ++ "\"" ++ " SERIAL")         commas = L.intercalate "," . map integer +dropAndCreateTableJson :: (String, [String]) -> PGS.Query+dropAndCreateTableJson = dropAndCreateTable "json"++dropAndCreateTableJsonb :: (String, [String]) -> PGS.Query+dropAndCreateTableJsonb = dropAndCreateTable "jsonb"+ type Table_ = (String, [String])  -- This should ideally be derived from the table definition above@@ -264,14 +298,25 @@ textTables :: [Table_] textTables = map columns2 ["table6", "table7"] +jsonTables :: [Table_]+jsonTables = [("table8", ["column1"])]++jsonbTables :: [Table_]+jsonbTables = [("table9", ["column1"])]+ dropAndCreateDB :: PGS.Connection -> IO () dropAndCreateDB conn = do   mapM_ execute tables   mapM_ executeTextTable textTables   mapM_ executeSerial serialTables+  mapM_ executeJson jsonTables+  -- Disabled until Travis supports Postgresql >= 9.4+  -- mapM_ executeJsonb jsonbTables   where execute = PGS.execute_ conn . dropAndCreateTableInt         executeTextTable = PGS.execute_ conn . dropAndCreateTableText         executeSerial = PGS.execute_ conn . dropAndCreateTableSerial+        executeJson = PGS.execute_ conn . dropAndCreateTableJson+        -- executeJsonb = PGS.execute_ conn . dropAndCreateTableJsonb  type Test = PGS.Connection -> IO Bool @@ -334,6 +379,16 @@         expected :: [Int]         expected = [12, 12, 21, 33] +-- This tests case_ with an empty list of cases, to make sure it generates valid+-- SQL.+testCaseEmpty :: Test+testCaseEmpty = testG q (== expected)+  where q :: Query (Column O.PGInt4)+        q = table1Q >>> proc _ ->+          Arr.returnA -< O.case_ [] 33+        expected :: [Int]+        expected = [33, 33, 33, 33]+ testDistinct :: Test testDistinct = testG (O.distinct table1Q)                (\r -> L.sort (L.nub table1data) == L.sort r)@@ -681,6 +736,100 @@   where     doubles = [1 :: Double, 2] +-- Test opaleye's equivalent of c1->'c'+testJsonGetFieldValue :: (O.PGIsJson a, O.QueryRunnerColumnDefault a Json.Value) => Query (Column a) -> Test+testJsonGetFieldValue dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+            Arr.returnA -< O.toNullable c1 O..-> O.pgStrictText "c"+        expected :: [Maybe Json.Value]+        expected = [Just $ Json.Number $ fromInteger 21]++-- Test opaleye's equivalent of c1->>'c'+testJsonGetFieldText :: (O.PGIsJson a) => Query (Column a) -> Test+testJsonGetFieldText dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+            Arr.returnA -< O.toNullable c1 O..->> O.pgStrictText "c"+        expected :: [Maybe T.Text]+        expected = [Just "21"]++-- Test opaleye's equivalent of c1->'a'->2+testJsonGetArrayValue :: (O.PGIsJson a, O.QueryRunnerColumnDefault a Json.Value) => Query (Column a) -> Test+testJsonGetArrayValue dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+            Arr.returnA -< O.toNullable c1 O..-> O.pgStrictText "a" O..-> O.pgInt4 2+        expected :: [Maybe Json.Value]+        expected = [Just $ Json.Number $ fromInteger 30]++-- Test opaleye's equivalent of c1->'a'->>2+testJsonGetArrayText :: (O.PGIsJson a) => Query (Column a) -> Test+testJsonGetArrayText dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+            Arr.returnA -< O.toNullable c1 O..-> O.pgStrictText "a" O..->> O.pgInt4 2+        expected :: [Maybe T.Text]+        expected = [Just "30"]++-- Test opaleye's equivalent of c1->>'missing'+-- Note that the missing field does not exist.+testJsonGetMissingField :: (O.PGIsJson a) => Query (Column a) -> Test+testJsonGetMissingField dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+            Arr.returnA -< O.toNullable c1 O..->> O.pgStrictText "missing"+        expected :: [Maybe T.Text]+        expected = [Nothing]++-- Test opaleye's equivalent of c1#>'{b,x}'+testJsonGetPathValue :: (O.PGIsJson a, O.QueryRunnerColumnDefault a Json.Value) => Query (Column a) -> Test+testJsonGetPathValue dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+              Arr.returnA -< O.toNullable c1 O..#> O.pgArray O.pgStrictText ["b", "x"]+        expected :: [Maybe Json.Value]+        expected = [Just $ Json.Number $ fromInteger 42]++-- Test opaleye's equivalent of c1#>>'{b,x}'+testJsonGetPathText :: (O.PGIsJson a) => Query (Column a) -> Test+testJsonGetPathText dataQuery = testG q (== expected)+  where q = dataQuery >>> proc c1 -> do+              Arr.returnA -< O.toNullable c1 O..#>> O.pgArray O.pgStrictText ["b", "x"]+        expected :: [Maybe T.Text]+        expected = [Just "42"]++-- Test opaleye's equivalent of c1 @> '{"c":21}'::jsonb+testJsonbRightInLeft :: Test+testJsonbRightInLeft = testG q (== [True])+  where q = table9Q >>> proc c1 -> do+              Arr.returnA -< c1 O..@> O.pgJSONB "{\"c\":21}"++-- Test opaleye's equivalent of '{"c":21}'::jsonb <@ c1+testJsonbLeftInRight :: Test+testJsonbLeftInRight = testG q (== [True])+  where q = table9Q >>> proc c1 -> do+              Arr.returnA -< O.pgJSONB "{\"c\":21}" O..<@ c1++-- Test opaleye's equivalent of c1 ? 'b'+testJsonbContains :: Test+testJsonbContains = testG q (== [True])+  where q = table9Q >>> proc c1 -> do+              Arr.returnA -< c1 O..? O.pgStrictText "c"++-- Test opaleye's equivalent of c1 ? 'missing'+-- Note that the missing field does not exist.+testJsonbContainsMissing :: Test+testJsonbContainsMissing = testG q (== [False])+  where q = table9Q >>> proc c1 -> do+              Arr.returnA -< c1 O..? O.pgStrictText "missing"++-- Test opaleye's equivalent of c1 ?| array['b', 'missing']+testJsonbContainsAny :: Test+testJsonbContainsAny = testG q (== [True])+  where q = table9Q >>> proc c1 -> do+              Arr.returnA -< c1 O..?| O.pgArray O.pgStrictText ["b", "missing"]++-- Test opaleye's equivalent of c1 ?& array['a', 'b', 'c']+testJsonbContainsAll :: Test+testJsonbContainsAll = testG q (== [True])+  where q = table9Q >>> proc c1 -> do+              Arr.returnA -< c1 O..?& O.pgArray O.pgStrictText ["a", "b", "c"]+ allTests :: [Test] allTests = [testSelect, testProduct, testRestrict, testNum, testDiv, testCase,             testDistinct, testAggregate, testAggregate0, testAggregateFunction,@@ -694,9 +843,25 @@             testKeywordColNames, testInsertSerial, testInQuery, testAtTimeZone,             testStringArrayAggregateOrdered, testMultipleAggregateOrdered,             testOverwriteAggregateOrdered, testCountRows0, testCountRows3,-            testArrayLiterals, testEmptyArray, testFloatArray+            testArrayLiterals, testEmptyArray, testFloatArray, testCaseEmpty,+            testJsonGetFieldValue   table8Q, testJsonGetFieldText  table8Q,+            testJsonGetMissingField table8Q, testJsonGetArrayValue table8Q,+            testJsonGetArrayText    table8Q, testJsonGetPathValue  table8Q,+            testJsonGetPathText     table8Q             ] +-- Note: these tests are left out of allTests until Travis supports+-- Postgresql >= 9.4+jsonbTests :: [Test]+jsonbTests = [testJsonGetFieldValue  table9Q,testJsonGetFieldText  table9Q,+             testJsonGetMissingField table9Q,testJsonGetArrayValue table9Q,+             testJsonGetArrayText    table9Q,testJsonGetPathValue  table9Q,+             testJsonGetPathText     table9Q,+             testJsonbRightInLeft, testJsonbLeftInRight,+             testJsonbContains, testJsonbContainsMissing,+             testJsonbContainsAny, testJsonbContainsAll+             ]+ -- Environment.getEnv throws an exception on missing environment variable! getEnv :: String -> IO (Maybe String) getEnv var = do@@ -732,6 +897,9 @@                , (table4, table4columndata) ]   insert (table6, table6columndata)   insert (table7, table7columndata)+  insert (table8, table8columndata)+  -- Disabled until Travis supports Postgresql >= 9.4+  -- insert (table9, table9columndata)    -- Need to run quickcheck after table data has been inserted   QuickCheck.run conn
opaleye.cabal view
@@ -1,6 +1,6 @@ name:            opaleye copyright:       Copyright (c) 2014-2016 Purely Agile Limited-version:         0.5.0.0+version:         0.5.1.0 synopsis:        An SQL-generating DSL targeting PostgreSQL description:     An SQL-generating DSL targeting PostgreSQL.  Allows                  Postgres queries to be written within Haskell in a@@ -13,7 +13,7 @@ maintainer:      Purely Agile category:        Database build-type:      Simple-cabal-version:   >= 1.8+cabal-version:   >= 1.10 extra-doc-files: *.md,                  Doc/*.md tested-with:     GHC==7.10.1, GHC==7.8.4, GHC==7.6.3@@ -23,13 +23,14 @@   location: https://github.com/tomjaguarpaw/haskell-opaleye.git  library+  default-language: Haskell2010   hs-source-dirs: src   build-depends:       -- attoparsec can be removed once postgresql-simple patch in       -- Internal.RunQuery is merged upstream-      aeson               >= 0.6     && < 0.12+      aeson               >= 0.6     && < 1.1     , attoparsec          >= 0.10.3  && < 0.14-    , base                >= 4       && < 5+    , base                >= 4.6     && < 5     , base16-bytestring   >= 0.1.1.6 && < 0.2     , case-insensitive    >= 1.2     && < 1.3     , bytestring          >= 0.10    && < 0.11@@ -92,11 +93,13 @@   ghc-options:     -Wall  test-suite test+  default-language: Haskell2010   type: exitcode-stdio-1.0   main-is: Test.hs   other-modules: QuickCheck   hs-source-dirs: Test   build-depends:+    aeson >= 0.6 && < 0.12,     base >= 4 && < 5,     containers,     contravariant,@@ -106,11 +109,13 @@     product-profunctors,     QuickCheck,     semigroups,+    text >= 0.11 && < 1.3,     time,     opaleye   ghc-options: -Wall  test-suite tutorial+  default-language: Haskell2010   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules: TutorialAdvanced,
src/Opaleye/Aggregate.hs view
@@ -1,4 +1,7 @@--- | Perform aggregations on query results.+-- | Perform aggregation on 'Query's.  To aggregate a 'Query' you+-- should construct an 'Aggregator' encoding how you want the+-- aggregation to proceed, then call 'aggregate' on it.+ module Opaleye.Aggregate (module Opaleye.Aggregate, Aggregator) where  import           Control.Applicative (pure)@@ -25,6 +28,13 @@ Given a 'Query' producing rows of type @a@ and an 'Aggregator' accepting rows of type @a@, apply the aggregator to the results of the query. +If you simply want to count the number of rows in a query you might+find the 'countRows' function more convenient.++By design there is no aggregation function of type @Aggregator b b' ->+QueryArr a b -> QueryArr a b'@.  Such a function would allow violation+of SQL's scoping rules and lead to invalid queries.+ Please note that when aggregating an empty query with no @GROUP BY@ clause, Opaleye's behaviour differs from Postgres's behaviour. Postgres returns a single row whereas Opaleye returns zero rows.@@ -33,12 +43,6 @@ query has zero rows it has zero groups, and thus zero rows in the result of an aggregation.) -If you simply want to count the number of rows in a query you might-find the 'countRows' function more convenient.--By design there is no aggregation function of type @Aggregator b b' ->-QueryArr a b -> QueryArr a b'@.  Such a function would allow violation-of SQL's scoping rules and lead to invalid queries. -} aggregate :: Aggregator a b -> Query a -> Query b aggregate agg q = Q.simpleQueryArr (A.aggregateU agg . Q.runSimpleQueryArr q)
src/Opaleye/Binary.hs view
@@ -1,15 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}--module Opaleye.Binary where--import           Opaleye.QueryArr (Query)-import qualified Opaleye.Internal.Binary as B-import qualified Opaleye.Internal.PrimQuery as PQ--import           Data.Profunctor.Product.Default (Default, def)---- | Example type specialization:+-- | Binary relational operations on 'Query's, that is, operations+-- which take two 'Query's as arguments and return a single 'Query'. --+-- All the binary relational operations have the same type+-- specializations.  For example:+-- -- @ -- unionAll :: Query (Column a, Column b) --          -> Query (Column a, Column b)@@ -24,64 +18,75 @@ --          -> Query (Foo (Column a) (Column b) (Column c)) -- @ ----- By design there is no union function of type @QueryArr a b ->--- QueryArr a b -> QueryArr a b@.  Such a function would allow--- violation of SQL's scoping rules and lead to invalid queries.+-- Please note that by design there are no binary relational functions+-- of type @QueryArr a b -> QueryArr a b -> QueryArr a b@.  Such+-- functions would allow violation of SQL's scoping rules and lead to+-- invalid queries.+--+-- `unionAll` is very close to being the @<|>@ operator of a+-- @Control.Applicative.Alternative@ instance but it fails to work+-- only because of the typeclass constraint it has.++{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}++module Opaleye.Binary where++import           Opaleye.QueryArr (Query)+import qualified Opaleye.Internal.Binary as B+import qualified Opaleye.Internal.PrimQuery as PQ++import           Data.Profunctor.Product.Default (Default, def)+ unionAll :: Default B.Binaryspec columns columns =>             Query columns -> Query columns -> Query columns unionAll = unionAllExplicit def -unionAllExplicit :: B.Binaryspec columns columns'-                 -> Query columns -> Query columns -> Query columns'-unionAllExplicit = B.sameTypeBinOpHelper PQ.UnionAll-- -- | The same as unionAll, except that it additionally removes any --   duplicate rows. union :: Default B.Binaryspec columns columns =>          Query columns -> Query columns -> Query columns union = unionExplicit def -unionExplicit :: B.Binaryspec columns columns'-              -> Query columns -> Query columns -> Query columns'-unionExplicit = B.sameTypeBinOpHelper PQ.Union--- intersectAll :: Default B.Binaryspec columns columns =>             Query columns -> Query columns -> Query columns intersectAll = intersectAllExplicit def -intersectAllExplicit :: B.Binaryspec columns columns'-                 -> Query columns -> Query columns -> Query columns'-intersectAllExplicit = B.sameTypeBinOpHelper PQ.IntersectAll-- -- | The same as intersectAll, except that it additionally removes any --   duplicate rows. intersect :: Default B.Binaryspec columns columns =>          Query columns -> Query columns -> Query columns intersect = intersectExplicit def -intersectExplicit :: B.Binaryspec columns columns'-              -> Query columns -> Query columns -> Query columns'-intersectExplicit = B.sameTypeBinOpHelper PQ.Intersect-- exceptAll :: Default B.Binaryspec columns columns =>             Query columns -> Query columns -> Query columns exceptAll = exceptAllExplicit def -exceptAllExplicit :: B.Binaryspec columns columns'-                 -> Query columns -> Query columns -> Query columns'-exceptAllExplicit = B.sameTypeBinOpHelper PQ.ExceptAll-- -- | The same as exceptAll, except that it additionally removes any --   duplicate rows. except :: Default B.Binaryspec columns columns =>          Query columns -> Query columns -> Query columns except = exceptExplicit def+++unionAllExplicit :: B.Binaryspec columns columns'+                 -> Query columns -> Query columns -> Query columns'+unionAllExplicit = B.sameTypeBinOpHelper PQ.UnionAll++unionExplicit :: B.Binaryspec columns columns'+              -> Query columns -> Query columns -> Query columns'+unionExplicit = B.sameTypeBinOpHelper PQ.Union++intersectAllExplicit :: B.Binaryspec columns columns'+                 -> Query columns -> Query columns -> Query columns'+intersectAllExplicit = B.sameTypeBinOpHelper PQ.IntersectAll++intersectExplicit :: B.Binaryspec columns columns'+              -> Query columns -> Query columns -> Query columns'+intersectExplicit = B.sameTypeBinOpHelper PQ.Intersect++exceptAllExplicit :: B.Binaryspec columns columns'+                 -> Query columns -> Query columns -> Query columns'+exceptAllExplicit = B.sameTypeBinOpHelper PQ.ExceptAll  exceptExplicit :: B.Binaryspec columns columns'               -> Query columns -> Query columns -> Query columns'
src/Opaleye/Column.hs view
@@ -1,3 +1,8 @@+-- | Functions for working directly with 'Column's.+--+-- Please note that numeric 'Column' types are instances of 'Num', so+-- you can use '*', '/', '+', '-' on them.+ module Opaleye.Column (module Opaleye.Column,                        Column,                        Nullable,@@ -17,6 +22,7 @@ null :: Column (Nullable a) null = C.Column (HPQ.ConstExpr HPQ.NullLit) +-- | @TRUE@ if the value of the column is @NULL@, @FALSE@ otherwise. isNull :: Column (Nullable a) -> Column T.PGBool isNull = C.unOp HPQ.OpIsNull @@ -24,7 +30,7 @@ -- otherwise map the underlying @Column a@ using the provided -- function. ----- The Opaleye equivalent of the 'Data.Maybe.maybe' function.+-- The Opaleye equivalent of 'Data.Maybe.maybe'. matchNullable :: Column b -> (Column a -> Column b) -> Column (Nullable a)               -> Column b matchNullable replacement f x = C.unsafeIfThenElse (isNull x) replacement@@ -33,11 +39,13 @@ -- | If the @Column (Nullable a)@ is NULL then return the provided -- @Column a@ otherwise return the underlying @Column a@. ----- The Opaleye equivalent of the 'Data.Maybe.fromMaybe' function+-- The Opaleye equivalent of 'Data.Maybe.fromMaybe'. fromNullable :: Column a -> Column (Nullable a) -> Column a fromNullable = flip matchNullable id --- | The Opaleye equivalent of 'Data.Maybe.Just'+-- | Treat a column as though it were nullable.  This is always safe.+--+-- The Opaleye equivalent of 'Data.Maybe.Just'. toNullable :: Column a -> Column (Nullable a) toNullable = unsafeCoerceColumn 
src/Opaleye/Constant.hs view
@@ -24,13 +24,32 @@ import           Control.Applicative (Applicative, pure, (<*>)) import           Data.Functor                    ((<$>)) --newtype Constant haskells columns =-  Constant { constantExplicit :: haskells -> columns }-+-- | 'constant' provides a convenient typeclass wrapper around the+-- 'Column' creation functions in "Opaleye.PGTypes".  Besides+-- convenience it doesn't provide any additional functionality.+--+-- It can be used with functions like 'Opaleye.Manipulation.runInsert'+-- to insert custom Haskell types into the database.+-- The following is an example of a function for inserting custom types.+--+-- @+--   customInsert+--      :: ( 'D.Default' 'Constant' haskells columns )+--      => Connection+--      -> 'Opaleye.Table' columns columns'+--      -> haskells+--      -> IO Int64+--   customInsert conn table haskells = 'Opaleye.Manipulation.runInsert' conn table $ 'constant' haskells+-- @+--+-- In order to use this function with your custom types, you need to define an+-- instance of 'D.Default' 'Constant' for your custom types. constant :: D.Default Constant haskells columns          => haskells -> columns constant = constantExplicit D.def++newtype Constant haskells columns =+  Constant { constantExplicit :: haskells -> columns }  instance D.Default Constant haskell (Column sql)          => D.Default Constant (Maybe haskell) (Column (C.Nullable sql)) where
src/Opaleye/Distinct.hs view
@@ -8,7 +8,7 @@  import qualified Data.Profunctor.Product.Default as D --- | Remove duplicate items from the query result.+-- | Remove duplicate rows from the 'Query'. -- -- Example type specialization: --@@ -22,7 +22,7 @@ -- distinct :: Query (Foo (Column a) (Column b) (Column c)) -> Query (Foo (Column a) (Column b) (Column c)) -- @ ----- By design there is no distinct function of type @QueryArr a b ->+-- By design there is no @distinct@ function of type @QueryArr a b -> -- QueryArr a b@.  Such a function would allow violation of SQL's -- scoping rules and lead to invalid queries. distinct :: D.Default Distinctspec columns columns =>
src/Opaleye/Internal/Column.hs view
@@ -4,10 +4,10 @@  import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ --- | Numeric 'Column' types are instances of 'Num', so you can use--- '*', '/', '+', '-' on them. newtype Column a = Column HPQ.PrimExpr deriving Show +-- | Only used within a 'Column', to indicate that it can take null+-- values. data Nullable a = Nullable  unColumn :: Column a -> HPQ.PrimExpr@@ -17,10 +17,15 @@ unsafeCoerce :: Column a -> Column b unsafeCoerce = unsafeCoerceColumn +-- | Treat a 'Column' as though it were of a different type.  If such+-- a treatment is not valid then Postgres may fail with an error at+-- SQL run time. unsafeCoerceColumn :: Column a -> Column b unsafeCoerceColumn (Column e) = Column e --- | Cast a column to any other type. This is safe for some conversions such as uuid to text.+-- | Cast a column to any other type. Implements Postgres's @::@ or+-- @CAST( ... AS ... )@ operations.  This is safe for some+-- conversions, such as uuid to text. unsafeCast :: String -> Column a -> Column b unsafeCast = mapColumn . HPQ.CastExpr   where@@ -46,19 +51,19 @@ unsafeIfThenElse cond t f = unsafeCase_ [(cond, t)] f  unsafeGt :: Column a -> Column a -> Column pgBool-unsafeGt = binOp HPQ.OpGt+unsafeGt = binOp (HPQ.:>)  unsafeEq :: Column a -> Column a -> Column pgBool-unsafeEq = binOp HPQ.OpEq+unsafeEq = binOp (HPQ.:==)  class PGNum a where   pgFromInteger :: Integer -> Column a  instance PGNum a => Num (Column a) where   fromInteger = pgFromInteger-  (*) = binOp HPQ.OpMul-  (+) = binOp HPQ.OpPlus-  (-) = binOp HPQ.OpMinus+  (*) = binOp (HPQ.:*)+  (+) = binOp (HPQ.:+)+  (-) = binOp (HPQ.:-)    abs = unOp HPQ.OpAbs   negate = unOp HPQ.OpNegate@@ -72,8 +77,9 @@  instance (PGNum a, PGFractional a) => Fractional (Column a) where   fromRational = pgFromRational-  (/) = binOp HPQ.OpDiv+  (/) = binOp (HPQ.:/) +-- | A dummy typeclass whose instances support integral operations. class PGIntegral a  class PGString a where
src/Opaleye/Internal/HaskellDB/PrimQuery.hs view
@@ -45,15 +45,18 @@              | OtherLit String       -- ^ used for hacking in custom SQL                deriving (Read,Show) -data BinOp      = OpEq | OpLt | OpLtEq | OpGt | OpGtEq | OpNotEq+data BinOp      = (:==) | (:<) | (:<=) | (:>) | (:>=) | (:<>)                 | OpAnd | OpOr                 | OpLike | OpIn                 | OpOther String -                | OpCat-                | OpPlus | OpMinus | OpMul | OpDiv | OpMod-                | OpBitNot | OpBitAnd | OpBitOr | OpBitXor-                | OpAsg | OpAtTimeZone+                | (:||)+                | (:+) | (:-) | (:*) | (:/) | OpMod+                | (:~) | (:&) | (:|) | (:^)+                | (:=) | OpAtTimeZone++                | (:->) | (:->>) | (:#>) | (:#>>)+                | (:@>) | (:<@) | (:?) | (:?|) | (:?&)                 deriving (Show,Read)  data UnOp = OpNot
src/Opaleye/Internal/HaskellDB/Sql.hs view
@@ -40,7 +40,7 @@              | FunSqlExpr     String [SqlExpr]              | AggrFunSqlExpr String [SqlExpr] [(SqlExpr, SqlOrder)] -- ^ Aggregate functions separate from normal functions.              | ConstSqlExpr   String-             | CaseSqlExpr    [(SqlExpr,SqlExpr)] SqlExpr+             | CaseSqlExpr    (NEL.NonEmpty (SqlExpr,SqlExpr)) SqlExpr              | ListSqlExpr    [SqlExpr]              | ParamSqlExpr (Maybe SqlName) SqlExpr              | PlaceHolderSqlExpr
src/Opaleye/Internal/HaskellDB/Sql/Default.hs view
@@ -130,7 +130,9 @@       ConstExpr l      -> ConstSqlExpr (sqlLiteral gen l)       CaseExpr cs e    -> let cs' = [(sqlExpr gen c, sqlExpr gen x)| (c,x) <- cs]                               e'  = sqlExpr gen e-                           in CaseSqlExpr cs' e'+                          in case NEL.nonEmpty cs' of+                            Just nel -> CaseSqlExpr nel e'+                            Nothing  -> e'       ListExpr es      -> ListSqlExpr (map (sqlExpr gen) es)       ParamExpr n _    -> ParamSqlExpr n PlaceHolderSqlExpr       FunExpr n exprs  -> FunSqlExpr n (map (sqlExpr gen) exprs)@@ -139,29 +141,38 @@       ArrayExpr es -> ArraySqlExpr (map (sqlExpr gen) es)  showBinOp :: BinOp -> String-showBinOp  OpEq         = "="-showBinOp  OpLt         = "<"-showBinOp  OpLtEq       = "<="-showBinOp  OpGt         = ">"-showBinOp  OpGtEq       = ">="-showBinOp  OpNotEq      = "<>"+showBinOp  (:==)        = "="+showBinOp  (:<)         = "<"+showBinOp  (:<=)        = "<="+showBinOp  (:>)         = ">"+showBinOp  (:>=)        = ">="+showBinOp  (:<>)        = "<>" showBinOp  OpAnd        = "AND" showBinOp  OpOr         = "OR" showBinOp  OpLike       = "LIKE" showBinOp  OpIn         = "IN" showBinOp  (OpOther s)  = s-showBinOp  OpCat        = "||"-showBinOp  OpPlus       = "+"-showBinOp  OpMinus      = "-"-showBinOp  OpMul        = "*"-showBinOp  OpDiv        = "/"+showBinOp  (:||)        = "||"+showBinOp  (:+)         = "+"+showBinOp  (:-)         = "-"+showBinOp  (:*)         = "*"+showBinOp  (:/)         = "/" showBinOp  OpMod        = "MOD"-showBinOp  OpBitNot     = "~"-showBinOp  OpBitAnd     = "&"-showBinOp  OpBitOr      = "|"-showBinOp  OpBitXor     = "^"-showBinOp  OpAsg        = "="+showBinOp  (:~)         = "~"+showBinOp  (:&)         = "&"+showBinOp  (:|)         = "|"+showBinOp  (:^)         = "^"+showBinOp  (:=)         = "=" showBinOp  OpAtTimeZone = "AT TIME ZONE"+showBinOp  (:->)        = "->"+showBinOp  (:->>)       = "->>"+showBinOp  (:#>)        = "#>"+showBinOp  (:#>>)       = "#>>"+showBinOp  (:@>)        = "@>"+showBinOp  (:<@)        = "<@"+showBinOp  (:?)         = "?"+showBinOp  (:?|)        = "?|"+showBinOp  (:?&)        = "?&"   data UnOpType = UnOpFun | UnOpPrefix | UnOpPostfix
src/Opaleye/Internal/HaskellDB/Sql/Print.hs view
@@ -27,6 +27,7 @@ import Text.PrettyPrint.HughesPJ (Doc, (<+>), ($$), (<>), comma, doubleQuotes,                                   empty, equals, hcat, hsep, parens, punctuate,                                   text, vcat, brackets)+import Data.Foldable (toList)  -- Silliness to avoid "ORDER BY 1" etc. meaning order by the first -- column.  We need an identity function, but due to@@ -125,7 +126,7 @@       FunSqlExpr f es     -> text f <> parens (commaH ppSqlExpr es)       AggrFunSqlExpr f es ord -> text f <> parens (commaH ppSqlExpr es <+> ppOrderBy ord)       ConstSqlExpr c      -> text c-      CaseSqlExpr cs el   -> text "CASE" <+> vcat (map ppWhen cs)+      CaseSqlExpr cs el   -> text "CASE" <+> vcat (toList (fmap ppWhen cs))                              <+> text "ELSE" <+> ppSqlExpr el <+> text "END"           where ppWhen (w,t) = text "WHEN" <+> ppSqlExpr w                                <+> text "THEN" <+> ppSqlExpr t
src/Opaleye/Internal/Join.hs view
@@ -3,8 +3,10 @@ module Opaleye.Internal.Join where  import qualified Opaleye.Internal.Tag as T-import qualified Opaleye.Internal.PackMap as PM-import           Opaleye.Internal.Column (Column, Nullable)+import           Opaleye.Internal.Column (Column(Column), Nullable)+import qualified Opaleye.Internal.QueryArr as Q+import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.PGTypes as T import qualified Opaleye.Column as C  import qualified Control.Applicative as A@@ -13,22 +15,35 @@ import qualified Data.Profunctor.Product as PP import qualified Data.Profunctor.Product.Default as D -import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ- newtype NullMaker a b = NullMaker (a -> b)  toNullable :: NullMaker a b -> a -> b toNullable (NullMaker f) = f -extractLeftJoinFields :: Int -> T.Tag -> HPQ.PrimExpr-            -> PM.PM [(HPQ.Symbol, HPQ.PrimExpr)] HPQ.PrimExpr-extractLeftJoinFields n = PM.extractAttr ("result" ++ show n ++ "_")- instance D.Default NullMaker (Column a) (Column (Nullable a)) where   def = NullMaker C.unsafeCoerceColumn  instance D.Default NullMaker (Column (Nullable a)) (Column (Nullable a)) where   def = NullMaker C.unsafeCoerceColumn++joinExplicit :: (columnsA -> returnedColumnsA)+             -> (columnsB -> returnedColumnsB)+             -> PQ.JoinType+             -> Q.Query columnsA -> Q.Query columnsB+             -> ((columnsA, columnsB) -> Column T.PGBool)+             -> Q.Query (returnedColumnsA, returnedColumnsB)+joinExplicit returnColumnsA returnColumnsB joinType+             qA qB cond = Q.simpleQueryArr q where+  q ((), startTag) = ((nullableColumnsA, nullableColumnsB), primQueryR, T.next endTag)+    where (columnsA, primQueryA, midTag) = Q.runSimpleQueryArr qA ((), startTag)+          (columnsB, primQueryB, endTag) = Q.runSimpleQueryArr qB ((), midTag)++          nullableColumnsA = returnColumnsA columnsA+          nullableColumnsB = returnColumnsB columnsB++          Column cond' = cond (columnsA, columnsB)+          primQueryR = PQ.Join joinType cond' primQueryA primQueryB+  -- { Boilerplate instances 
src/Opaleye/Internal/Operators.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -5,10 +6,15 @@  import           Opaleye.Internal.Column (Column) import qualified Opaleye.Internal.Column as C+import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+import qualified Opaleye.Internal.QueryArr as QA+import qualified Opaleye.Internal.TableMaker as TM+import qualified Opaleye.Internal.Table as Table+import qualified Opaleye.Internal.Tag as Tag import qualified Opaleye.PGTypes as T -import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor (Profunctor, dimap, lmap, rmap) import           Data.Profunctor.Product (ProductProfunctor, empty, (***!)) import qualified Data.Profunctor.Product.Default as D @@ -18,9 +24,12 @@ (.==) = eqExplicit (D.def :: EqPP columns columns)  infixr 3 .&&++-- | Boolean and (.&&) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool (.&&) = C.binOp HPQ.OpAnd +-- Probably should be newtype data EqPP a b = EqPP (a -> a -> Column T.PGBool)  eqExplicit :: EqPP columns a -> columns -> columns -> Column T.PGBool@@ -29,6 +38,45 @@ instance D.Default EqPP (Column a) (Column a) where   def = EqPP C.unsafeEq ++-- This seems to be the only place we use ViewColumnMaker now.+data RelExprMaker a b =+  forall c. RelExprMaker {+      relExprVCM :: TM.ViewColumnMaker a c+    , relExprCM  :: TM.ColumnMaker c b+    }++relExprColumn :: RelExprMaker String (Column a)+relExprColumn = RelExprMaker TM.tableColumn TM.column++instance D.Default RelExprMaker String (Column a) where+  def = relExprColumn++runRelExprMaker :: RelExprMaker strings columns+                -> Tag.Tag+                -> strings+                -> (columns, [(HPQ.Symbol, HPQ.PrimExpr)])+runRelExprMaker rem_ tag =+  case rem_ of RelExprMaker vcm cm -> Table.runColumnMaker cm tag+                                    . TM.runViewColumnMaker vcm++relationValuedExprExplicit :: RelExprMaker strings columns+                           -> strings+                           -> (a -> HPQ.PrimExpr)+                           -> QA.QueryArr a columns+relationValuedExprExplicit rem_ strings pe =+  QA.simpleQueryArr $ \(a, tag) ->+    let (primExprs, projcols) = runRelExprMaker rem_ tag strings+        primQ :: PQ.PrimQuery+        primQ = PQ.RelExpr (pe a) projcols+    in (primExprs, primQ, Tag.next tag)++relationValuedExpr :: D.Default RelExprMaker strings columns+                   => strings+                   -> (a -> HPQ.PrimExpr)+                   -> QA.QueryArr a columns+relationValuedExpr = relationValuedExprExplicit D.def+ -- { Boilerplate instances  instance Profunctor EqPP where@@ -39,4 +87,14 @@   EqPP f ***! EqPP f' = EqPP (\a a' ->                                f (fst a) (fst a') .&& f' (snd a) (snd a')) +instance Profunctor RelExprMaker where+  dimap f g (RelExprMaker a b) = RelExprMaker (lmap f a) (rmap g b)++instance ProductProfunctor RelExprMaker where+  empty = RelExprMaker empty empty+  f ***! g = case f of RelExprMaker vcmf cmf ->+                        case g of RelExprMaker vcmg cmg ->+                                    h vcmf vcmg cmf cmg+    where h vcmg vcmf cmg cmf = RelExprMaker (vcmg ***! vcmf)+                                             (cmg  ***! cmf) -- }
src/Opaleye/Internal/Optimize.hs view
@@ -55,6 +55,7 @@       PQ.UnionAll     -> binary Just            Just            PQ.UnionAll       PQ.IntersectAll -> binary (const Nothing) (const Nothing) PQ.IntersectAll   , PQ.label     = fmap . PQ.Label+  , PQ.relExpr   = return .: PQ.RelExpr   }   where -- If only the first argument is Just, do n1 on it         -- If only the second argument is Just, do n2 on it
src/Opaleye/Internal/Order.hs view
@@ -16,8 +16,8 @@ {-| An `Order` represents an expression to order on and a sort direction. Multiple `Order`s can be composed with-`Data.Monoid.mappend`.  If two rows are equal according to the first-`Order`, the second is used, and so on.+`Data.Monoid.mappend` or @(\<\>)@ from "Data.Monoid".  If two rows are+equal according to the first `Order`, the second is used, and so on. -}  -- Like the (columns -> RowParser haskells) field of QueryRunner this
src/Opaleye/Internal/PrimQuery.hs view
@@ -18,7 +18,7 @@            | IntersectAll              deriving Show -data JoinType = LeftJoin deriving Show+data JoinType = LeftJoin | RightJoin | FullJoin deriving Show  data TableIdentifier = TableIdentifier   { tiSchemaName :: Maybe String@@ -55,6 +55,7 @@                               [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))]                               (PrimQuery' a, PrimQuery' a)                   | Label     String (PrimQuery' a)+                  | RelExpr   HPQ.PrimExpr [(Symbol, HPQ.PrimExpr)]                  deriving Show  type PrimQuery = PrimQuery' ()@@ -72,6 +73,8 @@   , values    :: [Symbol] -> (NEL.NonEmpty [HPQ.PrimExpr]) -> p   , binary    :: BinOp -> [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))] -> (p, p) -> p   , label     :: String -> p -> p+  , relExpr   :: HPQ.PrimExpr -> [(Symbol, HPQ.PrimExpr)] -> p+    -- ^ A relation-valued expression   }  @@ -87,7 +90,9 @@   , join      = Join   , values    = Values   , binary    = Binary-  , label     = Label }+  , label     = Label+  , relExpr   = RelExpr+  }  foldPrimQuery :: PrimQueryFold' a p -> PrimQuery' a -> p foldPrimQuery f = fix fold@@ -103,6 +108,7 @@           Values ss pes             -> values    f ss pes           Binary binop pes (q1, q2) -> binary    f binop pes (self q1, self q2)           Label l pq                -> label     f l (self pq)+          RelExpr pe syms           -> relExpr   f pe syms         fix g = let x = g x in x  times :: PrimQuery -> PrimQuery -> PrimQuery
src/Opaleye/Internal/Print.hs view
@@ -3,7 +3,9 @@ import           Prelude hiding (product)  import qualified Opaleye.Internal.Sql as Sql-import           Opaleye.Internal.Sql (Select(SelectFrom, Table,+import           Opaleye.Internal.Sql (Select(SelectFrom,+                                              Table,+                                              RelExpr,                                               SelectJoin,                                               SelectValues,                                               SelectBinary,@@ -72,6 +74,8 @@  ppJoinType :: Sql.JoinType -> Doc ppJoinType Sql.LeftJoin = text "LEFT OUTER JOIN"+ppJoinType Sql.RightJoin = text "RIGHT OUTER JOIN"+ppJoinType Sql.FullJoin = text "FULL OUTER JOIN"  ppAttrs :: Sql.SelectAttrs -> Doc ppAttrs Sql.Star             = text "*"@@ -93,6 +97,7 @@ ppTable :: (TableAlias, Select) -> Doc ppTable (alias, select) = HPrint.ppAs (Just alias) $ case select of   Table table           -> HPrint.ppTable table+  RelExpr expr          -> HPrint.ppSqlExpr expr   SelectFrom selectFrom -> parens (ppSelectFrom selectFrom)   SelectJoin slj        -> parens (ppSelectJoin slj)   SelectValues slv      -> parens (ppSelectValues slv)
src/Opaleye/Internal/QueryArr.hs view
@@ -20,7 +20,10 @@ -- | @QueryArr a b@ is analogous to a Haskell function @a -> [b]@. newtype QueryArr a b = QueryArr ((a, PQ.PrimQuery, Tag) -> (b, PQ.PrimQuery, Tag)) --- | @Query a@ is analogous to a Haskell value @[a]@.+-- | A Postgres query, i.e. some functionality that can run via SQL+-- and produce a collection of rows.+--+-- @Query a@ is analogous to a Haskell value @[a]@. type Query = QueryArr ()  simpleQueryArr :: ((a, Tag) -> (b, PQ.PrimQuery, Tag)) -> QueryArr a b
src/Opaleye/Internal/RunQuery.hs view
@@ -55,7 +55,7 @@ -- | A 'QueryRunnerColumn' @pgType@ @haskellType@ encodes how to turn -- a value of Postgres type @pgType@ into a value of Haskell type -- @haskellType@.  For example a value of type 'QueryRunnerColumn'--- 'T.PGText' 'String' encodes how to turn a 'PGText' result from the+-- 'T.PGText' 'String' encodes how to turn a 'T.PGText' result from the -- database into a Haskell 'String'.  -- This is *not* a Product Profunctor because it is the only way I@@ -84,10 +84,10 @@               -- since we can't select zero columns.  In that case we               -- have to make sure we read a single Int. -fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn coltype haskell+fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn pgType haskell fieldQueryRunnerColumn = fieldParserQueryRunnerColumn fromField -fieldParserQueryRunnerColumn :: FieldParser haskell -> QueryRunnerColumn coltype haskell+fieldParserQueryRunnerColumn :: FieldParser haskell -> QueryRunnerColumn pgType haskell fieldParserQueryRunnerColumn = QueryRunnerColumn (P.rmap (const ()) U.unpackspecColumn)  queryRunner :: QueryRunnerColumn a b -> QueryRunner (Column a) b@@ -120,7 +120,25 @@  -- | A 'QueryRunnerColumnDefault' @pgType@ @haskellType@ represents -- the default way to turn a @pgType@ result from the database into a--- Haskell value of type @haskelType@.+-- Haskell value of type @haskellType@.+--+-- Creating an instance of 'QueryRunnerColumnDefault' for your own types is+-- necessary for retrieving those types from the database.+--+-- You should use one of the three methods below for writing a+-- 'QueryRunnerColumnDefault' instance.+--+-- 1. If you already have a 'FromField' instance for your @haskellType@, use+-- 'fieldQueryRunnerColumn'.  (This is how most of the built-in instances are+-- defined.)+--+-- 2. If you don't have a 'FromField' instance, use+-- 'Opaleye.RunQuery.queryRunnerColumn' if possible.  See the documentation for+-- 'Opaleye.RunQuery.queryRunnerColumn' for an example.+--+-- 3. If you have a more complicated case, but not a 'FromField' instance,+-- write a 'FieldParser' for your type and use 'fieldParserQueryRunnerColumn'.+-- You can also add a 'FromField' instance using this. class QueryRunnerColumnDefault pgType haskellType where   queryRunnerColumnDefault :: QueryRunnerColumn pgType haskellType 
src/Opaleye/Internal/Sql.hs view
@@ -20,6 +20,8 @@  data Select = SelectFrom From             | Table HSql.SqlTable+            | RelExpr HSql.SqlExpr+            -- ^ A relation-valued expression             | SelectJoin Join             | SelectValues Values             | SelectBinary Binary@@ -60,7 +62,7 @@   bSelect2 :: Select } deriving Show -data JoinType = LeftJoin deriving Show+data JoinType = LeftJoin | RightJoin | FullJoin deriving Show data BinOp = Except | ExceptAll | Union | UnionAll | Intersect | IntersectAll deriving Show  data Label = Label {@@ -82,7 +84,9 @@   , PQ.join      = join   , PQ.values    = values   , PQ.binary    = binary-  , PQ.label     = label }+  , PQ.label     = label+  , PQ.relExpr   = relExpr+  }  sql :: ([HPQ.PrimExpr], PQ.PrimQuery' V.Void, T.Tag) -> Select sql (pes, pq, t) = SelectFrom $ newSelect { attrs = SelectAttrs (ensureColumns (makeAttrs pes))@@ -180,6 +184,8 @@  joinType :: PQ.JoinType -> JoinType joinType PQ.LeftJoin = LeftJoin+joinType PQ.RightJoin = RightJoin+joinType PQ.FullJoin = FullJoin  binOp :: PQ.BinOp -> BinOp binOp o = case o of@@ -221,3 +227,10 @@  label :: String -> Select -> Select label l s = SelectLabel (Label l s)++-- Very similar to 'baseTable'+relExpr :: HPQ.PrimExpr -> [(Symbol, HPQ.PrimExpr)] -> Select+relExpr pe columns = SelectFrom $+    newSelect { attrs = SelectAttrs (ensureColumns (map sqlBinding columns))+              , tables = [RelExpr (sqlExpr pe)]+              }
src/Opaleye/Internal/Table.hs view
@@ -47,9 +47,9 @@ -- @ data Table writerColumns viewColumns   = Table String (TableProperties writerColumns viewColumns)-    -- ^ Uses the default schema name (@"public"@).+    -- ^ Uses the default schema name (@\"public\"@).   | TableWithSchema String String (TableProperties writerColumns viewColumns)-    -- ^ Schema name (@"public"@ by default in PostgreSQL), table name,+    -- ^ Schema name (@\"public\"@ by default in PostgreSQL), table name,     --   table properties.  tableIdentifier :: Table writerColumns viewColumns -> PQ.TableIdentifier
src/Opaleye/Join.hs view
@@ -1,39 +1,60 @@+-- | Left, right, and full outer joins.  If you want inner joins, just use 'restrict' instead.+--+-- The use of the 'D.Default' typeclass means that the compiler will+-- have trouble inferring types.  It is strongly recommended that you+-- provide full type signatures when using the join functions.+--+-- Example specialization:+--+-- @+-- leftJoin :: Query (Column a, Column b)+--          -> Query (Column c, Column (Nullable d))+--          -> (((Column a, Column b), (Column c, Column (Nullable d))) -> Column 'Opaleye.PGTypes.PGBool')+--          -> Query ((Column a, Column b), (Column (Nullable c), Column (Nullable d)))+-- @+ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}  module Opaleye.Join where  import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Internal.Join as J-import qualified Opaleye.Internal.Tag as T import qualified Opaleye.Internal.PrimQuery as PQ import           Opaleye.QueryArr (Query)-import qualified Opaleye.Internal.QueryArr as Q-import           Opaleye.Internal.Column (Column(Column))+import           Opaleye.Internal.Column (Column) import qualified Opaleye.PGTypes as T  import qualified Data.Profunctor.Product.Default as D --- | @leftJoin@'s use of the 'D.Default' typeclass means that the--- compiler will have trouble inferring types.  It is strongly--- recommended that you provide full type signatures when using--- @leftJoin@.------ Example specialization:------ @--- leftJoin :: Query (Column a, Column b)---          -> Query (Column c, Column (Nullable d))---          -> (((Column a, Column b), (Column c, Column (Nullable d))) -> Column 'Opaleye.PGTypes.PGBool')---          -> Query ((Column a, Column b), (Column (Nullable c), Column (Nullable d)))--- @ leftJoin  :: (D.Default U.Unpackspec columnsA columnsA,               D.Default U.Unpackspec columnsB columnsB,-              D.Default J.NullMaker columnsB nullableColumnsB) =>-             Query columnsA -> Query columnsB-          -> ((columnsA, columnsB) -> Column T.PGBool)-          -> Query (columnsA, nullableColumnsB)+              D.Default J.NullMaker columnsB nullableColumnsB)+          => Query columnsA  -- ^ Left query+          -> Query columnsB  -- ^ Right query+          -> ((columnsA, columnsB) -> Column T.PGBool) -- ^ Condition on which to join+          -> Query (columnsA, nullableColumnsB) -- ^ Left join leftJoin = leftJoinExplicit D.def D.def D.def +rightJoin  :: (D.Default U.Unpackspec columnsA columnsA,+               D.Default U.Unpackspec columnsB columnsB,+               D.Default J.NullMaker columnsA nullableColumnsA)+           => Query columnsA -- ^ Left query+           -> Query columnsB -- ^ Right query+           -> ((columnsA, columnsB) -> Column T.PGBool) -- ^ Condition on which to join+           -> Query (nullableColumnsA, columnsB) -- ^ Right join+rightJoin = rightJoinExplicit D.def D.def D.def+++fullJoin  :: (D.Default U.Unpackspec columnsA columnsA,+              D.Default U.Unpackspec columnsB columnsB,+              D.Default J.NullMaker columnsA nullableColumnsA,+              D.Default J.NullMaker columnsB nullableColumnsB)+          => Query columnsA -- ^ Left query+          -> Query columnsB -- ^ Right query+          -> ((columnsA, columnsB) -> Column T.PGBool) -- ^ Condition on which to join+          -> Query (nullableColumnsA, nullableColumnsB) -- ^ Full outer join+fullJoin = fullJoinExplicit D.def D.def D.def D.def+ -- We don't actually need the Unpackspecs any more, but I'm going to -- leave them here in case they're ever needed again.  I don't want to -- have to break the API to add them back.@@ -43,12 +64,25 @@                  -> Query columnsA -> Query columnsB                  -> ((columnsA, columnsB) -> Column T.PGBool)                  -> Query (columnsA, nullableColumnsB)-leftJoinExplicit _ _ nullmaker qA qB cond = Q.simpleQueryArr q where-  q ((), startTag) = ((columnsA, nullableColumnsB), primQueryR, T.next endTag)-    where (columnsA, primQueryA, midTag) = Q.runSimpleQueryArr qA ((), startTag)-          (columnsB, primQueryB, endTag) = Q.runSimpleQueryArr qB ((), midTag)+leftJoinExplicit _ _ nullmaker =+  J.joinExplicit id (J.toNullable nullmaker) PQ.LeftJoin -          nullableColumnsB = J.toNullable nullmaker columnsB+rightJoinExplicit :: U.Unpackspec columnsA columnsA+                  -> U.Unpackspec columnsB columnsB+                  -> J.NullMaker columnsA nullableColumnsA+                  -> Query columnsA -> Query columnsB+                  -> ((columnsA, columnsB) -> Column T.PGBool)+                  -> Query (nullableColumnsA, columnsB)+rightJoinExplicit _ _ nullmaker =+  J.joinExplicit (J.toNullable nullmaker) id PQ.RightJoin -          Column cond' = cond (columnsA, columnsB)-          primQueryR = PQ.Join PQ.LeftJoin cond' primQueryA primQueryB++fullJoinExplicit :: U.Unpackspec columnsA columnsA+                 -> U.Unpackspec columnsB columnsB+                 -> J.NullMaker columnsA nullableColumnsA+                 -> J.NullMaker columnsB nullableColumnsB+                 -> Query columnsA -> Query columnsB+                 -> ((columnsA, columnsB) -> Column T.PGBool)+                 -> Query (nullableColumnsA, nullableColumnsB)+fullJoinExplicit _ _ nullmakerA nullmakerB =+  J.joinExplicit (J.toNullable nullmakerA) (J.toNullable nullmakerB) PQ.FullJoin
src/Opaleye/Label.hs view
@@ -4,8 +4,6 @@ import qualified Opaleye.Internal.Label as L import qualified Opaleye.Internal.QueryArr as Q -{- |-Add a label in comments to the given query.--}+-- | Add a commented label to the generated SQL. label :: String -> Query a -> Query a label l a = Q.simpleQueryArr (L.label' l . Q.runSimpleQueryArr a)
src/Opaleye/Manipulation.hs view
@@ -47,12 +47,6 @@ import qualified Data.List.NonEmpty as NEL  -- | Returns the number of rows inserted------ This will be deprecated in a future release.  Use 'runInsertMany' instead.-runInsert :: PGS.Connection -> T.Table columns columns' -> columns -> IO Int64-runInsert conn = PGS.execute_ conn . fromString .: arrangeInsertSql---- | Returns the number of rows inserted runInsertMany :: PGS.Connection               -> T.Table columns columns'               -> [columns]@@ -62,21 +56,6 @@   Nothing       -> return 0   Just columns' -> (PGS.execute_ conn . fromString .: arrangeInsertManySql) table columns' --- | @runInsertReturning@'s use of the 'D.Default' typeclass means that the--- compiler will have trouble inferring types.  It is strongly--- recommended that you provide full type signatures when using--- @runInsertReturning@.------ This will be deprecated in a future release.  Use--- 'runInsertManyReturning' instead.-runInsertReturning :: (D.Default RQ.QueryRunner returned haskells)-                   => PGS.Connection-                   -> T.Table columnsW columnsR-                   -> columnsW-                   -> (columnsR -> returned)-                   -> IO [haskells]-runInsertReturning = runInsertReturningExplicit D.def- -- | @runInsertManyReturning@'s use of the 'D.Default' typeclass means that the -- compiler will have trouble inferring types.  It is strongly -- recommended that you provide full type signatures when using@@ -166,6 +145,27 @@   where IRQ.QueryRunner u _ _ = qr         parser = IRQ.prepareRowParser qr (r v)         TI.Table _ (TI.TableProperties _ (TI.View v)) = t++-- | Returns the number of rows inserted+--+-- This will be deprecated in a future release.  Use 'runInsertMany' instead.+runInsert :: PGS.Connection -> T.Table columns columns' -> columns -> IO Int64+runInsert conn = PGS.execute_ conn . fromString .: arrangeInsertSql++-- | @runInsertReturning@'s use of the 'D.Default' typeclass means that the+-- compiler will have trouble inferring types.  It is strongly+-- recommended that you provide full type signatures when using+-- @runInsertReturning@.+--+-- This will be deprecated in a future release.  Use+-- 'runInsertManyReturning' instead.+runInsertReturning :: (D.Default RQ.QueryRunner returned haskells)+                   => PGS.Connection+                   -> T.Table columnsW columnsR+                   -> columnsW+                   -> (columnsR -> returned)+                   -> IO [haskells]+runInsertReturning = runInsertReturningExplicit D.def  -- | For internal use only.  Do not use.  Will be removed in a -- subsequent release.
src/Opaleye/Operators.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE FlexibleContexts #-} --- | Operators on 'Column's.  Numeric 'Column' types are instances of--- 'Num', so you can use '*', '/', '+', '-' on them.+-- | Operators on 'Column's.  Please note that numeric 'Column' types+-- are instances of 'Num', so you can use '*', '/', '+', '-' on them.  module Opaleye.Operators (module Opaleye.Operators,                           (O..&&)) where@@ -38,22 +38,19 @@ {-| Filter a 'QueryArr' to only those rows where the given condition holds.  This is the 'QueryArr' equivalent of 'Prelude.filter' from the 'Prelude'.  You would typically use 'keepWhen' if you want to use a-"point free" style.-}+\"point free\" style.-} keepWhen :: (a -> Column T.PGBool) -> QueryArr a a keepWhen p = proc a -> do   restrict  -< p a   A.returnA -< a -doubleOfInt :: Column T.PGInt4 -> Column T.PGFloat8-doubleOfInt (Column e) = Column (HPQ.CastExpr "float8" e)- infix 4 .== (.==) :: Column a -> Column a -> Column T.PGBool-(.==) = C.binOp HPQ.OpEq+(.==) = C.binOp (HPQ.:==)  infix 4 ./= (./=) :: Column a -> Column a -> Column T.PGBool-(./=) = C.binOp HPQ.OpNotEq+(./=) = C.binOp (HPQ.:<>)  infix 4 .=== -- | A polymorphic equality operator that works for all types that you@@ -75,18 +72,18 @@  infix 4 .< (.<) :: Ord.PGOrd a => Column a -> Column a -> Column T.PGBool-(.<) = C.binOp HPQ.OpLt+(.<) = C.binOp (HPQ.:<)  infix 4 .<= (.<=) :: Ord.PGOrd a => Column a -> Column a -> Column T.PGBool-(.<=) = C.binOp HPQ.OpLtEq+(.<=) = C.binOp (HPQ.:<=)  infix 4 .>= (.>=) :: Ord.PGOrd a => Column a -> Column a -> Column T.PGBool-(.>=) = C.binOp HPQ.OpGtEq+(.>=) = C.binOp (HPQ.:>=)  quot_ :: C.PGIntegral a => Column a -> Column a -> Column a-quot_ = C.binOp HPQ.OpDiv+quot_ = C.binOp (HPQ.:/)  rem_ :: C.PGIntegral a => Column a -> Column a -> Column a rem_ = C.binOp HPQ.OpMod@@ -98,21 +95,27 @@ ifThenElse = unsafeIfThenElse  infixr 2 .||++-- | Boolean or (.||) :: Column T.PGBool -> Column T.PGBool -> Column T.PGBool (.||) = C.binOp HPQ.OpOr  not :: Column T.PGBool -> Column T.PGBool not = C.unOp HPQ.OpNot +-- | Concatenate 'Column' 'T.PGText' (.++) :: Column T.PGText -> Column T.PGText -> Column T.PGText-(.++) = C.binOp HPQ.OpCat+(.++) = C.binOp (HPQ.:||) +-- | To lowercase lower :: Column T.PGText -> Column T.PGText lower = C.unOp HPQ.OpLower +-- | To uppercase upper :: Column T.PGText -> Column T.PGText upper = C.unOp HPQ.OpUpper +-- | Postgres @LIKE@ operator like :: Column T.PGText -> Column T.PGText -> Column T.PGBool like = C.binOp HPQ.OpLike @@ -123,6 +126,11 @@ ors :: F.Foldable f => f (Column T.PGBool) -> Column T.PGBool ors = F.foldl' (.||) (T.pgBool False) +-- | 'in_' is designed to be used in prefix form.+--+-- 'in_' @validProducts@ @product@ checks whether @product@ is a valid+-- product.  'in_' @validProducts@ is a function which checks whether+-- a product is a valid product. in_ :: (Functor f, F.Foldable f) => f (Column a) -> Column a -> Column T.PGBool in_ hs w = ors . fmap (w .==) $ hs @@ -169,3 +177,83 @@  singletonArray :: T.IsSqlType a => Column a -> Column (T.PGArray a) singletonArray x = arrayPrepend x emptyArray++-- | Class of Postgres types that represent json values.+--+-- Used to overload functions and operators that work on both 'T.PGJson' and 'T.PGJsonb'.+--+-- Warning: making additional instances of this class can lead to broken code!+class PGIsJson a++instance PGIsJson T.PGJson+instance PGIsJson T.PGJsonb++-- | Class of Postgres types that can be used to index json values.+--+-- Warning: making additional instances of this class can lead to broken code!+class PGJsonIndex a++instance PGJsonIndex T.PGInt4+instance PGJsonIndex T.PGInt8+instance PGJsonIndex T.PGText++-- | Get JSON object field by key.+infixl 8 .->+(.->) :: (PGIsJson a, PGJsonIndex k)+      => Column (C.Nullable a) -- ^+      -> Column k -- ^ key or index+      -> Column (C.Nullable a)+(.->) = C.binOp (HPQ.:->)++-- | Get JSON object field as text.+infixl 8 .->>+(.->>) :: (PGIsJson a, PGJsonIndex k)+       => Column (C.Nullable a) -- ^+       -> Column k -- ^ key or index+       -> Column (C.Nullable T.PGText)+(.->>) = C.binOp (HPQ.:->>)++-- | Get JSON object at specified path.+infixl 8 .#>+(.#>) :: (PGIsJson a)+      => Column (C.Nullable a) -- ^+      -> Column (T.PGArray T.PGText) -- ^ path+      -> Column (C.Nullable a)+(.#>) = C.binOp (HPQ.:#>)++-- | Get JSON object at specified path as text.+infixl 8 .#>>+(.#>>) :: (PGIsJson a)+       => Column (C.Nullable a) -- ^+       -> Column (T.PGArray T.PGText) -- ^ path+       -> Column (C.Nullable T.PGText)+(.#>>) = C.binOp (HPQ.:#>>)++-- | Does the left JSON value contain within it the right value?+infix 4 .@>+(.@>) :: Column T.PGJsonb -> Column T.PGJsonb -> Column T.PGBool+(.@>) = C.binOp (HPQ.:@>)++-- | Is the left JSON value contained within the right value?+infix 4 .<@+(.<@) :: Column T.PGJsonb -> Column T.PGJsonb -> Column T.PGBool+(.<@) = C.binOp (HPQ.:<@)++-- | Does the key/element string exist within the JSON value?+infix 4 .?+(.?) :: Column T.PGJsonb -> Column T.PGText -> Column T.PGBool+(.?) = C.binOp (HPQ.:?)++-- | Do any of these key/element strings exist?+infix 4 .?|+(.?|) :: Column T.PGJsonb -> Column (T.PGArray T.PGText) -> Column T.PGBool+(.?|) = C.binOp (HPQ.:?|)++-- | Do all of these key/element strings exist?+infix 4 .?&+(.?&) :: Column T.PGJsonb -> Column (T.PGArray T.PGText) -> Column T.PGBool+(.?&) = C.binOp (HPQ.:?&)++-- | Cast a 'PGInt4' to a 'PGFloat8'+doubleOfInt :: Column T.PGInt4 -> Column T.PGFloat8+doubleOfInt (Column e) = Column (HPQ.CastExpr "float8" e)
src/Opaleye/Order.hs view
@@ -1,3 +1,5 @@+-- | Ordering, @LIMIT@ and @OFFSET@+ module Opaleye.Order (module Opaleye.Order, O.Order) where  import qualified Opaleye.Column as C
src/Opaleye/PGTypes.hs view
@@ -1,3 +1,6 @@+-- | Postgres types and functions to create 'Column's of those types.+-- You may find it more convenient to use "Opaleye.Constant" instead.+ {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -21,25 +24,6 @@  import           Data.Int (Int64) -data PGBool-data PGDate-data PGFloat4-data PGFloat8-data PGInt8-data PGInt4-data PGInt2-data PGNumeric-data PGText-data PGTime-data PGTimestamp-data PGTimestamptz-data PGUuid-data PGCitext-data PGArray a-data PGBytea-data PGJson-data PGJsonb- instance C.PGNum PGFloat8 where   pgFromInteger = pgDouble . fromInteger @@ -62,12 +46,6 @@ instance C.PGString PGCitext where   pgFromString = pgCiLazyText . CI.mk . LText.pack -literalColumn :: HPQ.Literal -> Column a-literalColumn = IPT.literalColumn-{-# WARNING literalColumn-    "'literalColumn' has been moved to Opaleye.Internal.PGTypes"-  #-}- pgString :: String -> Column PGText pgString = IPT.literalColumn . HPQ.StringLit @@ -98,12 +76,6 @@ pgUUID :: UUID.UUID -> Column PGUuid pgUUID = C.unsafeCoerceColumn . pgString . UUID.toString -unsafePgFormatTime :: Time.FormatTime t => HPQ.Name -> String -> t -> Column c-unsafePgFormatTime = IPT.unsafePgFormatTime-{-# WARNING unsafePgFormatTime-    "'unsafePgFormatTime' has been moved to Opaleye.Internal.PGTypes"-  #-}- pgDay :: Time.Day -> Column PGDate pgDay = IPT.unsafePgFormatTime "date" "'%F'" @@ -206,3 +178,34 @@   showPGType _ = "json" instance IsSqlType PGJsonb where   showPGType _ = "jsonb"++data PGBool+data PGDate+data PGFloat4+data PGFloat8+data PGInt8+data PGInt4+data PGInt2+data PGNumeric+data PGText+data PGTime+data PGTimestamp+data PGTimestamptz+data PGUuid+data PGCitext+data PGArray a+data PGBytea+data PGJson+data PGJsonb++literalColumn :: HPQ.Literal -> Column a+literalColumn = IPT.literalColumn+{-# WARNING literalColumn+    "'literalColumn' has been moved to Opaleye.Internal.PGTypes and will be deprecated in a future release"+  #-}++unsafePgFormatTime :: Time.FormatTime t => HPQ.Name -> String -> t -> Column c+unsafePgFormatTime = IPT.unsafePgFormatTime+{-# WARNING unsafePgFormatTime+    "'unsafePgFormatTime' has been moved to Opaleye.Internal.PGTypes and will be deprecated in a future release"+  #-}
src/Opaleye/QueryArr.hs view
@@ -1,9 +1,6 @@-{-|--This modules defines the 'QueryArr' arrow, which is an arrow that represents-selecting data from a database, and composing multiple queries together.+-- | 'Query' and 'QueryArr' are the composable units of database+-- querying that are used in Opaleye. --}-module Opaleye.QueryArr (QueryArr, Query) where+module Opaleye.QueryArr (Query, QueryArr) where  import           Opaleye.Internal.QueryArr (QueryArr, Query)
src/Opaleye/RunQuery.hs view
@@ -4,7 +4,8 @@                          QueryRunner,                          IRQ.QueryRunnerColumn,                          IRQ.QueryRunnerColumnDefault (..),-                         IRQ.fieldQueryRunnerColumn) where+                         IRQ.fieldQueryRunnerColumn,+                         IRQ.fieldParserQueryRunnerColumn) where  import qualified Database.PostgreSQL.Simple as PGS import qualified Database.PostgreSQL.Simple.FromRow as FR@@ -46,13 +47,6 @@          -> IO [haskells] runQuery = runQueryExplicit D.def -runQueryExplicit :: QueryRunner columns haskells-                 -> PGS.Connection-                 -> Query columns-                 -> IO [haskells]-runQueryExplicit qr conn q = maybe (return []) (PGS.queryWith_ parser conn) sql-  where (sql, parser) = prepareQuery qr q- -- | @runQueryFold@ streams the results of a query incrementally and consumes -- the results with a left fold. --@@ -67,18 +61,6 @@   -> IO b runQueryFold = runQueryFoldExplicit D.def -runQueryFoldExplicit-  :: QueryRunner columns haskells-  -> PGS.Connection-  -> Query columns-  -> b-  -> (b -> haskells -> IO b)-  -> IO b-runQueryFoldExplicit qr conn q z f = case sql of-  Nothing   -> return z-  Just sql' -> PGS.foldWith_ parser conn sql' z f-  where (sql, parser) = prepareQuery qr q- -- | Use 'queryRunnerColumn' to make an instance to allow you to run queries on --   your own datatypes.  For example: --@@ -99,7 +81,26 @@   where IRQ.QueryRunnerColumn u fp = qrc         fmapFP = fmap . fmap . fmap --- | For internal use only.  Do not use.  Will be removed in a+runQueryExplicit :: QueryRunner columns haskells+                 -> PGS.Connection+                 -> Query columns+                 -> IO [haskells]+runQueryExplicit qr conn q = maybe (return []) (PGS.queryWith_ parser conn) sql+  where (sql, parser) = prepareQuery qr q++runQueryFoldExplicit+  :: QueryRunner columns haskells+  -> PGS.Connection+  -> Query columns+  -> b+  -> (b -> haskells -> IO b)+  -> IO b+runQueryFoldExplicit qr conn q z f = case sql of+  Nothing   -> return z+  Just sql' -> PGS.foldWith_ parser conn sql' z f+  where (sql, parser) = prepareQuery qr q++-- | For internal use only.  Do not use.  Will be deprecated in a -- subsequent release. prepareQuery :: QueryRunner columns haskells -> Query columns -> (Maybe PGS.Query, FR.RowParser haskells) prepareQuery qr@(QueryRunner u _ _) q = (sql, parser)
src/Opaleye/Sql.hs view
@@ -15,7 +15,7 @@  import qualified Data.Profunctor.Product.Default as D --- | When 'Nothing' is returned it means that the query has no results.+-- | When 'Nothing' is returned it means that the 'Query' returns zero rows. -- -- Example type specialization: --@@ -45,6 +45,7 @@ showSqlForPostgresUnoptExplicit :: U.Unpackspec columns b -> Q.Query columns -> Maybe String showSqlForPostgresUnoptExplicit = formatAndShowSQL .: Q.runQueryArrUnpack +-- | For internal use only.  Do not use.  Will be deprecated in a future release. formatAndShowSQL :: ([HPQ.PrimExpr], PQ.PrimQuery' a, T.Tag) -> Maybe String formatAndShowSQL = fmap (show . Pr.ppSql . Sql.sql) . traverse2Of3 Op.removeEmpty   where -- Just a lens
src/Opaleye/Values.hs view
@@ -9,7 +9,10 @@  import           Data.Profunctor.Product.Default (Default, def) --- | Example type specialization:+-- | 'values' implements Postgres's @VALUES@ construct and allows you+-- to create a query that consists of the given rows.+--+-- Example type specialization: -- -- @ -- values :: [(Column a, Column b)] -> Query (Column a, Column b)