From 6a7b8dee959b85ff20063b96b7d9a309bc49d6cb Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Fri, 7 Jun 2024 18:23:59 +0100 Subject: [PATCH 1/5] Remove CPP for ConP --- src/Database/Esqueleto/Record.hs | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/Database/Esqueleto/Record.hs b/src/Database/Esqueleto/Record.hs index cdc9913be..d7fb70236 100644 --- a/src/Database/Esqueleto/Record.hs +++ b/src/Database/Esqueleto/Record.hs @@ -541,11 +541,7 @@ sqlSelectProcessRowPat fieldType var = do `AppT` ((ConT ((==) ''Entity -> True)) `AppT` _innerType) -> pure $ VarP var -- x -> Value var -#if MIN_VERSION_template_haskell(2,18,0) - _ -> pure $ ConP 'Value [] [VarP var] -#else - _ -> pure $ ConP 'Value [VarP var] -#endif + _ -> [p| Value $(varP var) |] -- Given a type, find the corresponding SQL type. -- From e19e69eea3d0ed91728fa6dc0120b0332d6af70d Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Fri, 7 Jun 2024 18:32:28 +0100 Subject: [PATCH 2/5] Use quote for toMaybeTDec --- src/Database/Esqueleto/Record.hs | 20 +++++--------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/src/Database/Esqueleto/Record.hs b/src/Database/Esqueleto/Record.hs index d7fb70236..ab0f62ec1 100644 --- a/src/Database/Esqueleto/Record.hs +++ b/src/Database/Esqueleto/Record.hs @@ -762,7 +762,7 @@ makeToMaybeInstance info@RecordInfo {..} = do instanceConstraints = [] instanceType = (ConT ''ToMaybe) `AppT` (ConT sqlName) - pure $ InstanceD overlap instanceConstraints instanceType [toMaybeTDec', toMaybeDec'] + pure $ InstanceD overlap instanceConstraints instanceType (toMaybeTDec' ++ [toMaybeDec']) -- | Generates a `ToMaybe` instance for the SqlMaybe of the given record. makeSqlMaybeToMaybeInstance :: RecordInfo -> Q Dec @@ -772,22 +772,12 @@ makeSqlMaybeToMaybeInstance RecordInfo {..} = do overlap = Nothing instanceConstraints = [] instanceType = (ConT ''ToMaybe) `AppT` (ConT sqlMaybeName) - pure $ InstanceD overlap instanceConstraints instanceType [sqlMaybeToMaybeTDec', toMaybeIdDec] + pure $ InstanceD overlap instanceConstraints instanceType (toMaybeIdDec:sqlMaybeToMaybeTDec') -- | Generates a `type ToMaybeT ... = ...` declaration for the given names. -toMaybeTDec :: Name -> Name -> Q Dec -toMaybeTDec nameLeft nameRight = do - pure $ mkTySynInstD ''ToMaybeT (ConT nameLeft) (ConT nameRight) - where - mkTySynInstD className lhsArg rhs = -#if MIN_VERSION_template_haskell(2,15,0) - let binders = Nothing - lhs = ConT className `AppT` lhsArg - in - TySynInstD $ TySynEqn binders lhs rhs -#else - TySynInstD className $ TySynEqn [lhsArg] rhs -#endif +toMaybeTDec :: Name -> Name -> Q [Dec] +toMaybeTDec nameLeft nameRight = + [d| type instance ToMaybeT $(conT nameLeft) = $(conT nameRight) |] -- | Generates a `toMaybe value = ...` declaration for the given record. toMaybeDec :: RecordInfo -> Q Dec From 995409cf29ba0c07ef5470fa2b69931bda9af975 Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Fri, 7 Jun 2024 18:39:42 +0100 Subject: [PATCH 3/5] Bump version and add chnglog entry --- changelog.md | 6 ++++++ esqueleto.cabal | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/changelog.md b/changelog.md index 6f4dd4674..887f38d53 100644 --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,9 @@ +3.5.13.1 +======== +- @TeofilC + - [#394](https://github.com/bitemyapp/esqueleto/pull/394) + - Use TH quotes to eliminate some CPP. + 3.5.13.0 ======== - @ac251 diff --git a/esqueleto.cabal b/esqueleto.cabal index 547741fff..5d2da3d39 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -2,7 +2,7 @@ cabal-version: 1.12 name: esqueleto -version: 3.5.13.0 +version: 3.5.13.1 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. . From 21a1a1ae18c9ebfef1e7df52f3c237f5aa372118 Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Fri, 7 Jun 2024 19:23:30 +0100 Subject: [PATCH 4/5] Convert more code to use TH quotes --- src/Database/Esqueleto/Record.hs | 115 ++++++------------------------- 1 file changed, 21 insertions(+), 94 deletions(-) diff --git a/src/Database/Esqueleto/Record.hs b/src/Database/Esqueleto/Record.hs index ab0f62ec1..563308294 100644 --- a/src/Database/Esqueleto/Record.hs +++ b/src/Database/Esqueleto/Record.hs @@ -379,15 +379,12 @@ makeSqlSelectInstance info@RecordInfo {..} = do sqlSelectProcessRowDec' <- sqlSelectProcessRowDec info let overlap = Nothing instanceConstraints = [] - instanceType = - (ConT ''SqlSelect) - `AppT` (ConT sqlName) - `AppT` (ConT name) + instanceType <- [t| SqlSelect $(conT sqlName) $(conT name) |] - pure $ InstanceD overlap instanceConstraints instanceType [sqlSelectColsDec', sqlSelectColCountDec', sqlSelectProcessRowDec'] + pure $ InstanceD overlap instanceConstraints instanceType (sqlSelectColsDec' ++ sqlSelectColCountDec' ++ [ sqlSelectProcessRowDec']) -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance. -sqlSelectColsDec :: RecordInfo -> Q Dec +sqlSelectColsDec :: RecordInfo -> Q [Dec] sqlSelectColsDec RecordInfo {..} = do -- Pairs of record field names and local variable names. fieldNames <- forM sqlFields (\(name', _type) -> do @@ -413,26 +410,12 @@ sqlSelectColsDec RecordInfo {..} = do in foldl' helper (VarE f1) rest identInfo <- newName "identInfo" - -- Roughly: - -- sqlSelectCols $identInfo SqlFoo{..} = sqlSelectCols $identInfo $joinedFields - pure $ - FunD - 'sqlSelectCols - [ Clause - [ VarP identInfo - , RecP sqlName fieldPatterns - ] - ( NormalB $ - (VarE 'sqlSelectCols) - `AppE` (VarE identInfo) - `AppE` (ParensE joinedFields) - ) - -- `where` clause. - [] - ] + [d| sqlSelectCols $(varP identInfo) $(pure $ RecP sqlName fieldPatterns) = + sqlSelectCols $(varE identInfo) $(pure joinedFields) + |] -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance. -sqlSelectColCountDec :: RecordInfo -> Q Dec +sqlSelectColCountDec :: RecordInfo -> Q [Dec] sqlSelectColCountDec RecordInfo {..} = do let joinedTypes = case snd `map` sqlFields of @@ -442,23 +425,7 @@ sqlSelectColCountDec RecordInfo {..} = do InfixT lhs ''(:&) ty in foldl' helper t1 rest - -- Roughly: - -- sqlSelectColCount _ = sqlSelectColCount (Proxy @($joinedTypes)) - pure $ - FunD - 'sqlSelectColCount - [ Clause - [WildP] - ( NormalB $ - AppE (VarE 'sqlSelectColCount) $ - ParensE $ - AppTypeE - (ConE 'Proxy) - joinedTypes - ) - -- `where` clause. - [] - ] + [d| sqlSelectColCount _ = sqlSelectColCount (Proxy @($(pure joinedTypes))) |] -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect` -- instance. @@ -762,7 +729,7 @@ makeToMaybeInstance info@RecordInfo {..} = do instanceConstraints = [] instanceType = (ConT ''ToMaybe) `AppT` (ConT sqlName) - pure $ InstanceD overlap instanceConstraints instanceType (toMaybeTDec' ++ [toMaybeDec']) + pure $ InstanceD overlap instanceConstraints instanceType (toMaybeTDec' ++ toMaybeDec') -- | Generates a `ToMaybe` instance for the SqlMaybe of the given record. makeSqlMaybeToMaybeInstance :: RecordInfo -> Q Dec @@ -780,7 +747,7 @@ toMaybeTDec nameLeft nameRight = [d| type instance ToMaybeT $(conT nameLeft) = $(conT nameRight) |] -- | Generates a `toMaybe value = ...` declaration for the given record. -toMaybeDec :: RecordInfo -> Q Dec +toMaybeDec :: RecordInfo -> Q [Dec] toMaybeDec RecordInfo {..} = do (fieldPatterns, fieldExps) <- unzip <$> forM (zip sqlFields sqlMaybeFields) (\((fieldName', _), (maybeFieldName', _)) -> do @@ -790,15 +757,9 @@ toMaybeDec RecordInfo {..} = do , (maybeFieldName', VarE 'toMaybe `AppE` VarE fieldPatternName) )) - pure $ - FunD - 'toMaybe - [ Clause - [ RecP sqlName fieldPatterns - ] - (NormalB $ RecConE sqlMaybeName fieldExps) - [] - ] + [d| toMaybe $(pure $ RecP sqlName fieldPatterns) = + $(pure $ RecConE sqlMaybeName fieldExps) + |] -- | Generates an `SqlSelect` instance for the given record and its -- @Sql@-prefixed variant. @@ -809,15 +770,11 @@ makeSqlMaybeRecordSelectInstance info@RecordInfo {..} = do sqlSelectProcessRowDec' <- sqlMaybeSelectProcessRowDec info let overlap = Nothing instanceConstraints = [] - instanceType = - (ConT ''SqlSelect) - `AppT` (ConT sqlMaybeName) - `AppT` (AppT (ConT ''Maybe) (ConT name)) - - pure $ InstanceD overlap instanceConstraints instanceType [sqlSelectColsDec', sqlSelectColCountDec', sqlSelectProcessRowDec'] + instanceType <- [t| SqlSelect $(conT sqlMaybeName) (Maybe $(conT name)) |] + pure $ InstanceD overlap instanceConstraints instanceType (sqlSelectColsDec' ++ sqlSelectColCountDec' ++ [sqlSelectProcessRowDec']) -- | Generates the `sqlSelectCols` declaration for an `SqlSelect` instance. -sqlMaybeSelectColsDec :: RecordInfo -> Q Dec +sqlMaybeSelectColsDec :: RecordInfo -> Q [Dec] sqlMaybeSelectColsDec RecordInfo {..} = do -- Pairs of record field names and local variable names. fieldNames <- forM sqlMaybeFields (\(name', _type) -> do @@ -843,23 +800,9 @@ sqlMaybeSelectColsDec RecordInfo {..} = do in foldl' helper (VarE f1) rest identInfo <- newName "identInfo" - -- Roughly: - -- sqlSelectCols $identInfo SqlFoo{..} = sqlSelectCols $identInfo $joinedFields - pure $ - FunD - 'sqlSelectCols - [ Clause - [ VarP identInfo - , RecP sqlMaybeName fieldPatterns - ] - ( NormalB $ - (VarE 'sqlSelectCols) - `AppE` (VarE identInfo) - `AppE` (ParensE joinedFields) - ) - -- `where` clause. - [] - ] + [d| sqlSelectCols $(varP identInfo) $(pure $ RecP sqlMaybeName fieldPatterns) = + sqlSelectCols $(varE identInfo) $(pure joinedFields) + |] -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect` -- instance for a SqlMaybe. @@ -927,7 +870,7 @@ sqlMaybeSelectProcessRowDec RecordInfo {..} = do _ -> error $ show x -- | Generates the `sqlSelectColCount` declaration for an `SqlSelect` instance. -sqlMaybeSelectColCountDec :: RecordInfo -> Q Dec +sqlMaybeSelectColCountDec :: RecordInfo -> Q [Dec] sqlMaybeSelectColCountDec RecordInfo {..} = do let joinedTypes = case snd `map` sqlMaybeFields of @@ -937,23 +880,7 @@ sqlMaybeSelectColCountDec RecordInfo {..} = do InfixT lhs ''(:&) ty in foldl' helper t1 rest - -- Roughly: - -- sqlSelectColCount _ = sqlSelectColCount (Proxy @($joinedTypes)) - pure $ - FunD - 'sqlSelectColCount - [ Clause - [WildP] - ( NormalB $ - AppE (VarE 'sqlSelectColCount) $ - ParensE $ - AppTypeE - (ConE 'Proxy) - joinedTypes - ) - -- `where` clause. - [] - ] + [d| sqlSelectColCount _ = sqlSelectColCount (Proxy @($(pure joinedTypes))) |] -- | Statefully parse some number of columns from a list of `PersistValue`s, -- where the number of columns to parse is determined by `sqlSelectColCount` From 89be96a77f1c4204294df9bc63e8c36639e68db8 Mon Sep 17 00:00:00 2001 From: Teo Camarasu Date: Thu, 31 Oct 2024 09:52:23 +0000 Subject: [PATCH 5/5] Fix newName error --- src/Database/Esqueleto/Record.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Database/Esqueleto/Record.hs b/src/Database/Esqueleto/Record.hs index 563308294..7b0dfba2b 100644 --- a/src/Database/Esqueleto/Record.hs +++ b/src/Database/Esqueleto/Record.hs @@ -410,7 +410,7 @@ sqlSelectColsDec RecordInfo {..} = do in foldl' helper (VarE f1) rest identInfo <- newName "identInfo" - [d| sqlSelectCols $(varP identInfo) $(pure $ RecP sqlName fieldPatterns) = + [d| $(varP 'sqlSelectCols) = \ $(varP identInfo) $(pure $ RecP sqlName fieldPatterns) -> sqlSelectCols $(varE identInfo) $(pure joinedFields) |] @@ -425,7 +425,7 @@ sqlSelectColCountDec RecordInfo {..} = do InfixT lhs ''(:&) ty in foldl' helper t1 rest - [d| sqlSelectColCount _ = sqlSelectColCount (Proxy @($(pure joinedTypes))) |] + [d| $(varP 'sqlSelectColCount) = \ _ -> sqlSelectColCount (Proxy @($(pure joinedTypes))) |] -- | Generates the `sqlSelectProcessRow` declaration for an `SqlSelect` -- instance. @@ -757,7 +757,7 @@ toMaybeDec RecordInfo {..} = do , (maybeFieldName', VarE 'toMaybe `AppE` VarE fieldPatternName) )) - [d| toMaybe $(pure $ RecP sqlName fieldPatterns) = + [d| $(varP 'toMaybe) = \ $(pure $ RecP sqlName fieldPatterns) -> $(pure $ RecConE sqlMaybeName fieldExps) |] @@ -800,7 +800,7 @@ sqlMaybeSelectColsDec RecordInfo {..} = do in foldl' helper (VarE f1) rest identInfo <- newName "identInfo" - [d| sqlSelectCols $(varP identInfo) $(pure $ RecP sqlMaybeName fieldPatterns) = + [d| $(varP 'sqlSelectCols) = \ $(varP identInfo) $(pure $ RecP sqlMaybeName fieldPatterns) -> sqlSelectCols $(varE identInfo) $(pure joinedFields) |] @@ -880,7 +880,7 @@ sqlMaybeSelectColCountDec RecordInfo {..} = do InfixT lhs ''(:&) ty in foldl' helper t1 rest - [d| sqlSelectColCount _ = sqlSelectColCount (Proxy @($(pure joinedTypes))) |] + [d| $(varP 'sqlSelectColCount) = \_ -> sqlSelectColCount (Proxy @($(pure joinedTypes))) |] -- | Statefully parse some number of columns from a list of `PersistValue`s, -- where the number of columns to parse is determined by `sqlSelectColCount`