esqueleto 3.5.6.1 → 3.5.7.0

raw patch · 4 files changed

+132/−4 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +8/−1
• esqueleto.cabal +1/−1
• src/Database/Esqueleto/Record.hs +94/−2
• test/Common/Record.hs +29/−0

@@ -1,4 +1,11 @@-3.5.6.1+3.5.7.0+=======+- @ivanbakel+    - [#329](https://github.com/bitemyapp/esqueleto/pull/329)+        - Add `ToAlias` and `ToAliasReference` instances to the type produced+          by `deriveEsqueletoRecord`, allowing in-SQL records to be used in+          CTEs+ ======= - @9999years     - [#324](https://github.com/bitemyapp/esqueleto/pull/324)

@@ -2,7 +2,7 @@  name:           esqueleto -version:        3.5.6.1+version:        3.5.7.0 synopsis:       Type-safe EDSL for SQL queries on persistent backends. description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.                 .

@@ -15,6 +15,8 @@ import Data.Proxy (Proxy(..)) import Database.Esqueleto.Experimental        (Entity, PersistValue, SqlExpr, Value(..), (:&)(..))+import Database.Esqueleto.Experimental.ToAlias (ToAlias(..))+import Database.Esqueleto.Experimental.ToAliasReference (ToAliasReference(..)) import Database.Esqueleto.Internal.Internal (SqlSelect(..)) import Language.Haskell.TH import Language.Haskell.TH.Syntax@@ -118,10 +120,14 @@   -- It would be nicer to use `mconcat` here but I don't think the right   -- instance is available in GHC 8.   recordDec <- makeSqlRecord info-  instanceDec <- makeSqlSelectInstance info+  sqlSelectInstanceDec <- makeSqlSelectInstance info+  toAliasInstanceDec <- makeToAliasInstance info+  toAliasReferenceInstanceDec <- makeToAliasReferenceInstance info   pure     [ recordDec-    , instanceDec+    , sqlSelectInstanceDec+    , toAliasInstanceDec+    , toAliasReferenceInstanceDec     ]  -- | Information about a record we need to generate the declarations.@@ -509,3 +515,89 @@         -- only show you the first name.         (GadtC names _fields _ret) -> head names         (RecGadtC names _fields _ret) -> head names++makeToAliasInstance :: RecordInfo -> Q Dec+makeToAliasInstance info@RecordInfo {..} = do+  toAliasDec' <- toAliasDec info+  let overlap = Nothing+      instanceConstraints = []+      instanceType =+        (ConT ''ToAlias)+          `AppT` (ConT sqlName)+  pure $ InstanceD overlap instanceConstraints instanceType [toAliasDec']++toAliasDec :: RecordInfo -> Q Dec+toAliasDec RecordInfo {..} = do+  (statements, fieldPatterns, fieldExps) <-+    unzip3 <$> forM sqlFields (\(fieldName', _) -> do+      fieldPatternName <- newName (nameBase fieldName')+      boundValueName <- newName (nameBase fieldName')+      pure+        ( BindS+            (VarP boundValueName)+            (VarE 'toAlias `AppE` VarE fieldPatternName)+        , (fieldName', VarP fieldPatternName)+        , (fieldName', VarE boundValueName)+        ))++  pure $+    FunD+      'toAlias+      [ Clause+          [ RecP sqlName fieldPatterns+          ]+          ( NormalB $+              DoE+#if MIN_VERSION_template_haskell(2,17,0)+                Nothing+#endif+                (statements ++ [NoBindS $ AppE (VarE 'pure) (RecConE sqlName fieldExps)])+          )+          -- `where` clause.+          []+      ]++makeToAliasReferenceInstance :: RecordInfo -> Q Dec+makeToAliasReferenceInstance info@RecordInfo {..} = do+  toAliasReferenceDec' <- toAliasReferenceDec info+  let overlap = Nothing+      instanceConstraints = []+      instanceType =+        (ConT ''ToAliasReference)+          `AppT` (ConT sqlName)+  pure $ InstanceD overlap instanceConstraints instanceType [toAliasReferenceDec']++toAliasReferenceDec :: RecordInfo -> Q Dec+toAliasReferenceDec RecordInfo {..} = do+  identInfo <- newName "identInfo"++  (statements, fieldPatterns, fieldExps) <-+    unzip3 <$> forM sqlFields (\(fieldName', _) -> do+      fieldPatternName <- newName (nameBase fieldName')+      boundValueName <- newName (nameBase fieldName')+      pure+        ( BindS+            (VarP boundValueName)+            (VarE 'toAliasReference `AppE` VarE identInfo `AppE` VarE fieldPatternName)+        , (fieldName', VarP fieldPatternName)+        , (fieldName', VarE boundValueName)+        ))++  pure $+    FunD+      'toAliasReference+      [ Clause+          [ VarP identInfo+          , RecP sqlName fieldPatterns+          ]+          ( NormalB $+              DoE+#if MIN_VERSION_template_haskell(2,17,0)+                Nothing+#endif+                (statements ++ [NoBindS $ AppE (VarE 'pure) (RecConE sqlName fieldExps)])+          )+          -- `where` clause.+          []+      ]+

@@ -144,3 +144,32 @@                                 }                    } -> addr1 == addr2 -- The keys should match.                  _ -> False)++    itDb "can be used in a CTE" $ do+        setup+        records <- select $ do+            recordCTE <- with myRecordQuery+            record <- from recordCTE+            pure record+        let sortedRecords = sortOn (\MyRecord {myName} -> myName) records+        liftIO $ sortedRecords !! 0+          `shouldSatisfy`+          (\case MyRecord { myName = "Rebecca"+                          , myAge = Just 10+                          , myUser = Entity _ User { userAddress  = Nothing+                                                   , userName = "Rebecca"+                                                   }+                          , myAddress = Nothing+                          } -> True+                 _ -> False)+        liftIO $ sortedRecords !! 1+          `shouldSatisfy`+          (\case MyRecord { myName = "Some Guy"+                          , myAge = Just 10+                          , myUser = Entity _ User { userAddress  = Just addr1+                                                   , userName = "Some Guy"+                                                   }+                          , myAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})+                          } -> addr1 == addr2 -- The keys should match.+                 _ -> False)+