Update Projectable type class and specify associativity of

binary operators.

relational-join/src/Database/Relational/Query.hs

@@ -17,8 +17,7 @@ import Database.Relational.Query.AliasId (Qualified)
 import Database.Relational.Query.Expr
 import Database.Relational.Query.Sub (SubQuery, unitSQL, width, queryWidth)
 import Database.Relational.Query.Projection
-  (Projectable((!)), ProjectableMaybe((!?)),
-   SqlProjectable (unsafeSqlValue),
+  (Projectable (project), SqlProjectable (unsafeSqlValue),
    value, valueTrue, valueFalse, valueNull, placeholder)
 import Database.Relational.Query.Relation (Relation)
 import Database.Relational.Query.Join

relational-join/src/Database/Relational/Query/Join.hs

@@ -5,7 +5,7 @@ module Database.Relational.Query.Join (
   on, wheres,
   table,
 
-  record, expr, compose, (>*<), relation,
+  record, expr, compose, (>*<), (!), (!?), relation,
 
   inner, outer, from,
 
@@ -16,6 +16,8 @@ import Prelude hiding (product)
 import Control.Monad (liftM, ap)
 import Control.Applicative (Applicative (pure, (<*>)))
 
+import Database.Record.Persistable (PersistableWidth)
+
 import Database.Relational.Query.AliasId.Unsafe (primAlias)
 import Database.Relational.Query.AliasId (AliasId, newAliasId, Qualified)
 import qualified Database.Relational.Query.AliasId as AliasId
@@ -30,9 +32,11 @@ import Database.Relational.Query.Product
   (QueryProduct, JoinAttr(Inner, Outer), growProduct, restrictProduct)
 import qualified Database.Relational.Query.Product as Product
 
-import Database.Relational.Query.Projection (Projection)
+import Database.Relational.Query.Projection (Projection, Projectable(project))
 import qualified Database.Relational.Query.Projection as Projection
 
+import Database.Relational.Query.Pi (Pi)
+
 import Database.Relational.Query.Relation (Relation, finalizeRelation)
 import qualified Database.Relational.Query.Relation as Relation
 
@@ -108,6 +112,14 @@ compose =  Projection.compose
 (>*<) :: Projection a -> Projection b -> Projection (a, b)
 (>*<) =  compose
 
+(!) :: (PersistableWidth b, Projectable p) => Projection a -> Pi a b -> p b
+p ! pi' = project $ Projection.pi p pi'
+
+(!?) :: (PersistableWidth b, Projectable p) => Projection (Maybe a) -> Pi a b -> p (Maybe b)
+p !? pi' = project $ Projection.piMaybe p pi'
+
+infixl 1 >*<
+
 
 instance Monad QueryJoin where
   return rel  = QueryJoin $ \st  -> (rel, st)

relational-join/src/Database/Relational/Query/Projection.hs

@@ -9,7 +9,7 @@ module Database.Relational.Query.Projection (
 
   toExpr,
 
-  Projectable ((!)), ProjectableMaybe ((!?)),
+  pi, piMaybe, Projectable (project),
 
   value,
 
@@ -19,7 +19,7 @@ module Database.Relational.Query.Projection (
   valueNull, placeholder
   ) where
 
-import Prelude hiding ((!!))
+import Prelude hiding ((!!), pi)
 
 import Data.Array (Array, listArray)
 import qualified Data.Array as Array
@@ -102,30 +102,20 @@ unsafeProject pr p pi' =
   . take (runPersistableRecordWidth pr) . drop (Pi.leafIndex pi')
   . columns $ p
 
-project :: PersistableWidth b => Projection a -> Pi a b -> Projection b
-project =  unsafeProject persistableWidth
-
-projectMaybe :: PersistableWidth b => Projection (Maybe a) -> Pi a b -> Projection (Maybe b)
-projectMaybe =  unsafeProject persistableWidth
+pi :: PersistableWidth b => Projection a -> Pi a b -> Projection b
+pi =  unsafeProject persistableWidth
 
+piMaybe :: PersistableWidth b => Projection (Maybe a) -> Pi a b -> Projection (Maybe b)
+piMaybe =  unsafeProject persistableWidth
 
 class Projectable p where
-  (!) :: PersistableWidth b => Projection a -> Pi a b -> p b
+  project :: Projection a -> p a
 
 instance Projectable Projection where
-  (!) = project
+  project = id
 
 instance Projectable Expr where
-  p ! pi' = toExpr $ p `project` pi'
-
-class ProjectableMaybe p where
-  (!?) :: PersistableWidth b => Projection (Maybe a) -> Pi a b -> p (Maybe b)
-
-instance ProjectableMaybe Projection where
-  (!?) = projectMaybe
-
-instance ProjectableMaybe Expr where
-  p !? pi' = toExpr $ p `projectMaybe` pi'
+  project = toExpr
 
 unsafeSqlProjection :: String -> Projection t
 unsafeSqlProjection =  unsafeFromColumns . (:[])

relational-join/src/Database/Relational/Query/TH.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 module Database.Relational.Query.TH (
-  inlineQuery
+  VarName, inlineQuery
   ) where
 
 import Language.Haskell.TH