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 +7/−0
- Doc/Tutorial/TutorialManipulation.lhs +29/−18
- Test/QuickCheck.hs +3/−3
- Test/Test.hs +169/−1
- opaleye.cabal +9/−4
- src/Opaleye/Aggregate.hs +11/−7
- src/Opaleye/Binary.hs +45/−40
- src/Opaleye/Column.hs +11/−3
- src/Opaleye/Constant.hs +23/−4
- src/Opaleye/Distinct.hs +2/−2
- src/Opaleye/Internal/Column.hs +15/−9
- src/Opaleye/Internal/HaskellDB/PrimQuery.hs +8/−5
- src/Opaleye/Internal/HaskellDB/Sql.hs +1/−1
- src/Opaleye/Internal/HaskellDB/Sql/Default.hs +28/−17
- src/Opaleye/Internal/HaskellDB/Sql/Print.hs +2/−1
- src/Opaleye/Internal/Join.hs +23/−8
- src/Opaleye/Internal/Operators.hs +59/−1
- src/Opaleye/Internal/Optimize.hs +1/−0
- src/Opaleye/Internal/Order.hs +2/−2
- src/Opaleye/Internal/PrimQuery.hs +8/−2
- src/Opaleye/Internal/Print.hs +6/−1
- src/Opaleye/Internal/QueryArr.hs +4/−1
- src/Opaleye/Internal/RunQuery.hs +22/−4
- src/Opaleye/Internal/Sql.hs +15/−2
- src/Opaleye/Internal/Table.hs +2/−2
- src/Opaleye/Join.hs +61/−27
- src/Opaleye/Label.hs +1/−3
- src/Opaleye/Manipulation.hs +21/−21
- src/Opaleye/Operators.hs +101/−13
- src/Opaleye/Order.hs +2/−0
- src/Opaleye/PGTypes.hs +34/−31
- src/Opaleye/QueryArr.hs +3/−6
- src/Opaleye/RunQuery.hs +22/−21
- src/Opaleye/Sql.hs +2/−1
- src/Opaleye/Values.hs +4/−1
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)