Remove EOrderBy, EDistinctOn; Change PreprocessedFrom a to just be an independent datatype

src/Database/Esqueleto/Internal/Internal.hs

@@ -84,35 +84,35 @@ fromStart
     ( PersistEntity a
     , BackendCompatible SqlBackend (PersistEntityBackend a)
     )
-    => SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Entity a))))
+    => SqlQuery (PreprocessedFrom (SqlExpr (Entity a)))
 fromStart = do
     let ed = entityDef (Proxy :: Proxy a)
     ident <- newIdentFor (entityDB ed)
     let ret = unsafeSqlEntity ident 
         f' = FromStart ident ed
-    return (EPreprocessedFrom ret f')
+    return (PreprocessedFrom ret f')
 
 -- | (Internal) Same as 'fromStart', but entity may be missing.
 fromStartMaybe
     :: ( PersistEntity a
        , BackendCompatible SqlBackend (PersistEntityBackend a)
        )
-    => SqlQuery (SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a)))))
+    => SqlQuery (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
 fromStartMaybe = maybelize <$> fromStart
   where
     maybelize
-        :: SqlExpr (PreprocessedFrom (SqlExpr (Entity a)))
+        :: PreprocessedFrom (SqlExpr (Entity a))
-        -> SqlExpr (PreprocessedFrom (SqlExpr (Maybe (Entity a))))
+        -> PreprocessedFrom (SqlExpr (Maybe (Entity a)))
-    maybelize (EPreprocessedFrom (ERaw m f) f') = EPreprocessedFrom (ERaw m f) f'
+    maybelize (PreprocessedFrom (ERaw m f) f') = PreprocessedFrom (ERaw m f) f'
 
 -- | (Internal) Do a @JOIN@.
 fromJoin
     :: IsJoinKind join
-    => SqlExpr (PreprocessedFrom a)
+    => PreprocessedFrom a
-    -> SqlExpr (PreprocessedFrom b)
+    -> PreprocessedFrom b
-    -> SqlQuery (SqlExpr (PreprocessedFrom (join a b)))
+    -> SqlQuery (PreprocessedFrom (join a b))
-fromJoin (EPreprocessedFrom lhsRet lhsFrom)
+fromJoin (PreprocessedFrom lhsRet lhsFrom)
-         (EPreprocessedFrom rhsRet rhsFrom) = Q $ do
+         (PreprocessedFrom rhsRet rhsFrom) = Q $ do
     let ret = smartJoin lhsRet rhsRet
         from' =
             FromJoin
@@ -120,13 +120,13 @@ fromJoin (EPreprocessedFrom lhsRet lhsFrom)
                 (reifyJoinKind ret) -- JOIN
                 rhsFrom             -- RHS
                 Nothing             -- ON
-    return (EPreprocessedFrom ret from')
+    return (PreprocessedFrom ret from')
 
 -- | (Internal) Finish a @JOIN@.
 fromFinish
-  :: SqlExpr (PreprocessedFrom a)
+  :: PreprocessedFrom a
   -> SqlQuery a
-fromFinish (EPreprocessedFrom ret f') = Q $ do
+fromFinish (PreprocessedFrom ret f') = Q $ do
     W.tell mempty { sdFromClause = [f'] }
     return ret
 
@@ -250,11 +250,22 @@ orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs }
 
 -- | Ascending order of this field or SqlExpression.
 asc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
-asc = EOrderBy ASC 
+asc = orderByExpr " ASC"
 
 -- | Descending order of this field or SqlExpression.
 desc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
-desc = EOrderBy DESC
+desc = orderByExpr " DESC" 
+
+orderByExpr :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr OrderBy
+orderByExpr orderByType (ERaw m f)
+  | Just fields <- sqlExprMetaCompositeFields m =
+        ERaw noMeta $ \_ info ->
+            let fs = fields info
+                vals = repeat []
+            in uncommas' $ zip (map (<> orderByType) fs) vals
+  | otherwise =
+      ERaw noMeta $ \_ info ->
+          first (<> orderByType) $ f Never info
 
 -- | @LIMIT@.  Limit the number of returned rows.
 limit :: Int64 -> SqlQuery ()
@@ -326,7 +337,7 @@ distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs })
 --
 -- @since 2.2.4
 don :: SqlExpr (Value a) -> SqlExpr DistinctOn
-don = EDistinctOn
+don (ERaw m f) = ERaw m f
 
 -- | A convenience function that calls both 'distinctOn' and
 -- 'orderBy'.  In other words,
@@ -352,7 +363,7 @@ distinctOnOrderBy exprs act =
         act
   where
     toDistinctOn :: SqlExpr OrderBy -> SqlExpr DistinctOn
-    toDistinctOn (EOrderBy _ f) = EDistinctOn f
+    toDistinctOn (ERaw m f) = ERaw m f
     toDistinctOn EOrderRandom =
         error "We can't select distinct by a random order!"
 
@@ -1362,9 +1373,6 @@ data OnClauseWithoutMatchingJoinException =
 
 instance Exception OnClauseWithoutMatchingJoinException
 
--- | (Internal) Phantom type used to process 'from' (see 'fromStart').
-data PreprocessedFrom a
-
 -- | Phantom type used by 'orderBy', 'asc' and 'desc'.
 data OrderBy
 
@@ -1606,7 +1614,7 @@ instance
 -- | (Internal) Class that implements the @JOIN@ 'from' magic
 -- (see 'fromStart').
 class FromPreprocess a where
-    fromPreprocess :: SqlQuery (SqlExpr (PreprocessedFrom a))
+    fromPreprocess :: SqlQuery (PreprocessedFrom a)
 
 instance
     (PersistEntity val, BackendCompatible SqlBackend (PersistEntityBackend val))
@@ -1996,34 +2004,7 @@ useIdent :: IdentInfo -> Ident -> TLB.Builder
 useIdent info (I ident) = fromDBName info $ DBName ident
 
 data SqlExprMeta = SqlExprMeta
-    { sqlExprMetaCompositeFields :: Maybe (IdentInfo -> [TLB.Builder])
+    { -- A composite key.
-    , sqlExprMetaAlias :: Maybe Ident
-    , sqlExprMetaIsReference :: Bool
-    } 
-
-noMeta :: SqlExprMeta
-noMeta = SqlExprMeta 
-    { sqlExprMetaCompositeFields = Nothing
-    , sqlExprMetaAlias = Nothing
-    , sqlExprMetaIsReference = False
-    }
-
-hasCompositeKeyMeta :: SqlExprMeta -> Bool
-hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields 
-
--- | An expression on the SQL backend.
---
--- There are many comments describing the constructors of this
--- data type.  However, Haddock doesn't like GADTs, so you'll have to read them by hitting \"Source\".
-data SqlExpr a where
-    -- Raw expression: states whether parenthesis are needed
-    -- around this expression, and takes information about the SQL
-    -- connection (mainly for escaping names) and returns both an
-    -- string ('TLB.Builder') and a list of values to be
-    -- interpolated by the SQL backend.
-    ERaw     :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a 
-
-    -- A composite key.
       --
       -- Persistent uses the same 'PersistList' constructor for both
       -- fields which are (homogeneous) lists of values and the
@@ -2063,25 +2044,44 @@ data SqlExpr a where
       -- used in the context of a composite key.  That's because it's
       -- impossible, e.g., for 'val' to disambiguate between these
       -- uses.
+      sqlExprMetaCompositeFields :: Maybe (IdentInfo -> [TLB.Builder])
+    , sqlExprMetaAlias :: Maybe Ident
+    , sqlExprMetaIsReference :: Bool
+    } 
 
-    -- A 'SqlExpr' accepted only by 'orderBy'.
+noMeta :: SqlExprMeta
-    EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy
+noMeta = SqlExprMeta 
+    { sqlExprMetaCompositeFields = Nothing
+    , sqlExprMetaAlias = Nothing
+    , sqlExprMetaIsReference = False
+    }
+
+hasCompositeKeyMeta :: SqlExprMeta -> Bool
+hasCompositeKeyMeta = Maybe.isJust . sqlExprMetaCompositeFields 
+
+-- | An expression on the SQL backend.
+--
+-- There are many comments describing the constructors of this
+-- data type.  However, Haddock doesn't like GADTs, so you'll have to read them by hitting \"Source\".
+data SqlExpr a where
+    -- Raw expression: states whether parenthesis are needed
+    -- around this expression, and takes information about the SQL
+    -- connection (mainly for escaping names) and returns both an
+    -- string ('TLB.Builder') and a list of values to be
+    -- interpolated by the SQL backend.
+    ERaw     :: SqlExprMeta -> (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a 
 
     EOrderRandom :: SqlExpr OrderBy
 
-    -- A 'SqlExpr' accepted only by 'distinctOn'.
-    EDistinctOn :: SqlExpr (Value a) -> SqlExpr DistinctOn
-
     -- A 'SqlExpr' accepted only by 'set'.
     ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val)
 
-    -- An internal 'SqlExpr' used by the 'from' hack.
-    EPreprocessedFrom :: a -> FromClause -> SqlExpr (PreprocessedFrom a)
-
     -- Used by 'insertSelect'.
     EInsert  :: Proxy a -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a)
     EInsertFinal :: PersistEntity a => SqlExpr (Insertion a) -> SqlExpr InsertFinal
 
+data PreprocessedFrom a = PreprocessedFrom a FromClause
+
 -- | Phantom type used to mark a @INSERT INTO@ query.
 data InsertFinal
 
@@ -2812,7 +2812,7 @@ makeSelect info mode_ distinctClause ret = process mode_
                 first (("SELECT DISTINCT ON (" <>) . (<> ") "))
                 $ uncommas' (processExpr <$> exprs)
       where
-        processExpr (EDistinctOn f) = materializeExpr info f
+        processExpr (ERaw m f) = materializeExpr info (ERaw m f :: SqlExpr (Value a))
     withCols v = v <> sqlSelectCols info ret
     plain    v = (v, [])
 
@@ -2908,16 +2908,7 @@ makeOrderByNoNewline _    [] = mempty
 makeOrderByNoNewline info os = first ("ORDER BY " <>) . uncommas' $ concatMap mk os
   where
     mk :: OrderByClause -> [(TLB.Builder, [PersistValue])]
-    mk (EOrderBy t v) 
+    mk (ERaw _ f) = [f Never info]
-      | ERaw m _ <- v, Just f <- sqlExprMetaCompositeFields m =
-            let fs = f info
-                vals = repeat []
-            in zip (map (<> orderByType t) fs) vals
-      | otherwise =
-        let x =
-                case v of
-                    ERaw _ f -> f Never
-        in [ first (<> orderByType t) $ x info ]
     mk EOrderRandom = [first (<> "RANDOM()") mempty]
 
     orderByType ASC  = " ASC"