relational-query 0.12.2.4 → 0.12.3.0

raw patch · 19 files changed

+235/−38 lines, 19 filesdep +bytestring-shortdep −th-data-compatdep ~product-isomorphicPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring-short

Dependencies removed: th-data-compat

Dependency ranges changed: product-isomorphic

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−3
• relational-query.cabal +34/−10
• src/Database/Relational/Arrow.hs +1/−1
• src/Database/Relational/Constraint.hs +2/−2
• src/Database/Relational/Derives.hs +1/−1
• src/Database/Relational/Export.hs +80/−0
• src/Database/Relational/InternalTH/Base.hs +1/−2
• src/Database/Relational/Monad/Trans/Assigning.hs +1/−1
• src/Database/Relational/Monad/Trans/Restricting.hs +1/−1
• src/Database/Relational/Pi/Unsafe.hs +1/−1
• src/Database/Relational/Projectable.hs +2/−2
• src/Database/Relational/Projectable/Instances.hs +2/−2
• src/Database/Relational/Projectable/Unsafe.hs +1/−1
• src/Database/Relational/Record.hs +1/−1
• src/Database/Relational/Relation.hs +2/−2
• src/Database/Relational/Type.hs +8/−8
• test/Export.hs +40/−0
• test/Model.hs +1/−0
• test/exportsEq.hs +53/−0

@@ -1,8 +1,8 @@ <!-- -*- Markdown -*- --> -## 0.12.2.4+## 0.12.3.0 -- fix typo.+- add module to export SQL string representation for other systems.  ## 0.12.2.3 @@ -229,7 +229,7 @@  ## 0.6.1.0 -- Add a configuration flag to print verbose compile-time messages.+- Add a configuration flag to pring verbose compile-time messages.  ## 0.6.0.0 

@@ -1,7 +1,7 @@ name:                relational-query-version:             0.12.2.4+version:             0.12.3.0 synopsis:            Typeful, Modular, Relational, algebraic query engine-description:         This package contains typeful relation structure and+description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can                      translate into SQL query.                      .@@ -16,16 +16,11 @@ license-file:        LICENSE author:              Kei Hibino maintainer:          ex8k.hibino@gmail.com-copyright:           Copyright (c) 2013-2023 Kei Hibino+copyright:           Copyright (c) 2013-2019 Kei Hibino category:            Database build-type:          Simple cabal-version:       >=1.10-tested-with:           GHC == 9.6.2-                     , GHC == 9.4.6-                     , GHC == 9.2.8-                     , GHC == 9.0.2-                     , GHC == 8.10.7-                     , GHC == 8.8.1, GHC == 8.8.2+tested-with:           GHC == 8.8.1, GHC == 8.8.2                      , GHC == 8.6.1, GHC == 8.6.2, GHC == 8.6.3, GHC == 8.6.4, GHC == 8.6.5                      , GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3, GHC == 8.4.4                      , GHC == 8.2.1, GHC == 8.2.2@@ -82,6 +77,8 @@                        Database.Relational.Derives                        Database.Relational.TH +                       Database.Relational.Export+                        -- for GHC version equal or more than 8.0                        Database.Relational.OverloadedProjection                        Database.Relational.OverloadedInstances@@ -117,13 +114,14 @@                        , template-haskell                        , th-reify-compat                        , th-constraint-compat-                       , th-data-compat                        , product-isomorphic >= 0.0.3                        , sql-words >=0.1.5                        , names-th                        , persistable-record >= 0.6   if impl(ghc == 7.4.*)     build-depends:       ghc-prim == 0.2.*+  if impl(ghc == 7.4.*) || impl(ghc == 7.6.*)+    build-depends:       bytestring-short    hs-source-dirs:      src   ghc-options:         -Wall -fsimpl-tick-factor=200@@ -180,6 +178,32 @@    default-language:    Haskell2010 +test-suite exports+  build-depends:         base <5+                       , quickcheck-simple+                       , product-isomorphic+                       , relational-query+                       , containers+                       , transformers+                       , bytestring+  if impl(ghc == 7.4.*)+    build-depends:        ghc-prim == 0.2.*+  if impl(ghc == 7.4.*) || impl(ghc == 7.6.*)+    build-depends:       bytestring-short++  type:                exitcode-stdio-1.0+  main-is:             exportsEq.hs+  other-modules:+                       Lex+                       Model+                       Export++  hs-source-dirs:      test+  ghc-options:         -Wall -fsimpl-tick-factor=200+  if impl(ghc >= 8)+    ghc-options:         -Wcompat++  default-language:    Haskell2010  source-repository head   type:       git

@@ -11,7 +11,7 @@ -- Portability : unknown -- -- This module defines arrow version combinators which--- improves type-safety on building queries.+-- improves type-safty on building queries. -- Referencing the local projected records may cause to break -- the result query. -- It is possible to controls injection of previous local projected records

@@ -103,11 +103,11 @@   constraintKey :: Key c r ct  -- | Inferred 'Unique' constraint 'Key'.---   Record type 'r' has unique key which type is 'ct' derived from primary key.+--   Record type 'r' has unique key which type is 'ct' derived from primay key. derivedUniqueKey :: HasConstraintKey Primary r ct => Key Unique r ct derivedUniqueKey =  uniqueKey constraintKey  -- -- | Inferred 'NotNull' constraint 'Key'.--- --   Record type 'r' has not-null key which type is 'ct' derived from primary key.+-- --   Record type 'r' has not-null key which type is 'ct' derived from primay key. -- derivedNotNullKey :: HasConstraintKey Primary r ct => Key NotNull r ct -- derivedNotNullKey =  notNullKey constraintKey

@@ -9,7 +9,7 @@ -- Stability   : experimental -- Portability : unknown ----- This module defines typed SQLs derived from type information.+-- This module defines typed SQLs derived from type informations. module Database.Relational.Derives (   -- * Query derivation   specifiedKey,

@@ -0,0 +1,80 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Database.Relational.Export+-- Copyright   : 2021 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines templates to export SQL string representation to other systems.+module Database.Relational.Export (+  inlineQuery_,+  inlineUpdate_,+  inlineInsertValue_,+  inlineInsertQuery_,+  inlineDelete_,+  ) where++import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.ByteString.Short (ShortByteString, toShort)++import Language.Haskell.TH (Q, Dec, stringE)+import Language.Haskell.TH.Name.CamelCase (varName, varCamelcaseName)+import Language.Haskell.TH.Lib.Extra (simpleValD)++import Database.Relational+  (Query, Update, Insert, InsertQuery, Delete,+   untypeQuery, UntypeableNoFetch (untypeNoFetch))+++inlineSQL_ :: (String -> Q ()) -- ^ action to check SQL string+           -> String           -- ^ SQL String+           -> String           -- ^ Variable name to define as inlined SQL+           -> Q [Dec]          -- ^ Result declarations+inlineSQL_ check sql declName = do+  check sql+  simpleValD (varName $ varCamelcaseName declName)+    [t| ShortByteString |]+    [| toShort $ T.encodeUtf8 $ T.pack $(stringE sql) |]+    -- IsString instance of ShortByteString type does not handle multi-byte characters.++inlineQuery_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())+             -> Query p a        -- ^ query to inline+             -> String           -- ^ Variable name to define as inlined query+             -> Q [Dec]          -- ^ Result declarations+inlineQuery_ check q declName = inlineSQL_ check (untypeQuery q) declName++inlineNoFetch_ :: UntypeableNoFetch s+              => (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())+              -> s a              -- ^ statement to inline+              -> String           -- ^ Variable name to define as inlined query+              -> Q [Dec]          -- ^ Result declarations+inlineNoFetch_ check q declName = inlineSQL_ check (untypeNoFetch q) declName++inlineUpdate_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())+              -> Update p         -- ^ statement to inline+              -> String           -- ^ Variable name to define as inlined query+              -> Q [Dec]          -- ^ Result declarations+inlineUpdate_ = inlineNoFetch_++inlineInsertValue_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())+                   -> Insert p         -- ^ statement to inline+                   -> String           -- ^ Variable name to define as inlined query+                   -> Q [Dec]          -- ^ Result declarations+inlineInsertValue_ = inlineNoFetch_++inlineInsertQuery_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())+                   -> InsertQuery p    -- ^ statement to inline+                   -> String           -- ^ Variable name to define as inlined query+                   -> Q [Dec]          -- ^ Result declarations+inlineInsertQuery_ = inlineNoFetch_++inlineDelete_ :: (String -> Q ()) -- ^ action to check SQL string. for example to call prepare. if you do not need this, pass (const $ pure ())+              -> Delete p         -- ^ statement to inline+              -> String           -- ^ Variable name to define as inlined query+              -> Q [Dec]          -- ^ Result declarations+inlineDelete_ = inlineNoFetch_

@@ -27,7 +27,6 @@    Dec, sigD, valD, instanceD,    TyVarBndr (PlainTV), ) import Language.Haskell.TH.Compat.Constraint (classP)-import Language.Haskell.TH.Compat.Data (plainTVspecified) import Database.Record.Persistable   (PersistableWidth, persistableWidth,    PersistableRecordWidth, runPersistableRecordWidth)@@ -60,7 +59,7 @@     template :: TypeQ -> [TypeQ] -> Name -> Q [Dec]     template ct pcts selN = do       sig <- sigD selN $-             forallT (map plainTVspecified avs)+             forallT (map PlainTV avs)              (mapM (classP ''PersistableWidth . (:[]) . varT) avs)              [t| Pi $tyRec $ct |]       let runPW t = [| runPersistableRecordWidth (persistableWidth :: PersistableRecordWidth $t) |]

@@ -71,7 +71,7 @@   leftsR = Record.columns . targetRecord target   rights = Record.columns vp --- | Add and assignment.+-- | Add and assginment. (<-#) :: Monad m => AssignTarget r v -> Record Flat v -> Assignings r m () (<-#) =  flip assignTo 

@@ -62,7 +62,7 @@   query'             = restrictings . query'   queryMaybe'        = restrictings . queryMaybe' --- | Restricted 'MonadAggregate' instance.+-- | Resticted 'MonadAggregate' instance. instance MonadAggregate m => MonadAggregate (Restrictings c m) where   groupBy  = restrictings . groupBy   groupBy' = restrictings . groupBy'

@@ -82,7 +82,7 @@ unsafeExpandIndexes' = expandIndexes' {-# DEPRECATED unsafeExpandIndexes' "Use expandIndexes' instead of this." #-} --- | Expand indexes from key. Inferred width version.+-- | Expand indexes from key. Infered width version. expandIndexes :: PersistableWidth a => Pi a b -> [Int] expandIndexes = expandIndexes' persistableWidth 

@@ -234,12 +234,12 @@ exists =  unsafeProjectSql' . SQL.paren . SQL.defineUniOp SQL.EXISTS           . Record.unsafeStringSqlList unsafeShowSql' --- | Concatenate operator corresponding SQL /||/ .+-- | Concatinate operator corresponding SQL /||/ . (.||.) :: OperatorContext c        => Record c a -> Record c a -> Record c a (.||.) =  unsafeBinOp (SQL..||.) --- | Concatenate operator corresponding SQL /||/ . Maybe type version.+-- | Concatinate operator corresponding SQL /||/ . Maybe type version. (?||?) :: (OperatorContext c, IsString a)        => Record c (Maybe a) -> Record c (Maybe a) -> Record c (Maybe a) (?||?) =  unsafeBinOp (SQL..||.)

@@ -37,9 +37,9 @@ instance SqlContext OverWindow where   unsafeProjectSqlTerms = Record.unsafeFromSqlTerms --- | full SQL expression is available in Flat context+-- | full SQL expression is availabe in Flat context instance OperatorContext Flat--- | full SQL expression is available in Aggregated context+-- | full SQL expression is availabe in Aggregated context instance OperatorContext Aggregated  -- | 'Aggregated' context is aggregated context

@@ -31,5 +31,5 @@ class AggregatedContext ac  --- | Placeholder parameter type which has real parameter type argument 'p'.+-- | Placeholder parameter type which has real parameter type arguemnt 'p'. data PlaceHolders p = PlaceHolders

@@ -196,7 +196,7 @@ unsafeListFromSubQuery :: SubQuery -> RecordList p t unsafeListFromSubQuery =  Sub --- | Map record show operatoions and concatenate to single SQL expression.+-- | Map record show operatoions and concatinate to single SQL expression. unsafeStringSqlList :: (p t -> StringSQL) -> RecordList p t -> StringSQL unsafeStringSqlList sf = d  where   d (List ps) = listStringSQL $ map sf ps

@@ -121,11 +121,11 @@ relation :: QuerySimple (Record Flat r) -> Relation () r relation =  relation' . addUnitPH --- | Finalize 'QueryAggregate' monad and generate 'Relation' with place-holder parameter 'p'.+-- | Finalize 'QueryAggregate' monad and geneate 'Relation' with place-holder parameter 'p'. aggregateRelation' :: AggregatedQuery p r -> Relation p r aggregateRelation' =  unsafeTypeRelation . Aggregate.toSubQuery --- | Finalize 'QueryAggregate' monad and generate 'Relation'.+-- | Finalize 'QueryAggregate' monad and geneate 'Relation'. aggregateRelation :: QueryAggregate (Record Aggregated r) -> Relation () r aggregateRelation =  aggregateRelation' . addUnitPH 

@@ -302,7 +302,7 @@ derivedInsert :: (PersistableWidth r, TableDerivable r) => Pi r r' -> Insert r' derivedInsert = insert --- | Make typed 'Insert' from 'Config', 'Table' and monadic built 'InsertTarget' object.+-- | Make typed 'Insert' from 'Config', 'Table' and monadic builded 'InsertTarget' object. typedInsertValue' :: Config -> Table r -> InsertTarget p r -> Insert p typedInsertValue' config tbl it =     unsafeTypedInsert'@@ -312,11 +312,11 @@     (ci, n) = sqlChunkFromInsertTarget config tbl it  {-# DEPRECATED typedInsertValue "use `typedInsertValue' defaultConfig` instead of this." #-}--- | Make typed 'Insert' from 'Table' and monadic built 'InsertTarget' object.+-- | Make typed 'Insert' from 'Table' and monadic builded 'InsertTarget' object. typedInsertValue :: Table r -> InsertTarget p r -> Insert p typedInsertValue = typedInsertValue' defaultConfig --- | Make typed 'Insert' from 'Config', derived table and monadic built 'Register' object.+-- | Make typed 'Insert' from 'Config', derived table and monadic builded 'Register' object. insertValue' :: TableDerivable r => Config -> Register r (PlaceHolders p) -> Insert p insertValue' config rs = typedInsertValue' config (rt rs) $ insertTarget' rs   where@@ -324,20 +324,20 @@     rt =  const derivedTable  {-# DEPRECATED derivedInsertValue' "use `insertValue'` instead of this." #-}--- | Make typed 'Insert' from 'Config', derived table and monadic built 'Register' object.+-- | Make typed 'Insert' from 'Config', derived table and monadic builded 'Register' object. derivedInsertValue' :: TableDerivable r => Config -> Register r (PlaceHolders p) -> Insert p derivedInsertValue' = insertValue' --- | Make typed 'Insert' from 'defaultConfig', derived table and monadic built 'Register' object.+-- | Make typed 'Insert' from 'defaultConfig', derived table and monadic builded 'Register' object. insertValue :: TableDerivable r => Register r (PlaceHolders p) -> Insert p insertValue = insertValue' defaultConfig --- | Make typed 'Insert' from 'defaultConfig', derived table and monadic built 'Register' object with no(unit) placeholder.+-- | Make typed 'Insert' from 'defaultConfig', derived table and monadic builded 'Register' object with no(unit) placeholder. insertValueNoPH :: TableDerivable r => Register r () -> Insert () insertValueNoPH = insertValue . (>> return unitPH)  {-# DEPRECATED derivedInsertValue "use `insertValue` instead of this." #-}--- | Make typed 'Insert' from 'defaultConfig', derived table and monadic built 'Register' object.+-- | Make typed 'Insert' from 'defaultConfig', derived table and monadic builded 'Register' object. derivedInsertValue :: TableDerivable r => Register r (PlaceHolders p) -> Insert p derivedInsertValue = insertValue @@ -450,7 +450,7 @@   show = untypeDelete  --- | Untype interface for typed no-result type statements+-- | Untype interface for typed no-result type statments --   with single type parameter which represents place-holder parameter 'p'. class UntypeableNoFetch s where   untypeNoFetch :: s p -> String

@@ -0,0 +1,40 @@+module Export where++import Data.Functor.ProductIsomorphic (pureP, (|$|), (|*|))+import Data.Int (Int32)++import Model++import Database.Relational+++onX :: Relation () (Maybe SetA, SetB)+onX = relation $ do+  a <- queryMaybe setA+  b <- query      setB+  on $ a ?! intA0' .=. just (b ! intB0')+  return $ (,) |$| a |*| b++assignX :: Update ()+assignX = update $ \_proj -> do+  intA0' <-# value (0 :: Int32)+  return $ pureP ()++registerX :: Insert (String, Maybe String)+registerX = insertValue $ do+  intC0' <-# value 1+  (ph1, ()) <- placeholder (\ph' -> strC1' <-# ph')+  intC2' <-# value 2+  (ph2, ()) <- placeholder (\ph' -> mayStrC3' <-# ph')+  return $ (,) |$| ph1 |*| ph2++setAFromB :: Pi SetB SetA+setAFromB =  SetA |$| intB0' |*| strB2' |*| strB2'++insertQueryX :: InsertQuery ()+insertQueryX =  insertQuery setAFromB setA++deleteX :: Delete ()+deleteX = delete $ \proj -> do+  wheres $ proj ! strA1' .=. value "A"+  return $ pureP ()

@@ -35,6 +35,7 @@   , ("may_str_c3" ,    [t| Maybe String |]) ]   [''Generic] [0] $ Just 0) + $(defineTable defaultConfig "TEST" "set_i"   [ ("int_i0" ,    [t| Int32 |])  ]   [''Generic] [0] $ Just 0)

@@ -0,0 +1,53 @@+{-# LANGUAGE TemplateHaskell #-}++import Test.QuickCheck.Simple (Test, eqTest, defaultMain)++import Export (onX, assignX, registerX, insertQueryX, deleteX)++import qualified Data.ByteString.Char8 as B+import Data.ByteString.Short (ShortByteString, fromShort)++import Database.Relational (relationalQuery)+import Database.Relational.Export+  (inlineQuery_, inlineUpdate_, inlineInsertValue_, inlineInsertQuery_, inlineDelete_)+++$(inlineQuery_+  (const $ return ())+  (relationalQuery onX)+  "inlineOnX")++$(inlineUpdate_+  (const $ return ())+  assignX+  "inlineAssignX")++$(inlineInsertValue_+  (const $ return ())+  registerX+  "inlineRegisterX")++$(inlineInsertQuery_+  (const $ return ())+  insertQueryX+  "inlineInsertQueryX")++$(inlineDelete_+  (const $ return ())+  deleteX+  "inlineDeleteX")++eqInline :: Show a => String -> ShortByteString -> a -> Test+eqInline name inline orig = eqTest name (B.unpack $ fromShort inline) (show orig)++tests :: [Test]+tests =+  [ eqInline "onX"          inlineOnX          onX+  , eqInline "assignX"      inlineAssignX      assignX+  , eqInline "registerX"    inlineRegisterX    registerX+  , eqInline "insertQueryX" inlineInsertQueryX insertQueryX+  , eqInline "deleteX"      inlineDeleteX      deleteX+  ]++main :: IO ()+main = defaultMain tests