Merge pull request #9 from foxhound-systems/final-expr

Convert SqlExpr to a final encoding

Author: belevy

src/Database/Esqueleto/Experimental/From.hs

@@ -52,7 +52,7 @@ instance PersistEntity a => From (Table a) where
     runFrom e@Table = do
         let ed = entityDef $ getVal e
         ident <- newIdentFor (entityDB ed)
-        let entity = EEntity ident
+        let entity = unsafeSqlEntity ident
         pure $ (entity, FromStart ident ed)
           where
             getVal ::  Table ent -> Proxy ent

src/Database/Esqueleto/Experimental/ToAlias.hs

@@ -16,20 +16,22 @@ class ToAlias a where
     toAlias :: a -> SqlQuery a
 
 instance ToAlias (SqlExpr (Value a)) where
-    toAlias v@(EAliasedValue _ _) = pure v
-    toAlias v = do
-        ident <- newIdentFor (DBName "v")
-        pure $ EAliasedValue ident v
+    toAlias e@(ERaw m f)
+      | Just _ <- sqlExprMetaAlias m, not (sqlExprMetaIsReference m) = pure e
+      | otherwise = do
+            ident <- newIdentFor (DBName "v")
+            pure $ ERaw noMeta{sqlExprMetaAlias = Just ident} f
 
 instance ToAlias (SqlExpr (Entity a)) where
-    toAlias v@(EAliasedEntityReference _ _) = pure v
-    toAlias v@(EAliasedEntity _ _) = pure v
-    toAlias (EEntity tableIdent) = do
+    toAlias (ERaw m f) = do
        ident <- newIdentFor (DBName "v")
-       pure $ EAliasedEntity ident tableIdent
+       pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
 
 instance ToAlias (SqlExpr (Maybe (Entity a))) where
-    toAlias (EMaybe e) = EMaybe <$> toAlias e
+    -- FIXME: Code duplication because the compiler doesnt like half final encoding
+    toAlias (ERaw m f) = do
+       ident <- newIdentFor (DBName "v")
+       pure $ ERaw m{sqlExprMetaIsReference = False, sqlExprMetaAlias = Just ident} f
 
 instance (ToAlias a, ToAlias b) => ToAlias (a,b) where
     toAlias (a,b) = (,) <$> toAlias a <*> toAlias b

src/Database/Esqueleto/Experimental/ToAliasReference.hs

@@ -1,10 +1,11 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Database.Esqueleto.Experimental.ToAliasReference
     where
 
-import Database.Esqueleto.Experimental.ToAlias
+import Data.Coerce
 import Database.Esqueleto.Internal.Internal hiding (From, from, on)
 import Database.Esqueleto.Internal.PersistentImport
 
@@ -16,18 +17,21 @@ class ToAliasReference a where
     toAliasReference :: Ident -> a -> SqlQuery a
 
 instance ToAliasReference (SqlExpr (Value a)) where
-    toAliasReference aliasSource (EAliasedValue aliasIdent _) = pure $ EValueReference aliasSource (\_ -> aliasIdent)
-    toAliasReference _           v@(ERaw _ _)                 = toAlias v
-    toAliasReference _           v@(ECompositeKey _)          = toAlias v
-    toAliasReference s             (EValueReference _ b)      = pure $ EValueReference s b
+    toAliasReference aliasSource (ERaw m _)
+      | Just alias <- sqlExprMetaAlias m = pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
+          (useIdent info aliasSource <> "." <> useIdent info alias, [])
+    toAliasReference _ e = pure e
 
 instance ToAliasReference (SqlExpr (Entity a)) where
-    toAliasReference aliasSource (EAliasedEntity ident _) = pure $ EAliasedEntityReference aliasSource ident
-    toAliasReference _ e@(EEntity _) = toAlias e
-    toAliasReference s   (EAliasedEntityReference _ b) = pure $ EAliasedEntityReference s b
+    toAliasReference aliasSource (ERaw m _)
+      | Just _ <- sqlExprMetaAlias m, False <- sqlExprMetaIsReference m =
+          pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
+            (useIdent info aliasSource, [])
+    toAliasReference _ e = pure e
 
 instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
-    toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s e
+    toAliasReference aliasSource e =
+        coerce <$> toAliasReference aliasSource (coerce e :: SqlExpr (Entity a))
 
 
 instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where

src/Database/Esqueleto/Experimental/ToMaybe.hs

@@ -21,7 +21,7 @@ instance ToMaybe (SqlExpr (Maybe a)) where
 
 instance ToMaybe (SqlExpr (Entity a)) where
     type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))
-    toMaybe = EMaybe
+    toMaybe (ERaw f m) = (ERaw f m)
 
 instance ToMaybe (SqlExpr (Value a)) where
     type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a)))