packages feed

opaleye (empty) → 0.2

raw patch · 44 files changed

+3065/−0 lines, 44 filesdep +basedep +contravariantdep +old-localesetup-changed

Dependencies added: base, contravariant, old-locale, opaleye, postgresql-simple, pretty, product-profunctors, profunctors, semigroups, text, time, transformers, uuid

Files

+ Doc/Tutorial/Main.hs view
@@ -0,0 +1,5 @@+import TutorialBasic+import TutorialManipulation++main :: IO ()+main = return ()
+ LICENSE view
@@ -0,0 +1,103 @@+Copyright (c) 2014, Purely Agile Limited++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the names of the copyright holders nor the names of the+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++++* Opaleye is based on code from Karamaan Group LLC under the following license+++Copyright (c) 2013, 2014, Karamaan Group LLC++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. Neither the name of Karamaan Group LLC nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL KARAMAAN GROUP LLC OR ITS AFFILIATES BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.++++* Opaleye contains code from the HaskellDB project under the following license+++Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl+Copyright (c) 2003-2004 The HaskellDB development team+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the names of the copyright holders nor the names of the+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Opaleye/Aggregate.hs view
@@ -0,0 +1,40 @@+-- | Perform aggregations on query results.+module Opaleye.Aggregate (module Opaleye.Aggregate, Aggregator) where++import qualified Opaleye.Internal.Aggregate as A+import           Opaleye.Internal.Aggregate (Aggregator)+import           Opaleye.QueryArr (Query)+import qualified Opaleye.Internal.QueryArr as Q+import qualified Opaleye.Column as C++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import           GHC.Int (Int64)++-- This page of Postgres documentation tell us what aggregate+-- functions are available+--+--   http://www.postgresql.org/docs/9.3/static/functions-aggregate.html++-- | Group the aggregation by equality on the input to 'groupBy'.+groupBy :: Aggregator (C.Column a) (C.Column a)+groupBy = A.makeAggr' Nothing++-- | Sum all rows in a group.+sum :: Aggregator (C.Column a) (C.Column a)+sum = A.makeAggr HPQ.AggrSum++-- | Count the number of non-null rows in a group.+count :: Aggregator (C.Column a) (C.Column Int64)+count = A.makeAggr HPQ.AggrCount++-- | Average of a group+avg :: Aggregator (C.Column Double) (C.Column Double)+avg = A.makeAggr HPQ.AggrAvg++{-|+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.+-}+aggregate :: Aggregator a b -> Query a -> Query b+aggregate agg q = Q.simpleQueryArr (A.aggregateU agg . Q.runSimpleQueryArr q)
+ Opaleye/Binary.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}++module Opaleye.Binary where++import           Opaleye.QueryArr (Query)+import qualified Opaleye.Internal.QueryArr as Q+import qualified Opaleye.Internal.Binary as B+import qualified Opaleye.Internal.Tag as T+import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.Internal.PackMap as PM++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 binaryspec q1 q2 = Q.simpleQueryArr q where+  q ((), startTag) = (newColumns, newPrimQuery, T.next endTag)+    where (columns1, primQuery1, midTag) = Q.runSimpleQueryArr q1 ((), startTag)+          (columns2, primQuery2, endTag) = Q.runSimpleQueryArr q2 ((), midTag)++          (newColumns, pes) =+            PM.run (B.runBinaryspec binaryspec (B.extractBinaryFields endTag)+                                    (columns1, columns2))++          newPrimQuery = PQ.Binary PQ.UnionAll pes (primQuery1, primQuery2)
+ Opaleye/Column.hs view
@@ -0,0 +1,29 @@+module Opaleye.Column (module Opaleye.Column,+                       Column,+                       Nullable,+                       unsafeCoerce)  where++import           Opaleye.Internal.Column (Column, Nullable, unsafeCoerce)+import qualified Opaleye.Internal.Column as C++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++-- | A NULL of any type+null :: Column (Nullable a)+null = unsafeCoerce (C.Column (HPQ.ConstExpr HPQ.NullLit))++isNull :: Column (Nullable a) -> Column Bool+isNull = C.unOp HPQ.OpIsNull++-- | The Opaleye equivalent of the maybe function+matchNullable :: Column b -> (Column a -> Column b) -> Column (Nullable a)+              -> Column b+matchNullable replacement f x = C.ifThenElse (isNull x) replacement+                                             (f (unsafeCoerce x))++-- | The Opaleye equivalent of the fromMaybe function+fromNullable :: Column a -> Column (Nullable a) -> Column a+fromNullable = flip matchNullable id++toNullable :: Column a -> Column (Nullable a)+toNullable = unsafeCoerce
+ Opaleye/Distinct.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE FlexibleContexts #-}++module Opaleye.Distinct (module Opaleye.Distinct, distinctExplicit)+       where++import           Opaleye.QueryArr (Query)+import           Opaleye.Internal.Distinct (distinctExplicit, Distinctspec)++import qualified Data.Profunctor.Product.Default as D++distinct :: D.Default Distinctspec columns columns =>+            Query columns -> Query columns+distinct = distinctExplicit D.def
+ Opaleye/Internal/Aggregate.hs view
@@ -0,0 +1,67 @@+module Opaleye.Internal.Aggregate where++import           Control.Applicative (Applicative, pure, (<*>))++import qualified Data.Profunctor as P+import qualified Data.Profunctor.Product as PP++import qualified Opaleye.Internal.PackMap as PM+import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.Internal.Tag as T+import qualified Opaleye.Internal.Column as C++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++{-|+An 'Aggregator' takes a collection of rows of type @a@, groups+them, and transforms each group into a single row of type @b@. This+corresponds to aggregators using @GROUP BY@ in SQL.+-}+newtype Aggregator a b = Aggregator+                         (PM.PackMap (HPQ.PrimExpr, Maybe HPQ.AggrOp) HPQ.PrimExpr+                                     a b)++makeAggr' :: Maybe HPQ.AggrOp -> Aggregator (C.Column a) (C.Column b)+makeAggr' m = Aggregator (PM.PackMap+                          (\f (C.Column e) -> fmap C.Column (f (e, m))))++makeAggr :: HPQ.AggrOp -> Aggregator (C.Column a) (C.Column b)+makeAggr = makeAggr' . Just++runAggregator :: Applicative f => Aggregator a b+              -> ((HPQ.PrimExpr, Maybe HPQ.AggrOp) -> f HPQ.PrimExpr) -> a -> f b+runAggregator (Aggregator a) = PM.packmap a++aggregateU :: Aggregator a b+           -> (a, PQ.PrimQuery, T.Tag) -> (b, PQ.PrimQuery, T.Tag)+aggregateU agg (c0, primQ, t0) = (c1, primQ', T.next t0)+  where (c1, projPEs) =+          PM.run (runAggregator agg (extractAggregateFields t0) c0)++        primQ' = PQ.Aggregate projPEs primQ++extractAggregateFields :: T.Tag -> (HPQ.PrimExpr, Maybe HPQ.AggrOp)+      -> PM.PM [(String, Maybe HPQ.AggrOp, HPQ.PrimExpr)] HPQ.PrimExpr+extractAggregateFields tag (pe, maggrop) = do+  i <- PM.new+  let s = T.tagWith tag ("result" ++ i)+  PM.write (s, maggrop, pe)+  return (HPQ.AttrExpr s)++-- { Boilerplate instances++instance Functor (Aggregator a) where+  fmap f (Aggregator g) = Aggregator (fmap f g)++instance Applicative (Aggregator a) where+  pure = Aggregator . pure+  Aggregator f <*> Aggregator x = Aggregator (f <*> x)++instance P.Profunctor Aggregator where+  dimap f g (Aggregator q) = Aggregator (P.dimap f g q)++instance PP.ProductProfunctor Aggregator where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++-- }
+ Opaleye/Internal/Binary.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}++module Opaleye.Internal.Binary where++import           Opaleye.Internal.Column (Column(Column))+import qualified Opaleye.Internal.Tag as T+import qualified Opaleye.Internal.PackMap as PM++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product as PP+import           Data.Profunctor.Product.Default (Default, def)++import           Control.Applicative (Applicative, pure, (<*>))+import           Control.Arrow ((***))++extractBinaryFields :: T.Tag -> (HPQ.PrimExpr, HPQ.PrimExpr)+                    -> PM.PM [(String, (HPQ.PrimExpr, HPQ.PrimExpr))]+                             HPQ.PrimExpr+extractBinaryFields = PM.extractAttr ("binary" ++)++data Binaryspec columns columns' =+  Binaryspec (PM.PackMap (HPQ.PrimExpr, HPQ.PrimExpr) HPQ.PrimExpr+                         (columns, columns) columns')++runBinaryspec :: Applicative f => Binaryspec columns columns'+                 -> ((HPQ.PrimExpr, HPQ.PrimExpr) -> f HPQ.PrimExpr)+                 -> (columns, columns) -> f columns'+runBinaryspec (Binaryspec b) = PM.packmap b++instance Default Binaryspec (Column a) (Column a) where+  def = Binaryspec (PM.PackMap (\f (Column e, Column e')+                                -> fmap Column (f (e, e'))))++-- {++-- Boilerplate instance definitions.  Theoretically, these are derivable.++instance Functor (Binaryspec a) where+  fmap f (Binaryspec g) = Binaryspec (fmap f g)++instance Applicative (Binaryspec a) where+  pure = Binaryspec . pure+  Binaryspec f <*> Binaryspec x = Binaryspec (f <*> x)++instance Profunctor Binaryspec where+  dimap f g (Binaryspec b) = Binaryspec (dimap (f *** f) g b)++instance ProductProfunctor Binaryspec where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++-- }
+ Opaleye/Internal/Column.hs view
@@ -0,0 +1,65 @@+module Opaleye.Internal.Column where++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+import qualified Opaleye.Internal.HaskellDB.Query as Q++import           GHC.Int (Int64)++-- | The 'Num' and 'Fractional' instances for 'Column' 'a' are too+-- general.  For example, they allow you to add two 'Column'+-- 'String's.  This will be fixed in a subsequent release.+newtype Column a = Column HPQ.PrimExpr deriving Show++data Nullable a = Nullable++unColumn :: Column a -> HPQ.PrimExpr+unColumn (Column e) = e++unsafeCoerce :: Column a -> Column b+unsafeCoerce (Column e) = Column e++-- This may well end up moving out somewhere else+constant :: Q.ShowConstant a => a -> Column a+constant = Column . HPQ.ConstExpr . Q.showConstant++binOp :: HPQ.BinOp -> Column a -> Column b -> Column c+binOp op (Column e) (Column e') = Column (HPQ.BinExpr op e e')++unOp :: HPQ.UnOp -> Column a -> Column b+unOp op (Column e) = Column (HPQ.UnExpr op e)++case_ :: [(Column Bool, Column a)] -> Column a -> Column a+case_ alts (Column otherwise_) = Column (HPQ.CaseExpr (unColumns alts) otherwise_)+  where unColumns = map (\(Column e, Column e') -> (e, e'))++ifThenElse :: Column Bool -> Column a -> Column a -> Column a+ifThenElse cond t f = case_ [(cond, t)] f++(.>) :: Column a -> Column a -> Column Bool+(.>) = binOp HPQ.OpGt++(.==) :: Column a -> Column a -> Column Bool+(.==) = binOp HPQ.OpEq++-- Naughty orphan instance+instance Q.ShowConstant Int64 where+  showConstant = HPQ.IntegerLit . fromIntegral++-- The constraints here are not really appropriate.  There should be+-- some restriction to a numeric Postgres type+instance (Q.ShowConstant a, Num a) => Num (Column a) where+  fromInteger = constant . fromInteger+  (*) = binOp HPQ.OpMul+  (+) = binOp HPQ.OpPlus+  (-) = binOp HPQ.OpMinus++  abs (Column e) = Column (HPQ.UnExpr (HPQ.UnOpOther "@") e)+  negate (Column e) = Column (HPQ.UnExpr (HPQ.UnOpOther "-") e)++  -- We can't use Postgres's 'sign' function because it returns only a+  -- numeric or a double+  signum c = case_ [(c .> 0, 1), (c .== 0, 0)] (-1)++instance (Q.ShowConstant a, Fractional a) => Fractional (Column a) where+  fromRational = constant . fromRational+  (/) = binOp HPQ.OpDiv
+ Opaleye/Internal/Distinct.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module Opaleye.Internal.Distinct where++import           Opaleye.QueryArr (Query)+import           Opaleye.Column (Column)+import           Opaleye.Aggregate (Aggregator, groupBy, aggregate)++import           Control.Applicative (Applicative, pure, (<*>))++import qualified Data.Profunctor as P+import qualified Data.Profunctor.Product as PP+import           Data.Profunctor.Product.Default (Default, def)++-- We implement distinct simply by grouping by all columns.  We could+-- 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 agg) = aggregate agg++data Distinctspec a b = Distinctspec (Aggregator a b)++instance Default Distinctspec (Column a) (Column a) where+  def = Distinctspec groupBy++-- { Boilerplate instances++instance Functor (Distinctspec a) where+  fmap f (Distinctspec g) = Distinctspec (fmap f g)++instance Applicative (Distinctspec a) where+  pure = Distinctspec . pure+  Distinctspec f <*> Distinctspec x = Distinctspec (f <*> x)++instance P.Profunctor Distinctspec where+  dimap f g (Distinctspec q) = Distinctspec (P.dimap f g q)++instance PP.ProductProfunctor Distinctspec where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++-- }
+ Opaleye/Internal/HaskellDB/PrimQuery.hs view
@@ -0,0 +1,61 @@+-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl+--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net+-- License     :  BSD-style++module Opaleye.Internal.HaskellDB.PrimQuery where++type TableName  = String+type Attribute  = String+type Name = String+type Scheme     = [Attribute]+type Assoc      = [(Attribute,PrimExpr)]+++data PrimExpr   = AttrExpr  Attribute+                | BinExpr   BinOp PrimExpr PrimExpr+                | UnExpr    UnOp PrimExpr+                | AggrExpr  AggrOp PrimExpr+                | ConstExpr Literal+		| CaseExpr [(PrimExpr,PrimExpr)] PrimExpr+                | ListExpr [PrimExpr]+                | ParamExpr (Maybe Name) PrimExpr+                | FunExpr Name [PrimExpr]+                | CastExpr Name PrimExpr -- ^ Cast an expression to a given type.+                deriving (Read,Show)++data Literal = NullLit+	     | DefaultLit            -- ^ represents a default value+	     | BoolLit Bool+	     | StringLit String+	     | IntegerLit Integer+	     | DoubleLit Double+	     | OtherLit String       -- ^ used for hacking in custom SQL+	       deriving (Read,Show)++data BinOp      = OpEq | OpLt | OpLtEq | OpGt | OpGtEq | OpNotEq +                | OpAnd | OpOr+                | OpLike | OpIn +                | OpOther String++                | OpCat+                | OpPlus | OpMinus | OpMul | OpDiv | OpMod+                | OpBitNot | OpBitAnd | OpBitOr | OpBitXor+                | OpAsg+                deriving (Show,Read)++data UnOp	= OpNot +		| OpIsNull | OpIsNotNull+		| OpLength+		| UnOpOther String+		deriving (Show,Read)++data AggrOp     = AggrCount | AggrSum | AggrAvg | AggrMin | AggrMax+                | AggrStdDev | AggrStdDevP | AggrVar | AggrVarP+                | AggrOther String+                deriving (Show,Read)++data OrderExpr = OrderExpr OrderOp PrimExpr +               deriving (Show)++data OrderOp = OpAsc | OpDesc+               deriving (Show)
+ Opaleye/Internal/HaskellDB/Query.hs view
@@ -0,0 +1,26 @@+-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl+--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net+-- License     :  BSD-style++{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}++module Opaleye.Internal.HaskellDB.Query where++import Opaleye.Internal.HaskellDB.PrimQuery++class ShowConstant a where+    showConstant :: a -> Literal++instance ShowConstant String where+    showConstant = StringLit+instance ShowConstant Int where+    showConstant = IntegerLit . fromIntegral+instance ShowConstant Integer where+    showConstant = IntegerLit+instance ShowConstant Double where+    showConstant = DoubleLit+instance ShowConstant Bool where+    showConstant = BoolLit++instance ShowConstant a => ShowConstant (Maybe a) where+    showConstant = maybe NullLit showConstant
+ Opaleye/Internal/HaskellDB/Sql.hs view
@@ -0,0 +1,61 @@+-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl+--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net+-- License     :  BSD-style++module Opaleye.Internal.HaskellDB.Sql ( +                               SqlTable,+                               SqlColumn,+                               SqlName,+                               SqlOrder(..),++	                       SqlUpdate(..), +	                       SqlDelete(..), +	                       SqlInsert(..), ++                               SqlExpr(..),+                               Mark(..),+	                      ) where+++-----------------------------------------------------------+-- * SQL data type+-----------------------------------------------------------++type SqlTable = String++type SqlColumn = String++-- | A valid SQL name for a parameter.+type SqlName = String++data SqlOrder = SqlAsc | SqlDesc+  deriving Show++data Mark = Columns [(SqlColumn, SqlExpr)]+  deriving Show+++-- | Expressions in SQL statements.+data SqlExpr = ColumnSqlExpr  SqlColumn+             | BinSqlExpr     String SqlExpr SqlExpr+             | PrefixSqlExpr  String SqlExpr+             | PostfixSqlExpr String SqlExpr+             | FunSqlExpr     String [SqlExpr]+             | AggrFunSqlExpr String [SqlExpr] -- ^ Aggregate functions separate from normal functions.+             | ConstSqlExpr   String+	     | CaseSqlExpr    [(SqlExpr,SqlExpr)] SqlExpr+             | ListSqlExpr    [SqlExpr]+             | ParamSqlExpr (Maybe SqlName) SqlExpr+             | PlaceHolderSqlExpr+             | ParensSqlExpr SqlExpr+             | CastSqlExpr String SqlExpr +  deriving Show++-- | Data type for SQL UPDATE statements.+data SqlUpdate  = SqlUpdate SqlTable [(SqlColumn,SqlExpr)] [SqlExpr]++-- | Data type for SQL DELETE statements.+data SqlDelete  = SqlDelete SqlTable [SqlExpr]++--- | Data type for SQL INSERT statements.+data SqlInsert  = SqlInsert      SqlTable [SqlColumn] [SqlExpr]
+ Opaleye/Internal/HaskellDB/Sql/Default.hs view
@@ -0,0 +1,190 @@+-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl+--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net+-- License     :  BSD-style++module Opaleye.Internal.HaskellDB.Sql.Default  where++import Opaleye.Internal.HaskellDB.PrimQuery+import Opaleye.Internal.HaskellDB.Sql+import Opaleye.Internal.HaskellDB.Sql.Generate++mkSqlGenerator :: SqlGenerator -> SqlGenerator+mkSqlGenerator gen = SqlGenerator +    {+     sqlUpdate      = defaultSqlUpdate      gen,+     sqlDelete      = defaultSqlDelete      gen,+     sqlInsert      = defaultSqlInsert      gen,+     sqlExpr        = defaultSqlExpr        gen,+     sqlLiteral     = defaultSqlLiteral     gen,+     sqlQuote       = defaultSqlQuote       gen+    }++defaultSqlGenerator :: SqlGenerator+defaultSqlGenerator = mkSqlGenerator defaultSqlGenerator+++toSqlOrder :: SqlGenerator -> OrderExpr -> (SqlExpr,SqlOrder)+toSqlOrder gen (OrderExpr o e) = (sqlExpr gen e, o')+    where o' = case o of+                 OpAsc  -> SqlAsc+                 OpDesc -> SqlDesc++toSqlAssoc :: SqlGenerator -> Assoc -> [(SqlColumn,SqlExpr)]+toSqlAssoc gen = map (\(attr,expr) -> (attr, sqlExpr gen expr))+++defaultSqlUpdate :: SqlGenerator +                 -> TableName  -- ^ Name of the table to update.+	         -> [PrimExpr] -- ^ Conditions which must all be true for a row+                               --   to be updated.+                 -> Assoc -- ^ Update the data with this.+	         -> SqlUpdate+defaultSqlUpdate gen name criteria assigns+        = SqlUpdate name (toSqlAssoc gen assigns) (map (sqlExpr gen) criteria) +++defaultSqlInsert :: SqlGenerator +                 -> TableName -- ^ Name of the table+	         -> Assoc -- ^ What to insert.+	         -> SqlInsert+defaultSqlInsert gen table assoc = SqlInsert table cs es+    where (cs,es) = unzip (toSqlAssoc gen assoc)+++defaultSqlDelete :: SqlGenerator +                 -> TableName -- ^ Name of the table+	         -> [PrimExpr] -- ^ Criteria which must all be true for a row+                               --   to be deleted.+	         -> SqlDelete+defaultSqlDelete gen name criteria = SqlDelete name (map (sqlExpr gen) criteria)+++defaultSqlExpr :: SqlGenerator -> PrimExpr -> SqlExpr+defaultSqlExpr gen expr = +    case expr of+      AttrExpr a       -> ColumnSqlExpr a+      BinExpr op e1 e2 ->+        let leftE = sqlExpr gen e1+            rightE = sqlExpr gen e2+            paren = ParensSqlExpr+            (expL, expR) = case (op, e1, e2) of+              (OpAnd, BinExpr OpOr _ _, BinExpr OpOr _ _) ->+                (paren leftE, paren rightE)+              (OpOr, BinExpr OpAnd _ _, BinExpr OpAnd _ _) ->+                (paren leftE, paren rightE)+              (OpAnd, BinExpr OpOr _ _, _) ->+                (paren leftE, rightE)+              (OpAnd, _, BinExpr OpOr _ _) ->+                (leftE, paren rightE)+              (OpOr, BinExpr OpAnd _ _, _) ->+                (paren leftE, rightE)+              (OpOr, _, BinExpr OpAnd _ _) ->+                (leftE, paren rightE)+              (_, ConstExpr _, ConstExpr _) ->+                (leftE, rightE)+              (_, _, ConstExpr _) ->+                (paren leftE, rightE)+              (_, ConstExpr _, _) ->+                (leftE, paren rightE)+              _ -> (paren leftE, paren rightE)+        in BinSqlExpr (showBinOp op) expL expR+      UnExpr op e      -> let (op',t) = sqlUnOp op+                              e' = sqlExpr gen e+                           in case t of+                                UnOpFun     -> FunSqlExpr op' [e']+                                UnOpPrefix  -> PrefixSqlExpr op' (ParensSqlExpr e')+                                UnOpPostfix -> PostfixSqlExpr op' e'+      AggrExpr op e    -> let op' = showAggrOp op+                              e' = sqlExpr gen e+                           in AggrFunSqlExpr op' [e']+      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'+      ListExpr es      -> ListSqlExpr (map (sqlExpr gen) es)+      ParamExpr n _    -> ParamSqlExpr n PlaceHolderSqlExpr+      FunExpr n exprs  -> FunSqlExpr n (map (sqlExpr gen) exprs)+      CastExpr typ e1 -> CastSqlExpr typ (sqlExpr gen e1)++showBinOp :: BinOp -> String+showBinOp  OpEq         = "=" +showBinOp  OpLt         = "<" +showBinOp  OpLtEq       = "<=" +showBinOp  OpGt         = ">" +showBinOp  OpGtEq       = ">=" +showBinOp  OpNotEq      = "<>" +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  OpMod        = "MOD" +showBinOp  OpBitNot     = "~" +showBinOp  OpBitAnd     = "&" +showBinOp  OpBitOr      = "|" +showBinOp  OpBitXor     = "^"+showBinOp  OpAsg        = "="+++data UnOpType = UnOpFun | UnOpPrefix | UnOpPostfix++sqlUnOp :: UnOp -> (String,UnOpType)+sqlUnOp  OpNot         = ("NOT", UnOpPrefix)+sqlUnOp  OpIsNull      = ("IS NULL", UnOpPostfix)+sqlUnOp  OpIsNotNull   = ("IS NOT NULL", UnOpPostfix)+sqlUnOp  OpLength      = ("LENGTH", UnOpFun)+sqlUnOp  (UnOpOther s) = (s, UnOpFun)+++showAggrOp :: AggrOp -> String+showAggrOp AggrCount    = "COUNT" +showAggrOp AggrSum      = "SUM" +showAggrOp AggrAvg      = "AVG" +showAggrOp AggrMin      = "MIN" +showAggrOp AggrMax      = "MAX" +showAggrOp AggrStdDev   = "StdDev" +showAggrOp AggrStdDevP  = "StdDevP" +showAggrOp AggrVar      = "Var" +showAggrOp AggrVarP     = "VarP"                +showAggrOp (AggrOther s)        = s+++defaultSqlLiteral :: SqlGenerator -> Literal -> String+defaultSqlLiteral _ l = +    case l of+      NullLit       -> "NULL"+      DefaultLit    -> "DEFAULT"+      BoolLit True  -> "TRUE"+      BoolLit False -> "FALSE"+      StringLit s   -> quote s+      IntegerLit i  -> show i+      DoubleLit d   -> show d+      OtherLit o    -> o+++defaultSqlQuote :: SqlGenerator -> String -> String+defaultSqlQuote _ s = quote s++-- | Quote a string and escape characters that need escaping+--   FIXME: this is *very* backend dependent.+--   We use Postgres "escape strings", i.e. strings prefixed+--   with E, to ensure that escaping with backslash is valid.+quote :: String -> String +quote s = "E'" ++ concatMap escape s ++ "'"++-- | Escape characters that need escaping+escape :: Char -> String+escape '\NUL' = "\\0"+escape '\'' = "''"+escape '"' = "\\\""+escape '\b' = "\\b"+escape '\n' = "\\n"+escape '\r' = "\\r"+escape '\t' = "\\t"+escape '\\' = "\\\\"+escape c = [c]
+ Opaleye/Internal/HaskellDB/Sql/Generate.hs view
@@ -0,0 +1,21 @@+-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl+--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net+-- License     :  BSD-style++module Opaleye.Internal.HaskellDB.Sql.Generate (SqlGenerator(..)) where++import Opaleye.Internal.HaskellDB.PrimQuery+import Opaleye.Internal.HaskellDB.Sql+++data SqlGenerator = SqlGenerator+    {+     sqlUpdate      :: TableName -> [PrimExpr] -> Assoc -> SqlUpdate,+     sqlDelete      :: TableName -> [PrimExpr] -> SqlDelete,+     sqlInsert      :: TableName -> Assoc -> SqlInsert,+     sqlExpr        :: PrimExpr -> SqlExpr,+     sqlLiteral     :: Literal -> String,+     -- | Turn a string into a quoted string. Quote characters+     -- and any escaping are handled by this function.+     sqlQuote       :: String -> String+    }
+ Opaleye/Internal/HaskellDB/Sql/Print.hs view
@@ -0,0 +1,103 @@+-- Copyright   :  Daan Leijen (c) 1999, daan@cs.uu.nl+--                HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net+-- License     :  BSD-style++module Opaleye.Internal.HaskellDB.Sql.Print ( +                                     ppUpdate,+                                     ppDelete, +                                     ppInsert,+                                     ppSqlExpr,+                                     ppWhere,+                                     ppGroupBy,+                                     ppOrderBy,+                                     ppAs,+                                     commaV,+                                     commaH+	                            ) where++import Opaleye.Internal.HaskellDB.Sql (Mark(Columns), SqlColumn, SqlDelete(..),+                               SqlExpr(..), SqlOrder(..), SqlInsert(..),+                               SqlUpdate(..))++import Data.List (intersperse)+import Text.PrettyPrint.HughesPJ (Doc, (<+>), ($$), (<>), comma, empty, equals,+                                  hcat, hsep, parens, punctuate, text, vcat)+++ppWhere :: [SqlExpr] -> Doc+ppWhere [] = empty+ppWhere es = text "WHERE" +             <+> hsep (intersperse (text "AND")+                       (map (parens . ppSqlExpr) es))++ppGroupBy :: Mark -> Doc+ppGroupBy (Columns es) = text "GROUP BY" <+> ppGroupAttrs es+  where+    ppGroupAttrs :: [(SqlColumn, SqlExpr)] -> Doc+    ppGroupAttrs cs = commaV nameOrExpr cs+    nameOrExpr :: (SqlColumn, SqlExpr) -> Doc+    nameOrExpr (_, ColumnSqlExpr col) = text col+    nameOrExpr (_, expr) = parens (ppSqlExpr expr)+    +ppOrderBy :: [(SqlExpr,SqlOrder)] -> Doc+ppOrderBy [] = empty+ppOrderBy ord = text "ORDER BY" <+> commaV ppOrd ord+    where+      ppOrd (e,o) = ppSqlExpr e <+> ppSqlOrder o+      ppSqlOrder :: SqlOrder -> Doc+      ppSqlOrder SqlAsc = text "ASC"+      ppSqlOrder SqlDesc = text "DESC"++ppAs :: String -> Doc -> Doc+ppAs alias expr    | null alias    = expr                               +                   | otherwise     = expr <+> (hsep . map text) ["as",alias]+++ppUpdate :: SqlUpdate -> Doc+ppUpdate (SqlUpdate name assigns criteria)+        = text "UPDATE" <+> text name+        $$ text "SET" <+> commaV ppAssign assigns+        $$ ppWhere criteria+    where+      ppAssign (c,e) = text c <+> equals <+> ppSqlExpr e+++ppDelete :: SqlDelete -> Doc+ppDelete (SqlDelete name criteria) =+    text "DELETE FROM" <+> text name $$ ppWhere criteria+++ppInsert :: SqlInsert -> Doc++ppInsert (SqlInsert table names values)+    = text "INSERT INTO" <+> text table +      <+> parens (commaV text names)+      $$ text "VALUES" <+> parens (commaV ppSqlExpr values)+++ppSqlExpr :: SqlExpr -> Doc+ppSqlExpr expr =+    case expr of+      ColumnSqlExpr c     -> text c+      ParensSqlExpr e -> parens (ppSqlExpr e)+      BinSqlExpr op e1 e2 -> ppSqlExpr e1 <+> text op <+> ppSqlExpr e2 +      PrefixSqlExpr op e  -> text op <+> ppSqlExpr e+      PostfixSqlExpr op e -> ppSqlExpr e <+> text op+      FunSqlExpr f es     -> text f <> parens (commaH ppSqlExpr es)+      AggrFunSqlExpr f es     -> text f <> parens (commaH ppSqlExpr es)+      ConstSqlExpr c      -> text c+      CaseSqlExpr cs el   -> text "CASE" <+> vcat (map ppWhen cs)+                             <+> text "ELSE" <+> ppSqlExpr el <+> text "END"+          where ppWhen (w,t) = text "WHEN" <+> ppSqlExpr w +                               <+> text "THEN" <+> ppSqlExpr t+      ListSqlExpr es      -> parens (commaH ppSqlExpr es)+      ParamSqlExpr _ v -> ppSqlExpr v+      PlaceHolderSqlExpr -> text "?"+      CastSqlExpr typ e -> text "CAST" <> parens (ppSqlExpr e <+> text "AS" <+> text typ)+    ++commaH :: (a -> Doc) -> [a] -> Doc+commaH f = hcat . punctuate comma . map f++commaV :: (a -> Doc) -> [a] -> Doc+commaV f = vcat . punctuate comma . map f
+ Opaleye/Internal/Helpers.hs view
@@ -0,0 +1,16 @@+module Opaleye.Internal.Helpers where++infixr 8 .:++(.:) :: (r -> z) -> (a -> b -> r) -> a -> b -> z+(.:) f g x y = f (g x y)++infixr 8 .:.++(.:.) :: (r -> z) -> (a -> b -> c -> r) -> a -> b -> c -> z+(.:.) f g a b c = f (g a b c)++infixr 8 .::++(.::) :: (r -> z) -> (a -> b -> c -> d -> r) -> a -> b -> c -> d -> z+(.::) f g a b c d = f (g a b c d)
+ Opaleye/Internal/Join.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}++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 qualified Opaleye.Column as C++import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product.Default as D++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++data NullMaker a b = NullMaker (a -> b)++toNullable :: NullMaker a b -> a -> b+toNullable (NullMaker f) = f++extractLeftJoinFields :: Int -> T.Tag -> HPQ.PrimExpr+            -> PM.PM [(String, HPQ.PrimExpr)] HPQ.PrimExpr+extractLeftJoinFields n = PM.extractAttr (\i -> "result" ++ show n ++ "_" ++ i)++instance D.Default NullMaker (Column a) (Column (Nullable a)) where+  def = NullMaker C.unsafeCoerce++instance D.Default NullMaker (Column (Nullable a)) (Column (Nullable a)) where+  def = NullMaker C.unsafeCoerce++-- { Boilerplate instances++instance Profunctor NullMaker where+  dimap f g (NullMaker h) = NullMaker (dimap f g h)++instance ProductProfunctor NullMaker where+  empty = NullMaker empty+  NullMaker f ***! NullMaker f' = NullMaker (f ***! f')++--
+ Opaleye/Internal/Optimize.hs view
@@ -0,0 +1,31 @@+module Opaleye.Internal.Optimize where++import           Prelude hiding (product)++import qualified Opaleye.Internal.PrimQuery as PQ++import qualified Data.List.NonEmpty as NEL++optimize :: PQ.PrimQuery -> PQ.PrimQuery+optimize = mergeProduct . removeUnit++removeUnit :: PQ.PrimQuery -> PQ.PrimQuery+removeUnit = PQ.foldPrimQuery (PQ.Unit, PQ.BaseTable, product, PQ.Aggregate,+                                PQ.Order, PQ.Limit, PQ.Join, PQ.Values,+                                PQ.Binary)+  where product pqs pes = PQ.Product pqs' pes+          where pqs' = case NEL.filter (not . PQ.isUnit) pqs of+                         [] -> return PQ.Unit+                         xs -> NEL.fromList xs++mergeProduct :: PQ.PrimQuery -> PQ.PrimQuery+mergeProduct = PQ.foldPrimQuery (PQ.Unit, PQ.BaseTable, product, PQ.Aggregate,+                                PQ.Order, PQ.Limit, PQ.Join, PQ.Values,+                                PQ.Binary)+  where product pqs pes = PQ.Product pqs' (pes ++ pes')+          where pqs' = pqs >>= queries+                queries (PQ.Product qs _) = qs+                queries q = return q+                pes' = NEL.toList pqs >>= conds+                conds (PQ.Product _ cs) = cs+                conds _ = []
+ Opaleye/Internal/Order.hs view
@@ -0,0 +1,47 @@+module Opaleye.Internal.Order where++import qualified Opaleye.Column as C+import qualified Opaleye.Internal.Column as IC+import qualified Opaleye.Internal.Tag as T+import qualified Opaleye.Internal.PrimQuery as PQ++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+import qualified Data.Functor.Contravariant as C+import qualified Data.Profunctor as P+import qualified Data.Monoid as M++data SingleOrder a = SingleOrder HPQ.OrderOp (a -> HPQ.PrimExpr)++instance C.Contravariant SingleOrder where+  contramap f (SingleOrder op g) = SingleOrder op (P.lmap f g)++{-|+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.+-}+newtype Order a = Order [SingleOrder a]++instance C.Contravariant Order where+  contramap f (Order xs) = Order (fmap (C.contramap f) xs)++instance M.Monoid (Order a) where+  mempty = Order M.mempty+  Order o `mappend` Order o' = Order (o `M.mappend` o')++order :: HPQ.OrderOp -> (a -> C.Column b) -> Order a+order op f = C.contramap f (Order [SingleOrder op IC.unColumn])++orderByU :: Order a -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)+orderByU os (columns, primQ, t) = (columns, primQ', t)+  where primQ' = PQ.Order orderExprs primQ+        Order sos = os+        orderExprs = map (\(SingleOrder op f)+                          -> HPQ.OrderExpr op (f columns)) sos++limit' :: Int -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)+limit' n (x, q, t) = (x, PQ.Limit (PQ.LimitOp n) q, t)++offset' :: Int -> (a, PQ.PrimQuery, T.Tag) -> (a, PQ.PrimQuery, T.Tag)+offset' n (x, q, t) = (x, PQ.Limit (PQ.OffsetOp n) q, t)
+ Opaleye/Internal/PackMap.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE Rank2Types #-}++module Opaleye.Internal.PackMap where++import qualified Opaleye.Internal.Tag as T++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import           Control.Applicative (Applicative, pure, (<*>), liftA2)+import qualified Control.Monad.Trans.State as State+import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product as PP+import qualified Data.Functor.Identity as I++-- This is rather like a Control.Lens.Traversal with the type+-- parameters switched but I'm not sure if it should be required to+-- obey the same laws.+--+-- TODO: We could attempt to generalise this to+--+-- data LensLike f a b s t = LensLike ((a -> f b) -> s -> f t)+--+-- i.e. a wrapped, argument-flipped Control.Lens.LensLike+--+-- This would allow us to do the Profunctor and ProductProfunctor+-- instances (requiring just Functor f and Applicative f respectively)+-- and share them between many different restrictions of f.  For+-- example, TableColumnMaker is like a Setter so we would restrict f+-- to the Distributive case.+data PackMap a b s t = PackMap (Applicative f =>+                                (a -> f b) -> s -> f t)++packmap :: Applicative f => PackMap a b s t -> (a -> f b) -> s -> f t+packmap (PackMap f) = f++over :: PackMap a b s t -> (a -> b) -> s -> t+over p f = I.runIdentity . packmap p (I.Identity . f)+++-- { A helpful monad for writing columns in the AST++type PM a = State.State (a, Int)++new :: PM a String+new = do+  (a, i) <- State.get+  State.put (a, i + 1)+  return (show i)++write :: a -> PM [a] ()+write a = do+  (as, i) <- State.get+  State.put (as ++ [a], i)++run :: PM [a] r -> (r, [a])+run m = (r, as)+  where (r, (as, _)) = State.runState m ([], 0)++-- }+++-- { General functions for writing columns in the AST++-- This one ignores the 'a' when making the internal column name.+extractAttr :: (String -> String) -> T.Tag -> a+               -> PM [(String, a)] HPQ.PrimExpr+extractAttr = extractAttrPE . const++-- This one can make the internal column name depend on the 'a' in+-- question (probably a PrimExpr)+extractAttrPE :: (a -> String -> String) -> T.Tag -> a+               -> PM [(String, a)] HPQ.PrimExpr+extractAttrPE mkName t pe = do+  i <- new+  let s = T.tagWith t (mkName pe i)+  write (s, pe)+  return (HPQ.AttrExpr s)++-- }+++-- {++-- Boilerplate instance definitions.  There's no choice here apart+-- from the order in which the applicative is applied.++instance Functor (PackMap a b s) where+  fmap f (PackMap g) = PackMap ((fmap . fmap . fmap) f g)++instance Applicative (PackMap a b s) where+  pure x = PackMap (pure (pure (pure x)))+  PackMap f <*> PackMap x = PackMap (liftA2 (liftA2 (<*>)) f x)++instance Profunctor (PackMap a b) where+  dimap f g (PackMap q) = PackMap (fmap (dimap f (fmap g)) q)++instance ProductProfunctor (PackMap a b) where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++-- }
+ Opaleye/Internal/PrimQuery.hs view
@@ -0,0 +1,62 @@+module Opaleye.Internal.PrimQuery where++import           Prelude hiding (product)++import qualified Data.List.NonEmpty as NEL+import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++type Symbol = String++data LimitOp = LimitOp Int | OffsetOp Int | LimitOffsetOp Int Int+             deriving Show++data BinOp = Except | Union | UnionAll deriving Show+data JoinType = LeftJoin deriving Show++-- We use a 'NEL.NonEmpty' for Product because otherwise we'd have to check+-- for emptiness explicity in the SQL generation phase.+data PrimQuery = Unit+               | BaseTable String [(Symbol, HPQ.PrimExpr)]+               | Product (NEL.NonEmpty PrimQuery) [HPQ.PrimExpr]+               | Aggregate [(Symbol, Maybe HPQ.AggrOp, HPQ.PrimExpr)] PrimQuery+               | Order [HPQ.OrderExpr] PrimQuery+               | Limit LimitOp PrimQuery+               | Join JoinType [(Symbol, HPQ.PrimExpr)] HPQ.PrimExpr PrimQuery PrimQuery+               | Values [Symbol] [[HPQ.PrimExpr]]+               | Binary BinOp [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))] (PrimQuery, PrimQuery)+                 deriving Show++type PrimQueryFold p = ( p+                       , String -> [(Symbol, HPQ.PrimExpr)] -> p+                       , NEL.NonEmpty p -> [HPQ.PrimExpr] -> p+                       , [(Symbol, Maybe HPQ.AggrOp, HPQ.PrimExpr)] -> p -> p+                       , [HPQ.OrderExpr] -> p -> p+                       , LimitOp -> p -> p+                       , JoinType -> [(Symbol, HPQ.PrimExpr)] -> HPQ.PrimExpr -> p -> p -> p+                       , [Symbol] -> [[HPQ.PrimExpr]] -> p+                       , BinOp -> [(Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))] -> (p, p) -> p+                       )++foldPrimQuery :: PrimQueryFold p -> PrimQuery -> p+foldPrimQuery (unit, baseTable, product, aggregate, order, limit, join, values,+               binary)+  = fold where fold primQ = case primQ of+                 Unit                       -> unit+                 BaseTable n s              -> baseTable n s+                 Product pqs pes            -> product (fmap fold pqs) pes+                 Aggregate aggrs pq         -> aggregate aggrs (fold pq)+                 Order pes pq               -> order pes (fold pq)+                 Limit op pq                -> limit op (fold pq)+                 Join j pes cond q1 q2      -> join j pes cond (fold q1) (fold q2)+                 Values ss pes              -> values ss pes+                 Binary binop pes (pq, pq') -> binary binop pes (fold pq, fold pq')++times :: PrimQuery -> PrimQuery -> PrimQuery+times q q' = Product (q NEL.:| [q']) []++restrict :: HPQ.PrimExpr -> PrimQuery -> PrimQuery+restrict cond primQ = Product (return primQ) [cond]++isUnit :: PrimQuery -> Bool+isUnit Unit = True+isUnit _    = False
+ Opaleye/Internal/Print.hs view
@@ -0,0 +1,115 @@+module Opaleye.Internal.Print where++import           Prelude hiding (product)++import qualified Opaleye.Internal.Sql as Sql+import           Opaleye.Internal.Sql (Select(SelectFrom, Table,+                                              SelectJoin,+                                              SelectValues,+                                              SelectBinary),+                                       From, Join, Values, Binary)++import qualified Opaleye.Internal.HaskellDB.Sql as HSql+import qualified Opaleye.Internal.HaskellDB.Sql.Print as HPrint++import           Text.PrettyPrint.HughesPJ (Doc, ($$), (<+>), text, empty,+                                            parens)++import qualified Data.Maybe as M++ppSql :: Select -> Doc+ppSql (SelectFrom s) = ppSelectFrom s+ppSql (Table name) = text name+ppSql (SelectJoin j) = ppSelectJoin j+ppSql (SelectValues v) = ppSelectValues v+ppSql (SelectBinary v) = ppSelectBinary v++ppSelectFrom :: From -> Doc+ppSelectFrom s = text "SELECT"+                 <+> ppAttrs (Sql.attrs s)+                 $$  ppTables (Sql.tables s)+                 $$  HPrint.ppWhere (Sql.criteria s)+                 $$  ppGroupBy (Sql.groupBy s)+                 $$  HPrint.ppOrderBy (Sql.orderBy s)+                 $$  ppLimit (Sql.limit s)+                 $$  ppOffset (Sql.offset s)+++ppSelectJoin :: Join -> Doc+ppSelectJoin j = text "SELECT"+                 <+> ppAttrs (Sql.jAttrs j)+                 $$  text "FROM"+                 $$  ppTable (tableAlias 1 s1)+                 $$  ppJoinType (Sql.jJoinType j)+                 $$  ppTable (tableAlias 2 s2)+                 $$  text "ON"+                 $$  HPrint.ppSqlExpr (Sql.jCond j)+  where (s1, s2) = Sql.jTables j++ppSelectValues :: Values -> Doc+ppSelectValues v = text "SELECT"+                   <+> ppAttrs (Sql.vAttrs v)+                   $$  text "FROM"+                   $$  ppValues (Sql.vValues v)++ppSelectBinary :: Binary -> Doc+ppSelectBinary b = ppSql (Sql.bSelect1 b)+                   $$ ppBinOp (Sql.bOp b)+                   $$ ppSql (Sql.bSelect2 b)++ppJoinType :: Sql.JoinType -> Doc+ppJoinType Sql.LeftJoin = text "LEFT OUTER JOIN"++ppAttrs :: [(HSql.SqlExpr, Maybe HSql.SqlColumn)] -> Doc+ppAttrs [] = text "*"+ppAttrs xs = HPrint.commaV nameAs xs++-- This is pretty much just nameAs from HaskellDB+nameAs :: (HSql.SqlExpr, Maybe HSql.SqlColumn) -> Doc+nameAs (expr, name) = HPrint.ppAs (M.fromMaybe "" name) (HPrint.ppSqlExpr expr)++ppTables :: [Select] -> Doc+ppTables [] = empty+ppTables ts = text "FROM" <+> HPrint.commaV ppTable (zipWith tableAlias [1..] ts)++tableAlias :: Int -> Select -> (HSql.SqlTable, Select)+tableAlias i select = ("T" ++ show i, select)++-- TODO: duplication with ppSql+ppTable :: (HSql.SqlTable, Select) -> Doc+ppTable (alias, select) = case select of+  Table name -> HPrint.ppAs alias (text name)+  SelectFrom selectFrom -> HPrint.ppAs alias (parens (ppSelectFrom selectFrom))+  SelectJoin slj -> HPrint.ppAs alias (parens (ppSelectJoin slj))+  SelectValues slv -> HPrint.ppAs alias (parens (ppSelectValues slv))+  SelectBinary slb -> HPrint.ppAs alias (parens (ppSelectBinary slb))++ppGroupBy :: [HSql.SqlExpr] -> Doc+ppGroupBy [] = empty+ppGroupBy xs = (HPrint.ppGroupBy . HSql.Columns . map (\expr -> ("", expr))) xs++ppLimit :: Maybe Int -> Doc+ppLimit Nothing = empty+ppLimit (Just n) = text ("LIMIT " ++ show n)++ppOffset :: Maybe Int -> Doc+ppOffset Nothing = empty+ppOffset (Just n) = text ("OFFSET " ++ show n)++ppValues :: [[HSql.SqlExpr]] -> Doc+ppValues v = HPrint.ppAs "V" (parens (text "VALUES" $$ HPrint.commaV ppValuesRow v))++ppValuesRow :: [HSql.SqlExpr] -> Doc+ppValuesRow = parens . HPrint.commaH HPrint.ppSqlExpr++ppBinOp :: Sql.BinOp -> Doc+ppBinOp o = text $ case o of+  Sql.Union    -> "UNION"+  Sql.UnionAll -> "UNION ALL"+  Sql.Except   -> "EXCEPT"++ppInsertReturning :: Sql.Returning HSql.SqlInsert -> Doc+ppInsertReturning (Sql.Returning insert returnExprs) =+  HPrint.ppInsert insert+  $$ text "RETURNING"+  <+> HPrint.commaV HPrint.ppSqlExpr returnExprs
+ Opaleye/Internal/QueryArr.hs view
@@ -0,0 +1,67 @@+module Opaleye.Internal.QueryArr where++import           Prelude hiding (id)++import qualified Opaleye.Internal.Unpackspec as U+import qualified Opaleye.Internal.Tag as Tag+import           Opaleye.Internal.Tag (Tag)+import qualified Opaleye.Internal.PrimQuery as PQ++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import qualified Control.Arrow as Arr+import           Control.Arrow ((&&&), (***), arr)+import qualified Control.Category as C+import           Control.Category ((<<<), id)+import           Control.Applicative (Applicative, pure, (<*>))+import qualified Data.Profunctor as P+import qualified Data.Profunctor.Product as PP++newtype QueryArr a b = QueryArr ((a, PQ.PrimQuery, Tag) -> (b, PQ.PrimQuery, Tag))+type Query = QueryArr ()++simpleQueryArr :: ((a, Tag) -> (b, PQ.PrimQuery, Tag)) -> QueryArr a b+simpleQueryArr f = QueryArr g+  where g (a0, primQuery, t0) = (a1, PQ.times primQuery primQuery', t1)+          where (a1, primQuery', t1) = f (a0, t0)++runQueryArr :: QueryArr a b -> (a, PQ.PrimQuery, Tag) -> (b, PQ.PrimQuery, Tag)+runQueryArr (QueryArr f) = f++runSimpleQueryArr :: QueryArr a b -> (a, Tag) -> (b, PQ.PrimQuery, Tag)+runSimpleQueryArr f (a, t) = runQueryArr f (a, PQ.Unit, t)++runQueryArrUnpack :: U.Unpackspec a b+                  -> Query a -> (PQ.PrimQuery, [HPQ.PrimExpr])+runQueryArrUnpack unpackspec q = (primQ, primExprs)+  where (columns, primQ, _) = runSimpleQueryArr q ((), Tag.start)+        f pe = ([pe], pe)+        primExprs :: [HPQ.PrimExpr]+        (primExprs, _) = U.runUnpackspec unpackspec f columns++first3 :: (a1 -> b) -> (a1, a2, a3) -> (b, a2, a3)+first3 f (a1, a2, a3) = (f a1, a2, a3)++instance C.Category QueryArr where+  id = QueryArr id+  QueryArr f . QueryArr g = QueryArr (f . g)++instance Arr.Arrow QueryArr where+  arr f   = QueryArr (first3 f)+  first f = QueryArr g+    where g ((b, d), primQ, t0) = ((c, d), primQ', t1)+            where (c, primQ', t1) = runQueryArr f (b, primQ, t0)++instance Functor (QueryArr a) where+  fmap f = (arr f <<<)++instance Applicative (QueryArr a) where+  pure = arr . const+  f <*> g = arr (uncurry ($)) <<< (f &&& g)++instance P.Profunctor QueryArr where+  dimap f g a = arr g <<< a <<< arr f++instance PP.ProductProfunctor QueryArr where+  empty = id+  (***!) = (***)
+ Opaleye/Internal/RunQuery.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}++module Opaleye.Internal.RunQuery where++import           Control.Applicative (Applicative, pure, (<*>))++import           Database.PostgreSQL.Simple.Internal (RowParser)+import           Database.PostgreSQL.Simple.FromField (FieldParser, FromField,+                                                       fromField)+import           Database.PostgreSQL.Simple.FromRow (fieldWith)++import           Opaleye.Column (Column)+import           Opaleye.Internal.Column (Nullable)+import qualified Opaleye.Column as C+import qualified Opaleye.Internal.Unpackspec as U++import qualified Data.Profunctor as P+import           Data.Profunctor (dimap)+import qualified Data.Profunctor.Product as PP+import           Data.Profunctor.Product (empty, (***!))+import qualified Data.Profunctor.Product.Default as D++import           GHC.Int (Int64)++data QueryRunnerColumn coltype haskell =+  QueryRunnerColumn (U.Unpackspec (Column coltype) ()) (FieldParser haskell)++data QueryRunner columns haskells = QueryRunner (U.Unpackspec columns ())+                                                (RowParser haskells)++fieldQueryRunnerColumn :: FromField haskell => QueryRunnerColumn coltype haskell+fieldQueryRunnerColumn =+  QueryRunnerColumn (P.rmap (const ()) U.unpackspecColumn) fromField++queryRunner :: QueryRunnerColumn a b -> QueryRunner (Column a) b+queryRunner qrc = QueryRunner u (fieldWith fp)+    where QueryRunnerColumn u fp = qrc++queryRunnerColumnNullable :: QueryRunnerColumn a b+                       -> QueryRunnerColumn (Nullable a) (Maybe b)+queryRunnerColumnNullable qr =+  QueryRunnerColumn (P.lmap C.unsafeCoerce u) (fromField' fp)+  where QueryRunnerColumn u fp = qr+        fromField' :: FieldParser a -> FieldParser (Maybe a)+        fromField' _ _ Nothing = pure Nothing+        fromField' fp' f bs = fmap Just (fp' f bs)++-- { Instances for automatic derivation++instance D.Default QueryRunnerColumn a b =>+         D.Default QueryRunnerColumn (Nullable a) (Maybe b) where+  def = queryRunnerColumnNullable D.def++instance D.Default QueryRunnerColumn a b =>+         D.Default QueryRunner (Column a) b where+  def = queryRunner D.def++-- }++-- { Instances that must be provided once for each type.  Instances+--   for Nullable are derived automatically from these.++instance D.Default QueryRunnerColumn Int Int where+  def = fieldQueryRunnerColumn++instance D.Default QueryRunnerColumn Int64 Int64 where+  def = fieldQueryRunnerColumn++instance D.Default QueryRunnerColumn Integer Integer where+  def = fieldQueryRunnerColumn++instance D.Default QueryRunnerColumn String String where+  def = fieldQueryRunnerColumn++instance D.Default QueryRunnerColumn Double Double where+  def = fieldQueryRunnerColumn++-- }++-- Boilerplate instances++instance Functor (QueryRunner c) where+  fmap f (QueryRunner u r) = QueryRunner u (fmap f r)++-- TODO: Seems like this one should be simpler!+instance Applicative (QueryRunner c) where+  pure = QueryRunner (P.lmap (const ()) PP.empty) . pure+  QueryRunner uf rf <*> QueryRunner ux rx =+    QueryRunner (P.dimap (\x -> (x,x)) (const ()) (uf PP.***! ux)) (rf <*> rx)++instance P.Profunctor QueryRunner where+  dimap f g (QueryRunner u r) = QueryRunner (P.lmap f u) (fmap g r)++instance PP.ProductProfunctor QueryRunner where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++-- }
+ Opaleye/Internal/Sql.hs view
@@ -0,0 +1,155 @@+module Opaleye.Internal.Sql where++import           Prelude hiding (product)++import qualified Opaleye.Internal.PrimQuery as PQ++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+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 Data.List.NonEmpty as NEL+import qualified Data.Maybe as M++data Select = SelectFrom From+            | Table HSql.SqlTable+            | SelectJoin Join+            | SelectValues Values+            | SelectBinary Binary+            deriving Show++data From = From {+  attrs     :: [(HSql.SqlExpr, Maybe HSql.SqlColumn)],+  tables    :: [Select],+  criteria  :: [HSql.SqlExpr],+  groupBy   :: [HSql.SqlExpr],+  orderBy   :: [(HSql.SqlExpr, HSql.SqlOrder)],+  limit     :: Maybe Int,+  offset    :: Maybe Int+  }+          deriving Show++data Join = Join {+  jJoinType   :: JoinType,+  jAttrs      :: [(HSql.SqlExpr, Maybe HSql.SqlColumn)],+  jTables     :: (Select, Select),+  jCond       :: HSql.SqlExpr+  }+                deriving Show++data Values = Values {+  vAttrs  :: [(HSql.SqlExpr, Maybe HSql.SqlColumn)],+  vValues :: [[HSql.SqlExpr]]+} deriving Show++data Binary = Binary {+  bOp :: BinOp,+  bSelect1 :: Select,+  bSelect2 :: Select+} deriving Show++data JoinType = LeftJoin deriving Show+data BinOp = Except | Union | UnionAll deriving Show++data TableName = String++data Returning a = Returning a [HSql.SqlExpr]++sqlQueryGenerator :: PQ.PrimQueryFold Select+sqlQueryGenerator = (unit, baseTable, product, aggregate, order, limit_, join,+                     values, binary)++sql :: (PQ.PrimQuery, [HPQ.PrimExpr]) -> Select+sql (pq, pes) = SelectFrom $ newSelect { attrs = makeAttrs pes+                                       , tables = [pqSelect] }+  where pqSelect = PQ.foldPrimQuery sqlQueryGenerator pq+        makeAttrs = flip (zipWith makeAttr) [1..]+        makeAttr pe i = (sqlExpr pe, Just ("result" ++ show (i :: Int)))++unit :: Select+unit = SelectFrom newSelect { attrs  = [(HSql.ConstSqlExpr "0", Nothing)] }++baseTable :: String -> [(PQ.Symbol, HPQ.PrimExpr)] -> Select+baseTable name columns = SelectFrom $+    newSelect { attrs = map (\(sym, col) -> (sqlExpr col, Just sym)) columns+              , tables = [Table name] }++product :: NEL.NonEmpty Select -> [HPQ.PrimExpr] -> Select+product ss pes = SelectFrom $+    newSelect { tables = NEL.toList ss+              , criteria = map sqlExpr pes }++aggregate :: [(PQ.Symbol, Maybe HPQ.AggrOp, HPQ.PrimExpr)] -> Select -> Select+aggregate aggrs s = SelectFrom $ newSelect { attrs = map attr aggrs+                                           , tables = [s]+                                           , groupBy = groupBy' }+  where groupBy' = (map sqlExpr+                    . map (\(_, _, e) -> e)+                    . filter (\(_, x, _) -> M.isNothing x)) aggrs+        attr (x, aggrOp, pe) = (sqlExpr (aggrExpr aggrOp pe), Just x)++aggrExpr :: Maybe HPQ.AggrOp -> HPQ.PrimExpr -> HPQ.PrimExpr+aggrExpr = maybe id HPQ.AggrExpr++order :: [HPQ.OrderExpr] -> Select -> Select+order oes s = SelectFrom $+    newSelect { tables = [s]+              , orderBy = map (SD.toSqlOrder SD.defaultSqlGenerator) oes }++limit_ :: PQ.LimitOp -> Select -> Select+limit_ lo s = SelectFrom $ newSelect { tables = [s]+                                     , limit = limit'+                                     , offset = offset' }+  where (limit', offset') = case lo of+          PQ.LimitOp n         -> (Just n, Nothing)+          PQ.OffsetOp n        -> (Nothing, Just n)+          PQ.LimitOffsetOp l o -> (Just l, Just o)++join :: PQ.JoinType -> [(PQ.Symbol, HPQ.PrimExpr)] -> HPQ.PrimExpr -> Select -> Select+     -> Select+join j columns cond s1 s2 = SelectJoin Join { jJoinType = joinType j+                                            , jAttrs = mkAttrs columns+                                            , jTables = (s1, s2)+                                            , jCond = sqlExpr cond }+  where mkAttrs = map (\(sym, pe) -> (sqlExpr pe, Just sym))++values :: [PQ.Symbol] -> [[HPQ.PrimExpr]] -> Select+values columns pes = SelectValues Values { vAttrs  = mkColumns columns+                                         , vValues = (map . map) sqlExpr pes }+  where mkColumns = zipWith (\i column -> ((sqlExpr . HPQ.AttrExpr) ("column" ++ show (i::Int)),+                                           Just column)) [1..]++binary :: PQ.BinOp -> [(PQ.Symbol, (HPQ.PrimExpr, HPQ.PrimExpr))]+       -> (Select, Select) -> Select+binary op pes (select1, select2) = SelectBinary Binary {+  bOp = binOp op,+  bSelect1 = SelectFrom newSelect { attrs = map (mkColumn fst) pes,+                                    tables = [select1] },+  bSelect2 = SelectFrom newSelect { attrs = map (mkColumn snd) pes,+                                    tables = [select2] }+  }+  where mkColumn e (sym, pes') = (sqlExpr (e pes'), Just sym)++joinType :: PQ.JoinType -> JoinType+joinType PQ.LeftJoin = LeftJoin++binOp :: PQ.BinOp -> BinOp+binOp o = case o of+  PQ.Except   -> Except+  PQ.Union    -> Union+  PQ.UnionAll -> UnionAll++newSelect :: From+newSelect = From {+  attrs     = [],+  tables    = [],+  criteria  = [],+  groupBy   = [],+  orderBy   = [],+  limit     = Nothing,+  offset    = Nothing+  }++sqlExpr :: HPQ.PrimExpr -> HSql.SqlExpr+sqlExpr = SG.sqlExpr SD.defaultSqlGenerator
+ Opaleye/Internal/Table.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleContexts #-}++module Opaleye.Internal.Table where++import           Opaleye.Internal.Column (Column(Column))+import qualified Opaleye.Internal.TableMaker as TM+import qualified Opaleye.Internal.Tag as Tag+import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.Internal.PackMap as PM++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import           Data.Profunctor (Profunctor, dimap, lmap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product as PP+import           Control.Applicative (Applicative, pure, (<*>), liftA2)++data Table writerColumns viewColumns =+  Table String (TableProperties writerColumns viewColumns)++data TableProperties writerColumns viewColumns =+  TableProperties (Writer writerColumns viewColumns) (View viewColumns)++data View columns = View columns++-- If we switch to a more lens-like approach to PackMap this should be+-- the equivalent of a Fold++-- There's no reason the second parameter should exist except that we+-- use ProductProfunctors more than ProductContravariants so it makes+-- things easier if we make it one of the former.+data Writer columns dummy =+  Writer (PM.PackMap (HPQ.PrimExpr, String) () columns ())++queryTable :: TM.ColumnMaker viewColumns columns+            -> Table writerColumns viewColumns+            -> Tag.Tag+            -> (columns, PQ.PrimQuery)+queryTable cm table tag = (primExprs, primQ) where+  (Table tableName (TableProperties _ (View tableCols))) = table+  (primExprs, projcols) = runColumnMaker cm tag tableCols+  primQ :: PQ.PrimQuery+  primQ = PQ.BaseTable tableName projcols++runColumnMaker :: TM.ColumnMaker tablecolumns columns+                  -> Tag.Tag+                  -> tablecolumns+                  -> (columns, [(String, HPQ.PrimExpr)])+runColumnMaker cm tag tableCols = PM.run (TM.runColumnMaker cm f tableCols) where+  f = PM.extractAttrPE mkName tag+  -- The non-AttrExpr PrimExprs are not created by 'makeView' or a+  -- 'ViewColumnMaker' so could only arise from an fmap (if we+  -- implemented a Functor instance) or a direct manipulation of the+  -- tablecols contained in the View (which would be naughty)+  mkName pe i = (++ i) $ case pe of+    HPQ.AttrExpr columnName -> columnName+    _ -> "tablecolumn"++runWriter :: Writer columns columns' -> columns -> [(HPQ.PrimExpr, String)]+runWriter (Writer (PM.PackMap f)) columns = outColumns+  where extractColumns t = ([t], ())+        (outColumns, ()) = f extractColumns columns++required :: String -> Writer (Column a) (Column a)+required columnName =+  Writer (PM.PackMap (\f (Column primExpr) -> f (primExpr, columnName)))++optional :: String -> Writer (Maybe (Column a)) (Column a)+optional columnName =+  Writer (PM.PackMap (\f c -> case c of+                         Nothing -> pure ()+                         Just (Column primExpr) -> f (primExpr, columnName)))++-- {++-- Boilerplate instance definitions++instance Functor (Writer a) where+  fmap _ (Writer g) = Writer g++instance Applicative (Writer a) where+  pure x = Writer (fmap (const ()) (pure x))+  Writer f <*> Writer x = Writer (liftA2 (\_ _ -> ()) f x)++instance Profunctor Writer where+  dimap f _ (Writer h) = Writer (lmap f h)++instance ProductProfunctor Writer where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++instance Functor (TableProperties a) where+  fmap f (TableProperties w (View v)) = TableProperties (fmap f w) (View (f v))++instance Applicative (TableProperties a) where+  pure x = TableProperties (pure x) (View x)+  TableProperties fw (View fv) <*> TableProperties xw (View xv) =+    TableProperties (fw <*> xw) (View (fv xv))++instance Profunctor TableProperties where+  dimap f g (TableProperties w (View v)) = TableProperties (dimap f g w)+                                                            (View (g v))+instance ProductProfunctor TableProperties where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++instance Functor (Table a) where+  fmap f (Table s tp) = Table s (fmap f tp)++-- }
+ Opaleye/Internal/TableMaker.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module Opaleye.Internal.TableMaker where++import qualified Opaleye.Column as C+import qualified Opaleye.Internal.Column as IC+import qualified Opaleye.Internal.PackMap as PM++import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product as PP+import           Data.Profunctor.Product.Default (Default, def)++import           Control.Applicative (Applicative, pure, (<*>))++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+++-- If we switch to a more lens-like approach to PackMap this should be+-- the equivalent of a Setter+newtype ViewColumnMaker strings columns =+  ViewColumnMaker (PM.PackMap () () strings columns)++newtype ColumnMaker columns columns' =+  ColumnMaker (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns')++runViewColumnMaker :: ViewColumnMaker strings tablecolumns ->+                       strings -> tablecolumns+runViewColumnMaker (ViewColumnMaker f) = PM.over f id++runColumnMaker :: Applicative f+                  => ColumnMaker tablecolumns columns+                  -> (HPQ.PrimExpr -> f HPQ.PrimExpr)+                  -> tablecolumns -> f columns+runColumnMaker (ColumnMaker f) = PM.packmap f++-- There's surely a way of simplifying this implementation+tableColumn :: ViewColumnMaker String (C.Column a)+tableColumn = ViewColumnMaker+              (PM.PackMap (\f s -> fmap (const ((IC.Column . HPQ.AttrExpr) s)) (f ())))++column :: ColumnMaker (C.Column a) (C.Column a)+column = ColumnMaker+         (PM.PackMap (\f (IC.Column s)+                      -> fmap IC.Column (f s)))++instance Default ViewColumnMaker String (C.Column a) where+  def = tableColumn++instance Default ColumnMaker (C.Column a) (C.Column a) where+  def = column++-- {++-- Boilerplate instance definitions.  Theoretically, these are derivable.++instance Functor (ViewColumnMaker a) where+  fmap f (ViewColumnMaker g) = ViewColumnMaker (fmap f g)++instance Applicative (ViewColumnMaker a) where+  pure = ViewColumnMaker . pure+  ViewColumnMaker f <*> ViewColumnMaker x = ViewColumnMaker (f <*> x)++instance Profunctor ViewColumnMaker where+  dimap f g (ViewColumnMaker q) = ViewColumnMaker (dimap f g q)++instance ProductProfunctor ViewColumnMaker where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++instance Functor (ColumnMaker a) where+  fmap f (ColumnMaker g) = ColumnMaker (fmap f g)++instance Applicative (ColumnMaker a) where+  pure = ColumnMaker . pure+  ColumnMaker f <*> ColumnMaker x = ColumnMaker (f <*> x)++instance Profunctor ColumnMaker where+  dimap f g (ColumnMaker q) = ColumnMaker (dimap f g q)++instance ProductProfunctor ColumnMaker where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++--}
+ Opaleye/Internal/Tag.hs view
@@ -0,0 +1,18 @@+module Opaleye.Internal.Tag where++data Tag = UnsafeTag Int++start :: Tag+start = UnsafeTag 1++next :: Tag -> Tag+next = UnsafeTag . (+1) . unsafeUnTag++unsafeUnTag :: Tag -> Int+unsafeUnTag (UnsafeTag i) = i++tagWith :: Tag -> String -> String+tagWith t = appendShow (unsafeUnTag t) . (++ "_")++appendShow :: Show a => a -> String -> String+appendShow = flip (++) . show
+ Opaleye/Internal/Unpackspec.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module Opaleye.Internal.Unpackspec where++import qualified Opaleye.Internal.PackMap as PM+import qualified Opaleye.Internal.Column as IC+import qualified Opaleye.Column as C++import           Control.Applicative (Applicative, pure, (<*>))+import           Data.Profunctor (Profunctor, dimap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product as PP+import qualified Data.Profunctor.Product.Default as D++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++newtype Unpackspec columns columns' =+  Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns')++unpackspecColumn :: Unpackspec (C.Column a) (C.Column a)+unpackspecColumn = Unpackspec+                   (PM.PackMap (\f (IC.Column pe) -> fmap IC.Column (f pe)))++runUnpackspec :: Applicative f+                 => Unpackspec columns b+                 -> (HPQ.PrimExpr -> f HPQ.PrimExpr)+                 -> columns -> f b+runUnpackspec (Unpackspec f) = PM.packmap f++instance D.Default Unpackspec (C.Column a) (C.Column a) where+  def = unpackspecColumn++-- {++-- Boilerplate instance definitions.  Theoretically, these are derivable.++instance Functor (Unpackspec a) where+  fmap f (Unpackspec g) = Unpackspec (fmap f g)++instance Applicative (Unpackspec a) where+  pure = Unpackspec . pure+  Unpackspec f <*> Unpackspec x = Unpackspec (f <*> x)++instance Profunctor Unpackspec where+  dimap f g (Unpackspec q) = Unpackspec (dimap f g q)++instance ProductProfunctor Unpackspec where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++--}
+ Opaleye/Internal/Values.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++module Opaleye.Internal.Values where++import           Opaleye.Internal.Column (Column(Column))++import qualified Opaleye.Internal.Unpackspec as U+import qualified Opaleye.Internal.Tag as T+import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.Internal.PackMap as PM+import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import           Data.Profunctor (Profunctor, dimap, rmap)+import           Data.Profunctor.Product (ProductProfunctor, empty, (***!))+import qualified Data.Profunctor.Product as PP+import           Data.Profunctor.Product.Default (Default, def)++import           Control.Applicative (Applicative, pure, (<*>))++-- There are two annoyances with creating SQL VALUES statements+--+-- 1. SQL does not allow empty VALUES statements so if we want to+--    create a VALUES statement from an empty list we have to fake it+--    somehow.  The current approach is to make a VALUES statement+--    with a single row of NULLs and then restrict it with WHERE+--    FALSE.++-- 2. Postgres's type inference of constants is pretty poor so we will+--    sometimes have to give explicit type signatures.  The future+--    ShowConstant class will have the same problem.  NB We don't+--    actually currently address this problem.++valuesU :: U.Unpackspec columns columns'+        -> Valuesspec columns columns'+        -> [columns]+        -> ((), T.Tag) -> (columns', PQ.PrimQuery, T.Tag)+valuesU unpack valuesspec rows ((), t) = (newColumns, primQ', T.next t)+  where runRow row = valuesRow+           where (_, valuesRow) =+                   PM.run (U.runUnpackspec unpack extractValuesEntry row)++        (newColumns, valuesPEs_nulls) =+          PM.run (runValuesspec valuesspec (extractValuesField t))++        valuesPEs = map fst valuesPEs_nulls+        nulls = map snd valuesPEs_nulls++        yieldNoRows :: PQ.PrimQuery -> PQ.PrimQuery+        yieldNoRows = PQ.restrict (HPQ.ConstExpr (HPQ.BoolLit False))++        values' :: [[HPQ.PrimExpr]]+        (values', wrap) = if null rows+                          then ([nulls], yieldNoRows)+                          else (map runRow rows, id)++        primQ' = wrap (PQ.Values valuesPEs values')++-- We don't actually use the return value of this.  It might be better+-- to come up with another Applicative instance for specifically doing+-- what we need.+extractValuesEntry :: HPQ.PrimExpr -> PM.PM [HPQ.PrimExpr] HPQ.PrimExpr+extractValuesEntry pe = do+  PM.write pe+  return pe++extractValuesField :: T.Tag -> HPQ.PrimExpr+                   -> PM.PM [(String, HPQ.PrimExpr)] HPQ.PrimExpr+extractValuesField = PM.extractAttr ("values" ++)++data Valuesspec columns columns' =+  Valuesspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr () columns')++runValuesspec :: Applicative f => Valuesspec columns columns'+              -> (HPQ.PrimExpr -> f HPQ.PrimExpr) -> f columns'+runValuesspec (Valuesspec v) f = PM.packmap v f ()++instance Default Valuesspec (Column Int) (Column Int) where+  def = Valuesspec (PM.PackMap (\f () -> fmap Column (f (HPQ.ConstExpr HPQ.NullLit))))++-- {++-- Boilerplate instance definitions.  Theoretically, these are derivable.++instance Functor (Valuesspec a) where+  fmap f (Valuesspec g) = Valuesspec (fmap f g)++instance Applicative (Valuesspec a) where+  pure = Valuesspec . pure+  Valuesspec f <*> Valuesspec x = Valuesspec (f <*> x)++instance Profunctor Valuesspec where+  dimap _ g (Valuesspec q) = Valuesspec (rmap g q)++instance ProductProfunctor Valuesspec where+  empty = PP.defaultEmpty+  (***!) = PP.defaultProfunctorProduct++-- }
+ Opaleye/Join.hs view
@@ -0,0 +1,43 @@+{-# 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 qualified Opaleye.Internal.PackMap as PM+import           Opaleye.QueryArr (Query)+import qualified Opaleye.Internal.QueryArr as Q+import           Opaleye.Internal.Column (Column(Column))++import qualified Data.Profunctor.Product.Default as 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 Bool)+          -> Query (columnsA, nullableColumnsB)+leftJoin = leftJoinExplicit D.def D.def D.def++leftJoinExplicit :: U.Unpackspec columnsA columnsA+                 -> U.Unpackspec columnsB columnsB+                 -> J.NullMaker columnsB nullableColumnsB+                 -> Query columnsA -> Query columnsB+                 -> ((columnsA, columnsB) -> Column Bool)+                 -> Query (columnsA, nullableColumnsB)+leftJoinExplicit unpackA unpackB nullmaker qA qB cond = Q.simpleQueryArr q where+  q ((), startTag) = ((newColumnsA, nullableColumnsB), primQueryR, T.next endTag)+    where (columnsA, primQueryA, midTag) = Q.runSimpleQueryArr qA ((), startTag)+          (columnsB, primQueryB, endTag) = Q.runSimpleQueryArr qB ((), midTag)++          (newColumnsA, ljPEsA) =+            PM.run (U.runUnpackspec unpackA (J.extractLeftJoinFields 1 endTag) columnsA)+          (newColumnsB, ljPEsB) =+            PM.run (U.runUnpackspec unpackB (J.extractLeftJoinFields 2 endTag) columnsB)++          nullableColumnsB = J.toNullable nullmaker newColumnsB++          Column cond' = cond (columnsA, columnsB)+          primQueryR = PQ.Join PQ.LeftJoin (ljPEsA ++ ljPEsB) cond' primQueryA primQueryB
+ Opaleye/Manipulation.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE FlexibleContexts #-}++module Opaleye.Manipulation where++import qualified Opaleye.Internal.Sql as Sql+import qualified Opaleye.Internal.Print as Print+import qualified Opaleye.RunQuery as RQ+import qualified Opaleye.Internal.RunQuery as IRQ+import qualified Opaleye.Table as T+import qualified Opaleye.Internal.Table as TI+import           Opaleye.Internal.Column (Column(Column))+import           Opaleye.Internal.Helpers ((.:), (.:.), (.::))+import qualified Opaleye.Internal.Unpackspec as U++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ+import qualified Opaleye.Internal.HaskellDB.Sql as HSql+import qualified Opaleye.Internal.HaskellDB.Sql.Print as HPrint+import qualified Opaleye.Internal.HaskellDB.Sql.Default as SD+import qualified Opaleye.Internal.HaskellDB.Sql.Generate as SG++import qualified Database.PostgreSQL.Simple as PGS++import qualified Data.Profunctor.Product.Default as D++import           Data.Int (Int64)+import           Data.String (fromString)++arrangeInsert :: T.Table columns a -> columns -> HSql.SqlInsert+arrangeInsert (T.Table tableName (TI.TableProperties writer _)) columns = insert+  where outColumns' = (map (\(x, y) -> (y, x))+                       . TI.runWriter writer) columns+        insert = SG.sqlInsert SD.defaultSqlGenerator tableName outColumns'++arrangeInsertSql :: T.Table columns a -> columns -> String+arrangeInsertSql = show . HPrint.ppInsert .: arrangeInsert++runInsert :: PGS.Connection -> T.Table columns columns' -> columns -> IO Int64+runInsert conn = PGS.execute_ conn . fromString .: arrangeInsertSql++arrangeUpdate :: T.Table columnsW columnsR+              -> (columnsR -> columnsW) -> (columnsR -> Column Bool)+              -> HSql.SqlUpdate+arrangeUpdate (TI.Table tableName (TI.TableProperties writer (TI.View tableCols)))+              update cond =+  SG.sqlUpdate SD.defaultSqlGenerator tableName [condExpr] (update' tableCols)+  where update' = map (\(x, y) -> (y, x))+                   . TI.runWriter writer+                   . update+        Column condExpr = cond tableCols++arrangeUpdateSql :: T.Table columnsW columnsR+              -> (columnsR -> columnsW) -> (columnsR -> Column Bool)+              -> String+arrangeUpdateSql = show . HPrint.ppUpdate .:. arrangeUpdate++runUpdate :: PGS.Connection -> T.Table columnsW columnsR+          -> (columnsR -> columnsW) -> (columnsR -> Column Bool)+          -> IO Int64+runUpdate conn = PGS.execute_ conn . fromString .:. arrangeUpdateSql++arrangeDelete :: T.Table a columnsR -> (columnsR -> Column Bool) -> HSql.SqlDelete+arrangeDelete (TI.Table tableName (TI.TableProperties _ (TI.View tableCols)))+              cond =+  SG.sqlDelete SD.defaultSqlGenerator tableName [condExpr]+  where Column condExpr = cond tableCols++arrangeDeleteSql :: T.Table a columnsR -> (columnsR -> Column Bool) -> String+arrangeDeleteSql = show . HPrint.ppDelete .: arrangeDelete++runDelete :: PGS.Connection -> T.Table a columnsR -> (columnsR -> Column Bool)+          -> IO Int64+runDelete conn = PGS.execute_ conn . fromString .: arrangeDeleteSql++arrangeInsertReturning :: U.Unpackspec returned returned+                       -> T.Table columnsW columnsR+                       -> columnsW+                       -> (columnsR -> returned)+                       -> Sql.Returning HSql.SqlInsert+arrangeInsertReturning unpackspec table columns returningf =+  Sql.Returning insert returningSEs+  where insert = arrangeInsert table columns+        TI.Table _ (TI.TableProperties _ (TI.View columnsR)) = table+        returning = returningf columnsR+        -- TODO: duplication with runQueryArrUnpack+        f pe = ([pe], pe)+        returningPEs :: [HPQ.PrimExpr]+        (returningPEs, _) = U.runUnpackspec unpackspec f returning+        returningSEs = map Sql.sqlExpr returningPEs++arrangeInsertReturningSql :: U.Unpackspec returned returned+                          -> T.Table columnsW columnsR+                          -> columnsW+                          -> (columnsR -> returned)+                          -> String+arrangeInsertReturningSql = show+                            . Print.ppInsertReturning+                            .:: arrangeInsertReturning++runInsertReturningExplicit :: RQ.QueryRunner returned haskells+                           -> U.Unpackspec returned returned+                           -> PGS.Connection+                           -> T.Table columnsW columnsR+                           -> columnsW+                           -> (columnsR -> returned)+                           -> IO [haskells]+runInsertReturningExplicit qr u conn = PGS.queryWith_ rowParser conn+                                       . fromString+                                       .:. arrangeInsertReturningSql u+  where IRQ.QueryRunner _ rowParser = qr++runInsertReturning :: (D.Default RQ.QueryRunner returned haskells,+                       D.Default U.Unpackspec returned returned)+                      => PGS.Connection+                      -> T.Table columnsW columnsR+                      -> columnsW+                      -> (columnsR -> returned)+                      -> IO [haskells]+runInsertReturning = runInsertReturningExplicit D.def D.def
+ Opaleye/Operators.hs view
@@ -0,0 +1,48 @@+module Opaleye.Operators (module Opaleye.Operators,+                          (.==),+                          (.>),+                          case_,+                          ifThenElse) where++import           Opaleye.Internal.Column (Column(Column), (.==), case_, (.>),+                                          ifThenElse)+import qualified Opaleye.Internal.Column as C+import           Opaleye.Internal.QueryArr (QueryArr(QueryArr))+import qualified Opaleye.Internal.PrimQuery as PQ++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++{-| Restrict query results to a particular condition.  Corresponds to+    the guard method of the MonadPlus class.+-}+restrict :: QueryArr (Column Bool) ()+restrict = QueryArr f where+  f (Column predicate, primQ, t0) = ((), PQ.restrict predicate primQ, t0)++doubleOfInt :: Column Int -> Column Double+doubleOfInt (Column e) = Column (HPQ.CastExpr "double precision" e)++(.<) :: Column a -> Column a -> Column Bool+(.<) = C.binOp HPQ.OpLt++(.<=) :: Column a -> Column a -> Column Bool+(.<=) = C.binOp HPQ.OpLtEq++(.>=) :: Column a -> Column a -> Column Bool+(.>=) = C.binOp HPQ.OpGtEq++(.&&) :: Column Bool -> Column Bool -> Column Bool+(.&&) = C.binOp HPQ.OpAnd++(.||) :: Column Bool -> Column Bool -> Column Bool+(.||) = C.binOp HPQ.OpOr++not :: Column Bool -> Column Bool+not = C.unOp HPQ.OpNot++-- FIXME: Should we get rid of this and just use a monoid instance?+(.++) :: Column String -> Column String -> Column String+(.++) = C.binOp (HPQ.OpOther "||")++(./=) :: Column a -> Column a -> Column Bool+(./=) = C.binOp HPQ.OpNotEq
+ Opaleye/Order.hs view
@@ -0,0 +1,35 @@+module Opaleye.Order (module Opaleye.Order, O.Order) where++import qualified Opaleye.Column as C+import           Opaleye.QueryArr (Query)+import qualified Opaleye.Internal.QueryArr as Q+import qualified Opaleye.Internal.Order as O++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++{-| Order the rows of a `Query` according to the `Order`. -}+orderBy :: O.Order a -> Query a -> Query a+orderBy os q =+  Q.simpleQueryArr (O.orderByU os . Q.runSimpleQueryArr q)++-- | Specify an ascending ordering by the given expression.+asc :: (a -> C.Column b) -> O.Order a+asc = O.order HPQ.OpAsc++-- | Specify an descending ordering by the given expression.+desc :: (a -> C.Column b) -> O.Order a+desc = O.order HPQ.OpDesc++{- |+Limit the results of the given query to the given maximum number of+items.+-}+limit :: Int -> Query a -> Query a+limit n a = Q.simpleQueryArr (O.limit' n . Q.runSimpleQueryArr a)++{- |+Offset the results of the given query by the given amount, skipping+that many result rows.+-}+offset :: Int -> Query a -> Query a+offset n a = Q.simpleQueryArr (O.offset' n . Q.runSimpleQueryArr a)
+ Opaleye/PGTypes.hs view
@@ -0,0 +1,53 @@+module Opaleye.PGTypes where++import           Opaleye.Internal.Column (Column(Column))+import qualified Opaleye.Internal.Column as C++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import qualified Data.Text as Text+import qualified Data.Time as Time+import qualified Data.UUID as UUID+import qualified System.Locale as SL++literalColumn :: HPQ.Literal -> Column a+literalColumn = Column . HPQ.ConstExpr++pgString :: String -> Column String+pgString = literalColumn . HPQ.StringLit++pgText :: Text.Text -> Column String+pgText = literalColumn . HPQ.StringLit . Text.unpack++pgInt :: Int -> Column Int+pgInt = literalColumn . HPQ.IntegerLit . fromIntegral++pgInteger :: Integer -> Column Integer+pgInteger = literalColumn . HPQ.IntegerLit++pgDouble :: Double -> Column Double+pgDouble = literalColumn . HPQ.DoubleLit++pgBool :: Bool -> Column Bool+pgBool = literalColumn . HPQ.BoolLit++pgUUID :: UUID.UUID -> Column UUID.UUID+pgUUID = C.unsafeCoerce . pgString . UUID.toString++pgDay :: Time.Day -> Column Time.Day+pgDay = Column+        . HPQ.CastExpr "date"+        . HPQ.ConstExpr+        . HPQ.OtherLit+        . format+  where formatString = "'%Y-%m-%d'"+        format = Time.formatTime SL.defaultTimeLocale formatString++pgUTCTime :: Time.UTCTime -> Column Time.UTCTime+pgUTCTime = Column+            . HPQ.CastExpr "timestamp"+            . HPQ.ConstExpr+            . HPQ.OtherLit+            . format+  where formatString = "'%Y-%m-%dT%H:%M:%SZ'"+        format = Time.formatTime SL.defaultTimeLocale formatString
+ Opaleye/QueryArr.hs view
@@ -0,0 +1,9 @@+{-|++This modules defines the 'QueryArr' arrow, which is an arrow that represents+selecting data from a database, and composing multiple queries together.++-}+module Opaleye.QueryArr (QueryArr, Query) where++import           Opaleye.Internal.QueryArr (QueryArr, Query)
+ Opaleye/RunQuery.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE FlexibleContexts #-}++module Opaleye.RunQuery (module Opaleye.RunQuery,+                         QueryRunner,+                         IRQ.QueryRunnerColumn) where++import qualified Database.PostgreSQL.Simple as PGS+import qualified Data.String as String++-- It seems that we need the import of unsafeCoerce for Haddock+import           Opaleye.Column (Column, unsafeCoerce)+import qualified Opaleye.Sql as S+import           Opaleye.QueryArr (Query)+import           Opaleye.Internal.RunQuery (QueryRunner(QueryRunner))+import qualified Opaleye.Internal.RunQuery as IRQ++import qualified Data.Profunctor as P+import qualified Data.Profunctor.Product.Default as D++runQuery :: D.Default QueryRunner columns haskells+         => PGS.Connection+         -> Query columns+         -> IO [haskells]+runQuery = runQueryExplicit D.def++runQueryExplicit :: QueryRunner columns haskells+                 -> PGS.Connection+                 -> Query columns+                 -> IO [haskells]+runQueryExplicit (QueryRunner u rowParser) conn q =+  PGS.queryWith_ rowParser conn sql+  where sql :: PGS.Query+        sql = String.fromString (S.showSqlForPostgresExplicit u q)++-- | Use 'queryRunnerColumn' to make an instance to allow you to run queries on+--   your own datatypes.  For example:+--+-- @+-- newtype Foo = Foo Int+-- instance Default QueryRunnerColumn Foo Foo where+--    def = queryRunnerColumn ('unsafeCoerce' :: Column Foo -> Column Int) Foo def+-- @+queryRunnerColumn :: (Column a' -> Column a) -> (b -> b')+                  -> IRQ.QueryRunnerColumn a b -> IRQ.QueryRunnerColumn a' b'+queryRunnerColumn colF haskellF qrc = IRQ.QueryRunnerColumn (P.lmap colF u)+                                                            (fmapFP haskellF fp)+  where IRQ.QueryRunnerColumn u fp = qrc+        fmapFP = fmap . fmap . fmap
+ Opaleye/Sql.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}++module Opaleye.Sql where++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++import qualified Opaleye.Internal.Unpackspec as U+import qualified Opaleye.Internal.Sql as Sql+import qualified Opaleye.Internal.Print as Pr+import qualified Opaleye.Internal.PrimQuery as PQ+import qualified Opaleye.Internal.Optimize as Op+import           Opaleye.Internal.Helpers ((.:))+import qualified Opaleye.Internal.QueryArr as Q++import qualified Data.Profunctor.Product.Default as D++import qualified Control.Arrow as Arr++showSqlForPostgres :: forall columns . D.Default U.Unpackspec columns columns =>+                      Q.Query columns -> String+showSqlForPostgres = showSqlForPostgresExplicit (D.def :: U.Unpackspec columns columns)++showSqlForPostgresUnopt :: forall columns . D.Default U.Unpackspec columns columns =>+                           Q.Query columns -> String+showSqlForPostgresUnopt = showSqlForPostgresUnoptExplicit (D.def :: U.Unpackspec columns columns)++showSqlForPostgresExplicit :: U.Unpackspec columns b -> Q.Query columns -> String+showSqlForPostgresExplicit = formatAndShowSQL+                             . Arr.first Op.optimize+                             .: Q.runQueryArrUnpack++showSqlForPostgresUnoptExplicit :: U.Unpackspec columns b -> Q.Query columns -> String+showSqlForPostgresUnoptExplicit = formatAndShowSQL .: Q.runQueryArrUnpack++formatAndShowSQL :: (PQ.PrimQuery, [HPQ.PrimExpr]) -> String+formatAndShowSQL = show . Pr.ppSql . Sql.sql
+ Opaleye/Table.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE FlexibleContexts #-}++module Opaleye.Table (module Opaleye.Table,+                      View,+                      Writer,+                      Table(Table),+                      TableProperties) where++import           Opaleye.Internal.Column (Column(Column))+import qualified Opaleye.Internal.QueryArr as Q+import qualified Opaleye.Internal.Table as T+import           Opaleye.Internal.Table (View(View), Writer(Writer),+                                         Table, TableProperties)+import qualified Opaleye.Internal.TableMaker as TM+import qualified Opaleye.Internal.Tag as Tag+import qualified Opaleye.Internal.PackMap as PM++import qualified Data.Profunctor.Product.Default as D+import           Control.Applicative (Applicative, pure)++import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ++queryTable :: D.Default TM.ColumnMaker columns columns =>+              Table a columns -> Q.Query columns+queryTable = queryTableExplicit D.def++queryTableExplicit :: TM.ColumnMaker tablecolumns columns ->+                     Table a tablecolumns -> Q.Query columns+queryTableExplicit cm table = Q.simpleQueryArr f where+  f ((), t0) = (retwires, primQ, Tag.next t0) where+    (retwires, primQ) = T.queryTable cm table t0++required :: String -> TableProperties (Column a) (Column a)+required columnName = T.TableProperties+  (Writer (PM.PackMap (\f (Column primExpr) -> f (primExpr, columnName))))+  (View (Column (HPQ.AttrExpr columnName)))++optional :: String -> TableProperties (Maybe (Column a)) (Column a)+optional columnName = T.TableProperties+  (Writer (PM.PackMap (\f c -> case c of+                          Nothing -> pure ()+                          Just (Column primExpr) -> f (primExpr, columnName))))+  (View (Column (HPQ.AttrExpr columnName)))
+ Opaleye/Values.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE FlexibleContexts #-}++module Opaleye.Values where++import qualified Opaleye.Internal.QueryArr as Q+import           Opaleye.QueryArr (Query)+import           Opaleye.Internal.Values as V+import qualified Opaleye.Internal.Unpackspec as U++import           Data.Profunctor.Product.Default (Default, def)++values :: (Default V.Valuesspec columns columns,+           Default U.Unpackspec columns columns) =>+          [columns] -> Q.Query columns+values = valuesExplicit def def++valuesExplicit :: U.Unpackspec columns columns'+               -> V.Valuesspec columns columns'+               -> [columns] -> Query columns'+valuesExplicit unpack valuesspec columns =+  Q.simpleQueryArr (V.valuesU unpack valuesspec columns)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Test.hs view
@@ -0,0 +1,504 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE FlexibleContexts #-}++module Main where++import qualified Opaleye.Table as T+import           Opaleye.Column (Column, Nullable)+import qualified Opaleye.Column as C+import           Opaleye.Operators ((.==), (.>))+import qualified Opaleye.Operators as O+import           Opaleye.QueryArr (Query, QueryArr)+import qualified Opaleye.RunQuery as RQ+import qualified Opaleye.Order as Order+import qualified Opaleye.Distinct as Dis+import qualified Opaleye.Aggregate as Agg+import qualified Opaleye.Join as J+import qualified Opaleye.Values as V+import qualified Opaleye.Binary as B+import qualified Opaleye.Manipulation as M++import qualified Database.PostgreSQL.Simple as PGS+import qualified Data.Profunctor.Product.Default as D+import qualified Data.Profunctor.Product as PP+import qualified Data.Profunctor as P+import qualified Data.Ord as Ord+import qualified Data.List as L+import           Data.Monoid ((<>))+import qualified Data.String as String++import qualified System.Exit as Exit++import qualified Control.Applicative as A+import qualified Control.Arrow as Arr+import           Control.Arrow ((&&&), (***), (<<<), (>>>))++import           GHC.Int (Int64)++-- { Set your test database info here.  Then invoke the 'main'+--   function to run the tests, or just use 'cabal test'.  The test+--   database must already exist and the test user must have+--   permissions to modify it.++connectInfo :: PGS.ConnectInfo+connectInfo =  PGS.ConnectInfo { PGS.connectHost = "localhost"+                               , PGS.connectPort = 25433+                               , PGS.connectUser = "tom"+                               , PGS.connectPassword = "tom"+                               , PGS.connectDatabase = "opaleye_test" }++-- }++{-++Status+======++The tests here are very superficial and pretty much the bare mininmum+that needs to be tested.+++Future+======++The overall approach to testing should probably go as follows.++1. Test all individual units of functionality by running them on a+   table and checking that they produce the expected result.  This type+   of testing is amenable to the QuickCheck approach if we reimplement+   the individual units of functionality in Haskell.++2. Test that "the denotation is an arrow morphism" is correct.  I+   think in combination with 1. this is all that will be required to+   demonstrate that the library is correct.++   "The denotation is an arrow morphism" means that for each arrow+   operation, the denotation preserves the operation.  If we have++       f :: QueryArr wiresa wiresb++   then [f] should be something like++       [f] :: a -> IO [b]+       f as = runQuery (toValues as >>> f)++   For example, take the operation >>>.  We need to check that++       [f >>> g] = [f] >>> [g]++   for all f and g, where [] means the denotation.  We would also want+   to check that++       [id] = id++   and++       [first f] = first [f]++   I think checking these operations is sufficient because all the+   other QueryArr operations are implemented in terms of them.++   (Here I'm taking a slight liberty as `a -> IO [b]` is not directly+   an arrow, but it could be made one straightforwardly.  (For the laws+   to be satisfied, perhaps we have to assume that the IO actions+   commute.))++   I don't think this type of testing is amenable to QuickCheck.  It+   seems we have to check the properties for arbitrary arrows indexed by+   arbitrary types.  I don't think QuickCheck supports this sort of+   randomised testing.++Note+----++This seems to be equivalent to just reimplementing Opaleye in+Haskell-side terms and comparing the results of queries run in both+ways.++-}++twoIntTable :: String+            -> T.Table (Column Int, Column Int) (Column Int, Column Int)+twoIntTable n = T.Table n (PP.p2 (T.required "column1", T.required "column2"))++table1 :: T.Table (Column Int, Column Int) (Column Int, Column Int)+table1 = twoIntTable "table1"++table1F :: T.Table (Column Int, Column Int) (Column Int, Column Int)+table1F = fmap (\(col1, col2) -> (col1 + col2, col1 - col2)) table1++table2 :: T.Table (Column Int, Column Int) (Column Int, Column Int)+table2 = twoIntTable "table2"++table3 :: T.Table (Column Int, Column Int) (Column Int, Column Int)+table3 = twoIntTable "table3"++table4 :: T.Table (Column Int, Column Int) (Column Int, Column Int)+table4 = twoIntTable "table4"++table1Q :: Query (Column Int, Column Int)+table1Q = T.queryTable table1++table2Q :: Query (Column Int, Column Int)+table2Q = T.queryTable table2++table3Q :: Query (Column Int, Column Int)+table3Q = T.queryTable table3++table1dataG :: Num a => [(a, a)]+table1dataG = [ (1, 100)+              , (1, 100)+              , (1, 200)+              , (2, 300) ]++table1data :: [(Int, Int)]+table1data = table1dataG++table1columndata :: [(Column Int, Column Int)]+table1columndata = table1dataG++table2dataG :: Num a => [(a, a)]+table2dataG = [ (1, 100)+              , (3, 400) ]++table2data :: [(Int, Int)]+table2data = table2dataG++table2columndata :: [(Column Int, Column Int)]+table2columndata = table2dataG++table3dataG :: Num a => [(a, a)]+table3dataG = [ (1, 50) ]++table3data :: [(Int, Int)]+table3data = table3dataG++table3columndata :: [(Column Int, Column Int)]+table3columndata = table3dataG++table4dataG :: Num a => [(a, a)]+table4dataG = [ (1, 10)+              , (2, 20) ]++table4data :: [(Int, Int)]+table4data = table4dataG++table4columndata :: [(Column Int, Column Int)]+table4columndata = table4dataG++dropAndCreateTable :: String -> PGS.Query+dropAndCreateTable t = String.fromString ("DROP TABLE IF EXISTS " ++ t ++ ";"+                                          ++ "CREATE TABLE " ++ t+                                          ++ " (column1 integer, column2 integer);")++dropAndCreateDB :: PGS.Connection -> IO ()+dropAndCreateDB conn = mapM_ execute ["table1", "table2", "table3", "table4"]+  where execute = PGS.execute_ conn . dropAndCreateTable++type Test = PGS.Connection -> IO Bool++testG :: D.Default RQ.QueryRunner wires haskells =>+         Query wires+         -> ([haskells] -> b)+         -> PGS.Connection+         -> IO b+testG q p conn = do+  result <- RQ.runQuery conn q+  return (p result)++testSelect :: Test+testSelect = testG table1Q+             (\r -> L.sort table1data == L.sort r)++testProduct :: Test+testProduct = testG query+                 (\r -> L.sort (A.liftA2 (,) table1data table2data) == L.sort r)+  where query = table1Q &&& table2Q++testRestrict :: Test+testRestrict = testG query+               (\r -> filter ((== 1) . fst) (L.sort table1data) == L.sort r)+  where query = proc () -> do+          t <- table1Q -< ()+          O.restrict -< fst t .== 1+          Arr.returnA -< t++testNum :: Test+testNum = testG query expected+  where query :: Query (Column Int)+        query = proc () -> do+          t <- table1Q -< ()+          Arr.returnA -< op t+        expected = \r -> L.sort (map op table1data) == L.sort r+        op :: Num a => (a, a) -> a+        op (x, y) = abs (x - 5) * signum (x - 4) * (y * y + 1)++testDiv :: Test+testDiv = testG query expected+  where query :: Query (Column Double)+        query = proc () -> do+          t <- Arr.arr (O.doubleOfInt *** O.doubleOfInt) <<< table1Q -< ()+          Arr.returnA -< op t+        expected r = L.sort (map (op . toDoubles) table1data) == L.sort r+        op :: Fractional a => (a, a) -> a+        -- Choosing 0.5 here as it should be exactly representable in+        -- floating point+        op (x, y) = y / x * 0.5+        toDoubles :: (Int, Int) -> (Double, Double)+        toDoubles = fromIntegral *** fromIntegral++-- TODO: need to implement and test case_ returning tuples+testCase :: Test+testCase = testG q (== expected)+  where q :: Query (Column Int)+        q = table1Q >>> proc (i, j) -> do+          Arr.returnA -< O.case_ [(j .== 100, 12), (i .== 1, 21)] 33+        expected :: [Int]+        expected = [12, 12, 21, 33]++testDistinct :: Test+testDistinct = testG (Dis.distinct table1Q)+               (\r -> L.sort (L.nub table1data) == L.sort r)++-- FIXME: the unsafeCoerce is currently needed because the type+-- changes required for aggregation are not currently dealt with by+-- Opaleye.+aggregateCoerceFIXME :: QueryArr (Column Int) (Column Int64)+aggregateCoerceFIXME = Arr.arr aggregateCoerceFIXME'++aggregateCoerceFIXME' :: Column a -> Column Int64+aggregateCoerceFIXME' = C.unsafeCoerce++testAggregate :: Test+testAggregate = testG (Arr.second aggregateCoerceFIXME+                        <<< Agg.aggregate (PP.p2 (Agg.groupBy, Agg.sum))+                                           table1Q)+                      (\r -> [(1, 400) :: (Int, Int64), (2, 300)] == L.sort r)++testAggregateProfunctor :: Test+testAggregateProfunctor = testG q expected+  where q = Agg.aggregate (PP.p2 (Agg.groupBy, countsum)) table1Q+        expected r = [(1, 1200) :: (Int, Int64), (2, 300)] == L.sort r+        countsum = P.dimap (\x -> (x,x))+                           (\(x, y) -> aggregateCoerceFIXME' x * y)+                           (PP.p2 (Agg.sum, Agg.count))++testOrderByG :: Order.Order (Column Int, Column Int)+                -> ((Int, Int) -> (Int, Int) -> Ordering)+                -> Test+testOrderByG orderQ order = testG (Order.orderBy orderQ table1Q)+                                  (L.sortBy order table1data ==)++testOrderBy :: Test+testOrderBy = testOrderByG (Order.desc snd)+                           (flip (Ord.comparing snd))++testOrderBy2 :: Test+testOrderBy2 = testOrderByG (Order.desc fst <> Order.asc snd)+                            (flip (Ord.comparing fst) <> Ord.comparing snd)++testOrderBySame :: Test+testOrderBySame = testOrderByG (Order.desc fst <> Order.asc fst)+                               (flip (Ord.comparing fst) <> Ord.comparing fst)++testLOG :: (Query (Column Int, Column Int) -> Query (Column Int, Column Int))+           -> ([(Int, Int)] -> [(Int, Int)]) -> Test+testLOG olQ ol = testG (olQ (orderQ table1Q))+                       (ol (order table1data) ==)+  where orderQ = Order.orderBy (Order.desc snd)+        order = L.sortBy (flip (Ord.comparing snd))++testLimit :: Test+testLimit = testLOG (Order.limit 2) (take 2)++testOffset :: Test+testOffset = testLOG (Order.offset 2) (drop 2)++testLimitOffset :: Test+testLimitOffset = testLOG (Order.limit 2 . Order.offset 2) (take 2 . drop 2)++testOffsetLimit :: Test+testOffsetLimit = testLOG (Order.offset 2 . Order.limit 2) (drop 2 . take 2)++testDistinctAndAggregate :: Test+testDistinctAndAggregate = testG q expected+  where q = Dis.distinct table1Q+            &&& (Arr.second aggregateCoerceFIXME+                 <<< Agg.aggregate (PP.p2 (Agg.groupBy, Agg.sum)) table1Q)+        expected r = L.sort r == L.sort expectedResult+        expectedResult = A.liftA2 (,) (L.nub table1data)+                                      [(1 :: Int, 400 :: Int64), (2, 300)]++one :: Query (Column Int)+one = Arr.arr (const (1 :: Column Int))++-- The point of the "double" tests is to ensure that we do not+-- introduce name clashes in the operations which create new column names+testDoubleG :: (Eq haskells, D.Default RQ.QueryRunner columns haskells) =>+               (QueryArr () (Column Int) -> QueryArr () columns) -> [haskells]+               -> Test+testDoubleG q expected1 = testG (q one &&& q one) (== expected2)+  where expected2 = A.liftA2 (,) expected1 expected1++testDoubleDistinct :: Test+testDoubleDistinct = testDoubleG Dis.distinct [1 :: Int]++testDoubleAggregate :: Test+testDoubleAggregate = testDoubleG (Agg.aggregate Agg.count) [1 :: Int64]++testDoubleLeftJoin :: Test+testDoubleLeftJoin = testDoubleG lj [(1 :: Int, Just (1 :: Int))]+  where lj :: Query (Column Int)+          -> Query (Column Int, Column (Nullable Int))+        lj q = J.leftJoin q q (uncurry (.==))++testDoubleValues :: Test+testDoubleValues = testDoubleG v [1 :: Int]+  where v :: Query (Column Int) -> Query (Column Int)+        v _ = V.values [1]++testDoubleUnionAll :: Test+testDoubleUnionAll = testDoubleG u [1 :: Int, 1]+  where u q = q `B.unionAll` q++aLeftJoin :: Query ((Column Int, Column Int),+                    (Column (Nullable Int), Column (Nullable Int)))+aLeftJoin = J.leftJoin table1Q table3Q (\(l, r) -> fst l .== fst r)++testLeftJoin :: Test+testLeftJoin = testG aLeftJoin (== expected)+  where expected :: [((Int, Int), (Maybe Int, Maybe Int))]+        expected = [ ((1, 100), (Just 1, Just 50))+                   , ((1, 100), (Just 1, Just 50))+                   , ((1, 200), (Just 1, Just 50))+                   , ((2, 300), (Nothing, Nothing)) ]++testLeftJoinNullable :: Test+testLeftJoinNullable = testG q (== expected)+  where q :: Query ((Column Int, Column Int),+                    ((Column (Nullable Int), Column (Nullable Int)),+                     (Column (Nullable Int),+                      Column (Nullable Int))))+        q = J.leftJoin table3Q aLeftJoin cond++        cond (x, y) = fst x .== fst (fst y)++        expected :: [((Int, Int), ((Maybe Int, Maybe Int), (Maybe Int, Maybe Int)))]+        expected = [ ((1, 50), ((Just 1, Just 100), (Just 1, Just 50)))+                   , ((1, 50), ((Just 1, Just 100), (Just 1, Just 50)))+                   , ((1, 50), ((Just 1, Just 200), (Just 1, Just 50))) ]++testThreeWayProduct :: Test+testThreeWayProduct = testG q (== expected)+  where q = A.liftA3 (,,) table1Q table2Q table3Q+        expected = A.liftA3 (,,) table1data table2data table3data++testValues :: Test+testValues = testG (V.values values) (values' ==)+  where values :: [(Column Int, Column Int)]+        values = [ (1, 10)+                 , (2, 100) ]+        values' :: [(Int, Int)]+        values' = [ (1, 10)+                  , (2, 100) ]++{- FIXME: does not yet work+testValuesDouble :: Test+testValuesDouble = testG (V.values values) (values' ==)+  where values :: [(Column Int, Column Double)]+        values = [ (1, 10.0)+                 , (2, 100.0) ]+        values' :: [(Int, Double)]+        values' = [ (1, 10.0)+                  , (2, 100.0) ]+-}++testValuesEmpty :: Test+testValuesEmpty = testG (V.values values) (values' ==)+  where values :: [Column Int]+        values = []+        values' :: [Int]+        values' = []++testUnionAll :: Test+testUnionAll = testG (table1Q `B.unionAll` table2Q)+                     (\r -> L.sort (table1data ++ table2data) == L.sort r)++testTableFunctor :: Test+testTableFunctor = testG (T.queryTable table1F) (result ==)+  where result = fmap (\(col1, col2) -> (col1 + col2, col1 - col2)) table1data++-- TODO: This is getting too complicated+testUpdate :: Test+testUpdate conn = do+  _ <- M.runUpdate conn table4 update cond+  result <- runQueryTable4++  if result /= expected+    then return False+    else do+    _ <- M.runDelete conn table4 condD+    resultD <- runQueryTable4++    if resultD /= expectedD+      then return False+      else do+      returned <- M.runInsertReturning conn table4 insertT returning+      resultI <- runQueryTable4++      return ((resultI == expectedI) && (returned == expectedR))++  where update (x, y) = (x + y, x - y)+        cond (_, y) = y .> 15+        condD (x, _) = x .> 20+        expected :: [(Int, Int)]+        expected = [ (1, 10)+                   , (22, -18)]+        expectedD :: [(Int, Int)]+        expectedD = [(1, 10)]+        runQueryTable4 = RQ.runQuery conn (T.queryTable table4)++        insertT :: (Column Int, Column Int)+        insertT = (1, 2)++        expectedI :: [(Int, Int)]+        expectedI = [(1, 10), (1, 2)]+        returning (x, y) = x - y+        expectedR :: [Int]+        expectedR = [-1]+++allTests :: [Test]+allTests = [testSelect, testProduct, testRestrict, testNum, testDiv, testCase,+            testDistinct, testAggregate, testAggregateProfunctor,+            testOrderBy, testOrderBy2, testOrderBySame, testLimit, testOffset,+            testLimitOffset, testOffsetLimit, testDistinctAndAggregate,+            testDoubleDistinct, testDoubleAggregate, testDoubleLeftJoin,+            testDoubleValues, testDoubleUnionAll,+            testLeftJoin, testLeftJoinNullable, testThreeWayProduct, testValues,+            testValuesEmpty, testUnionAll, testTableFunctor, testUpdate+           ]++main :: IO ()+main = do+  conn <- PGS.connect connectInfo++  dropAndCreateDB conn++  let insert (writeable, columndata) =+        mapM_ (M.runInsert conn writeable) columndata++  mapM_ insert [ (table1, table1columndata)+               , (table2, table2columndata)+               , (table3, table3columndata)+               , (table4, table4columndata) ]++  results <- mapM ($ conn) allTests++  print results++  let passed = and results++  putStrLn (if passed then "All passed" else "Failure")+  Exit.exitWith (if passed then Exit.ExitSuccess+                           else Exit.ExitFailure 1)
+ opaleye.cabal view
@@ -0,0 +1,98 @@+name:          opaleye+version:       0.2+synopsis:      An SQL-generating DSL targeting PostgreSQL+description:   An SQL-generating DSL targeting PostgreSQL.  Allows+               Postgres queries to be written within Haskell in a+               typesafe and composable fashion.+homepage:      https://github.com/tomjaguarpaw/haskell-opaleye+license:       BSD3+license-File:  LICENSE+author:        Purely Agile+maintainer:    Purely Agile+category:      Database+build-type:    Simple+cabal-version: >= 1.8++source-repository head+  Type:     git+  Location: https://github.com/tomjaguarpaw/haskell-opaleye++library+  build-depends:+      base                >= 4       && < 5+    , contravariant       >= 0.4.4   && < 1.3+    , old-locale          >= 1.0     && < 1.1+    , postgresql-simple   >= 0.3     && < 0.5+    , pretty              >= 1.1.1.0 && < 1.2+    , product-profunctors >= 0.5     && < 0.6+    , profunctors         >= 4.0     && < 4.3+    , semigroups          >= 0.13    && < 0.16+    , text                >= 0.11    && < 1.2+    , transformers        >= 0.3     && < 0.4+    , time                >= 1.4     && < 1.5+    , uuid                >= 1.3     && < 1.4+  exposed-modules: Opaleye.Aggregate,+                   Opaleye.Binary,+                   Opaleye.Column,+                   Opaleye.Distinct,+                   Opaleye.Join,+                   Opaleye.Manipulation,+                   Opaleye.Operators,+                   Opaleye.Order,+                   Opaleye.PGTypes,+                   Opaleye.QueryArr,+                   Opaleye.RunQuery,+                   Opaleye.Sql,+                   Opaleye.Table,+                   Opaleye.Values,+                   Opaleye.Internal.Aggregate,+                   Opaleye.Internal.Binary,+                   Opaleye.Internal.Column,+                   Opaleye.Internal.Distinct,+                   Opaleye.Internal.Helpers,+                   Opaleye.Internal.Join,+                   Opaleye.Internal.Order,+                   Opaleye.Internal.Optimize,+                   Opaleye.Internal.PackMap,+                   Opaleye.Internal.PrimQuery,+                   Opaleye.Internal.Print,+                   Opaleye.Internal.QueryArr,+                   Opaleye.Internal.RunQuery,+                   Opaleye.Internal.Sql,+                   Opaleye.Internal.Table,+                   Opaleye.Internal.TableMaker,+                   Opaleye.Internal.Tag,+                   Opaleye.Internal.Unpackspec,+                   Opaleye.Internal.Values+                   Opaleye.Internal.HaskellDB.PrimQuery,+                   Opaleye.Internal.HaskellDB.Query,+                   Opaleye.Internal.HaskellDB.Sql,+                   Opaleye.Internal.HaskellDB.Sql.Default,+                   Opaleye.Internal.HaskellDB.Sql.Generate,+                   Opaleye.Internal.HaskellDB.Sql.Print+  ghc-options:     -Wall++test-suite test+  type: exitcode-stdio-1.0+  main-is: Test.hs+  hs-source-dirs: Test+  build-depends:+    base >= 4 && < 5,+    postgresql-simple,+    profunctors,+    product-profunctors,+    opaleye+  ghc-options: -Wall++test-suite tutorial+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: Doc/Tutorial+  build-depends:+    base >= 4 && < 5,+    postgresql-simple,+    profunctors,+    product-profunctors,+    time,+    opaleye+  ghc-options: -Wall