diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,26 @@ +## 0.6.7004.0 + +* Many changes to the documentation that use the new names. See entry + for version 0.6.7000.0. + +* Added `fromPGSFromField` to replace `fieldQueryRunnerColumn`. + +* Added `fromPGSFieldParser` to replace `fieldParserQueryRunnerColumn`. + +* Added `defaultFromField` to replace `queryRunnerColumnDefault`. + +* Added `tableField` to replace `tableColumn`. + +* Added `unsafeFromField` to replace `queryRunnerColumn`. + +* Added `toFieldsExplicit` to replace `constantExplicit`. + +* Added `TableRecordField` to replace `TableField` in + `Opaleye.TypeFamilies`. The latter may be used to replace + `TableColumn` in the future. + +* Added array functions `arrayAppend`, `arrayRemove`, `arrayRemoveNulls`. + ## 0.6.7003.1 * Bumped some depedencies so there is an install plan on GHC 8.6 diff --git a/Doc/Tutorial/DefaultExplanation.lhs b/Doc/Tutorial/DefaultExplanation.lhs --- a/Doc/Tutorial/DefaultExplanation.lhs +++ b/Doc/Tutorial/DefaultExplanation.lhs @@ -1,7 +1,7 @@ > {-# LANGUAGE FlexibleContexts #-} > module DefaultExplanation where > -> import Opaleye (Column, Nullable, QueryRunner, Query, +> import Opaleye (Field, FieldNullable, FromFields, Select, > SqlInt4, SqlBool, SqlText, SqlFloat4) > import qualified Opaleye as O > import qualified Opaleye.Internal.Binary as Internal.Binary @@ -29,62 +29,62 @@ `unionAll` that does not have a Default constraint is called `unionAllExplicit` and has the following type. -> unionAllExplicit :: Binaryspec a b -> Query a -> Query a -> Query b +> unionAllExplicit :: Binaryspec a b -> Select a -> Select a -> Select b > unionAllExplicit = O.unionAllExplicit What is the `Binaryspec` used for here? Let's take a simple case -where we want to union two queries of type `Query (Column SqlInt4, -Column SqlText)` +where we want to union two queries of type `Select (Field SqlInt4, +Field SqlText)` -> myQuery1 :: Query (Column SqlInt4, Column SqlText) -> myQuery1 = undefined -- We won't actually need specific implementations here +> mySelect1 :: Select (Field SqlInt4, Field SqlText) +> mySelect1 = undefined -- We won't actually need specific implementations here > -> myQuery2 :: Query (Column SqlInt4, Column SqlText) -> myQuery2 = undefined +> mySelect2 :: Select (Field SqlInt4, Field SqlText) +> mySelect2 = undefined That means we will be using unionAll at the type -> unionAllExplicit' :: Binaryspec (Column SqlInt4, Column SqlText) (Column SqlInt4, Column SqlText) -> -> Query (Column SqlInt4, Column SqlText) -> -> Query (Column SqlInt4, Column SqlText) -> -> Query (Column SqlInt4, Column SqlText) +> unionAllExplicit' :: Binaryspec (Field SqlInt4, Field SqlText) (Field SqlInt4, Field SqlText) +> -> Select (Field SqlInt4, Field SqlText) +> -> Select (Field SqlInt4, Field SqlText) +> -> Select (Field SqlInt4, Field SqlText) > unionAllExplicit' = unionAllExplicit -Since every `Column` is actually just a string containing an SQL -expression, `(Column SqlInt4, Column SqlText)` is a pair of expressions. +Since every `Field` is actually just a string containing an SQL +expression, `(Field SqlInt4, Field SqlText)` is a pair of expressions. When we generate the SQL we need to take the two pairs of expressions, generate new unique names that refer to them and produce these new -unique names in another value of type `(Column SqlInt4, Column +unique names in another value of type `(Field SqlInt4, Field SqlText)`. This is exactly what a value of type - Binaryspec (Column SqlInt4, Column SqlText) (Column SqlInt4, Column SqlText) + Binaryspec (Field SqlInt4, Field SqlText) (Field SqlInt4, Field SqlText) allows us to do. So the next question is, how do we get our hands on a value of that -type? Well, we have `binaryspecColumn` which is a value that allows +type? Well, we have `binaryspecField` which is a value that allows us to access the column name within a single column. -> binaryspecColumn :: Binaryspec (Column a) (Column a) +> binaryspecColumn :: Binaryspec (Field a) (Field a) > binaryspecColumn = Internal.Binary.binaryspecColumn `Binaryspec` is a `ProductProfunctor` so we can combine two of them to work on a pair. -> binaryspecColumn2 :: Binaryspec (Column a, Column b) (Column a, Column b) +> binaryspecColumn2 :: Binaryspec (Field a, Field b) (Field a, Field b) > binaryspecColumn2 = binaryspecColumn ***! binaryspecColumn Then we can use `binaryspecColumn2` in `unionAllExplicit`. -> theUnionAll :: Query (Column SqlInt4, Column SqlText) -> theUnionAll = unionAllExplicit binaryspecColumn2 myQuery1 myQuery2 +> theUnionAll :: Select (Field SqlInt4, Field SqlText) +> theUnionAll = unionAllExplicit binaryspecColumn2 mySelect1 mySelect2 Now suppose that we wanted to take a union of two queries with columns in a tuple of size four. We can make a suitable `Binaryspec` like this: -> binaryspecColumn4 :: Binaryspec (Column a, Column b, Column c, Column d) -> (Column a, Column b, Column c, Column d) +> binaryspecColumn4 :: Binaryspec (Field a, Field b, Field c, Field d) +> (Field a, Field b, Field c, Field d) > binaryspecColumn4 = p4 (binaryspecColumn, binaryspecColumn, > binaryspecColumn, binaryspecColumn) @@ -100,17 +100,17 @@ `Opaleye.Internal.Binary` contains the `Default` instance - instance Default Binaryspec (Column a) (Column a) where + instance Default Binaryspec (Field a) (Field a) where def = binaryspecColumn That means that we know the "default" way of getting a - Binaryspec (Column a) (Column a) + Binaryspec (Field a) (Field a) However, if we have a default way of getting one of these, we also have a default way of getting a - Binaryspec (Column a, Column b) (Column a, Column b) + Binaryspec (Field a, Field b) (Field a, Field b) just by using the `ProductProfunctor` product operation `(***!)`. And in the general case for a product type `T` with n type parameters we @@ -129,94 +129,94 @@ provide it. This is exactly what `Opaleye.Binary.unionAll` does. > unionAll :: Default Binaryspec a b -> => Query a -> Query a -> Query b +> => Select a -> Select a -> Select b > unionAll = O.unionAllExplicit def > -> theUnionAll' :: Query (Column SqlInt4, Column SqlText) -> theUnionAll' = unionAll myQuery1 myQuery2 +> theUnionAll' :: Select (Field SqlInt4, Field SqlText) +> theUnionAll' = unionAll mySelect1 mySelect2 In the long run this prevents writing a huge amount of boilerplate code. -A further example: `QueryRunner` +A further example: `FromFields` ============================== -A `QueryRunner a b` is the product-profunctor which represents how to -turn run a `Query a` (currently on Postgres) and return you a list of +A `FromFields a b` is the product-profunctor which represents how to +turn run a `Select a` (currently on Postgres) and return you a list of rows, each row of type `b`. The function which is responsible for -this is `runQuery` +this is `runSelect` -> runQueryExplicit :: QueryRunner a b -> SQL.Connection -> Query a -> IO [b] -> runQueryExplicit = O.runQueryExplicit +> runSelectExplicit :: FromFields a b -> SQL.Connection -> Select a -> IO [b] +> runSelectExplicit = O.runSelectExplicit -Basic values of `QueryRunner` will have the following types +Basic values of `FromFields` will have the following types -> intRunner :: QueryRunner (Column SqlInt4) Int +> intRunner :: FromFields (Field SqlInt4) Int > intRunner = undefined -- The implementation is not important here > -> doubleRunner :: QueryRunner (Column SqlFloat4) Double +> doubleRunner :: FromFields (Field SqlFloat4) Double > doubleRunner = undefined > -> stringRunner :: QueryRunner (Column SqlText) String +> stringRunner :: FromFields (Field SqlText) String > stringRunner = undefined > -> boolRunner :: QueryRunner (Column SqlBool) Bool +> boolRunner :: FromFields (Field SqlBool) Bool > boolRunner = undefined Furthermore we will have basic ways of running queries which return `Nullable` values, for example -> nullableIntRunner :: QueryRunner (Column (Nullable SqlInt4)) (Maybe Int) +> nullableIntRunner :: FromFields (FieldNullable SqlInt4) (Maybe Int) > nullableIntRunner = undefined If I have a very simple query with a single column of `SqlInt4` then I can run it using the `intRunner`. -> myQuery3 :: Query (Column SqlInt4) -> myQuery3 = undefined -- The implementation is not important +> mySelect3 :: Select (Field SqlInt4) +> mySelect3 = undefined -- The implementation is not important > -> runTheQuery :: SQL.Connection -> IO [Int] -> runTheQuery c = runQueryExplicit intRunner c myQuery3 +> runTheSelect :: SQL.Connection -> IO [Int] +> runTheSelect c = runSelectExplicit intRunner c mySelect3 If my query has several columns of different types I need to build up -a larger `QueryRunner`. +a larger `FromFields`. -> myQuery4 :: Query (Column SqlInt4, Column SqlText, Column SqlBool, Column (Nullable SqlInt4)) -> myQuery4 = undefined +> mySelect4 :: Select (Field SqlInt4, Field SqlText, Field SqlBool, FieldNullable SqlInt4) +> mySelect4 = undefined > -> largerQueryRunner :: QueryRunner -> (Column SqlInt4, Column SqlText, Column SqlBool, Column (Nullable SqlInt4)) +> largerSelectRunner :: FromFields +> (Field SqlInt4, Field SqlText, Field SqlBool, FieldNullable SqlInt4) > (Int, String, Bool, Maybe Int) -> largerQueryRunner = p4 (intRunner, stringRunner, boolRunner, nullableIntRunner) +> largerSelectRunner = p4 (intRunner, stringRunner, boolRunner, nullableIntRunner) > -> runTheBiggerQuery :: SQL.Connection -> IO [(Int, String, Bool, Maybe Int)] -> runTheBiggerQuery c = runQueryExplicit largerQueryRunner c myQuery4 +> runTheBiggerSelect :: SQL.Connection -> IO [(Int, String, Bool, Maybe Int)] +> runTheBiggerSelect c = runSelectExplicit largerSelectRunner c mySelect4 -But having to build up `largerQueryRunner` was a pain and completely +But having to build up `largerSelectRunner` was a pain and completely redundant! Like the `Binaryspec` it can be automatically deduced. -`Karamaan.Opaleye.RunQuery` already gives us `Default` instances for +`Opaleye.RunSelect` already gives us `Default` instances for the following types (plus many others, of course!). -* `QueryRunner (Column SqlInt4) Int` -* `QueryRunner (Column SqlText) String` -* `QueryRunner (Column Bool) Bool` -* `QueryRunner (Column (Nullable Int)) (Maybe Int)` +* `FromFields (Field SqlInt4) Int` +* `FromFields (Field SqlText) String` +* `FromFields (Field Bool) Bool` +* `FromFields (Field (Nullable Int)) (Maybe Int)` Then the `Default` typeclass machinery automatically deduces the correct value of the type we want. -> largerQueryRunner' :: QueryRunner -> (Column SqlInt4, Column SqlText, Column SqlBool, Column (Nullable SqlInt4)) +> largerSelectRunner' :: FromFields +> (Field SqlInt4, Field SqlText, Field SqlBool, FieldNullable SqlInt4) > (Int, String, Bool, Maybe Int) -> largerQueryRunner' = def +> largerSelectRunner' = def -And we can produce a version of `runQuery` which allows us to write +And we can produce a version of `runSelect` which allows us to write our query without explicitly passing the product-profunctor value. -> runQuery :: Default QueryRunner a b => SQL.Connection -> Query a -> IO [b] -> runQuery = O.runQueryExplicit def +> runSelect :: Default FromFields a b => SQL.Connection -> Select a -> IO [b] +> runSelect = O.runSelectExplicit def > -> runTheBiggerQuery' :: SQL.Connection -> IO [(Int, String, Bool, Maybe Int)] -> runTheBiggerQuery' c = runQuery c myQuery4 +> runTheBiggerSelect' :: SQL.Connection -> IO [(Int, String, Bool, Maybe Int)] +> runTheBiggerSelect' c = runSelect c mySelect4 Conclusion ========== diff --git a/Doc/Tutorial/TutorialAdvanced.lhs b/Doc/Tutorial/TutorialAdvanced.lhs --- a/Doc/Tutorial/TutorialAdvanced.lhs +++ b/Doc/Tutorial/TutorialAdvanced.lhs @@ -4,12 +4,11 @@ > > import Prelude hiding (sum) > -> import Opaleye.QueryArr (Query) -> import Opaleye.Column (Column) -> import Opaleye.Table (Table, table, tableColumn, queryTable) -> import Opaleye.SqlTypes (SqlText, SqlInt4) +> import Opaleye (Select, Field, Table, table, tableField, +> queryTable, SqlText, SqlInt4, Aggregator, +> aggregate) > import qualified Opaleye.Aggregate as A -> import Opaleye.Aggregate (Aggregator, aggregate) +> import Opaleye.Aggregate () > > import qualified Opaleye.Sql as Sql > import qualified Opaleye.Internal.Unpackspec as U @@ -32,18 +31,18 @@ advantage of treating `range` as a first-class value able to be passed around between functions and manipulated at will. -> range :: Aggregator (Column SqlInt4) (Column SqlInt4) +> range :: Aggregator (Field SqlInt4) (Field SqlInt4) > range = dimap (\x -> (x, x)) (uncurry (-)) (A.max ***! A.min) We can test it on a person table which contains rows containing people's names along with the age of their children. -> personTable :: Table (Column SqlText, Column SqlInt4) -> (Column SqlText, Column SqlInt4) -> personTable = table "personTable" (p2 ( tableColumn "name" -> , tableColumn "child_age" )) +> personTable :: Table (Field SqlText, Field SqlInt4) +> (Field SqlText, Field SqlInt4) +> personTable = table "personTable" (p2 ( tableField "name" +> , tableField "child_age" )) -> rangeOfChildrensAges :: Query (Column SqlText, Column SqlInt4) +> rangeOfChildrensAges :: Select (Field SqlText, Field SqlInt4) > rangeOfChildrensAges = aggregate (p2 (A.groupBy, range)) (queryTable personTable) @@ -72,5 +71,5 @@ Helper function =============== -> printSql :: Default U.Unpackspec a a => Query a -> IO () +> printSql :: Default U.Unpackspec a a => Select a -> IO () > printSql = putStrLn . maybe "Empty query" id . Sql.showSqlForPostgres diff --git a/Doc/Tutorial/TutorialBasicTypeFamilies.lhs b/Doc/Tutorial/TutorialBasicTypeFamilies.lhs --- a/Doc/Tutorial/TutorialBasicTypeFamilies.lhs +++ b/Doc/Tutorial/TutorialBasicTypeFamilies.lhs @@ -24,7 +24,7 @@ > import qualified Opaleye as O > import qualified Opaleye.Map as M > import Opaleye.TypeFamilies (O, H, NN, Req, Nulls, W, -> TableField, IMap, F, +> TableRecordField, IMap, F, > (:<$>), (:<*>)) > > import qualified Data.Profunctor as P @@ -131,8 +131,8 @@ using type families that reduces boiler plate and has always been compatible with Opaleye! -> data Birthday f = Birthday { bdName :: TableField f String SqlText NN Req -> , bdDay :: TableField f Day SqlDate NN Req +> data Birthday f = Birthday { bdName :: TableRecordField f String SqlText NN Req +> , bdDay :: TableRecordField f Day SqlDate NN Req > } This instance, adaptor and type family are fully derivable by Template @@ -140,18 +140,18 @@ Please volunteer to do that if you can. > instance ( PP.ProductProfunctor p -> , Default p (TableField a String SqlText NN Req) -> (TableField b String SqlText NN Req) -> , Default p (TableField a Day SqlDate NN Req) -> (TableField b Day SqlDate NN Req)) => +> , Default p (TableRecordField a String SqlText NN Req) +> (TableRecordField b String SqlText NN Req) +> , Default p (TableRecordField a Day SqlDate NN Req) +> (TableRecordField b Day SqlDate NN Req)) => > Default p (Birthday a) (Birthday b) where > def = pBirthday (Birthday D.def D.def) > > pBirthday :: PP.ProductProfunctor p > => Birthday (p :<$> a :<*> b) > -> p (Birthday a) (Birthday b) -> pBirthday (Birthday a b) = Birthday PP.***$ P.lmap bdName a -> PP.**** P.lmap bdDay b +> pBirthday b = Birthday PP.***$ P.lmap bdName (bdName b) +> PP.**** P.lmap bdDay (bdDay b) > > type instance M.Map g (Birthday (F f)) = Birthday (F (IMap g f)) @@ -195,34 +195,34 @@ style, color, location, quantity and radius of widgets. We can model this information with the following datatype. -> data Widget f = Widget { style :: TableField f String SqlText NN Req -> , color :: TableField f String SqlText NN Req -> , location :: TableField f String SqlText NN Req -> , quantity :: TableField f Int SqlInt4 NN Req -> , radius :: TableField f Double SqlFloat8 NN Req +> data Widget f = Widget { style :: TableRecordField f String SqlText NN Req +> , color :: TableRecordField f String SqlText NN Req +> , location :: TableRecordField f String SqlText NN Req +> , quantity :: TableRecordField f Int SqlInt4 NN Req +> , radius :: TableRecordField f Double SqlFloat8 NN Req > } This instance, adaptor and type family are fully derivable but no one's implemented the Template Haskell or generics to do that yet. > instance ( PP.ProductProfunctor p -> , Default p (TableField a String SqlText NN Req) -> (TableField b String SqlText NN Req) -> , Default p (TableField a Int SqlInt4 NN Req) -> (TableField b Int SqlInt4 NN Req) -> , Default p (TableField a Double SqlFloat8 NN Req) -> (TableField b Double SqlFloat8 NN Req)) => +> , Default p (TableRecordField a String SqlText NN Req) +> (TableRecordField b String SqlText NN Req) +> , Default p (TableRecordField a Int SqlInt4 NN Req) +> (TableRecordField b Int SqlInt4 NN Req) +> , Default p (TableRecordField a Double SqlFloat8 NN Req) +> (TableRecordField b Double SqlFloat8 NN Req)) => > Default p (Widget a) (Widget b) where > def = pWidget (Widget D.def D.def D.def D.def D.def) > > pWidget :: PP.ProductProfunctor p > => Widget (p :<$> a :<*> b) > -> p (Widget a) (Widget b) -> pWidget (Widget a b c d e) = Widget PP.***$ P.lmap style a -> PP.**** P.lmap color b -> PP.**** P.lmap location c -> PP.**** P.lmap quantity d -> PP.**** P.lmap radius e +> pWidget w = Widget PP.***$ P.lmap style (style w) +> PP.**** P.lmap color (color w) +> PP.**** P.lmap location (location w) +> PP.**** P.lmap quantity (quantity w) +> PP.**** P.lmap radius (radius w) > > type instance M.Map g (Widget (F f)) = Widget (F (IMap g f)) diff --git a/Doc/Tutorial/TutorialManipulation.lhs b/Doc/Tutorial/TutorialManipulation.lhs --- a/Doc/Tutorial/TutorialManipulation.lhs +++ b/Doc/Tutorial/TutorialManipulation.lhs @@ -2,8 +2,8 @@ > > import Prelude hiding (sum) > -> import Opaleye (Column, Table, table, -> tableColumn, (.==), (.<), +> import Opaleye (Field, Table, table, +> tableField, (.==), (.<), > Insert(..), > Update(..), > Delete(..), @@ -15,7 +15,7 @@ > ) > > import Data.Profunctor.Product (p4) -> import qualified Opaleye.Constant as C +> import Opaleye.ToFields (toFields) > > import GHC.Int (Int64) @@ -32,20 +32,20 @@ type arguments. The first one is the type of writes to the table, and the second is the type of reads from the table. The "id" column is defined as optional (for writes) because its write type is `Maybe -(Column SqlInt4)`. That means we don't necessarily need to specify it +(Field SqlInt4)`. That means we don't necessarily need to specify it when writing to the table. The database will automatically fill in a value for us. > myTable :: Table -> (Maybe (Column SqlInt4), Column SqlFloat8, Column SqlFloat8, Column SqlText) -> (Column SqlInt4, Column SqlFloat8, Column SqlFloat8, Column SqlText) -> myTable = table "tablename" (p4 ( tableColumn "id" -> , tableColumn "x" -> , tableColumn "y" -> , tableColumn "s" )) +> (Maybe (Field SqlInt4), Field SqlFloat8, Field SqlFloat8, Field SqlText) +> (Field SqlInt4, Field SqlFloat8, Field SqlFloat8, Field SqlText) +> myTable = table "tablename" (p4 ( tableField "id" +> , tableField "x" +> , tableField "y" +> , tableField "s" )) To perform a delete we provide an expression from our read type to -`Column Bool`. All rows for which the expression is true are deleted. +`Field SqlBool`. All rows for which the expression is true are deleted. > delete :: Delete Int64 > delete = Delete @@ -84,12 +84,12 @@ If we'd like to pass a variable into the insertion function, we can't -rely on the `Num` instance and must use `constant`: +rely on the `Num` instance and must use `toFields`: > insertNonLiteral :: Double -> Insert Int64 > insertNonLiteral i = Insert > { iTable = myTable -> , iRows = [(Nothing, 2, C.constant i, sqlString "Hello")] +> , iRows = [(Nothing, 2, toFields i, sqlString "Hello")] > , iReturning = rCount > , iOnConflict = Nothing > } @@ -126,7 +126,7 @@ An update takes an update function from the read type to the write type, and a condition given by a function from the read type to -`Column Bool`. All rows that satisfy the condition are updated +`Field SqlBool`. All rows that satisfy the condition are updated according to the update function. > update :: Update Int64 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2018 Purely Agile Limited +Copyright (c) 2014-2019 Purely Agile Limited All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# Brief introduction to Opaleye [![Hackage version](https://img.shields.io/hackage/v/opaleye.svg?label=Hackage)](https://hackage.haskell.org/package/opaleye) [![Linux Build Status](https://img.shields.io/travis/tomjaguarpaw/haskell-opaleye/master.svg?label=Linux%20build)](https://travis-ci.org/tomjaguarpaw/haskell-opaleye) +# Brief introduction to Opaleye [![Hackage version](https://img.shields.io/hackage/v/opaleye.svg?label=Hackage)](https://hackage.haskell.org/package/opaleye) [![Linux build status](https://img.shields.io/travis/tomjaguarpaw/haskell-opaleye/master.svg?label=Linux%20build)](https://travis-ci.org/tomjaguarpaw/haskell-opaleye) Opaleye is a Haskell library that provides an SQL-generating embedded domain specific language for targeting Postgres. You need Opaleye if diff --git a/Test/Test.hs b/Test/Test.hs --- a/Test/Test.hs +++ b/Test/Test.hs @@ -33,6 +33,8 @@ import Test.Hspec import qualified TypeFamilies () +import Opaleye.Manipulation (Delete (Delete)) + {- Status @@ -307,14 +309,13 @@ mapM_ executeSerial serialTables mapM_ executeJson jsonTables mapM_ executeConflict conflictTables - -- Disabled until Travis supports Postgresql >= 9.4 - -- mapM_ executeJsonb jsonbTables + mapM_ executeJsonb jsonbTables where execute = PGS.execute_ conn . dropAndCreateTableInt executeTextTable = PGS.execute_ conn . dropAndCreateTableText executeSerial = PGS.execute_ conn . dropAndCreateTableSerial executeJson = PGS.execute_ conn . dropAndCreateTableJson executeConflict = PGS.execute_ conn . dropAndCreateTablePk - -- executeJsonb = PGS.execute_ conn . dropAndCreateTableJsonb + executeJsonb = PGS.execute_ conn . dropAndCreateTableJsonb type Test = SpecWith PGS.Connection @@ -771,6 +772,17 @@ expectedR :: [Int] expectedR = [-1, -2] +testDeleteReturning :: Test +testDeleteReturning = it "" $ \conn -> do + result <- O.runDelete_ conn delete + _ <- O.runInsertMany conn table4 ([(40,50)] :: [(Column O.SqlInt4, Column O.SqlInt4)]) :: IO Int64 + result `shouldBe` expected + where delete = Delete table cond returning + table = table4 + cond (_, y) = y .> 45 + returning = O.rReturning id + expected = [(40, 50)] :: [(Int, Int)] + testInsertConflict :: Test testInsertConflict = it "inserts with conflicts" $ \conn -> do _ <- O.runDelete conn table10 (const $ O.constant True) @@ -814,10 +826,10 @@ testInsertSerial :: Test testInsertSerial = it "" $ \conn -> do - _ <- O.runInsert conn table5 (Just 10, Just 20) - _ <- O.runInsert conn table5 (Just 30, Nothing) - _ <- O.runInsert conn table5 (Nothing, Nothing) - _ <- O.runInsert conn table5 (Nothing, Just 40) + _ <- runInsert conn table5 (Just 10, Just 20) + _ <- runInsert conn table5 (Just 30, Nothing) + _ <- runInsert conn table5 (Nothing, Nothing) + _ <- runInsert conn table5 (Nothing, Just 40) resultI <- O.runQuery conn (O.queryTable table5) @@ -828,6 +840,7 @@ , (30, 1) , (1, 2) , (2, 40) ] + runInsert conn table row = O.runInsertMany conn table [row] testInQuery :: Test testInQuery = it "" $ \conn -> do @@ -872,6 +885,16 @@ testH (A.pure $ O.pgArray O.pgInt4 [5,6,7] `O.index` O.pgInt4 8) (`shouldBe` ([Nothing] :: [Maybe Int])) +testSingletonArray :: Test +testSingletonArray = it "constructs a singleton PGInt8 array" $ + testH (A.pure $ O.singletonArray (O.pgInt8 1)) + (`shouldBe` ([[1]] :: [[Int64]])) + +testArrayAppend :: Test +testArrayAppend = it "appends two arrays" $ + testH (A.pure $ O.pgArray O.pgInt4 [5,6,7] `O.arrayAppend` O.pgArray O.pgInt4 [1,2,3]) + (`shouldBe` ([[5,6,7,1,2,3]] :: [[Int]])) + type JsonTest a = SpecWith (Query (Column a) -> PGS.Connection -> Expectation) -- Test opaleye's equivalent of c1->'c' testJsonGetFieldValue :: (O.SqlIsJson a, O.QueryRunnerColumnDefault a Json.Value) => Query (Column a) -> Test @@ -1031,28 +1054,51 @@ => String -> (a -> Column b) -> a -> a -> Test testRangeBoundsEnum msg mkCol x y = it msg $ \conn -> do -- bound functions for discrete range types return fields as from the form [x,y) - let ranges = [ O.pgRange mkCol (R.Inclusive x) R.PosInfinity - , O.pgRange mkCol R.NegInfinity (R.Inclusive y) - , O.pgRange mkCol (R.Exclusive x) (R.Exclusive y) - ] - [r1,r2,r3] <- mapM (O.runQuery conn . pure . (O.lowerBound &&& O.upperBound)) ranges - r1 `shouldBe` [(Just x, Nothing)] - r2 `shouldBe` [(Nothing, Just $ succ y)] - r3 `shouldBe` [(Just $ succ x, Just y)] + let pgr = O.pgRange mkCol + ranges_expecteds = + [ (pgr (R.Inclusive x) R.PosInfinity, (Just x, Nothing)) + , (pgr R.NegInfinity (R.Inclusive y), (Nothing, Just $ succ y)) + , (pgr (R.Exclusive x) (R.Exclusive y), (Just $ succ x, Just y)) + ] + ranges = map fst ranges_expecteds + expecteds = map ((:[]) . snd) ranges_expecteds + r <- mapM (O.runQuery conn . pure . (O.lowerBound &&& O.upperBound)) ranges + r `shouldBe` expecteds --- 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 - ] +jsonTests :: (O.SqlIsJson a, O.QueryRunnerColumnDefault a Json.Value) + => Query (Column a) -> Test +jsonTests t = do + testJsonGetFieldValue t + testJsonGetFieldText t + testJsonGetMissingField t + testJsonGetArrayValue t + testJsonGetArrayText t + testJsonGetPathValue t + testJsonGetPathText t + testRestrictWithJsonOp t +testLiterals :: Test +testLiterals = do + let testLiteral fn value = testH (pure (fn value)) (`shouldBe` [value]) + it "sqlString" $ testLiteral O.sqlString "Hello" + it "sqlLazyByteString" $ testLiteral O.sqlLazyByteString "Hello" + it "sqlNumeric" $ testLiteral O.sqlNumeric 3.14159 + it "sqlInt4" $ testLiteral O.sqlInt4 17 + it "sqlInt8" $ testLiteral O.sqlInt8 0x100000000 + it "sqlDouble" $ testLiteral O.sqlDouble 3.14 + it "sqlBool" $ testLiteral O.sqlBool True + it "sqlUUID" $ testLiteral O.sqlUUID (read "c2cc10e1-57d6-4b6f-9899-38d972112d8c") + it "sqlDay" $ testLiteral O.sqlDay (read "2018-11-29") + it "sqlUTCTime" $ testLiteral O.sqlUTCTime (read "2018-11-29 11:22:33") + it "sqlLocalTime" $ testLiteral O.sqlLocalTime (read "2018-11-29 11:22:33") + + -- ZonedTime has no Eq instance, so we compare on the result of 'zonedTimeToUTC' + it "sqlZonedTime" $ + let value = read "2018-11-29 11:22:33" :: Time.ZonedTime in + testH (pure (O.sqlZonedTime value)) + (\r -> map Time.zonedTimeToUTC r `shouldBe` [Time.zonedTimeToUTC value]) + main :: IO () main = do let envVarName = "POSTGRES_CONNSTRING" @@ -1075,8 +1121,7 @@ dropAndCreateDB conn - let insert (writeable, columndata) = - mapM_ (O.runInsert conn writeable) columndata + let insert (t, d) = do { _ <- O.runInsertMany conn t d; return () } mapM_ insert [ (table1, table1columndata) , (table2, table2columndata) @@ -1085,8 +1130,7 @@ insert (table6, table6columndata) insert (table7, table7columndata) insert (table8, table8columndata) - -- Disabled until Travis supports Postgresql >= 9.4 - -- insert (table9, table9columndata) + insert (table9, table9columndata) -- Need to run quickcheck after table data has been inserted QuickCheck.run conn @@ -1145,20 +1189,22 @@ testFloatArray testArrayIndex testArrayIndexOOB + testSingletonArray + testArrayAppend describe "joins" $ do testLeftJoin testLeftJoinNullable testThreeWayProduct testLeftJoinF - describe "json" $ do - testJsonGetFieldValue table8Q - testJsonGetFieldText table8Q - testJsonGetMissingField table8Q - testJsonGetArrayValue table8Q - testJsonGetArrayText table8Q - testJsonGetPathValue table8Q - testJsonGetPathText table8Q - testRestrictWithJsonOp table8Q + describe "json" $ jsonTests table8Q + describe "jsonb" $ do + jsonTests table9Q + testJsonbRightInLeft + testJsonbLeftInRight + testJsonbContains + testJsonbContainsMissing + testJsonbContainsAny + testJsonbContainsAll describe "uncat" $ do testKeywordColNames testInsertSerial @@ -1169,6 +1215,7 @@ testValues testValuesEmpty testUpdate + testDeleteReturning testInsertConflict describe "range" $ do testRangeOverlap @@ -1182,3 +1229,5 @@ O.pgInt8 10 26 testRangeBoundsEnum "can access bounds from a date range" O.pgDay (read "2018-01-01") (read "2018-01-12") + describe "literals" $ do + testLiterals diff --git a/opaleye.cabal b/opaleye.cabal --- a/opaleye.cabal +++ b/opaleye.cabal @@ -1,6 +1,6 @@ name: opaleye -copyright: Copyright (c) 2014-2018 Purely Agile Limited -version: 0.6.7003.1 +copyright: Copyright (c) 2014-2019 Purely Agile Limited +version: 0.6.7004.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 @@ -18,7 +18,7 @@ CHANGELOG.md *.md Doc/*.md -tested-with: GHC==8.6.1, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 +tested-with: GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2 source-repository head type: git @@ -37,9 +37,9 @@ , postgresql-simple >= 0.5.3 && < 0.7 , pretty >= 1.1.1.0 && < 1.2 , product-profunctors >= 0.6.2 && < 0.11 - , profunctors >= 4.0 && < 5.4 + , profunctors >= 4.0 && < 5.5 , scientific >= 0.3 && < 0.4 - , semigroups >= 0.13 && < 0.19 + , semigroups >= 0.13 && < 0.20 , text >= 0.11 && < 1.3 , transformers >= 0.3 && < 0.6 , time >= 1.4 && < 1.10 @@ -68,6 +68,7 @@ Opaleye.Sql, Opaleye.SqlTypes, Opaleye.Table, + Opaleye.ToFields, Opaleye.TypeFamilies, Opaleye.Values, Opaleye.Internal.Aggregate, @@ -109,7 +110,7 @@ TypeFamilies hs-source-dirs: Test build-depends: - aeson >= 0.6 && < 1.3, + aeson >= 0.6 && < 1.5, base >= 4 && < 5, containers, contravariant, @@ -122,6 +123,7 @@ semigroups, text >= 0.11 && < 1.3, time, + uuid, transformers, hspec, hspec-discover, diff --git a/src/Opaleye/Binary.hs b/src/Opaleye/Binary.hs --- a/src/Opaleye/Binary.hs +++ b/src/Opaleye/Binary.hs @@ -5,17 +5,17 @@ -- specializations. For example: -- -- @ --- unionAll :: S.Select (Column a, Column b) --- -> S.Select (Column a, Column b) --- -> S.Select (Column a, Column b) +-- unionAll :: S.Select (Field a, Field b) +-- -> S.Select (Field a, Field b) +-- -> S.Select (Field a, Field b) -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@: -- -- @ --- unionAll :: S.Select (Foo (Column a) (Column b) (Column c)) --- -> S.Select (Foo (Column a) (Column b) (Column c)) --- -> S.Select (Foo (Column a) (Column b) (Column c)) +-- unionAll :: S.Select (Foo (Field a) (Field b) (Field c)) +-- -> S.Select (Foo (Field a) (Field b) (Field c)) +-- -> S.Select (Foo (Field a) (Field b) (Field c)) -- @ -- -- Please note that by design there are no binary relational functions diff --git a/src/Opaleye/Column.hs b/src/Opaleye/Column.hs --- a/src/Opaleye/Column.hs +++ b/src/Opaleye/Column.hs @@ -3,6 +3,9 @@ -- -- Please note that numeric 'Column' types are instances of 'Num', so -- you can use '*', '/', '+', '-' on them. +-- +-- 'Column' will be renamed to "Opaelye.Field.Field_" in version 0.7, +-- so you might want to use the latter as much as you can. module Opaleye.Column (-- * 'Column' Column, diff --git a/src/Opaleye/Constant.hs b/src/Opaleye/Constant.hs --- a/src/Opaleye/Constant.hs +++ b/src/Opaleye/Constant.hs @@ -1,3 +1,6 @@ +-- | Do not use. Use "Opaleye.ToFields" instead. Will be deprecated +-- in version 0.7. + {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} module Opaleye.Constant where @@ -28,7 +31,7 @@ import qualified Database.PostgreSQL.Simple.Range as R -- | 'toFields' provides a convenient typeclass wrapper around the --- 'Column' creation functions in "Opaleye.SqlTypes". Besides +-- 'Opaleye.Field.Field_' creation functions in "Opaleye.SqlTypes". Besides -- convenience it doesn't provide any additional functionality. -- -- It can be used with functions like 'Opaleye.Manipulation.runInsert' @@ -37,7 +40,7 @@ -- -- @ -- customInsert --- :: ( 'D.Default' 'Constant' haskells fields ) +-- :: ( 'D.Default' 'ToFields' haskells fields ) -- => Connection -- -> 'Opaleye.Table' fields fields' -- -> haskells @@ -46,123 +49,126 @@ -- @ -- -- In order to use this function with your custom types, you need to define an --- instance of 'D.Default' 'Constant' for your custom types. -toFields :: D.Default Constant haskells fields +-- instance of 'D.Default' 'ToFields' for your custom types. +toFields :: D.Default ToFields haskells fields => haskells -> fields toFields = constantExplicit D.def -constant :: D.Default Constant haskells fields +-- | Do not use. Use 'toFields' instead. Will be deprecated in version 0.7. +constant :: D.Default ToFields haskells fields => haskells -> fields constant = constantExplicit D.def +-- | Do not use the name @Constant@. Use 'ToFields' instead. Will be +-- deprecated in version 0.7. newtype Constant haskells fields = Constant { constantExplicit :: haskells -> fields } type ToFields = Constant -instance D.Default Constant haskell (Column sql) - => D.Default Constant (Maybe haskell) (Column (C.Nullable sql)) where +instance D.Default ToFields haskell (Column sql) + => D.Default ToFields (Maybe haskell) (Column (C.Nullable sql)) where def = Constant (C.maybeToNullable . fmap f) where Constant f = D.def -instance D.Default Constant String (Column T.SqlText) where +instance D.Default ToFields String (Column T.SqlText) where def = Constant T.sqlString -instance D.Default Constant LBS.ByteString (Column T.SqlBytea) where +instance D.Default ToFields LBS.ByteString (Column T.SqlBytea) where def = Constant T.sqlLazyByteString -instance D.Default Constant SBS.ByteString (Column T.SqlBytea) where +instance D.Default ToFields SBS.ByteString (Column T.SqlBytea) where def = Constant T.sqlStrictByteString -instance D.Default Constant ST.Text (Column T.SqlText) where +instance D.Default ToFields ST.Text (Column T.SqlText) where def = Constant T.sqlStrictText -instance D.Default Constant LT.Text (Column T.SqlText) where +instance D.Default ToFields LT.Text (Column T.SqlText) where def = Constant T.sqlLazyText -instance D.Default Constant Sci.Scientific (Column T.SqlNumeric) where +instance D.Default ToFields Sci.Scientific (Column T.SqlNumeric) where def = Constant T.sqlNumeric -instance D.Default Constant Int (Column T.SqlInt4) where +instance D.Default ToFields Int (Column T.SqlInt4) where def = Constant T.sqlInt4 -instance D.Default Constant Int.Int32 (Column T.SqlInt4) where +instance D.Default ToFields Int.Int32 (Column T.SqlInt4) where def = Constant $ T.sqlInt4 . fromIntegral -instance D.Default Constant Int.Int64 (Column T.SqlInt8) where +instance D.Default ToFields Int.Int64 (Column T.SqlInt8) where def = Constant T.sqlInt8 -instance D.Default Constant Double (Column T.SqlFloat8) where +instance D.Default ToFields Double (Column T.SqlFloat8) where def = Constant T.sqlDouble -instance D.Default Constant Bool (Column T.SqlBool) where +instance D.Default ToFields Bool (Column T.SqlBool) where def = Constant T.sqlBool -instance D.Default Constant UUID.UUID (Column T.SqlUuid) where +instance D.Default ToFields UUID.UUID (Column T.SqlUuid) where def = Constant T.sqlUUID -instance D.Default Constant Time.Day (Column T.SqlDate) where +instance D.Default ToFields Time.Day (Column T.SqlDate) where def = Constant T.sqlDay -instance D.Default Constant Time.UTCTime (Column T.SqlTimestamptz) where +instance D.Default ToFields Time.UTCTime (Column T.SqlTimestamptz) where def = Constant T.sqlUTCTime -instance D.Default Constant Time.LocalTime (Column T.SqlTimestamp) where +instance D.Default ToFields Time.LocalTime (Column T.SqlTimestamp) where def = Constant T.sqlLocalTime -instance D.Default Constant Time.ZonedTime (Column T.SqlTimestamptz) where +instance D.Default ToFields Time.ZonedTime (Column T.SqlTimestamptz) where def = Constant T.sqlZonedTime -instance D.Default Constant Time.TimeOfDay (Column T.SqlTime) where +instance D.Default ToFields Time.TimeOfDay (Column T.SqlTime) where def = Constant T.sqlTimeOfDay -instance D.Default Constant (CI.CI ST.Text) (Column T.SqlCitext) where +instance D.Default ToFields (CI.CI ST.Text) (Column T.SqlCitext) where def = Constant T.sqlCiStrictText -instance D.Default Constant (CI.CI LT.Text) (Column T.SqlCitext) where +instance D.Default ToFields (CI.CI LT.Text) (Column T.SqlCitext) where def = Constant T.sqlCiLazyText -instance D.Default Constant SBS.ByteString (Column T.SqlJson) where +instance D.Default ToFields SBS.ByteString (Column T.SqlJson) where def = Constant T.sqlStrictJSON -instance D.Default Constant LBS.ByteString (Column T.SqlJson) where +instance D.Default ToFields LBS.ByteString (Column T.SqlJson) where def = Constant T.sqlLazyJSON -instance D.Default Constant Ae.Value (Column T.SqlJson) where +instance D.Default ToFields Ae.Value (Column T.SqlJson) where def = Constant T.sqlValueJSON -instance D.Default Constant SBS.ByteString (Column T.SqlJsonb) where +instance D.Default ToFields SBS.ByteString (Column T.SqlJsonb) where def = Constant T.sqlStrictJSONB -instance D.Default Constant LBS.ByteString (Column T.SqlJsonb) where +instance D.Default ToFields LBS.ByteString (Column T.SqlJsonb) where def = Constant T.sqlLazyJSONB -instance D.Default Constant Ae.Value (Column T.SqlJsonb) where +instance D.Default ToFields Ae.Value (Column T.SqlJsonb) where def = Constant T.sqlValueJSONB -instance D.Default Constant haskell (Column sql) => D.Default Constant (Maybe haskell) (Maybe (Column sql)) where +instance D.Default ToFields haskell (Column sql) => D.Default ToFields (Maybe haskell) (Maybe (Column sql)) where def = Constant (constant <$>) -instance (D.Default Constant a (Column b), T.IsSqlType b) - => D.Default Constant [a] (Column (T.SqlArray b)) where +instance (D.Default ToFields a (Column b), T.IsSqlType b) + => D.Default ToFields [a] (Column (T.SqlArray b)) where def = Constant (T.sqlArray (constantExplicit D.def)) -instance D.Default Constant (R.PGRange Int.Int) (Column (T.SqlRange T.SqlInt4)) where +instance D.Default ToFields (R.PGRange Int.Int) (Column (T.SqlRange T.SqlInt4)) where def = Constant $ \(R.PGRange a b) -> T.sqlRange T.sqlInt4 a b -instance D.Default Constant (R.PGRange Int.Int64) (Column (T.SqlRange T.SqlInt8)) where +instance D.Default ToFields (R.PGRange Int.Int64) (Column (T.SqlRange T.SqlInt8)) where def = Constant $ \(R.PGRange a b) -> T.sqlRange T.sqlInt8 a b -instance D.Default Constant (R.PGRange Sci.Scientific) (Column (T.SqlRange T.SqlNumeric)) where +instance D.Default ToFields (R.PGRange Sci.Scientific) (Column (T.SqlRange T.SqlNumeric)) where def = Constant $ \(R.PGRange a b) -> T.sqlRange T.sqlNumeric a b -instance D.Default Constant (R.PGRange Time.LocalTime) (Column (T.SqlRange T.SqlTimestamp)) where +instance D.Default ToFields (R.PGRange Time.LocalTime) (Column (T.SqlRange T.SqlTimestamp)) where def = Constant $ \(R.PGRange a b) -> T.sqlRange T.sqlLocalTime a b -instance D.Default Constant (R.PGRange Time.UTCTime) (Column (T.SqlRange T.SqlTimestamptz)) where +instance D.Default ToFields (R.PGRange Time.UTCTime) (Column (T.SqlRange T.SqlTimestamptz)) where def = Constant $ \(R.PGRange a b) -> T.sqlRange T.sqlUTCTime a b -instance D.Default Constant (R.PGRange Time.Day) (Column (T.SqlRange T.SqlDate)) where +instance D.Default ToFields (R.PGRange Time.Day) (Column (T.SqlRange T.SqlDate)) where def = Constant $ \(R.PGRange a b) -> T.sqlRange T.sqlDay a b -- { Boilerplate instances diff --git a/src/Opaleye/Distinct.hs b/src/Opaleye/Distinct.hs --- a/src/Opaleye/Distinct.hs +++ b/src/Opaleye/Distinct.hs @@ -13,13 +13,13 @@ -- Example type specialization: -- -- @ --- distinct :: Select (Column a, Column b) -> Select (Column a, Column b) +-- distinct :: Select (Field a, Field b) -> Select (Field a, Field b) -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@: -- -- @ --- distinct :: Select (Foo (Column a) (Column b) (Column c)) -> Select (Foo (Column a) (Column b) (Column c)) +-- distinct :: Select (Foo (Field a) (Field b) (Field c)) -> Select (Foo (Field a) (Field b) (Field c)) -- @ -- -- By design there is no @distinct@ function of type @SelectArr a b -> diff --git a/src/Opaleye/Field.hs b/src/Opaleye/Field.hs --- a/src/Opaleye/Field.hs +++ b/src/Opaleye/Field.hs @@ -1,3 +1,8 @@ +-- | Functions for working directly with 'Field_'s. +-- +-- Please note that numeric 'Field_' types are instances of 'Num', so +-- you can use '*', '/', '+', '-' on them. + {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} @@ -6,6 +11,11 @@ import qualified Opaleye.Column as C import qualified Opaleye.PGTypes as T +-- | The name @Column@ will be replaced by @Field@ in version 0.7. +-- The @Field_@, @Field@ and @FieldNullable@ types exist to help +-- smooth the transition. We recommend that you use @Field_@, @Field@ +-- or @FieldNullable@ instead of @Column@ everywhere that it is +-- sufficient. type family Field_ (a :: Nullability) b data Nullability = NonNullable | Nullable @@ -20,7 +30,7 @@ null :: FieldNullable a null = C.null --- | @TRUE@ if the value of the column is @NULL@, @FALSE@ otherwise. +-- | @TRUE@ if the value of the field is @NULL@, @FALSE@ otherwise. isNull :: FieldNullable a -> Field T.PGBool isNull = C.isNull diff --git a/src/Opaleye/FunctionalJoin.hs b/src/Opaleye/FunctionalJoin.hs --- a/src/Opaleye/FunctionalJoin.hs +++ b/src/Opaleye/FunctionalJoin.hs @@ -15,7 +15,7 @@ import qualified Data.Profunctor.Product.Default as D import qualified Data.Profunctor.Product as PP -import qualified Opaleye.Column as C +import qualified Opaleye.Field as C import qualified Opaleye.Field as F import qualified Opaleye.Internal.Join as IJ import qualified Opaleye.Internal.Operators as IO diff --git a/src/Opaleye/Internal/Column.hs b/src/Opaleye/Internal/Column.hs --- a/src/Opaleye/Internal/Column.hs +++ b/src/Opaleye/Internal/Column.hs @@ -12,6 +12,12 @@ -- -- Do not use the 'Show' instance of 'Column'. It is considered -- deprecated and will be removed in version 0.7. +-- +-- The name @Column@ will be replaced by @Field@ in version 0.7. +-- There already exists a @Field@ type family to help smooth the +-- transition. We recommend that you use @Field_@, @Field@ or +-- @FieldNullable@ instead of @Column@ everywhere that it is +-- sufficient. newtype Column pgType = Column HPQ.PrimExpr deriving Show -- | Only used within a 'Column', to indicate that it can be @NULL@. diff --git a/src/Opaleye/Internal/Distinct.hs b/src/Opaleye/Internal/Distinct.hs --- a/src/Opaleye/Internal/Distinct.hs +++ b/src/Opaleye/Internal/Distinct.hs @@ -16,8 +16,8 @@ -- instead implement it as SQL's DISTINCT but implementing it in terms -- of something else that we already have is easier at this point. -distinctExplicit :: Distinctspec columns columns' - -> Query columns -> Query columns' +distinctExplicit :: Distinctspec fields fields' + -> Query fields -> Query fields' distinctExplicit (Distinctspec agg) = aggregate agg newtype Distinctspec a b = Distinctspec (Aggregator a b) diff --git a/src/Opaleye/Internal/Manipulation.hs b/src/Opaleye/Internal/Manipulation.hs --- a/src/Opaleye/Internal/Manipulation.hs +++ b/src/Opaleye/Internal/Manipulation.hs @@ -7,12 +7,12 @@ import qualified Control.Applicative as A -import Opaleye.Internal.Column (Column) +import Opaleye.Internal.Column (Column(Column)) import qualified Opaleye.Internal.HaskellDB.Sql as HSql import qualified Opaleye.Internal.HaskellDB.Sql.Default as SD import qualified Opaleye.Internal.HaskellDB.Sql.Generate as SG import qualified Opaleye.Internal.HaskellDB.Sql.Print as HPrint -import Opaleye.Internal.Helpers ((.:.), (.::.)) +import Opaleye.Internal.Helpers ((.:.), (.::.), (.::)) import qualified Opaleye.Internal.PrimQuery as PQ import qualified Opaleye.Internal.Print as Print import qualified Opaleye.Internal.RunQuery as IRQ @@ -21,6 +21,7 @@ import qualified Opaleye.Internal.Table as TI import qualified Opaleye.Internal.Unpackspec as U import qualified Opaleye.Table as T +import Opaleye.SqlTypes (SqlBool) import Data.Int (Int64) import qualified Data.List.NonEmpty as NEL @@ -36,8 +37,6 @@ data Returning a b where Count :: Returning a Int64 - Returning - :: D.Default RQ.QueryRunner b c => (a -> b) -> Returning a [c] ReturningExplicit :: RQ.QueryRunner b c -> (a -> b) -> Returning a [c] @@ -130,3 +129,58 @@ instance D.Default Updater (Column a) (Maybe (Column a)) where def = Updater Just +arrangeDeleteReturning :: U.Unpackspec columnsReturned ignored + -> T.Table columnsW columnsR + -> (columnsR -> Column SqlBool) + -> (columnsR -> columnsReturned) + -> Sql.Returning HSql.SqlDelete + -- this implementation was copied, it does not make sense yet +arrangeDeleteReturning unpackspec t cond returningf = + Sql.Returning delete returningSEs + where delete = arrangeDelete t cond + TI.View columnsR = TI.tableColumnsView (TI.tableColumns t) + returningPEs = U.collectPEs unpackspec (returningf columnsR) + returningSEs = Sql.ensureColumnsGen id (map Sql.sqlExpr returningPEs) + +arrangeDeleteReturningSql :: U.Unpackspec columnsReturned ignored + -> T.Table columnsW columnsR + -> (columnsR -> Column SqlBool) + -> (columnsR -> columnsReturned) + -> String +arrangeDeleteReturningSql = + show . Print.ppDeleteReturning .:: arrangeDeleteReturning + + +runDeleteReturning :: (D.Default RQ.QueryRunner columnsReturned haskells) + => PGS.Connection + -- ^ + -> T.Table a columnsR + -- ^ Table to delete rows from + -> (columnsR -> Column SqlBool) + -- ^ Predicate function @f@ to choose which rows to delete. + -- 'runDeleteReturning' will delete rows for which @f@ returns @TRUE@ + -- and leave unchanged rows for + -- which @f@ returns @FALSE@. + -> (columnsR -> columnsReturned) + -> IO [haskells] + -- ^ Returned rows which have been deleted +runDeleteReturning = runDeleteReturningExplicit D.def + +runDeleteReturningExplicit :: RQ.QueryRunner columnsReturned haskells + -> PGS.Connection + -> T.Table a columnsR + -> (columnsR -> Column SqlBool) + -> (columnsR -> columnsReturned) + -> IO [haskells] +runDeleteReturningExplicit qr conn t cond r = + PGS.queryWith_ parser conn + (fromString (arrangeDeleteReturningSql u t cond r)) + where IRQ.QueryRunner u _ _ = qr + parser = IRQ.prepareRowParser qr (r v) + TI.View v = TI.tableColumnsView (TI.tableColumns t) + +arrangeDelete :: T.Table a columnsR -> (columnsR -> Column SqlBool) -> HSql.SqlDelete +arrangeDelete t cond = + SG.sqlDelete SD.defaultSqlGenerator (PQ.tiToSqlTable (TI.tableIdentifier t)) [condExpr] + where Column condExpr = cond tableCols + TI.View tableCols = TI.tableColumnsView (TI.tableColumns t) diff --git a/src/Opaleye/Internal/PGTypes.hs b/src/Opaleye/Internal/PGTypes.hs --- a/src/Opaleye/Internal/PGTypes.hs +++ b/src/Opaleye/Internal/PGTypes.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE ScopedTypeVariables #-} + module Opaleye.Internal.PGTypes where import Opaleye.Internal.Column (Column(Column)) +import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ +import Data.Proxy (Proxy(..)) import qualified Data.Text as SText import qualified Data.Text.Encoding as STextEncoding import qualified Data.Text.Lazy as LText @@ -16,8 +20,8 @@ unsafePgFormatTime typeName formatString = castToType typeName . format where format = Time.formatTime Locale.defaultTimeLocale formatString -literalColumn :: HPQ.Literal -> Column a -literalColumn = Column . HPQ.ConstExpr +literalColumn :: forall a. IsSqlType a => HPQ.Literal -> Column a +literalColumn = Column . HPQ.CastExpr (showSqlType (Proxy :: Proxy a)) . HPQ.ConstExpr castToType :: HPQ.Name -> String -> Column c castToType typeName = @@ -28,3 +32,18 @@ lazyDecodeUtf8 :: LByteString.ByteString -> String lazyDecodeUtf8 = LText.unpack . LTextEncoding.decodeUtf8 + +{-# DEPRECATED showPGType + "Use 'showSqlType' instead. 'showPGType' will be removed \ + \in version 0.7." #-} +class IsSqlType sqlType where + showPGType :: proxy sqlType -> String + showPGType = showSqlType + + showSqlType :: proxy sqlType -> String + showSqlType = showPGType + + {-# MINIMAL showPGType | showSqlType #-} + +instance IsSqlType a => IsSqlType (C.Nullable a) where + showSqlType _ = showSqlType (Proxy :: Proxy a) diff --git a/src/Opaleye/Internal/Print.hs b/src/Opaleye/Internal/Print.hs --- a/src/Opaleye/Internal/Print.hs +++ b/src/Opaleye/Internal/Print.hs @@ -164,3 +164,10 @@ HPrint.ppUpdate update $$ text "RETURNING" <+> HPrint.commaV HPrint.ppSqlExpr (NEL.toList returnExprs) + +ppDeleteReturning :: Sql.Returning HSql.SqlDelete -> Doc +ppDeleteReturning (Sql.Returning delete returnExprs) = + HPrint.ppDelete delete + $$ text "RETURNING" + <+> HPrint.commaV HPrint.ppSqlExpr (NEL.toList returnExprs) + diff --git a/src/Opaleye/Internal/RunQuery.hs b/src/Opaleye/Internal/RunQuery.hs --- a/src/Opaleye/Internal/RunQuery.hs +++ b/src/Opaleye/Internal/RunQuery.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ConstraintKinds #-} module Opaleye.Internal.RunQuery where @@ -49,13 +50,15 @@ -- } --- | 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 'T.PGText' result from the +-- | A 'FromField' @sqlType@ @haskellType@ +-- (or the old name, 'QueryRunnerColumn' @sqlType@ @haskellType@) +-- encodes how to turn +-- a value of Postgres type @sqlType@ into a value of Haskell type +-- @haskellType@. For example a value of type 'FromField' +-- 'T.SqlText' 'String' encodes how to turn a 'T.SqlText' result from the -- database into a Haskell 'String'. -- --- \"'QueryRunnerColumn' @pgType@ @haskellType@\" corresponds to +-- \"'FromField' @sqlType@ @haskellType@\" corresponds to -- postgresql-simple's \"'FieldParser' @haskellType@\". -- This is *not* a Product Profunctor because it is the only way I @@ -74,14 +77,15 @@ type FromField = QueryRunnerColumn --- | A 'QueryRunner' specifies how to convert Postgres values (@columns@) +-- | A 'FromFields' (or the old name 'QueryRunner') +-- specifies how to convert Postgres values (@fields@) -- into Haskell values (@haskells@). Most likely you will never need -- to create on of these or handle one directly. It will be provided --- for you by the 'D.Default' 'QueryRunner' instance. +-- for you by the 'D.Default' 'FromFields' instance. -- --- \"'QueryRunner' @columns@ @haskells@\" corresponds to +-- \"'FromFields' @fields@ @haskells@\" corresponds to -- postgresql-simple's \"'RowParser' @haskells@\". \"'Default' --- 'QueryRunner' @columns@ @haskells@\" corresponds to +-- 'FromFields' @columns@ @haskells@\" corresponds to -- postgresql-simple's \"@FromRow@ @haskells@\". data QueryRunner columns haskells = QueryRunner (U.Unpackspec columns ()) @@ -105,11 +109,17 @@ type FromFields = QueryRunner fieldQueryRunnerColumn :: PGS.FromField haskell => FromField pgType haskell -fieldQueryRunnerColumn = fieldParserQueryRunnerColumn fromField +fieldQueryRunnerColumn = fromPGSFromField +fromPGSFromField :: PGS.FromField haskell => FromField pgType haskell +fromPGSFromField = fieldParserQueryRunnerColumn fromField + fieldParserQueryRunnerColumn :: FieldParser haskell -> FromField pgType haskell -fieldParserQueryRunnerColumn = QueryRunnerColumn (P.rmap (const ()) U.unpackspecColumn) +fieldParserQueryRunnerColumn = fromPGSFieldParser +fromPGSFieldParser :: FieldParser haskell -> FromField pgType haskell +fromPGSFieldParser = QueryRunnerColumn (P.rmap (const ()) U.unpackspecColumn) + queryRunner :: FromField a b -> FromFields (Column a) b queryRunner qrc = QueryRunner u (const (fieldWith fp)) (const True) where QueryRunnerColumn u fp = qrc @@ -125,24 +135,30 @@ -- { Instances for automatic derivation -instance QueryRunnerColumnDefault a b => +instance DefaultFromField a b => QueryRunnerColumnDefault (Nullable a) (Maybe b) where - queryRunnerColumnDefault = queryRunnerColumnNullable queryRunnerColumnDefault + defaultFromField = queryRunnerColumnNullable defaultFromField -instance QueryRunnerColumnDefault a b => - D.Default QueryRunner (Column a) b where - def = queryRunner queryRunnerColumnDefault +instance DefaultFromField a b => + D.Default FromFields (Column a) b where + def = queryRunner defaultFromField -- } -- { Instances that must be provided once for each type. Instances -- for Nullable are derived automatically from these. --- | A 'QueryRunnerColumnDefault' @pgType@ @haskellType@ represents --- the default way to turn a @pgType@ result from the database into a +-- | (Note that a better name for this class would be +-- 'DefaultFromField' and it probably will have this name in version +-- 0.7. When you see 'QueryRunnerColumnDefault' please read +-- 'DefaultFromField' instead. That will probably make things easier +-- to understand.) +-- +-- A 'QueryRunnerColumnDefault' @sqlType@ @haskellType@ represents +-- the default way to turn a @sqlType@ result from the database into a -- Haskell value of type @haskellType@. -- --- \"'QueryRunnerColumnDefault' @pgType@ @haskellType@\" corresponds +-- \"'QueryRunnerColumnDefault' @sqlType@ @haskellType@\" corresponds -- to postgresql-simple's \"'FromField' @haskellType@\". -- -- Creating an instance of 'QueryRunnerColumnDefault' for your own types is @@ -151,108 +167,119 @@ -- 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 +-- 1. If you already have a postgresql-simple 'PGS.FromField' instance for +-- your @haskellType@, use +-- 'fromPGSFromField'. (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. +-- 2. If you don't have a postgresql-simple 'PGS.FromField' instance, but +-- you do have an Opaleye 'FromField' value for the type it wraps use +-- 'Opaleye.RunSelect.unsafeFromField' if possible. See the documentation for +-- 'Opaleye.RunSelect.unsafeFromField' 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'. +-- 3. If you have a more complicated case, but not a 'PGS.FromField' instance, +-- write a 'FieldParser' for your type and use 'fromPGSFieldParser'. -- You can also add a 'FromField' instance using this. -class QueryRunnerColumnDefault pgType haskellType where - queryRunnerColumnDefault :: QueryRunnerColumn pgType haskellType +class QueryRunnerColumnDefault sqlType haskellType where + -- | Do not use @queryRunnerColumnDefault@. It will be deprecated + -- in version 0.7. + queryRunnerColumnDefault :: FromField sqlType haskellType + queryRunnerColumnDefault = defaultFromField + defaultFromField :: FromField sqlType haskellType + defaultFromField = queryRunnerColumnDefault -instance QueryRunnerColumnDefault sqlType haskellType + {-# MINIMAL queryRunnerColumnDefault | defaultFromField #-} + +type DefaultFromField = QueryRunnerColumnDefault + +instance DefaultFromField sqlType haskellType => D.Default FromField sqlType haskellType where - def = queryRunnerColumnDefault + def = defaultFromField instance QueryRunnerColumnDefault T.PGNumeric Sci.Scientific where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGInt4 Int where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGInt4 Int32 where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGInt8 Int64 where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGText String where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGFloat8 Double where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGBool Bool where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGUuid UUID where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGBytea SBS.ByteString where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGBytea LBS.ByteString where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGText ST.Text where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGText LT.Text where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGDate Time.Day where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGTimestamptz Time.UTCTime where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGTimestamp Time.LocalTime where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGTimestamptz Time.ZonedTime where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGTime Time.TimeOfDay where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGCitext (CI.CI ST.Text) where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGCitext (CI.CI LT.Text) where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGJson String where - queryRunnerColumnDefault = fieldParserQueryRunnerColumn jsonFieldParser + defaultFromField = fieldParserQueryRunnerColumn jsonFieldParser instance QueryRunnerColumnDefault T.PGJson Ae.Value where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField instance QueryRunnerColumnDefault T.PGJsonb String where - queryRunnerColumnDefault = fieldParserQueryRunnerColumn jsonbFieldParser + defaultFromField = fieldParserQueryRunnerColumn jsonbFieldParser instance QueryRunnerColumnDefault T.PGJsonb Ae.Value where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField -- No CI String instance since postgresql-simple doesn't define FromField (CI String) arrayColumn :: Column (T.PGArray a) -> Column a arrayColumn = C.unsafeCoerceColumn -instance (Typeable b, QueryRunnerColumnDefault a b) => +instance (Typeable b, DefaultFromField a b) => QueryRunnerColumnDefault (T.PGArray a) [b] where - queryRunnerColumnDefault = QueryRunnerColumn (P.lmap arrayColumn c) ((fmap . fmap . fmap) fromPGArray (pgArrayFieldParser f)) - where QueryRunnerColumn c f = queryRunnerColumnDefault + defaultFromField = QueryRunnerColumn (P.lmap arrayColumn c) ((fmap . fmap . fmap) fromPGArray (pgArrayFieldParser f)) + where QueryRunnerColumn c f = defaultFromField -- } -instance (Typeable b, PGS.FromField b, QueryRunnerColumnDefault a b) => +instance (Typeable b, PGS.FromField b, DefaultFromField a b) => QueryRunnerColumnDefault (T.PGRange a) (PGSR.PGRange b) where - queryRunnerColumnDefault = fieldQueryRunnerColumn + defaultFromField = fromPGSFromField -- Boilerplate instances diff --git a/src/Opaleye/Internal/Table.hs b/src/Opaleye/Internal/Table.hs --- a/src/Opaleye/Internal/Table.hs +++ b/src/Opaleye/Internal/Table.hs @@ -128,21 +128,21 @@ (View (Column (HPQ.BaseTableAttrExpr columnName))) class TableColumn writeType sqlType | writeType -> sqlType where + -- | Do not use. Use 'tableField' instead. Will be deprecated in + -- 0.7. + tableColumn :: String -> TableFields writeType (Column sqlType) + tableColumn = tableField -- | Infer either a 'required' or 'optional' column depending on -- the write type. It's generally more convenient to use this -- than 'required' or 'optional' but you do have to provide a type -- signature instead. - tableColumn :: String -> TableFields writeType (Column sqlType) + tableField :: String -> TableFields writeType (Column sqlType) instance TableColumn (Column a) a where - tableColumn = required + tableField = required instance TableColumn (Maybe (Column a)) a where - tableColumn = optional - -tableField :: TableColumn writeType sqlType - => String -> TableFields writeType (Column sqlType) -tableField = tableColumn + tableField = optional queryTable :: U.Unpackspec viewColumns columns -> Table writeColumns viewColumns diff --git a/src/Opaleye/Internal/TypeFamilies.hs b/src/Opaleye/Internal/TypeFamilies.hs --- a/src/Opaleye/Internal/TypeFamilies.hs +++ b/src/Opaleye/Internal/TypeFamilies.hs @@ -68,7 +68,10 @@ type instance A ('H NullsT) ('TC '(t, b)) = A ('H NullsT) ('C t) type RecordField f a b c = A f ('C '(a, b, c)) -type TableField f a b c d = A f ('TC '( '(a, b, c), d)) +type TableRecordField f a b c d = A f ('TC '( '(a, b, c), d)) +-- | Do not use. Use 'TableRecordField' instead. Will be deprecated +-- in version 0.7. +type TableField f a b c d = TableRecordField f a b c d type H = 'H HT type O = 'H OT diff --git a/src/Opaleye/Join.hs b/src/Opaleye/Join.hs --- a/src/Opaleye/Join.hs +++ b/src/Opaleye/Join.hs @@ -13,10 +13,10 @@ -- Example specialization: -- -- @ --- leftJoin :: Select (Column a, Column b) --- -> Select (Column c, Column (Nullable d)) --- -> (((Column a, Column b), (Column c, Column (Nullable d))) -> Column 'Opaleye.SqlTypes.SqlBool') --- -> Select ((Column a, Column b), (Column (Nullable c), Column (Nullable d))) +-- leftJoin :: Select (Field a, Field b) +-- -> Select (Field c, FieldNullable d) +-- -> (((Field a, Field b), (Field c, FieldNullable d)) -> Field 'Opaleye.SqlTypes.SqlBool') +-- -> Select ((Field a, Field b), (FieldNullable c, FieldNullable d)) -- @ {-# LANGUAGE FlexibleContexts #-} @@ -33,9 +33,6 @@ import qualified Opaleye.Map as Map import qualified Opaleye.Select as S import qualified Opaleye.SqlTypes as T -import qualified Opaleye.PGTypes as T -import Opaleye.QueryArr (Query) -import Opaleye.Column (Column) import qualified Data.Profunctor.Product.Default as D @@ -120,47 +117,47 @@ -- * Inferrable versions -leftJoinInferrable :: (D.Default U.Unpackspec columnsL columnsL, - D.Default U.Unpackspec columnsR columnsR, - D.Default J.NullMaker columnsR nullableColumnsR, - Map.Map J.Nulled columnsR ~ nullableColumnsR) - => Query columnsL +leftJoinInferrable :: (D.Default U.Unpackspec fieldsL fieldsL, + D.Default U.Unpackspec fieldsR fieldsR, + D.Default J.NullMaker fieldsR nullableFieldsR, + Map.Map J.Nulled fieldsR ~ nullableFieldsR) + => S.Select fieldsL -- ^ Left query - -> Query columnsR + -> S.Select fieldsR -- ^ Right query - -> ((columnsL, columnsR) -> Column T.PGBool) + -> ((fieldsL, fieldsR) -> F.Field T.SqlBool) -- ^ Condition on which to join - -> Query (columnsL, nullableColumnsR) + -> S.Select (fieldsL, nullableFieldsR) -- ^ Left join leftJoinInferrable = leftJoin -rightJoinInferrable :: (D.Default U.Unpackspec columnsL columnsL, - D.Default U.Unpackspec columnsR columnsR, - D.Default J.NullMaker columnsL nullableColumnsL, - Map.Map J.Nulled columnsL ~ nullableColumnsL) - => Query columnsL +rightJoinInferrable :: (D.Default U.Unpackspec fieldsL fieldsL, + D.Default U.Unpackspec fieldsR fieldsR, + D.Default J.NullMaker fieldsL nullableFieldsL, + Map.Map J.Nulled fieldsL ~ nullableFieldsL) + => S.Select fieldsL -- ^ Left query - -> Query columnsR + -> S.Select fieldsR -- ^ Right query - -> ((columnsL, columnsR) -> Column T.PGBool) + -> ((fieldsL, fieldsR) -> F.Field T.SqlBool) -- ^ Condition on which to join - -> Query (nullableColumnsL, columnsR) + -> S.Select (nullableFieldsL, fieldsR) -- ^ Right join rightJoinInferrable = rightJoin -fullJoinInferrable :: (D.Default U.Unpackspec columnsL columnsL, - D.Default U.Unpackspec columnsR columnsR, - D.Default J.NullMaker columnsL nullableColumnsL, - D.Default J.NullMaker columnsR nullableColumnsR, - Map.Map J.Nulled columnsL ~ nullableColumnsL, - Map.Map J.Nulled columnsR ~ nullableColumnsR) - => Query columnsL +fullJoinInferrable :: (D.Default U.Unpackspec fieldsL fieldsL, + D.Default U.Unpackspec fieldsR fieldsR, + D.Default J.NullMaker fieldsL nullableFieldsL, + D.Default J.NullMaker fieldsR nullableFieldsR, + Map.Map J.Nulled fieldsL ~ nullableFieldsL, + Map.Map J.Nulled fieldsR ~ nullableFieldsR) + => S.Select fieldsL -- ^ Left query - -> Query columnsR + -> S.Select fieldsR -- ^ Right query - -> ((columnsL, columnsR) -> Column T.PGBool) + -> ((fieldsL, fieldsR) -> F.Field T.SqlBool) -- ^ Condition on which to join - -> Query (nullableColumnsL, nullableColumnsR) + -> S.Select (nullableFieldsL, nullableFieldsR) -- ^ Full outer join fullJoinInferrable = fullJoin diff --git a/src/Opaleye/Manipulation.hs b/src/Opaleye/Manipulation.hs --- a/src/Opaleye/Manipulation.hs +++ b/src/Opaleye/Manipulation.hs @@ -79,8 +79,6 @@ runInsertMany (MI.Count, Just HSql.DoNothing) -> runInsertManyOnConflictDoNothing - (MI.Returning f, oc) -> - \c t r -> MI.runInsertManyReturningExplicit D.def c t r f oc (MI.ReturningExplicit qr f, oc) -> \c t r -> MI.runInsertManyReturningExplicit qr c t r f oc in insert conn table_ rows_ @@ -99,8 +97,6 @@ let update = case returning_ of MI.Count -> runUpdate - MI.Returning f -> - \c t u w -> runUpdateReturning c t u w f MI.ReturningExplicit qr f -> \c t u w -> runUpdateReturningExplicit qr c t u w f in update conn table_ updateWith_ where_ @@ -109,18 +105,17 @@ -- constructor. runDelete_ :: PGS.Connection -- ^ - -> Delete Int64 - -- ^ You must pass 'rCount' here. 'runDelete_' does not - -- yet support @DELETE RETURNING@. If you want it please - -- file an issue. - -> IO Int64 + -> Delete haskells + -> IO haskells -- ^ Returns a type that depends on the 'MI.Returning' that - -- you provided when creating the 'Update'. + -- you provided when creating the 'Delete'. runDelete_ conn i = case i of Delete table_ where_ returning_ -> let delete = case returning_ of MI.Count -> runDelete + MI.ReturningExplicit qr f -> + \c t w -> MI.runDeleteReturningExplicit qr c t w f in delete conn table_ where_ -- * Create a manipulation @@ -142,10 +137,10 @@ data Update haskells = forall fieldsW fieldsR. Update { uTable :: T.Table fieldsW fieldsR , uUpdateWith :: fieldsR -> fieldsW - -- ^ Be careful: providing 'Nothing' to a column created by - -- 'Opaleye.Table.optional' updates the column to its default + -- ^ Be careful: providing 'Nothing' to a field created by + -- 'Opaleye.Table.optional' updates the field to its default -- value. Many users have been confused by this because they - -- assume it means that the column is to be left unchanged. For an + -- assume it means that the field is to be left unchanged. For an -- easier time wrap your update function in 'updateEasy'. , uWhere :: fieldsR -> F.Field SqlBool , uReturning :: MI.Returning fieldsR haskells @@ -164,7 +159,7 @@ data Delete haskells = forall fieldsW fieldsR. Delete { dTable :: T.Table fieldsW fieldsR , dWhere :: fieldsR -> F.Field SqlBool - , dReturning :: MI.Returning fieldsR Int64 + , dReturning :: MI.Returning fieldsR haskells } -- ** Returning @@ -183,7 +178,7 @@ => (fieldsR -> fields) -- ^ -> MI.Returning fieldsR [haskells] -rReturning = MI.Returning +rReturning = rReturningExplicit D.def -- | Return a function of the inserted or updated rows. Explicit -- version. You probably just want to use 'rReturning' instead. @@ -270,10 +265,7 @@ "You probably want 'runDelete' instead. \ \Will be removed in version 0.7." #-} arrangeDelete :: T.Table a columnsR -> (columnsR -> Column SqlBool) -> HSql.SqlDelete -arrangeDelete t cond = - SG.sqlDelete SD.defaultSqlGenerator (PQ.tiToSqlTable (TI.tableIdentifier t)) [condExpr] - where Column condExpr = cond tableCols - TI.View tableCols = TI.tableColumnsView (TI.tableColumns t) +arrangeDelete = MI.arrangeDelete {-# DEPRECATED arrangeDeleteSql "You probably want 'runDelete' instead. \ @@ -506,3 +498,4 @@ -> IO Int64 -- ^ The number of rows deleted runDelete conn = PGS.execute_ conn . fromString .: arrangeDeleteSql + diff --git a/src/Opaleye/Operators.hs b/src/Opaleye/Operators.hs --- a/src/Opaleye/Operators.hs +++ b/src/Opaleye/Operators.hs @@ -332,8 +332,21 @@ emptyArray :: T.IsSqlType a => Column (T.SqlArray a) emptyArray = T.sqlArray id [] +-- | Append two 'T.SqlArray's +arrayAppend :: F.Field (T.SqlArray a) -> F.Field (T.SqlArray a) -> F.Field (T.SqlArray a) +arrayAppend = C.binOp (HPQ.:||) + +-- | Prepend an element to a 'T.SqlArray' arrayPrepend :: Column a -> Column (T.SqlArray a) -> Column (T.SqlArray a) arrayPrepend (Column e) (Column es) = Column (HPQ.FunExpr "array_prepend" [e, es]) + +-- | Remove all instances of an element from a 'T.SqlArray' +arrayRemove :: Column a -> Column (T.SqlArray a) -> Column (T.SqlArray a) +arrayRemove (Column e) (Column es) = Column (HPQ.FunExpr "array_remove" [es, e]) + +-- | Remove all 'NULL' values from a 'T.SqlArray' +arrayRemoveNulls :: Column (T.SqlArray (C.Nullable a)) -> Column (T.SqlArray a) +arrayRemoveNulls = Column.unsafeCoerceColumn . arrayRemove Column.null singletonArray :: T.IsSqlType a => Column a -> Column (T.SqlArray a) singletonArray x = arrayPrepend x emptyArray diff --git a/src/Opaleye/Order.hs b/src/Opaleye/Order.hs --- a/src/Opaleye/Order.hs +++ b/src/Opaleye/Order.hs @@ -42,10 +42,10 @@ @ import Data.Monoid ((\<\>)) -\-- Order by the first column ascending. When first columns are equal -\-- order by second column descending. -example :: 'S.Select' ('C.Column' 'T.SqlInt4', 'C.Column' 'T.SqlText') - -> 'S.Select' ('C.Column' 'T.SqlInt4', 'C.Column' 'T.SqlText') +\-- Order by the first field ascending. When first fields are equal +\-- order by second field descending. +example :: 'S.Select' ('Opaleye.Field.Field' 'T.SqlInt4', 'Opaleye.Field.Field' 'T.SqlText') + -> 'S.Select' ('Opaleye.Field.Field' 'T.SqlInt4', 'Opaleye.Field.Field' 'T.SqlText') example = 'orderBy' ('asc' fst \<\> 'desc' snd) @ @@ -125,7 +125,8 @@ -- | Keep a row from each set where the given function returns the same result. No -- ordering is guaranteed. Mutliple fields may be distinguished by projecting out --- tuples of 'Column's. Use 'distinctOnBy' to control how the rows are chosen. +-- tuples of 'Opaleye.Field.Field_'s. Use 'distinctOnBy' to control how the rows +-- are chosen. distinctOn :: D.Default U.Unpackspec b b => (a -> b) -> S.Select a -> S.Select a distinctOn proj q = Q.simpleQueryArr (O.distinctOn D.def proj . Q.runSimpleQueryArr q) @@ -133,7 +134,7 @@ -- | Keep the row from each set where the given function returns the same result. The -- row is chosen according to which comes first by the supplied ordering. However, no -- output ordering is guaranteed. Mutliple fields may be distinguished by projecting --- out tuples of 'Column's. +-- out tuples of 'Opaleye.Field.Field_'s. distinctOnBy :: D.Default U.Unpackspec b b => (a -> b) -> O.Order a -> S.Select a -> S.Select a distinctOnBy proj ord q = Q.simpleQueryArr (O.distinctOnBy D.def proj ord . Q.runSimpleQueryArr q) diff --git a/src/Opaleye/PGTypes.hs b/src/Opaleye/PGTypes.hs --- a/src/Opaleye/PGTypes.hs +++ b/src/Opaleye/PGTypes.hs @@ -1,14 +1,14 @@ --- | Postgres types and functions to create 'Column's of those types. --- You may find it more convenient to use "Opaleye.Constant" instead. +-- | Use "Opaleye.SqlTypes" instead. Will be deprecated in version 0.7. {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ScopedTypeVariables #-} -module Opaleye.PGTypes (module Opaleye.PGTypes) where +module Opaleye.PGTypes (module Opaleye.PGTypes, IsSqlType(..)) where import Opaleye.Internal.Column (Column) import qualified Opaleye.Internal.Column as C import qualified Opaleye.Internal.PGTypes as IPT +import Opaleye.Internal.PGTypes (IsSqlType(..)) import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ import qualified Opaleye.Internal.HaskellDB.Sql.Default as HSD @@ -83,7 +83,7 @@ pgBool = IPT.literalColumn . HPQ.BoolLit pgUUID :: UUID.UUID -> Column PGUuid -pgUUID = C.unsafeCoerceColumn . pgString . UUID.toString +pgUUID = IPT.literalColumn . HPQ.StringLit . UUID.toString pgDay :: Time.Day -> Column PGDate pgDay = IPT.unsafePgFormatTime "date" "'%F'" @@ -157,16 +157,6 @@ oneEl R.NegInfinity = HPQ.NegInfinity oneEl R.PosInfinity = HPQ.PosInfinity -{-# DEPRECATED showPGType - "Use 'showSqlType' instead. 'showPGType' will be removed \ - \in version 0.7." #-} -class IsSqlType sqlType where - showPGType :: proxy sqlType -> String - showPGType = showSqlType - - showSqlType :: proxy sqlType -> String - showSqlType = showPGType - instance IsSqlType PGBool where showSqlType _ = "boolean" instance IsSqlType PGDate where @@ -199,8 +189,6 @@ showSqlType _ = "bytea" instance IsSqlType a => IsSqlType (PGArray a) where showSqlType _ = showSqlType ([] :: [a]) ++ "[]" -instance IsSqlType a => IsSqlType (C.Nullable a) where - showSqlType _ = showSqlType ([] :: [a]) instance IsSqlType PGJson where showSqlType _ = "json" instance IsSqlType PGJsonb where @@ -254,7 +242,7 @@ -- * Deprecated functions literalColumn :: HPQ.Literal -> Column a -literalColumn = IPT.literalColumn +literalColumn = C.Column . HPQ.ConstExpr {-# DEPRECATED literalColumn "'literalColumn' has been moved to Opaleye.Internal.PGTypes and will be removed in version 0.7." #-} diff --git a/src/Opaleye/RunQuery.hs b/src/Opaleye/RunQuery.hs --- a/src/Opaleye/RunQuery.hs +++ b/src/Opaleye/RunQuery.hs @@ -32,37 +32,16 @@ -- * Running 'S.Select's --- | @runQuery@'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 --- @runQuery@. --- --- Example type specialization: --- --- @ --- runQuery :: 'S.Select' (Column 'Opaleye.SqlTypes.SqlInt4', Column 'Opaleye.SqlTypes.SqlText') -> IO [(Int, String)] --- @ --- --- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@: --- --- @ --- runQuery :: 'S.Select' (Foo (Column 'Opaleye.SqlTypes.SqlInt4') (Column 'Opaleye.SqlTypes.SqlText') (Column 'Opaleye.SqlTypes.SqlBool') --- -> IO [Foo Int String Bool] --- @ --- --- Opaleye types are converted to Haskell types based on instances of --- the 'Opaleye.Internal.RunQuery.QueryRunnerColumnDefault' typeclass. +-- | Use 'Opaleye.RunSelect.runSelect' instead. @runQuery@ will be +-- deprecated in 0.7. runQuery :: D.Default IRQ.FromFields fields haskells => PGS.Connection -> S.Select fields -> IO [haskells] runQuery = runQueryExplicit D.def --- | @runQueryFold@ streams the results of a query incrementally and consumes --- the results with a left fold. --- --- This fold is /not/ strict. The stream consumer is responsible for --- forcing the evaluation of its result to avoid space leaks. +-- | Use 'Opaleye.RunSelect.runSelectFold' instead. @runQueryFold@ +-- will be deprecated in 0.7. runQueryFold :: D.Default IRQ.FromFields fields haskells => PGS.Connection @@ -74,21 +53,10 @@ -- * Creating new 'QueryRunnerColumn's --- | Use 'queryRunnerColumn' to make an instance to allow you to run queries on --- your own datatypes. For example: --- --- @ --- newtype Foo = Foo Int --- --- instance QueryRunnerColumnDefault Foo Foo where --- queryRunnerColumnDefault = --- queryRunnerColumn ('Opaleye.Column.unsafeCoerceColumn' --- :: Column Foo -> Column SqlInt4) --- Foo --- queryRunnerColumnDefault --- @ +-- | Use 'Opaleye.RunSelect.unsafeFromField' instead. +-- @queryRunnerColumn@ will be deprecated in 0.7. queryRunnerColumn :: (Column a' -> Column a) -> (b -> b') - -> IRQ.QueryRunnerColumn a b -> IRQ.QueryRunnerColumn a' b' + -> IRQ.FromField a b -> IRQ.FromField a' b' queryRunnerColumn colF haskellF qrc = IRQ.QueryRunnerColumn (P.lmap colF u) (fmapFP haskellF fp) where IRQ.QueryRunnerColumn u fp = qrc @@ -96,6 +64,8 @@ -- * Explicit versions +-- | Use 'Opaleye.RunSelect.runSelectExplict' instead. Will be +-- deprecated in 0.7. runQueryExplicit :: IRQ.FromFields fields haskells -> PGS.Connection -> S.Select fields @@ -103,6 +73,8 @@ runQueryExplicit qr conn q = maybe (return []) (PGS.queryWith_ parser conn) sql where (sql, parser) = prepareQuery qr q +-- | Use 'Opaleye.RunSelect.runSelectFoldExplict' instead. Will be +-- deprecated in 0.7. runQueryFoldExplicit :: IRQ.FromFields fields haskells -> PGS.Connection @@ -117,10 +89,8 @@ -- * Cursor interface --- | Declare a temporary cursor. The cursor is given a unique name for the given --- connection. --- --- Returns 'Nothing' when the query returns zero rows. +-- | Use 'Opaleye.RunSelect.declareCursor' instead. Will be +-- deprecated in 0.7. declareCursor :: D.Default IRQ.FromFields fields haskells => PGS.Connection @@ -128,7 +98,8 @@ -> IO (IRQ.Cursor haskells) declareCursor = declareCursorExplicit D.def --- | Like 'declareCursor' but takes a 'IRQ.FromFields' explicitly. +-- | Use 'Opaleye.RunSelect.declareCursorExplicit' instead. Will be +-- deprecated in 0.7. declareCursorExplicit :: IRQ.FromFields fields haskells -> PGS.Connection @@ -141,14 +112,14 @@ where (mbQuery, rowParser) = prepareQuery qr q --- | Close the given cursor. +-- | Use 'Opaleye.RunSelect.closeCursor' instead. Will be +-- deprecated in 0.7. closeCursor :: IRQ.Cursor fields -> IO () closeCursor IRQ.EmptyCursor = pure () closeCursor (IRQ.Cursor _ cursor) = PGSC.closeCursor cursor --- | Fold over a chunk of rows, calling the supplied fold-like function on each --- row as it is received. In case the cursor is exhausted, a 'Left' value is --- returned, otherwise a 'Right' value is returned. +-- | Use 'Opaleye.RunSelect.foldForward' instead. Will be +-- deprecated in 0.7. foldForward :: IRQ.Cursor haskells -> Int diff --git a/src/Opaleye/RunSelect.hs b/src/Opaleye/RunSelect.hs --- a/src/Opaleye/RunSelect.hs +++ b/src/Opaleye/RunSelect.hs @@ -9,11 +9,12 @@ IRQ.FromFields, IRQ.FromField) where +import qualified Data.Profunctor as P import qualified Database.PostgreSQL.Simple as PGS +import qualified Opaleye.Column as C import qualified Opaleye.Select as S import qualified Opaleye.RunQuery as RQ -import qualified Opaleye.Sql as S import qualified Opaleye.TypeFamilies as TF import Opaleye.Internal.RunQuery (FromFields) import qualified Opaleye.Internal.RunQuery as IRQ @@ -30,13 +31,13 @@ -- Example type specialization: -- -- @ --- runSelect :: 'S.Select' (Column 'Opaleye.SqlTypes.SqlInt4', Column 'Opaleye.SqlTypes.SqlText') -> IO [(Int, String)] +-- runSelect :: 'S.Select' ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlInt4', 'Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlText') -> IO [(Int, String)] -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@: -- -- @ --- runSelect :: 'S.Select' (Foo (Column 'Opaleye.SqlTypes.SqlInt4') (Column 'Opaleye.SqlTypes.SqlText') (Column 'Opaleye.SqlTypes.SqlBool') +-- runSelect :: 'S.Select' (Foo ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlInt4') ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlText') ('Opaleye.Field.Field' 'Opaleye.SqlTypes.SqlBool') -- -> IO [Foo Int String Bool] -- @ runSelect :: D.Default FromFields fields haskells @@ -108,6 +109,29 @@ -- ^ -> IO (Either a a) foldForward = RQ.foldForward + +-- * Creating new 'FromField's + +-- | Use 'unsafeFromField' to make an instance to allow you to run +-- queries on your own datatypes. For example: +-- +-- @ +-- newtype Foo = Foo Int +-- +-- instance QueryRunnerColumnDefault Foo Foo where +-- defaultFromField = unsafeFromField Foo defaultFromField +-- @ +-- +-- It is \"unsafe\" because it does not check that the @sqlType@ +-- correctly corresponds to the Haskell type. +unsafeFromField :: (b -> b') + -> IRQ.FromField sqlType b + -> IRQ.FromField sqlType' b' +unsafeFromField haskellF qrc = IRQ.QueryRunnerColumn (P.lmap colF u) + (fmapFP haskellF fp) + where IRQ.QueryRunnerColumn u fp = qrc + fmapFP = fmap . fmap . fmap + colF = C.unsafeCoerceColumn -- * Explicit versions diff --git a/src/Opaleye/Select.hs b/src/Opaleye/Select.hs --- a/src/Opaleye/Select.hs +++ b/src/Opaleye/Select.hs @@ -1,15 +1,22 @@ --- | 'Select' and 'SelectArr' are the composable units of database --- querying that are used in Opaleye. +-- | A 'Select' represents an SQL @SELECT@ statment. To run a +-- 'Select' use the functions in "Opaleye.RunSelect". To create a +-- 'Select' you probably want to start by querying one of your +-- 'Opaleye.Table.Table's using 'Opaleye.Table.selectTable'. +-- 'SelectArr' is a parametrised version of 'Select', i.e. it can be +-- passed arguments. module Opaleye.Select where import qualified Opaleye.QueryArr as Q --- | A Postgres @SELECT@, i.e. some functionality that can run via SQL --- and produce a collection of rows. +-- | A @SELECT@, i.e. an SQL query which produces a collection of +-- rows. -- -- @Select a@ is analogous to a Haskell value @[a]@. type Select = SelectArr () --- | @SelectArr a b@ is analogous to a Haskell function @a -> [b]@. +-- | A parametrised 'Select'. A @SelectArr a b@ accepts an argument +-- of type @a@. +-- +-- @SelectArr a b@ is analogous to a Haskell function @a -> [b]@. type SelectArr = Q.QueryArr diff --git a/src/Opaleye/Sql.hs b/src/Opaleye/Sql.hs --- a/src/Opaleye/Sql.hs +++ b/src/Opaleye/Sql.hs @@ -27,14 +27,14 @@ -- Example type specialization: -- -- @ --- showSql :: Select (Column a, Column b) -> Maybe String +-- showSql :: Select (Field a, Field b) -> Maybe String -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the -- product type @Foo@: -- -- @ --- showSql :: Select (Foo (Column a) (Column b) (Column c)) -> Maybe String +-- showSql :: Select (Foo (Field a) (Field b) (Field c)) -> Maybe String -- @ showSql :: forall fields. D.Default U.Unpackspec fields fields diff --git a/src/Opaleye/SqlTypes.hs b/src/Opaleye/SqlTypes.hs --- a/src/Opaleye/SqlTypes.hs +++ b/src/Opaleye/SqlTypes.hs @@ -1,3 +1,7 @@ +-- | SQL types and functions to create 'Opaleye.Field.Field_'s of +-- those types. You may find it more convenient to use +-- "Opaleye.Constant" instead. + module Opaleye.SqlTypes (module Opaleye.SqlTypes, P.IsSqlType, P.IsRangeType) where diff --git a/src/Opaleye/Table.hs b/src/Opaleye/Table.hs --- a/src/Opaleye/Table.hs +++ b/src/Opaleye/Table.hs @@ -5,67 +5,66 @@ {- | - Columns can be required or optional and, independently, nullable or + Fields can be required or optional and, independently, nullable or non-nullable. - A required non-nullable @SqlInt4@ (for example) is created with + A required non-nullable @SqlInt4@ (for example) is defined with 'required' and gives rise to a @ - TableFields (Column SqlInt4) (Column SqlInt4) + TableFields (Field SqlInt4) (Field SqlInt4) @ The leftmost argument is the type of writes. When you insert or - update into this column you must give it a @Column SqlInt4@ (which you - can create with @sqlInt4 :: Int -> Column SqlInt4@). + update into this column you must give it a @Field SqlInt4@ (which you + can define with @sqlInt4 :: Int -> Field SqlInt4@). - A required nullable @SqlInt4@ is created with 'required' and gives rise + A required nullable @SqlInt4@ is defined with 'required' and gives rise to a @ - TableFields (Column (Nullable SqlInt4)) (Column (Nullable SqlInt4)) + TableFields (FieldNullable SqlInt4) (FieldNullable SqlInt4) @ - When you insert or update into this column you must give it a @Column - (Nullable SqlInt4)@, which you can create either with @sqlInt4@ and - @toNullable :: Column a -> Column (Nullable a)@, or with @null :: - Column (Nullable a)@. + When you insert or update into this column you must give it a + @FieldNullable SqlInt4@, which you can define either with @sqlInt4@ and + @toNullable :: Field a -> FieldNullable a@, or with @null :: + FieldNullable a@. - An optional non-nullable @SqlInt4@ is created with 'optional' and gives + An optional non-nullable @SqlInt4@ is defined with 'optional' and gives rise to a @ - TableFields (Maybe (Column SqlInt4)) (Column SqlInt4) + TableFields (Maybe (Field SqlInt4)) (Field SqlInt4) @ Optional columns are those that can be omitted on writes, such as those that have @DEFAULT@s or those that are @SERIAL@. When you insert or update into this column you must give it a @Maybe - (Column SqlInt4)@. If you provide @Nothing@ then the column will be + (Field SqlInt4)@. If you provide @Nothing@ then the column will be omitted from the query and the default value will be used. Otherwise - you have to provide a @Just@ containing a @Column SqlInt4@. + you have to provide a @Just@ containing a @Field SqlInt4@. - An optional nullable @SqlInt4@ is created with 'optional' and gives + An optional nullable @SqlInt4@ is defined with 'optional' and gives rise to a @ - TableFields (Maybe (Column (Nullable SqlInt4))) (Column (Nullable SqlInt4)) + TableFields (Maybe (FieldNullable SqlInt4)) (FieldNullable SqlInt4) @ Optional columns are those that can be omitted on writes, such as those that have @DEFAULT@s or those that are @SERIAL@. When you insert or update into this column you must give it a @Maybe - (Column (Nullable SqlInt4))@. If you provide @Nothing@ then the default + (FieldNullable SqlInt4)@. If you provide @Nothing@ then the default value will be used. Otherwise you have to provide a @Just@ containing - a @Column (Nullable SqlInt4)@ (which can be null). + a @FieldNullable SqlInt4@ (which can be null). -} -module Opaleye.Table (-- * Creating tables +module Opaleye.Table (-- * Defining tables table, tableWithSchema, T.Table, - T.tableColumn, T.tableField, T.optional, T.required, @@ -75,6 +74,7 @@ T.TableColumns, TableFields, -- * Deprecated + T.tableColumn, View, Writer, T.Table(T.Table, T.TableWithSchema), @@ -96,16 +96,16 @@ -- | Example type specialization: -- -- @ --- selectTable :: Table w (Column a, Column b) --- -> Select (Column a, Column b) +-- selectTable :: Table w (Field a, Field b) +-- -> Select (Field a, Field b) -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the -- product type @Foo@: -- -- @ --- selectTable :: Table w (Foo (Column a) (Column b) (Column c)) --- -> Select (Foo (Column a) (Column b) (Column c)) +-- selectTable :: Table w (Foo (Field a) (Field b) (Field c)) +-- -> Select (Foo (Field a) (Field b) (Field c)) -- @ selectTable :: D.Default U.Unpackspec fields fields => Table a fields @@ -113,14 +113,14 @@ -> S.Select fields selectTable = selectTableExplicit D.def --- | Create a table with unqualified names. +-- | Define a table with an unqualified name. table :: String -- ^ Table name -> TableFields writeFields viewFields -> Table writeFields viewFields table = T.Table --- | Create a table. +-- | Define a table with a qualified name. tableWithSchema :: String -- ^ Schema name -> String diff --git a/src/Opaleye/ToFields.hs b/src/Opaleye/ToFields.hs new file mode 100644 --- /dev/null +++ b/src/Opaleye/ToFields.hs @@ -0,0 +1,6 @@ +module Opaleye.ToFields (C.toFields, C.ToFields, module Opaleye.ToFields) where + +import qualified Opaleye.Constant as C + +toFieldsExplicit :: C.ToFields haskells fields -> haskells -> fields +toFieldsExplicit = C.constantExplicit diff --git a/src/Opaleye/TypeFamilies.hs b/src/Opaleye/TypeFamilies.hs --- a/src/Opaleye/TypeFamilies.hs +++ b/src/Opaleye/TypeFamilies.hs @@ -1,5 +1,5 @@ module Opaleye.TypeFamilies - ( TF.TableField + ( TF.TableRecordField , TF.RecordField , (TF.:<*>) , (TF.:<$>) @@ -15,6 +15,7 @@ , TF.Opt , TF.Req , TF.Nulls + , TF.TableField ) where import Opaleye.Internal.TypeFamilies as TF diff --git a/src/Opaleye/Values.hs b/src/Opaleye/Values.hs --- a/src/Opaleye/Values.hs +++ b/src/Opaleye/Values.hs @@ -15,14 +15,14 @@ -- Example type specialization: -- -- @ --- values :: [(Column a, Column b)] -> Select (Column a, Column b) +-- values :: [(Field a, Field b)] -> Select (Field a, Field b) -- @ -- -- Assuming the @makeAdaptorAndInstance@ splice has been run for the -- product type @Foo@: -- -- @ --- queryTable :: [Foo (Column a) (Column b) (Column c)] -> S.Select (Foo (Column a) (Column b) (Column c)) +-- selectTable :: [Foo (Field a) (Field b) (Field c)] -> S.Select (Foo (Field a) (Field b) (Field c)) -- @ values :: (Default V.Valuesspec fields fields, Default U.Unpackspec fields fields) =>