packages feed

relational-query 0.8.5.1 → 0.8.6.0

raw patch · 13 files changed

+143/−89 lines, 13 filesdep ~names-thdep ~persistable-recordPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: names-th, persistable-record

API changes (from Hackage documentation)

- Database.Relational.Query.SQL: insertSizedChunkSQL :: Pi r r' -> Table r -> Int -> (String, Int)
+ Database.Relational.Query.Monad.BaseType: relationWidth :: Relation p r -> PersistableRecordWidth r
+ Database.Relational.Query.Pi: pzero :: Pi a ()
+ Database.Relational.Query.Pi.Unsafe: instance Control.Category.Category Database.Relational.Query.Pi.Unsafe.Pi
+ Database.Relational.Query.Pi.Unsafe: instance Database.Record.Persistable.PersistableWidth r0 => GHC.Show.Show (Database.Relational.Query.Pi.Unsafe.Pi r0 r1)
+ Database.Relational.Query.Pi.Unsafe: pzero :: Pi a ()
+ Database.Relational.Query.Pi.Unsafe: unsafeExpandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]
+ Database.Relational.Query.Projection: wpi :: PersistableRecordWidth a -> Projection c a -> Pi a b -> Projection c b
+ Database.Relational.Query.Pure: instance Database.Relational.Query.Pure.ShowConstantTermsSQL ()
+ Database.Relational.Query.Table: recordWidth :: Table r -> PersistableRecordWidth r
- Database.Relational.Query.Pi: id' :: PersistableWidth a => Pi a a
+ Database.Relational.Query.Pi: id' :: Pi a a
- Database.Relational.Query.Pi.Unsafe: pi :: [a] -> Pi r0 r1 -> [a]
+ Database.Relational.Query.Pi.Unsafe: pi :: PersistableRecordWidth r0 -> Pi r0 r1 -> [a] -> [a]
- Database.Relational.Query.Pi.Unsafe: unsafeExpandIndexes :: Pi a b -> [Int]
+ Database.Relational.Query.Pi.Unsafe: unsafeExpandIndexes :: PersistableWidth a => Pi a b -> [Int]
- Database.Relational.Query.Pi.Unsafe: width :: Pi r a -> Int
+ Database.Relational.Query.Pi.Unsafe: width :: PersistableWidth r => Pi r a -> Int
- Database.Relational.Query.Pi.Unsafe: width' :: Pi r ct -> PersistableRecordWidth ct
+ Database.Relational.Query.Pi.Unsafe: width' :: PersistableWidth r => Pi r ct -> PersistableRecordWidth ct
- Database.Relational.Query.ProjectableExtended: (!) :: Projection c a -> Pi a b -> Projection c b
+ Database.Relational.Query.ProjectableExtended: (!) :: PersistableWidth a => Projection c a -> Pi a b -> Projection c b
- Database.Relational.Query.ProjectableExtended: (!??) :: (ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c) => Projection cont (Maybe a) -> Pi a b -> Projection cont c
+ Database.Relational.Query.ProjectableExtended: (!??) :: (PersistableWidth a, ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c) => Projection cont (Maybe a) -> Pi a b -> Projection cont c
- Database.Relational.Query.ProjectableExtended: (?!) :: Projection c (Maybe a) -> Pi a b -> Projection c (Maybe b)
+ Database.Relational.Query.ProjectableExtended: (?!) :: PersistableWidth a => Projection c (Maybe a) -> Pi a b -> Projection c (Maybe b)
- Database.Relational.Query.ProjectableExtended: (?!?) :: Projection c (Maybe a) -> Pi a (Maybe b) -> Projection c (Maybe b)
+ Database.Relational.Query.ProjectableExtended: (?!?) :: PersistableWidth a => Projection c (Maybe a) -> Pi a (Maybe b) -> Projection c (Maybe b)
- Database.Relational.Query.ProjectableExtended: flattenPiMaybe :: (ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c) => Projection cont (Maybe a) -> Pi a b -> Projection cont c
+ Database.Relational.Query.ProjectableExtended: flattenPiMaybe :: (PersistableWidth a, ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c) => Projection cont (Maybe a) -> Pi a b -> Projection cont c
- Database.Relational.Query.Projection: pi :: Projection c a -> Pi a b -> Projection c b
+ Database.Relational.Query.Projection: pi :: PersistableWidth a => Projection c a -> Pi a b -> Projection c b
- Database.Relational.Query.Projection: piMaybe :: Projection c (Maybe a) -> Pi a b -> Projection c (Maybe b)
+ Database.Relational.Query.Projection: piMaybe :: PersistableWidth a => Projection c (Maybe a) -> Pi a b -> Projection c (Maybe b)
- Database.Relational.Query.Projection: piMaybe' :: Projection c (Maybe a) -> Pi a (Maybe b) -> Projection c (Maybe b)
+ Database.Relational.Query.Projection: piMaybe' :: PersistableWidth a => Projection c (Maybe a) -> Pi a (Maybe b) -> Projection c (Maybe b)
- Database.Relational.Query.SQL: insertSQL :: Pi r r' -> Table r -> String
+ Database.Relational.Query.SQL: insertSQL :: PersistableWidth r => Pi r r' -> Table r -> String

Files

ChangeLog.md view
@@ -1,10 +1,17 @@ <!-- -*- Markdown -*- --> +## 0.8.6.0++- add Show instance of Pi.+- add pzero and ConstantTermsSQL instance of ().+- add Category instance of Pi.+ ## 0.8.5.1  - add tested-with 8.2.1.  ## 0.8.5.0+ - Add derivedInsertValue definitions to arrow interface. - Apply chunked-insert to derivedInsertValue. 
relational-query.cabal view
@@ -1,5 +1,5 @@ name:                relational-query-version:             0.8.5.1+version:             0.8.6.0 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can@@ -90,7 +90,7 @@                        , th-reify-compat                        , sql-words >=0.1.4                        , names-th-                       , persistable-record >=0.3 && <0.5+                       , persistable-record >=0.4.2 && <0.5    hs-source-dirs:      src   ghc-options:         -Wall -fsimpl-tick-factor=200
src/Database/Relational/Query/Derives.hs view
@@ -38,7 +38,7 @@ import Database.Relational.Query.Projectable (placeholder, (.=.)) import Database.Relational.Query.ProjectableExtended ((!)) import Database.Relational.Query.Monad.Class (wheres)-import Database.Relational.Query.Monad.BaseType (Relation)+import Database.Relational.Query.Monad.BaseType (Relation, relationWidth) import Database.Relational.Query.Relation   (derivedRelation, relation, relation', query, UniqueRelation, unsafeUnique) import Database.Relational.Query.Constraint@@ -55,7 +55,7 @@       -> Relation p a  -- ^ Result restricted 'Relation' specifiedKey key rel = relation' $ do   q <- query rel-  (param, ()) <- placeholder (\ph -> wheres $ q ! key .=. ph)+  (param, ()) <- placeholder (\ph -> wheres $ Projection.wpi (relationWidth rel) q key .=. ph)   return (param, q)  -- | Query restricted with specified unique key.
src/Database/Relational/Query/Monad/BaseType.hs view
@@ -14,7 +14,7 @@          qualifyQuery, askConfig,           -- * Relation type-         Relation, unsafeTypeRelation, untypeRelation,+         Relation, unsafeTypeRelation, untypeRelation, relationWidth,           dump,          sqlFromRelationWith, sqlFromRelation,@@ -25,10 +25,12 @@ import Data.Functor.Identity (Identity, runIdentity) import Control.Applicative ((<$>)) +import Database.Record.Persistable (PersistableRecordWidth, unsafePersistableRecordWidth)+ import Database.Relational.Query.Internal.Config (Config, defaultConfig) import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL) -import Database.Relational.Query.Sub (Qualified, SubQuery, showSQL)+import Database.Relational.Query.Sub (Qualified, SubQuery, showSQL, width) import qualified Database.Relational.Query.Monad.Trans.Qualify as Qualify import Database.Relational.Query.Monad.Trans.Qualify (Qualify, qualify, evalQualifyPrime) import Database.Relational.Query.Monad.Trans.Config (QueryConfig, runQueryConfig, askQueryConfig)@@ -59,6 +61,12 @@ -- | Sub-query Qualify monad from relation. untypeRelation :: Relation p r -> ConfigureQuery SubQuery untypeRelation (SubQuery qsub) = qsub++-- | 'PersistableRecordWidth' of 'Relation' type.+relationWidth :: Relation p r ->  PersistableRecordWidth r+relationWidth rel =+  unsafePersistableRecordWidth . width $ configureQuery (untypeRelation rel) defaultConfig+  ---                               Assume that width is independent from Config structure  unsafeCastPlaceHolder :: Relation a r -> Relation b r unsafeCastPlaceHolder (SubQuery qsub) = SubQuery qsub
src/Database/Relational/Query/Monad/Trans/Assigning.hs view
@@ -35,7 +35,7 @@  import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Pi (Pi)-import Database.Relational.Query.Table (Table)+import Database.Relational.Query.Table (Table, recordWidth) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Monad.Class (MonadQualify (..), MonadRestrict(..))@@ -63,7 +63,7 @@ type AssignTarget r v = Pi r v  targetProjection :: AssignTarget r v ->  Table r -> Projection Flat v-targetProjection pi' tbl = Projection.pi (Projection.unsafeFromTable tbl) pi'+targetProjection pi' tbl = Projection.wpi (recordWidth tbl) (Projection.unsafeFromTable tbl) pi'  -- | Add an assignment. assignTo :: Monad m => Projection Flat v ->  AssignTarget r v -> Assignings r m ()
src/Database/Relational/Query/Pi.hs view
@@ -11,23 +11,24 @@ -- Contains normal interfaces. module Database.Relational.Query.Pi (   -- * Projection path-  Pi, pfmap, pap, (<.>), (<?.>), (<?.?>),+  Pi, pfmap, pap, pzero, (<.>), (<?.>), (<?.?>),    id', fst', snd'   ) where +import qualified Control.Category as Category import Database.Record   (PersistableWidth, persistableWidth, PersistableRecordWidth) import Database.Record.Persistable   (runPersistableRecordWidth)  import Database.Relational.Query.Pi.Unsafe-  (Pi, pfmap, pap, (<.>), (<?.>), (<?.?>), definePi)+  (Pi, pfmap, pap, pzero, (<.>), (<?.>), (<?.?>), definePi)   -- | Identity projection path.-id' :: PersistableWidth a => Pi a a-id' =  definePi 0+id' :: Pi a a+id' = Category.id  -- | Projection path for fst of tuple. fst' :: PersistableWidth a => Pi (a, b) a -- ^ Projection path of fst.
src/Database/Relational/Query/Pi/Unsafe.hs view
@@ -3,7 +3,7 @@  -- | -- Module      : Database.Relational.Query.Pi.Unsafe--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -18,6 +18,8 @@    pfmap, pap, +  pzero,+   width', width,    (<.>), (<?.>), (<?.?>),@@ -26,10 +28,12 @@    definePi, defineDirectPi', defineDirectPi, +  unsafeExpandIndexes',   unsafeExpandIndexes   ) where -import Prelude hiding (pi)+import Prelude hiding (pi, (.), id)+import Control.Category (Category (..), (>>>)) import Data.Array (listArray, (!))  import Database.Record.Persistable@@ -52,20 +56,30 @@  -- | Projection path from type 'r0' into type 'r1'. --   This type also indicate key object which type is 'r1' for record type 'r0'.-data Pi r0 r1 = Pi (Pi' r0 r1) (PersistableRecordWidth r1)+newtype Pi r0 r1 = Pi { runPi :: PersistableRecordWidth r0 -> (Pi' r0 r1, PersistableRecordWidth r1) } -unsafePiAppend :: (PersistableRecordWidth c' -> PersistableRecordWidth c)-                  -> Pi a b' -> Pi b c' -> Pi a c-unsafePiAppend f (Pi p0 _) (Pi p1 w) =-  Pi (p0 `unsafePiAppend'` p1) (f w)+instance PersistableWidth r0 => Show (Pi r0 r1) where+  show p = unwords ["Pi", show $ unsafeExpandIndexes p] +unsafePiAppend :: (PersistableRecordWidth b' -> PersistableRecordWidth b)+               -> (PersistableRecordWidth c' -> PersistableRecordWidth c)+               -> Pi a b' -> Pi b c' -> Pi a c+unsafePiAppend wbf wcf (Pi f) (Pi g) = Pi $ \wa ->+  let (pab, wb) = f wa+      (pbc, wc) = g $ wbf wb+  in (pab `unsafePiAppend'` pbc, wcf wc)+ -- | Unsafely untype key to expand indexes.-unsafeExpandIndexes :: Pi a b -> [Int]-unsafeExpandIndexes = d  where-  d (Pi (Map is) _)    = is-  d (Pi (Leftest i) w) = [ i .. i + w' - 1 ]  where+unsafeExpandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]+unsafeExpandIndexes' wa (Pi f) = d $ f wa where+  d (Map is, _)    = is+  d (Leftest i, w) = [ i .. i + w' - 1 ]  where     w' = runPersistableRecordWidth w +-- | Unsafely untype key to expand indexes.+unsafeExpandIndexes :: PersistableWidth a => Pi a b -> [Int]+unsafeExpandIndexes = unsafeExpandIndexes' persistableWidth+ -- | Unsafely cast width proof object of record. Result record must be same width. unsafeCastRecordWidth :: PersistableRecordWidth a -> PersistableRecordWidth a' unsafeCastRecordWidth =  unsafePersistableRecordWidth . runPersistableRecordWidth@@ -74,7 +88,9 @@ unsafeCast =  c  where   d (Leftest i) = Leftest i   d (Map m)     = Map m-  c (Pi p w)    = Pi (d p) (unsafeCastRecordWidth w)+  c (Pi f)    = Pi $ \wa ->+    let (pb, wb) = f wa in+    (d pb, unsafeCastRecordWidth wb)  -- | Projectable fmap of 'Pi' type. pfmap :: ProductConstructor (a -> b)@@ -83,37 +99,55 @@  -- | Projectable ap of 'Pi' type. pap :: Pi r (a -> b) -> Pi r a -> Pi r b-pap b@(Pi _ wb) c@(Pi _ wc) =-   Pi-   (Map $ unsafeExpandIndexes b ++ unsafeExpandIndexes c)-   (unsafeCastRecordWidth $ wb <&> wc)+pap pab pb =+   Pi $ \wr ->+   let (_, wab) = runPi pab wr+       (_, wb)  = runPi pb  wr in+   (Map $ unsafeExpandIndexes' wr pab ++ unsafeExpandIndexes' wr pb,+    unsafeCastRecordWidth $ wab <&> wb) {- should switch to safe projectable-applicative -} +-- | 'Pi' with zero width which projects to unit+pzero :: Pi a ()+pzero = Pi $ \_ -> (Map [], persistableWidth)+ -- | Get record width proof object.-width' :: Pi r ct -> PersistableRecordWidth ct-width' (Pi _ w) = w+width' :: PersistableWidth r => Pi r ct -> PersistableRecordWidth ct+width' (Pi f) = snd $ f persistableWidth  -- | Get record width.-width :: Pi r a -> Int+width :: PersistableWidth r => Pi r a -> Int width =  runPersistableRecordWidth . width' +justWidth :: PersistableRecordWidth (Maybe a) -> PersistableRecordWidth a+justWidth = unsafeCastRecordWidth+++instance Category Pi where+  id = Pi $ \pw -> (Leftest 0, pw)+  Pi fb . Pi fa = Pi $ \wa ->+    let (pb, wb) = fa wa+        (pc, wc) = fb wb+    in (unsafePiAppend' pb pc, wc)+ -- | Compose projection path. (<.>) :: Pi a b -> Pi b c -> Pi a c-(<.>) = unsafePiAppend id+(<.>) = (>>>)  -- | Compose projection path. 'Maybe' phantom functor is 'map'-ed. (<?.>) :: Pi a (Maybe b) -> Pi b c -> Pi a (Maybe c)-(<?.>) = unsafePiAppend maybeWidth+(<?.>) = unsafePiAppend justWidth maybeWidth  -- | Compose projection path. 'Maybe' phantom functors are 'join'-ed like '>=>'. (<?.?>) :: Pi a (Maybe b) -> Pi b (Maybe c) -> Pi a (Maybe c)-(<?.?>) = unsafePiAppend id+(<?.?>) = unsafePiAppend justWidth id  infixl 8 <.>, <?.>, <?.?>  -- | Unsafely project untyped value list.-pi :: [a] -> Pi r0 r1 -> [a]-pi cs (Pi p' w) = d p'  where-  d (Leftest i) = take (runPersistableRecordWidth w) . drop i $ cs+pi :: PersistableRecordWidth r0 -> Pi r0 r1 -> [a] -> [a]+pi w0 (Pi f) cs = d p'  where+  (p', w1) = f w0+  d (Leftest i) = take (runPersistableRecordWidth w1) . drop i $ cs   d (Map is)    = [cs' ! i | i <- is]   cs' = listArray (0, length cs) cs @@ -121,7 +155,7 @@ definePi' :: PersistableRecordWidth r1           -> Int      -- ^ Index of flat SQL value list           -> Pi r0 r1 -- ^ Result projection path-definePi' pw i = Pi (Leftest i) pw+definePi' pw i = Pi $ \_ -> (Leftest i, pw)  -- | Unsafely define projection path from type 'r0' into type 'r1'. --   Use inferred 'PersistableRecordWidth'.@@ -134,7 +168,7 @@ defineDirectPi' :: PersistableRecordWidth r1                 -> [Int]    -- ^ Indexes of flat SQL value list                 -> Pi r0 r1 -- ^ Result projection path-defineDirectPi' pw is = Pi (Map is) pw+defineDirectPi' pw is = Pi $ \_ -> (Map is, pw)  -- | Unsafely define projection path from type 'r0' into type 'r1'. --   Use inferred 'PersistableRecordWidth'.
src/Database/Relational/Query/ProjectableExtended.hs view
@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.ProjectableExtended--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -38,6 +38,7 @@ import Prelude hiding (pi)  import qualified Language.SQL.Keyword as SQL+import Database.Record (PersistableWidth)  import Database.Relational.Query.Context (Flat, Aggregated, OverWindow) import Database.Relational.Query.Projection (Projection)@@ -119,14 +120,16 @@ some' =  unsafeAggregateOp SQL.SOME  -- | Get narrower projection along with projection path.-(!) :: Projection c a -- ^ Source projection+(!) :: PersistableWidth a+    => Projection c a -- ^ Source projection     -> Pi a b         -- ^ Projection path     -> Projection c b -- ^ Narrower projected object (!) = Projection.pi  -- | Get narrower projection along with projection path --   'Maybe' phantom functor is 'map'-ed.-(?!) :: Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type+(?!) :: PersistableWidth a+     => Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type      -> Pi a b                 -- ^ Projection path      -> Projection c (Maybe b) -- ^ Narrower projected object. 'Maybe' type result (?!) = Projection.piMaybe@@ -134,7 +137,8 @@ -- | Get narrower projection along with projection path --   and project into result projection type. --   Source record 'Maybe' phantom functor and projection path leaf 'Maybe' functor are 'join'-ed.-(?!?) :: Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type+(?!?) :: PersistableWidth a+      => Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type       -> Pi a (Maybe b)         -- ^ Projection path. 'Maybe' type leaf       -> Projection c (Maybe b) -- ^ Narrower projected object. 'Maybe' phantom type result (?!?) = Projection.piMaybe'@@ -154,14 +158,14 @@   flatten = id  -- | Get narrower projection with flatten leaf phantom Maybe types along with projection path.-flattenPiMaybe :: (ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c)+flattenPiMaybe :: (PersistableWidth a, ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c)                => Projection cont (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type                -> Pi a b                    -- ^ Projection path                -> Projection cont c         -- ^ Narrower 'Projection'. Flatten 'Maybe' phantom type flattenPiMaybe p = flatten . Projection.piMaybe p  -- | Get narrower projection with flatten leaf phantom Maybe types along with projection path.-(!??) :: (ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c)+(!??) :: (PersistableWidth a, ProjectableMaybe (Projection cont), ProjectableFlattenMaybe (Maybe b) c)       => Projection cont (Maybe a) -- ^ Source 'Projection'. 'Maybe' phantom type       -> Pi a b                    -- ^ Projection path       -> Projection cont c         -- ^ Narrower flatten and projected object.
src/Database/Relational/Query/Projection.hs view
@@ -27,6 +27,7 @@    -- * Projections   pi, piMaybe, piMaybe',+  wpi,    flattenMaybe, just, @@ -44,7 +45,8 @@  import qualified Language.SQL.Keyword as SQL -import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint)+import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint, PersistableWidth, persistableWidth)+import Database.Record.Persistable (PersistableRecordWidth) import qualified Database.Record.KeyConstraint as KeyConstraint  import Database.Relational.Query.Internal.SQL (StringSQL, listStringSQL, )@@ -103,30 +105,40 @@   -- | Unsafely trace projection path.-unsafeProject :: Projection c a' -> Pi a b -> Projection c b'-unsafeProject p pi' =+unsafeProject :: PersistableRecordWidth a -> Projection c a' -> Pi a b -> Projection c b'+unsafeProject w p pi' =   Internal.projectFromColumns-  . (`UnsafePi.pi` pi')+  . (UnsafePi.pi w pi')   . columns $ p  -- | Trace projection path to get narrower 'Projection'.-pi :: Projection c a -- ^ Source 'Projection'+wpi :: PersistableRecordWidth a+    -> Projection c a -- ^ Source 'Projection'+    -> Pi a b         -- ^ Projection path+    -> Projection c b -- ^ Narrower 'Projection'+wpi =  unsafeProject++-- | Trace projection path to get narrower 'Projection'.+pi :: PersistableWidth a+   => Projection c a -- ^ Source 'Projection'    -> Pi a b         -- ^ Projection path    -> Projection c b -- ^ Narrower 'Projection'-pi =  unsafeProject+pi =  unsafeProject persistableWidth  -- | Trace projection path to get narrower 'Projection'. From 'Maybe' type to 'Maybe' type.-piMaybe :: Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type+piMaybe :: PersistableWidth a+        => Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type         -> Pi a b                 -- ^ Projection path         -> Projection c (Maybe b) -- ^ Narrower 'Projection'. 'Maybe' type result-piMaybe =  unsafeProject+piMaybe = unsafeProject persistableWidth  -- | Trace projection path to get narrower 'Projection'. From 'Maybe' type to 'Maybe' type. --   Leaf type of projection path is 'Maybe'.-piMaybe' :: Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type+piMaybe' :: PersistableWidth a+         => Projection c (Maybe a) -- ^ Source 'Projection'. 'Maybe' type          -> Pi a (Maybe b)         -- ^ Projection path. 'Maybe' type leaf          -> Projection c (Maybe b) -- ^ Narrower 'Projection'. 'Maybe' type result-piMaybe' =  unsafeProject+piMaybe' = unsafeProject persistableWidth  unsafeCast :: Projection c r -> Projection c r' unsafeCast =  typedProjection . untypeProjection
src/Database/Relational/Query/Pure.hs view
@@ -81,6 +81,10 @@ showConstantTermsSQL :: ShowConstantTermsSQL a => a -> [String] showConstantTermsSQL =  map showStringSQL . showConstantTermsSQL' +-- | Constant SQL terms of '()'.+instance ShowConstantTermsSQL () where+  showConstantTermsSQL' () = []+ -- | Constant SQL terms of 'Int8'. instance ShowConstantTermsSQL Int8 where   showConstantTermsSQL' = intTermsSQL
src/Database/Relational/Query/Relation.hs view
@@ -47,7 +47,7 @@ import Database.Relational.Query.Context (Flat, Aggregated) import Database.Relational.Query.Monad.BaseType   (ConfigureQuery, qualifyQuery,-   Relation, unsafeTypeRelation, untypeRelation)+   Relation, unsafeTypeRelation, untypeRelation, relationWidth) import Database.Relational.Query.Monad.Class   (MonadQualify (liftQualify), MonadQuery (query', queryMaybe'), on) import Database.Relational.Query.Monad.Simple (QuerySimple, SimpleQuery)@@ -66,7 +66,6 @@ import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Projectable   (PlaceHolders, unitPlaceHolder, unsafeAddPlaceHolders, unsafePlaceHolders, projectZip)-import Database.Relational.Query.ProjectableExtended ((!))   -- | Simple 'Relation' from 'Table'.@@ -371,7 +370,7 @@                  -> UniqueRelation ph Flat b aggregatedUnique rel k ag = unsafeUnique . aggregateRelation' $ do   (ph, a) <- query' rel-  return (ph, ag $ a ! k)+  return (ph, ag $ Projection.wpi (relationWidth rel) a k)  -- | Scalar sub-query with place-holder parameter 'p'. queryScalar' :: (MonadQualify ConfigureQuery m, ScalarDegree r)
src/Database/Relational/Query/SQL.hs view
@@ -20,7 +20,7 @@   updateOtherThanKeySQL', updateOtherThanKeySQL,    -- * Insert SQL-  insertPrefixSQL, insertSQL, insertSizedChunkSQL,+  insertPrefixSQL, insertSQL,    -- * Delete SQL   deletePrefixSQL', deletePrefixSQL@@ -31,6 +31,7 @@  import Language.SQL.Keyword (Keyword(..), (.=.), (|*|)) import qualified Language.SQL.Keyword as SQL+import Database.Record (PersistableWidth) import Database.Record.ToSql (untypedUpdateValuesIndex)  import Database.Relational.Query.Internal.SQL@@ -38,7 +39,7 @@  import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi-import Database.Relational.Query.Table (Table, name, columns)+import Database.Relational.Query.Table (Table, name, columns, recordWidth) import qualified Database.Relational.Query.Projection as Projection  @@ -89,43 +90,23 @@           -> Pi r p  -- ^ Key columns           -> String  -- ^ Result SQL updateOtherThanKeySQL tbl key =-  updateOtherThanKeySQL' (name tbl) (columns tbl) (UnsafePi.unsafeExpandIndexes key)+  updateOtherThanKeySQL' (name tbl) (columns tbl) (UnsafePi.unsafeExpandIndexes' (recordWidth tbl) key)  -- | Generate prefix string of insert SQL. insertPrefixSQL :: Pi r r' -> Table r -> StringSQL insertPrefixSQL pi' table =   INSERT <> INTO <> stringSQL (name table) <> rowConsStringSQL cols  where-    cols = Projection.columns . Projection.pi (Projection.unsafeFromTable table) $ pi'--{-# DEPRECATED insertChunkSQL "Deprecated." #-}--- | Generate records chunk insert SQL.-insertChunkSQL :: Int     -- ^ Records count to insert-               -> Pi r r' -- ^ Columns selector to insert-               -> Table r -- ^ Table metadata-               -> String  -- ^ Result SQL-insertChunkSQL n0 pi' tbl = showStringSQL $ insertPrefixSQL pi' tbl <> VALUES <> vs  where-  n | n0 >= 1    =  n0-    | otherwise  =  error $ "Invalid chunk count value: " ++ show n0-  w = UnsafePi.width pi'-  vs = SQL.fold (|*|) . replicate n $ rowConsStringSQL (replicate w "?")--{-# DEPRECATED insertSizedChunkSQL "Deprecated." #-}--- | Generate size measured records chunk insert SQL.-insertSizedChunkSQL :: Pi r r'       -- ^ Columns selector to insert-                    -> Table r       -- ^ Table metadata-                    -> Int           -- ^ Chunk size threshold (column count)-                    -> (String, Int) -- ^ Result SQL and records count of chunk-insertSizedChunkSQL pi' tbl th = (insertChunkSQL n pi' tbl, n)  where-  n | w <= 0     =  th + 1-    | otherwise  =  th `quot` w + 1-  w = UnsafePi.width pi'+    cols = Projection.columns . Projection.wpi (recordWidth table) (Projection.unsafeFromTable table) $ pi'  {-# DEPRECATED insertSQL "Deprecated." #-} -- | Generate insert SQL.-insertSQL :: Pi r r' -- ^ Columns selector to insert+insertSQL :: PersistableWidth r+          => Pi r r' -- ^ Columns selector to insert           -> Table r -- ^ Table metadata           -> String  -- ^ Result SQL-insertSQL =  insertChunkSQL 1+insertSQL pi' tbl = showStringSQL $ insertPrefixSQL pi' tbl <> VALUES <> vs  where+  w = UnsafePi.width pi'+  vs = rowConsStringSQL (replicate w "?")  -- | Generate all column delete SQL by specified table. Untyped table version. deletePrefixSQL' :: String -> StringSQL
src/Database/Relational/Query/Table.hs view
@@ -10,7 +10,7 @@ -- This module defines table type which has table metadatas. module Database.Relational.Query.Table (   -- * Phantom typed table type-  Table, unType, name, shortName, width, columns, index, table, toMaybe,+  Table, unType, name, shortName, width, columns, index, table, toMaybe, recordWidth,    -- * Table existence inference   TableDerivable (..)@@ -18,7 +18,7 @@  import Data.Array (listArray) -import Database.Record (PersistableWidth)+import Database.Record.Persistable (PersistableWidth, PersistableRecordWidth, unsafePersistableRecordWidth)  import Database.Relational.Query.Internal.UntypedTable (Untyped (Untyped), name', width', columns', (!)) import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, )@@ -66,3 +66,7 @@ -- | Inference rule of 'Table' existence. class PersistableWidth r => TableDerivable r where   derivedTable :: Table r++-- | PersistableRecordWidth of table+recordWidth :: Table r -> PersistableRecordWidth r+recordWidth = unsafePersistableRecordWidth . width