esqueleto 3.5.7.1 → 3.5.8.0

raw patch · 4 files changed

+140/−14 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• changelog.md +13/−0
• esqueleto.cabal +2/−2
• src/Database/Esqueleto/Record.hs +62/−11
• test/Common/Record.hs +63/−1

@@ -1,3 +1,16 @@+3.5.8.0+=======+- @ivanbakel+    - [#331](https://github.com/bitemyapp/esqueleto/pull/331)+        - Add `deriveEsqueletoRecordWith` to derive Esqueleto instances for+          records using custom deriving settings.+        - Add `DeriveEsqueletoRecordSettings` to control how Esqueleto record+          instances are derived.+        - Add `sqlNameModifier` to control how Esqueleto record instance+          deriving generates the SQL record type name.+        - Add `sqlFieldModifier` to control how Esqueleto record instance+          deriving generates the SQL record fields.+ 3.5.7.1 ======= - @belevy

@@ -2,7 +2,7 @@  name:           esqueleto -version:        3.5.7.1+version:        3.5.8.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.                 .@@ -65,7 +65,7 @@       , resourcet >=1.2       , tagged >=0.2       , template-haskell-      , text >=0.11 && <1.3+      , text >=0.11 && <2.1       , time >=1.5.0.1 && <=1.13       , transformers >=0.2       , unliftio

@@ -9,6 +9,10 @@  module Database.Esqueleto.Record   ( deriveEsqueletoRecord+  , deriveEsqueletoRecordWith++  , DeriveEsqueletoRecordSettings(..)+  , defaultDeriveEsqueletoRecordSettings   ) where  import Control.Monad.Trans.State.Strict (StateT(..), evalStateT)@@ -115,8 +119,51 @@ -- -- @since 3.5.6.0 deriveEsqueletoRecord :: Name -> Q [Dec]-deriveEsqueletoRecord originalName = do-  info <- getRecordInfo originalName+deriveEsqueletoRecord = deriveEsqueletoRecordWith defaultDeriveEsqueletoRecordSettings++-- | Codegen settings for 'deriveEsqueletoRecordWith'.+--+-- @since 3.5.8.0+data DeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings+  { sqlNameModifier :: String -> String+    -- ^ Function applied to the Haskell record's type name and constructor+    -- name to produce the SQL record's type name and constructor name.+    --+    -- @since 3.5.8.0+  , sqlFieldModifier :: String -> String+    -- ^ Function applied to the Haskell record's field names to produce the+    -- SQL record's field names.+    --+    -- @since 3.5.8.0+  }++-- | The default codegen settings for 'deriveEsqueletoRecord'.+--+-- These defaults will cause you to require @{-# LANGUAGE DuplicateRecordFields #-}@+-- in certain cases (see 'deriveEsqueletoRecord'.) If you don't want to do this,+-- change the value of 'sqlFieldModifier' so the field names of the generated SQL+-- record different from those of the Haskell record.+--+-- @since 3.5.8.0+defaultDeriveEsqueletoRecordSettings :: DeriveEsqueletoRecordSettings+defaultDeriveEsqueletoRecordSettings = DeriveEsqueletoRecordSettings+  { sqlNameModifier = ("Sql" ++)+  , sqlFieldModifier = id+  }++-- | Takes the name of a Haskell record type and creates a variant of that+-- record based on the supplied settings which can be used in esqueleto+-- expressions. This reduces the amount of pattern matching on large tuples+-- required to interact with data extracted with esqueleto.+--+-- This is a variant of 'deriveEsqueletoRecord' which allows you to avoid the+-- use of @{-# LANGUAGE DuplicateRecordFields #-}@, by configuring the+-- 'DeriveEsqueletoRecordSettings' used to generate the SQL record.+--+-- @since 3.5.8.0+deriveEsqueletoRecordWith :: DeriveEsqueletoRecordSettings -> Name -> Q [Dec]+deriveEsqueletoRecordWith settings originalName = do+  info <- getRecordInfo settings originalName   -- It would be nicer to use `mconcat` here but I don't think the right   -- instance is available in GHC 8.   recordDec <- makeSqlRecord info@@ -136,7 +183,7 @@ data RecordInfo = RecordInfo   { -- | The original record's name.     name :: Name-  , -- | The generated @Sql@-prefixed record's name.+  , -- | The generated SQL record's name.     sqlName :: Name   , -- | The original record's constraints. If this isn't empty it'll probably     -- cause problems, but it's easy to pass around so might as well.@@ -151,17 +198,19 @@     kind :: Maybe Kind   , -- | The original record's constructor name.     constructorName :: Name+  , -- | The generated SQL record's constructor name.+    sqlConstructorName :: Name   , -- | The original record's field names and types, derived from the     -- constructors.     fields :: [(Name, Type)]-  , -- | The generated @Sql@-prefixed record's field names and types, computed+  , -- | The generated SQL record's field names and types, computed     -- with 'sqlFieldType'.     sqlFields :: [(Name, Type)]   }  -- | Get a `RecordInfo` instance for the given record name.-getRecordInfo :: Name -> Q RecordInfo-getRecordInfo name = do+getRecordInfo :: DeriveEsqueletoRecordSettings -> Name -> Q RecordInfo+getRecordInfo settings name = do   TyConI dec <- reify name   (constraints, typeVarBinders, kind, constructors) <-         case dec of@@ -178,7 +227,8 @@           RecC name' _fields -> name'           con -> error $ nonRecordConstructorMessage con       fields = getFields constructor-      sqlName = makeSqlName name+      sqlName = makeSqlName settings name+      sqlConstructorName = makeSqlName settings constructorName    sqlFields <- mapM toSqlField fields @@ -189,12 +239,13 @@     getFields con = error $ nonRecordConstructorMessage con      toSqlField (fieldName', ty) = do+      let modifier = mkName . sqlFieldModifier settings . nameBase       sqlTy <- sqlFieldType ty-      pure (fieldName', sqlTy)+      pure (modifier fieldName', sqlTy)  -- | Create a new name by prefixing @Sql@ to a given name.-makeSqlName :: Name -> Name-makeSqlName name = mkName $ "Sql" ++ nameBase name+makeSqlName :: DeriveEsqueletoRecordSettings -> Name -> Name+makeSqlName settings name = mkName $ sqlNameModifier settings $ nameBase name  -- | Transforms a record field type into a corresponding `SqlExpr` type. --@@ -228,7 +279,7 @@ -- record's information. makeSqlRecord :: RecordInfo -> Q Dec makeSqlRecord RecordInfo {..} = do-  let newConstructor = RecC (makeSqlName constructorName) (makeField `map` sqlFields)+  let newConstructor = RecC sqlConstructorName (makeField `map` sqlFields)       derivingClauses = []   pure $ DataD constraints sqlName typeVarBinders kind [newConstructor] derivingClauses   where

@@ -22,7 +22,12 @@ import Common.Test.Import hiding (from, on) import Data.List (sortOn) import Database.Esqueleto.Experimental-import Database.Esqueleto.Record (deriveEsqueletoRecord)+import Database.Esqueleto.Record+  ( DeriveEsqueletoRecordSettings(..)+  , defaultDeriveEsqueletoRecordSettings+  , deriveEsqueletoRecord+  , deriveEsqueletoRecordWith+  )  data MyRecord =     MyRecord@@ -77,6 +82,36 @@             }       } +data MyModifiedRecord =+    MyModifiedRecord+        { myModifiedName :: Text+        , myModifiedAge :: Maybe Int+        , myModifiedUser :: Entity User+        , myModifiedAddress :: Maybe (Entity Address)+        }+  deriving (Show, Eq)++$(deriveEsqueletoRecordWith (defaultDeriveEsqueletoRecordSettings+    { sqlNameModifier = (++ "Sql")+    , sqlFieldModifier = (++ "Sql")+    })+    ''MyModifiedRecord)++myModifiedRecordQuery :: SqlQuery MyModifiedRecordSql+myModifiedRecordQuery = do+  user :& address <- from $+    table @User+      `leftJoin`+      table @Address+      `on` (do \(user :& address) -> user ^. #address ==. address ?. #id)+  pure+    MyModifiedRecordSql+      { myModifiedNameSql = castString $ user ^. #name+      , myModifiedAgeSql = val $ Just 10+      , myModifiedUserSql = user+      , myModifiedAddressSql = address+      }+ testDeriveEsqueletoRecord :: SpecDb testDeriveEsqueletoRecord = describe "deriveEsqueletoRecord" $ do     let setup :: MonadIO m => SqlPersistT m ()@@ -173,3 +208,30 @@                           } -> addr1 == addr2 -- The keys should match.                  _ -> False) ++    itDb "can select user-modified records" $ do+        setup+        records <- select myModifiedRecordQuery+        let sortedRecords = sortOn (\MyModifiedRecord {myModifiedName} -> myModifiedName) records+        liftIO $ sortedRecords !! 0+          `shouldSatisfy`+          (\case MyModifiedRecord+                  { myModifiedName = "Rebecca"+                  , myModifiedAge = Just 10+                  , myModifiedUser = Entity _ User { userAddress  = Nothing+                                           , userName = "Rebecca"+                                           }+                  , myModifiedAddress = Nothing+                  } -> True+                 _ -> False)+        liftIO $ sortedRecords !! 1+          `shouldSatisfy`+          (\case MyModifiedRecord+                    { myModifiedName = "Some Guy"+                    , myModifiedAge = Just 10+                    , myModifiedUser = Entity _ User { userAddress  = Just addr1+                                             , userName = "Some Guy"+                                             }+                    , myModifiedAddress = Just (Entity addr2 Address {addressAddress = "30-50 Feral Hogs Rd"})+                    } -> addr1 == addr2 -- The keys should match.+                 _ -> False)