selda 0.1.12.1 → 0.2.0.0

raw patch · 7 files changed

+109/−40 lines, 7 filesdep ~basedep ~exceptionsdep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, exceptions, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−1
• selda.cabal +3/−3
• src/Database/Selda.hs +2/−2
• src/Database/Selda/Generic.hs +37/−12
• src/Database/Selda/Inner.hs +38/−2
• src/Database/Selda/Query.hs +3/−3
• src/Database/Selda/Table.hs +18/−17

@@ -1,12 +1,19 @@ # Revision history for Selda  +## 0.2.0.0 -- 2018-04-02++* Support custom column names for generic tables.+* Scope safety fix for inner queries.+* Better type errors on GHC 8+ for inner queries.++ ## 0.1.12.1 -- 2018-02-27  * New PPConfig hook for more flexibility when compiling types.  -## 0.1.12 -- 2018-01-11+## 0.1.12.0 -- 2018-01-11  * Allow recursive and optional foreign keys. * Allow arbitrary enums in tables, represented as text.

@@ -1,5 +1,5 @@ name:                selda-version:             0.1.12.1+version:             0.2.0.0 synopsis:            Multi-backend, high-level EDSL for interacting with SQL databases. description:         This package provides an EDSL for writing portable, type-safe, high-level                      database code. Its feature set includes querying and modifying databases,@@ -84,11 +84,11 @@   build-depends:       base                 >=4.8   && <5     , bytestring           >=0.10  && <0.11-    , exceptions           >=0.8   && <0.10+    , exceptions           >=0.8   && <0.11     , hashable             >=1.1   && <1.3     , mtl                  >=2.0   && <2.3     , text                 >=1.0   && <1.3-    , time                 >=1.5   && <1.9+    , time                 >=1.5   && <1.10     , unordered-containers >=0.2.6 && <0.3   if impl(ghc < 7.11)     build-depends:

@@ -87,7 +87,7 @@     -- * Converting between column types   , round_, just, fromBool, fromInt, toString     -- * Inner queries-  , Aggr, Aggregates, OuterCols, LeftCols, Inner, SqlOrd+  , Aggr, Aggregates, OuterCols, AggrCols, LeftCols, Inner, SqlOrd   , innerJoin, leftJoin   , aggregate, groupBy   , count, avg, sum_, max_, min_@@ -101,7 +101,7 @@   , prepared     -- * Defining schemas   , TableSpec, ColSpecs, ColSpec, TableName, ColName-  , NonNull, IsNullable, Nullable, NotNullable+  , NonNull   , Append (..), (:++:)   , Selectors, HasSelectors   , table, tableWithSelectors, selectors

@@ -23,7 +23,7 @@ module Database.Selda.Generic   ( Relational, Generic   , GenAttr (..), GenTable (..), Attribute, Relation-  , genTable, toRel, toRels, fromRel, fromRels+  , genTable, genTableFieldMod, toRel, toRels, fromRel, fromRels   , insertGen, insertGen_, insertGenWithPK   , primaryGen, autoPrimaryGen, uniqueGen, fkGen   ) where@@ -102,10 +102,35 @@          => TableName          -> [GenAttr a]          -> GenTable a-genTable tn attrs = GenTable $ Table tn (validate tn (map tidy cols)) apk+genTable tn attrs = genTableFieldMod tn attrs id++-- | Generate a table from the given table name,+--   a list of column attributes and a function+--   that maps from field names to column names.+--   Ex.:+--+-- > data Person = Person+-- >   { personId   :: Int+-- >   , personName :: Text+-- >   , personAge  :: Int+-- >   , personPet  :: Maybe Text+-- >   }+-- >   deriving Generic+-- >+-- > people :: GenTable Person+-- > people = genTableFieldMod "people" [(personName, autoPrimaryGen)] (stripPrefix "person")+--+--   This will create a table with the columns named+--   "Id", "Name", "Age" and "Pet".+genTableFieldMod :: forall a. Relational a+                 => TableName+                 -> [GenAttr a]+                 -> (String -> String)+                 -> GenTable a+genTableFieldMod tn attrs fieldMod = GenTable $ Table tn (validate tn (map tidy cols)) apk   where     dummy = mkDummy-    cols = zipWith addAttrs [0..] (tblCols (Proxy :: Proxy a))+    cols = zipWith addAttrs [0..] (tblCols (Proxy :: Proxy a) fieldMod)     apk = or [AutoIncrement `elem` as | _ :- Attribute as <- attrs]     addAttrs n ci = ci       { colAttrs = colAttrs ci ++ concat@@ -219,8 +244,8 @@ -- | Extract all column names from the given type. --   If the type is not a record, the columns will be named @col_1@, --   @col_2@, etc.-tblCols :: forall a. (GRelation (Rep a)) => Proxy a -> [ColInfo]-tblCols _ = zipWith pack' [0 :: Int ..] $ gTblCols (Proxy :: Proxy (Rep a))+tblCols :: forall a. (GRelation (Rep a)) => Proxy a -> (String -> String) -> [ColInfo]+tblCols _ fieldMod = zipWith pack' [0 :: Int ..] $ gTblCols (Proxy :: Proxy (Rep a)) fieldMod   where     pack' n ci = ci       { colName = if colName ci == ""@@ -247,7 +272,7 @@   gToRel   :: f a -> Rel f    -- | Compute all columns needed to represent the given type.-  gTblCols :: Proxy f -> [ColInfo]+  gTblCols :: Proxy f -> (String -> String) -> [ColInfo]    -- | Create a dummy value where all fields are replaced by @unsafeCoerce@'d   --   ints. See 'mkDummy' and 'identify' for more information.@@ -264,12 +289,12 @@   gMkDummy = M1 <$> gMkDummy  instance (G.Selector c, GRelation a) => GRelation (M1 S c a) where-  gToRel (M1 x) = gToRel x-  gTblCols _    = [ci']+  gToRel (M1 x)     = gToRel x+  gTblCols _ fieldMod = [ci']     where-      [ci] = gTblCols (Proxy :: Proxy a)+      [ci] = gTblCols (Proxy :: Proxy a) fieldMod       ci' = ColInfo-        { colName = mkColName . pack $ selName ((M1 undefined) :: M1 S c a b)+        { colName = mkColName . pack $ fieldMod (selName ((M1 undefined) :: M1 S c a b))         , colType = colType ci         , colAttrs = colAttrs ci         , colFKs = colFKs ci@@ -278,7 +303,7 @@  instance (Typeable a, SqlType a) => GRelation (K1 i a) where   gToRel (K1 x) = x-  gTblCols _    = [ColInfo "" (sqlType (Proxy :: Proxy a)) optReq []]+  gTblCols _ _  = [ColInfo "" (sqlType (Proxy :: Proxy a)) optReq []]     where       -- workaround for GHC 8.2 not resolving overlapping instances properly       maybeTyCon = typeRepTyCon (typeRep (Proxy :: Proxy (Maybe ())))@@ -293,7 +318,7 @@ instance (Append (Rel a) (Rel b), GRelation a, GRelation b) =>          GRelation (a G.:*: b) where   gToRel (a G.:*: b)   = gToRel a `app` gToRel b-  gTblCols _ = gTblCols a ++ gTblCols b+  gTblCols _ f = gTblCols a f ++ gTblCols b f     where       a = Proxy :: Proxy a       b = Proxy :: Proxy b

@@ -1,5 +1,6 @@ {-# LANGUAGE TypeOperators, TypeFamilies, FlexibleInstances, FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP, DataKinds, UndecidableInstances #-} -- | Helpers for working with inner queries. module Database.Selda.Inner where import Database.Selda.Column@@ -7,6 +8,8 @@ import Database.Selda.Types import Data.Text (Text) import Data.Typeable+import GHC.Exts+import GHC.TypeLits as TL  -- | A single aggregate column. --   Aggregate columns may not be used to restrict queries.@@ -38,9 +41,36 @@ --   @OuterCols (Aggr (Inner s) a :*: Aggr (Inner s) b) = Col s a :*: Col s b@, --   for instance. type family OuterCols a where-  OuterCols (t (Inner s) a :*: b) = Col s a :*: OuterCols b-  OuterCols (t (Inner s) a)       = Col s a+  OuterCols (Col (Inner s) a :*: b)  = Col s a :*: OuterCols b+  OuterCols (Col (Inner s) a)        = Col s a+#if MIN_VERSION_base(4, 9, 0)+  OuterCols (Col s a) = TypeError+    ( TL.Text "An inner query can only return columns from its own scope."+    )+#endif+#if MIN_VERSION_base(4, 9, 0)+  OuterCols a = TypeError+    ( TL.Text "Only (inductive tuples of) columns can be returned from" :$$:+      TL.Text "an inner query."+    )+#endif +type family AggrCols a where+  AggrCols (Aggr (Inner s) a :*: b) = Col s a :*: AggrCols b+  AggrCols (Aggr (Inner s) a)       = Col s a+#if MIN_VERSION_base(4, 9, 0)+  AggrCols (Aggr s a) = TypeError+    ( TL.Text "An aggregate query can only return columns from its own" :$$:+      TL.Text "scope."+    )+#endif+#if MIN_VERSION_base(4, 9, 0)+  AggrCols a = TypeError+    ( TL.Text "Only (inductive tuples of) aggregates can be returned from" :$$:+      TL.Text "an aggregate query."+    )+#endif+ -- | The results of a left join are always nullable, as there is no guarantee --   that all joined columns will be non-null. --   @JoinCols a@ where @a@ is an extensible tuple is that same tuple, but in@@ -54,6 +84,12 @@   LeftCols (Col (Inner s) a :*: b)         = Col s (Maybe a) :*: LeftCols b   LeftCols (Col (Inner s) (Maybe a))       = Col s (Maybe a)   LeftCols (Col (Inner s) a)               = Col s (Maybe a)+#if MIN_VERSION_base(4, 9, 0)+  LeftCols a = TypeError+    ( TL.Text "Only (inductive tuples of) columns can be returned" :$$:+      TL.Text "from a join."+    )+#endif  -- | One or more aggregate columns. class Aggregates a where

@@ -93,9 +93,9 @@ -- >     return (count address :*: some address) -- >  restrict (num_tenants .> 1) -- >  return (num_tenants :*: address)-aggregate :: (Columns (OuterCols a), Aggregates a)+aggregate :: (Columns (AggrCols a), Aggregates a)           => Query (Inner s) a-          -> Query s (OuterCols a)+          -> Query s (AggrCols a) aggregate q = Query $ do   (gst, aggrs) <- isolate q   cs <- mapM rename $ unAggrs aggrs@@ -166,7 +166,7 @@ -- > aggregate $ do -- >   (name :*: pet_name) <- select people -- >   name' <- groupBy name--- >   return (name' :*: count(pet_name) > 0)+-- >   return (name' :*: count(pet_name) .> 0) groupBy :: Col (Inner s) a -> Query (Inner s) (Aggr (Inner s) a) groupBy (C c) = Query $ do   st <- get

@@ -1,11 +1,14 @@ {-# LANGUAGE TypeOperators, TypeFamilies, OverloadedStrings #-} {-# LANGUAGE UndecidableInstances, FlexibleInstances, ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}+{-# LANGUAGE CPP, DataKinds #-} -- | Selda table definition language. module Database.Selda.Table where import Database.Selda.Types import Database.Selda.SqlType-import Control.Exception+import Control.Exception hiding (TypeError)+import GHC.Exts+import GHC.TypeLits import Data.Dynamic import Data.List (sort, group) import Data.Monoid@@ -61,20 +64,18 @@ -- | A table column specification. newtype ColSpec a = ColSpec {unCS :: [ColInfo]} --- | Used by 'IsNullable' to indicate a nullable type.-data Nullable---- | Used by 'IsNullable' to indicate a nullable type.-data NotNullable---- | Is the given type nullable?-type family IsNullable a where-  IsNullable (Maybe a) = Nullable-  IsNullable a         = NotNullable- -- | Any SQL type which is NOT nullable.-class SqlType a => NonNull a-instance (SqlType a, IsNullable a ~ NotNullable) => NonNull a+type family NonNull a :: Constraint where+#if MIN_VERSION_base(4, 9, 0)+  NonNull (Maybe a) = TypeError+    ( Text "Optional columns must not be nested, and" :<>:+      Text " required or primary key columns" :$$:+      Text "must not have option types."+    )+#else+  NonNull (Maybe a) = a ~ Maybe a+#endif+  NonNull a         = ()  -- | Column attributes such as nullability, auto increment, etc. --   When adding elements, make sure that they are added in the order@@ -84,17 +85,17 @@   deriving (Show, Eq, Ord)  -- | A non-nullable column with the given name.-required :: NonNull a => ColName -> ColSpec a+required :: (SqlType a, NonNull a) => ColName -> ColSpec a required = addAttr Required . newCol  -- | A nullable column with the given name.-optional :: NonNull a => ColName -> ColSpec (Maybe a)+optional :: (SqlType a, NonNull a) => ColName -> ColSpec (Maybe a) optional = addAttr Optional . newCol  -- | Marks the given column as the table's primary key. --   A table may only have one primary key; marking more than one key as --   primary will result in 'ValidationError' during validation.-primary :: NonNull a => ColName -> ColSpec a+primary :: (SqlType a, NonNull a) => ColName -> ColSpec a primary = addAttr Primary . unique . required  -- | Automatically increment the given attribute if not specified during insert.