hasql-generate 1.0.0 → 1.1.0

raw patch · 6 files changed

+93/−74 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +3/−3
• hasql-generate.cabal +2/−2
• src/Hasql/Generate.hs +2/−2
• src/Hasql/Generate/TH.hs +80/−65
• test/Main.hs +2/−2

@@ -1,3 +1,7 @@ # Changelog  1.0.0: Hello, world! The README is probably a better source for what this is++1.0.1:+- Added `withDefaultedCols`+- Removed `withholdPk`, in favor of `withDefaultedCols ["myPrimaryKeyColumn"]`.

@@ -136,13 +136,13 @@ - a `HasUpdate` instance - a `HasDelete` instance -If your Primary Key has a DEFAULT and you want to defer to the database to generate PK values on INSERT, add `withholdPk` to the `fromTable` generator. Without `withholdPk`, the primary key you supply in Haskell will be included in the INSERT, and the Postgres DEFAULT will not be used. You still need to create the record with a primary key value, but it can be a dummy value, like `0` for any Int-based type, or `UUID.nil` for a `UUID`:+If your columns has a DEFAULT and you want to defer to the database to generate values on INSERT, add `withDefaultedCols` to the `fromTable` generator. Without `withDefaultedCols`, the values you supply in Haskell will be included in the INSERT, and the Postgres DEFAULT will not be used. You still need to create the record with values for each column with defaults, but it can be a dummy value, like `0` for any Int-based type, `UUID.nil` for a `UUID`, or `""` for a `String`: ```haskell import Data.Function ((&))-import Hasql.Generate (generate, fromTable, withholdPk)+import Hasql.Generate (generate, fromTable, withDefaultedCols) import MyApp.MyHasqlGenerateConfig (config) -$(generate config (fromTable "public" "users" & withholdPk))+$(generate config (fromTable "public" "users" & withDefaultedCols [ "id" ])) ```  ### Use Generated Views

@@ -1,11 +1,11 @@ cabal-version: 3.4 name:          hasql-generate-version:       1.0.0+version:       1.1.0 synopsis:      Compile-time PostgreSQL data generation for hasql description:   Connects to a live PostgreSQL database at compile time via TemplateHaskell,   introspects table schemas from pg_catalog, and generates types, hasql-  decoders\/encoders, and CRUD statements targeting hasql's binary protocol.+  decoders\/encoders, and CRUD statements.  author:           dneaves maintainer:       dneavesdev@pm.me

@@ -16,9 +16,9 @@     , fromView     , generate     , libpqDefaults+    , withDefaultedCols     , withDerivations     , withOverrides-    , withholdPk     ) where  import           Hasql.Generate.Class@@ -43,7 +43,7 @@     , fromType     , fromView     , generate+    , withDefaultedCols     , withDerivations     , withOverrides-    , withholdPk     )

@@ -4,22 +4,21 @@     , fromType     , fromView     , generate+    , withDefaultedCols     , withDerivations     , withOverrides-    , withholdPk     ) where  ----------------------------------------------------------------------------------------------------  import           Control.Applicative                ( (<*>) )-import           Control.Monad                      ( mapM, return )+import           Control.Monad                      ( mapM, mapM_, return ) import           Control.Monad.Fail                 ( MonadFail (fail) )  import           Data.Bool     ( Bool (..)     , not     , otherwise-    , (&&)     ) import           Data.Char                          ( toLower, toUpper ) import           Data.Eq                            ( (==) )@@ -29,8 +28,7 @@ import qualified Data.Functor.Contravariant         as Contravariant import           Data.Int                           ( Int ) import           Data.List-    ( all-    , break+    ( break     , concatMap     , elem     , filter@@ -86,7 +84,7 @@ -- | Whether the target relation is a table (full CRUD), a view (read-only), or a type (enum). data RelationKind = Table | View | Type -{-  Configuration for a table, view, or type code-generation request.+{- | Configuration for a table, view, or type code-generation request.      Use 'fromTable', 'fromView', or 'fromType' to create a default config,     then chain modifier functions with @(&)@ to customise it:@@ -95,49 +93,49 @@     fromTable \"public\" \"users\"         & withDerivations [''Show, ''Eq, ''Generic]         & withOverrides [(\"timestamptz\", ''UTCTime)]-        & withholdPk+        & withDefaultedCols [\"id\"]     @ -} data GenerateConfig     = GenerateConfig-      { tcSchema      :: String-      , tcTable       :: String-      , tcKind        :: RelationKind-      , tcDerivations :: [Name]-      , tcOverrides   :: [(String, Name)]-      , tcWithholdPk  :: Bool+      { gcSchema        :: String+      , gcTable         :: String+      , gcKind          :: RelationKind+      , gcDerivations   :: [Name]+      , gcOverrides     :: [(String, Name)]+      , gcDefaultedCols :: [String]       } -{-  Create a 'GenerateConfig' for the given schema and table with no derivations+{- | Create a 'GenerateConfig' for the given schema and table with no derivations     and no type overrides. Generates full CRUD code. -} fromTable :: String -> String -> GenerateConfig fromTable schema table =   GenerateConfig-    { tcSchema = schema-    , tcTable = table-    , tcKind = Table-    , tcDerivations = []-    , tcOverrides = []-    , tcWithholdPk = False+    { gcSchema = schema+    , gcTable = table+    , gcKind = Table+    , gcDerivations = []+    , gcOverrides = []+    , gcDefaultedCols = []     } -{-  Create a 'GenerateConfig' for the given schema and view with no derivations+{- | Create a 'GenerateConfig' for the given schema and view with no derivations     and no type overrides. Generates read-only code: a record type, a decoder,     a SELECT statement, and a 'HasView' instance. -} fromView :: String -> String -> GenerateConfig fromView schema view =   GenerateConfig-    { tcSchema = schema-    , tcTable = view-    , tcKind = View-    , tcDerivations = []-    , tcOverrides = []-    , tcWithholdPk = False+    { gcSchema = schema+    , gcTable = view+    , gcKind = View+    , gcDerivations = []+    , gcOverrides = []+    , gcDefaultedCols = []     } -{-  Create a 'GenerateConfig' for the given schema and enum type with no+{- | Create a 'GenerateConfig' for the given schema and enum type with no     derivations. Generates a Haskell sum type, a 'PgCodec' instance,     and a 'PgColumn' instance. Overrides are ignored for types. @@ -157,36 +155,37 @@ fromType :: String -> String -> GenerateConfig fromType schema typeName =   GenerateConfig-    { tcSchema = schema-    , tcTable = typeName-    , tcKind = Type-    , tcDerivations = []-    , tcOverrides = []-    , tcWithholdPk = False+    { gcSchema = schema+    , gcTable = typeName+    , gcKind = Type+    , gcDerivations = []+    , gcOverrides = []+    , gcDefaultedCols = []     }  -- | Append derivation class 'Name's to the config. withDerivations :: [Name] -> GenerateConfig -> GenerateConfig-withDerivations names cfg = cfg {tcDerivations = tcDerivations cfg <> names}+withDerivations names cfg = cfg {gcDerivations = gcDerivations cfg <> names} -{-  Append per-table PG type overrides. Each pair maps a PostgreSQL type name+{- | Append per-table PG type overrides. Each pair maps a PostgreSQL type name     (e.g. @\"timestamptz\"@) to a Haskell type 'Name' (e.g. @''UTCTime@).     The override type must still have a 'PgCodec' instance. -} withOverrides :: [(String, Name)] -> GenerateConfig -> GenerateConfig-withOverrides ovs cfg = cfg {tcOverrides = tcOverrides cfg <> ovs}+withOverrides ovs cfg = cfg {gcOverrides = gcOverrides cfg <> ovs} -{-  Opt in to excluding PK columns from INSERT when all PK columns have-    database defaults. Without this, INSERT always includes all columns.+{- | Exclude the named columns from INSERT statements. Each column must exist+    in the table and have a database default (@atthasdef = true@ in+    @pg_catalog@); a compile-time error is raised otherwise.      @-    fromTable \"public\" \"users\" & withholdPk+    fromTable \"public\" \"users\" & withDefaultedCols [\"id\", \"created_at\"]     @ -}-withholdPk :: GenerateConfig -> GenerateConfig-withholdPk cfg = cfg {tcWithholdPk = True}+withDefaultedCols :: [String] -> GenerateConfig -> GenerateConfig+withDefaultedCols cols cfg = cfg {gcDefaultedCols = gcDefaultedCols cfg <> cols} -{-  Terminal step that introspects a PostgreSQL database at compile time and+{- | Terminal step that introspects a PostgreSQL database at compile time and     generates the provided data construct:      Usage:@@ -206,18 +205,18 @@     Table -> do       (typeName, resolvedCols, pkCols) <- getPgData       let pkInfo = buildPkInfo resolvedCols pkCols-      generateAllDecs config withhold schema table typeName derivNames resolvedCols pkInfo+      generateAllDecs config defaultedCols schema table typeName derivNames resolvedCols pkInfo     View -> do       (typeName, resolvedCols, _) <- getPgData       generateViewDecs schema table typeName derivNames resolvedCols   where     connStr = toConnString (connection config)-    schema = tcSchema genConfig-    table = tcTable genConfig-    kind = tcKind genConfig-    derivNames = tcDerivations genConfig-    withhold = tcWithholdPk genConfig-    mergedOverrides = tcOverrides genConfig <> globalOverrides config+    schema = gcSchema genConfig+    table = gcTable genConfig+    kind = gcKind genConfig+    derivNames = gcDerivations genConfig+    defaultedCols = gcDefaultedCols genConfig+    mergedOverrides = gcOverrides genConfig <> globalOverrides config     getPgData = do       (columns, pkCols') <- runIO $ withCompileTimeConnection connStr $ \conn -> do         cols <- introspectColumns conn schema table@@ -326,8 +325,8 @@ ----------------------------------------------------------------------------------------------------  generateAllDecs-  :: Config -> Bool -> String -> String -> String -> [Name] -> [ResolvedColumn] -> PkInfo -> Q [Dec]-generateAllDecs config withhold schema table typName derivNames resolvedCols pkInfo = do+  :: Config -> [String] -> String -> String -> String -> [Name] -> [ResolvedColumn] -> PkInfo -> Q [Dec]+generateAllDecs config defaultedCols schema table typName derivNames resolvedCols pkInfo = do   let useNtPk = newtypePrimaryKeys config       pkTypName = typName <> "Pk"       allowDupFields = allowDuplicateRecordFields config@@ -368,7 +367,7 @@   dataDec <- genDataType typName derivNames resolvedCols'   decoderDec <- genDecoder typName resolvedCols'   encoderDec <- genEncoder typName resolvedCols'-  let insertCols = computeInsertCols withhold resolvedCols' pkInfo'+  insertCols <- computeInsertCols defaultedCols resolvedCols'   insDec <- genInsert schema table typName resolvedCols' insertCols   insMany <- genInsertMany schema table typName resolvedCols' insertCols   hasInsInst <- genHasInsertInstance typName@@ -785,19 +784,35 @@   pkEnc <- pkEncoder pkTypOverride pkInfo   genStatement stmtName sigTy sql pkEnc (AppE (VarE 'Hasql.Decoders.rowMaybe) (VarE decName)) -{-  Compute the columns to include in INSERT. When 'withholdPk' is active-    and all PK columns have database defaults, the PK columns are excluded-    from the insert column list (the DB generates them). Without 'withholdPk',-    all columns are always included.+{-  Compute the columns to include in INSERT. Each column name in the+    @defaultedNames@ list is validated to exist in the table and to have a+    database default (@atthasdef@); a compile-time error is raised otherwise.+    Validated columns are then excluded from the insert column list. -}-computeInsertCols :: Bool -> [ResolvedColumn] -> PkInfo -> [ResolvedColumn]-computeInsertCols withhold allCols pkInfo =-  let pkNames = pkColumnNames pkInfo-      pkCols = filter (\rc -> rcColName rc `elem` pkNames) allCols-      allPkDefaulted = not (null pkCols) && all rcHasDefault pkCols-   in if withhold && allPkDefaulted-        then filter (\rc -> rcColName rc `notElem` pkNames) allCols-        else allCols+computeInsertCols :: [String] -> [ResolvedColumn] -> Q [ResolvedColumn]+computeInsertCols [] allCols = return allCols+computeInsertCols defaultedNames allCols = do+  mapM_ (validateDefaulted allCols) defaultedNames+  return (filter (\rc -> rcColName rc `notElem` defaultedNames) allCols)++validateDefaulted :: [ResolvedColumn] -> String -> Q ()+validateDefaulted allCols name =+  case filter (\rc -> rcColName rc == name) allCols of+    [] ->+      fail+        ( "hasql-generate: withDefaultedCols: column '"+            <> name+            <> "' not found"+        )+    (rc : _) ->+      if rcHasDefault rc+        then return ()+        else+          fail+            ( "hasql-generate: withDefaultedCols: column '"+                <> name+                <> "' has no database default"+            )  {-  Generate the INSERT statement. @allCols@ is the full record column list     (used for RETURNING and the decoder), @insertCols@ is the subset actually

@@ -36,8 +36,8 @@     , fromType     , fromView     , generate+    , withDefaultedCols     , withDerivations-    , withholdPk     ) import qualified Hasql.Generate.Class as Q import qualified Hasql.Session@@ -72,7 +72,7 @@      (def {allowDuplicateRecordFields = True, globalOverrides = [("text", ''String)]})      ( fromTable "hg_test" "users"          & withDerivations [''Show, ''Eq, ''Generic, ''ToJSON, ''FromJSON]-         & withholdPk+         & withDefaultedCols ["id"]      )  )