A bunch of cleanups (ping @albertov).

src/Database/Esqueleto/Internal/Sql.hs

@@ -31,6 +31,7 @@ module Database.Esqueleto.Internal.Sql
     -- * The guts
   , unsafeSqlCase
   , unsafeSqlBinOp
+  , unsafeSqlBinOpList
   , unsafeSqlValue
   , unsafeSqlFunction
   , unsafeSqlExtractSubField
@@ -341,15 +342,15 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
   sub_select         = sub SELECT
   sub_selectDistinct = sub SELECT_DISTINCT
 
-  (^.) :: forall val typ. (PersistEntity val, PersistField typ) =>
+  (^.) :: forall val typ. (PersistEntity val, PersistField typ)
-          SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
+       => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
   EEntity ident ^. field
-    | isIdField field && hasCompositeKey ed
+    | isComposite = ERawList   $ \info -> (dot info <$> compositeFields pdef,  [])
-    = ERawList $
+    | otherwise   = ERaw Never $ \info -> (dot info  $  persistFieldDef field, [])
-      \info@(conn,_) -> (map (\a -> useIdent info ident <> "." <> TLB.fromText (connEscapeName conn (fieldDB a))) (compositeFields pdef), [])
-    | otherwise = ERaw Never $ \info -> (useIdent info ident <> ("." <> fieldName info field), [])
     where
-      ed = entityDef $ getEntityVal $ (Proxy :: Proxy (SqlExpr (Entity val)))
+      isComposite = isIdField field && hasCompositeKey ed
+      dot info x  = useIdent info ident <> "." <> fromDBName info (fieldDB x)
+      ed          = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val)))
       Just pdef   = entityPrimary ed
 
   EMaybe r ?. field = maybelize (r ^. field)
@@ -358,11 +359,10 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
       maybelize (ERaw p f)   = ERaw p f
       maybelize (ERawList f) = ERawList f
 
-  val v = case v' of
+  val v =
+    case toPersistValue v of
       PersistList vs -> ERawList   $ const (replicate (length vs) "?", vs)
-            _              -> ERaw Never . const . (,) "?" . return $ v'
+      pv             -> ERaw Never $ const ("?", [pv])
-    where v' = toPersistValue v
-    
 
   isNothing (ERaw p f)   = ERaw Parens $ first ((<> " IS NULL") . parensM p) . f
   isNothing (ERawList f) = ERaw Parens $ first (intersperseB " AND " . map (<> " IS NULL")) . f
@@ -381,11 +381,11 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where
   not_ (ERawList _) = unexpectedCompositeKeyError
 
   (==.) = unsafeSqlBinOpList " = " " AND "
+  (!=.) = unsafeSqlBinOpList " != " " OR "
   (>=.) = unsafeSqlBinOp " >= "
   (>.)  = unsafeSqlBinOp " > "
   (<=.) = unsafeSqlBinOp " <= "
   (<.)  = unsafeSqlBinOp " < "
-  (!=.) = unsafeSqlBinOpList " != " " OR "
   (&&.) = unsafeSqlBinOp " AND "
   (||.) = unsafeSqlBinOp " OR "
   (+.)  = unsafeSqlBinOp " + "
@@ -492,7 +492,7 @@ unsafeSqlCase when (ERaw p1 f1) = ERaw Never buildCase
         in ( "CASE" <> b2 <> " ELSE " <> parensM p1 b1 <> " END", vals2 <> vals1)
 
     mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> IdentInfo -> (TLB.Builder, [PersistValue])
-    mapWhen []    _    = error "unsafeSqlCase: empty when_ list."
+    mapWhen []    _    = error "unsafeSqlCase: empty when list."
     mapWhen when' info = foldl (foldHelp info) (mempty, mempty) when'
 
     foldHelp :: IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue])
@@ -526,7 +526,19 @@ unsafeSqlBinOp op (ERaw p1 f1) (ERaw p2 f2) = ERaw Parens f
 unsafeSqlBinOp _ _ _ = unexpectedCompositeKeyError
 {-# INLINE unsafeSqlBinOp #-}
 
+
+-- | Similar to 'unsafeSqlBinOp', but may also be applied to
+-- composite keys.  Uses the operator given as the second
+-- argument whenever applied to composite keys.
+--
+-- Usage example:
+--
+-- @
+-- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool)
+-- (==.) = unsafeSqlBinOpList " = " " AND "
+-- @
 unsafeSqlBinOpList :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c)
+unsafeSqlBinOpList op _ a@(ERaw _ _)    b@(ERaw _ _)  = unsafeSqlBinOp op a b
 unsafeSqlBinOpList op sep (ERawList f1) (ERawList f2) = ERaw Never f
   where
     f info = let (b1, vals1) = f1 info
@@ -534,13 +546,11 @@ unsafeSqlBinOpList op sep (ERawList f1) (ERawList f2) = ERaw Never f
              in ( intersperseB sep . map (\(a,b) -> a <> op <> b) $
                   zip b1 b2
                 , vals1 <> vals2 )
-unsafeSqlBinOpList op _ a@(ERaw _ _) b@(ERaw _ _) = unsafeSqlBinOp op a b
+unsafeSqlBinOpList op sep a b = unsafeSqlBinOpList op sep (promote a) (promote b)
-unsafeSqlBinOpList op sep (ERaw p1 f1) b@(ERawList _) = unsafeSqlBinOpList op sep a b
+  where
-  where a = ERawList $ \info -> let (b1, vals1) = f1 info
+    promote :: SqlExpr (Value d) -> SqlExpr (Value d)
-                                in ([parensM p1  b1], vals1)
+    promote (ERaw p f)     = ERawList $ first (return . parensM p) . f
-unsafeSqlBinOpList op sep a@(ERawList _) (ERaw p2 f2) = unsafeSqlBinOpList op sep a b
+    promote x@(ERawList _) = x
-  where b = ERawList $ \info -> let (b2, vals2) = f2 info
-                                in ([parensM p2  b2], vals2)
 {-# INLINE unsafeSqlBinOpList #-}
 
 -- | (Internal) A raw SQL value.  The same warning from
@@ -954,10 +964,10 @@ unexpectedCompositeKeyError = error "non-id/composite keys not expected here"
 
 makeSet :: IdentInfo -> [SetClause] -> (TLB.Builder, [PersistValue])
 makeSet _    [] = mempty
-makeSet info os = first ("\nSET " <>) . uncommas' . concat . map mk $ os
+makeSet info os = first ("\nSET " <>) . uncommas' $ concatMap mk os
   where
     mk (SetClause (ERaw _ f))   = [f info]
-    mk (SetClause (ERawList _)) = undefined --FIXME
+    mk (SetClause (ERawList _)) = error "esqueleto/makeSet: FIXME"
 
 makeWhere :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])
 makeWhere _    NoWhere              = mempty
@@ -978,7 +988,7 @@ makeHaving _ (Where (ERawList _ )) = unexpectedCompositeKeyError
 
 makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue])
 makeOrderBy _    [] = mempty
-makeOrderBy info os = first ("\nORDER BY " <>) . uncommas' . concat . map mk $ os
+makeOrderBy info os = first ("\nORDER BY " <>) . uncommas' $ concatMap mk os
   where
     mk :: OrderByClause -> [(TLB.Builder, [PersistValue])]
     mk (EOrderBy t (ERaw p f))   = [first ((<> orderByType t) . parensM p) (f info)]
@@ -1055,9 +1065,9 @@ instance SqlSelect () () where
 instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where
   sqlSelectCols info expr@(EEntity ident) = ret
       where
-        conn = fst info
+        process ed = uncommas $
-        process ed = uncommas . map ((name <>) . TLB.fromText) $
+                     map ((name <>) . TLB.fromText) $
-                     entityColumnNames ed conn
+                     entityColumnNames ed (fst info)
         -- 'name' is the biggest difference between 'RawSql' and
         -- 'SqlSelect'.  We automatically create names for tables
         -- (since it's not the user who's writing the FROM