selda 0.1.11.2 → 0.1.12

raw patch · 10 files changed

+103/−24 lines, 10 filesdep ~exceptionsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: exceptions

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• README.md +2/−0
• selda.cabal +2/−2
• src/Database/Selda.hs +10/−3
• src/Database/Selda/SQL/Print.hs +5/−0
• src/Database/Selda/SQL/Print/Config.hs +12/−0
• src/Database/Selda/SqlType.hs +27/−3
• src/Database/Selda/Table.hs +9/−9
• src/Database/Selda/Table/Compile.hs +14/−5
• src/Database/Selda/Table/Foreign.hs +14/−2

@@ -1,6 +1,14 @@ # Revision history for Selda  +## 0.1.12 -- 2018-01-11++* Allow recursive and optional foreign keys.+* Allow arbitrary enums in tables, represented as text.+* Fix RowID issues for PostgreSQL.+* Fix auto-incrementing primary keys for generic tables.++ ## 0.1.11.2 -- 2017-12-14  * Fix treatment of booleans in PostgreSQL backend.

@@ -1,5 +1,7 @@ Selda =====++[![Join the chat at https://gitter.im/selda-hs/Lobby](https://badges.gitter.im/selda-hs/Lobby.svg)](https://gitter.im/selda-hs/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage](https://img.shields.io/hackage/v/selda.svg?style=flat)](http://hackage.haskell.org/package/selda) [![IRC channel](https://img.shields.io/badge/IRC-%23selda-1e72ff.svg?style=flat)](https://www.irccloud.com/invite?channel=%23selda&hostname=irc.freenode.net&port=6697&ssl=1) ![MIT License](http://img.shields.io/badge/license-MIT-brightgreen.svg)

@@ -1,6 +1,6 @@ name:                selda-version:             0.1.11.2-synopsis:            Type-safe, high-level EDSL for interacting with relational databases.+version:             0.1.12+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,                      automatic, in-process caching with consistency guarantees, and transaction

@@ -69,7 +69,7 @@   , query, transaction, setLocalCache     -- * Constructing queries   , Selector, (!), Assignment(..), with-  , SqlType (..)+  , SqlType (..), SqlEnum (..)   , Cols, Columns   , Order (..)   , (:*:)(..)@@ -107,10 +107,10 @@   , table, tableWithSelectors, selectors   , required, optional   , primary, autoPrimary-  , fk, unique+  , fk, optFk, unique     -- * Creating and dropping tables   , createTable, tryCreateTable-  , dropTable, tryDropTable+  , validateTable, dropTable, tryDropTable     -- * Compiling and inspecting queries   , OnError (..)   , compile@@ -153,6 +153,13 @@ instance SqlOrd UTCTime instance SqlOrd TimeOfDay instance SqlOrd a => SqlOrd (Maybe a)++-- | Validate a table schema.+--   Throws a 'ValidationError' if the schema does not validate.+--   Currently does not check the schema against what's actually in the+--   current database.+validateTable :: MonadSelda m => Table a -> m ()+validateTable t = validate (tableName t) (tableCols t) `seq` return ()  -- | Convenient shorthand for @fmap (! sel) q@. --   The following two queries are quivalent:

@@ -210,6 +210,11 @@   c <- ppConfig <$> get   pure $ Cfg.ppType c t +ppTypePK :: SqlTypeRep -> PP Text+ppTypePK t = do+  c <- ppConfig <$> get+  pure $ Cfg.ppTypePK c t+ ppCol :: Exp SQL a -> PP Text ppCol (TblCol xs)    = error $ "compiler bug: ppCol saw TblCol: " ++ show xs ppCol (Col name)     = pure (fromColName name)

@@ -8,8 +8,16 @@ -- | Backend-specific configuration for the SQL pretty-printer. data PPConfig = PPConfig   { -- | The SQL type name of the given type.+    --+    --   This function should be used everywhere a type is needed to be printed but in primary+    --   keys position. This is due to the fact that some backends might have a special+    --   representation of primary keys (using sequences are such). If you have such a need,+    --   please use the 'ppTypePK' record instead.     ppType :: SqlTypeRep -> Text +    -- | The SQL type name of the given type for primary keys uses.+  , ppTypePK :: SqlTypeRep -> Text+     -- | Parameter placeholder for the @n@th parameter.   , ppPlaceholder :: Int -> Text @@ -31,9 +39,13 @@  -- | Default settings for pretty-printing. --   Geared towards SQLite.+--+--   The default definition of 'ppTypePK' is 'defType, so that you don’t have to do anything+--   special if you don’t use special types for primary keys. defPPConfig :: PPConfig defPPConfig = PPConfig     { ppType = defType+    , ppTypePK = defType     , ppPlaceholder = T.cons '$' . T.pack . show     , ppColAttrs = T.unwords . map defColAttr     , ppAutoIncInsert = "NULL"

@@ -1,10 +1,11 @@ {-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-} -- | Types representable in Selda's subset of SQL. module Database.Selda.SqlType-  ( Lit (..), RowID, SqlValue (..), SqlType, SqlTypeRep (..)+  ( SqlType (..), SqlEnum (..)+  , Lit (..), RowID, SqlValue (..), SqlTypeRep (..)   , invalidRowId, isInvalidRowId, unsafeRowId, fromRowId-  , mkLit, sqlType, litType, fromSql, defaultValue-  , compLit+  , compLit, litType   , sqlDateTimeFormat, sqlDateFormat, sqlTimeFormat   ) where import Data.ByteString (ByteString, empty)@@ -57,6 +58,23 @@   -- | Default value when using 'def' at this type.   defaultValue :: Lit a +-- | Any type that's bounded, enumerable and has a text representation, and+--   thus representable as a Selda enumerable.+--+--   While it would be more efficient to store enumerables as integers, this+--   makes hand-rolled SQL touching the values inscrutable, and will break if+--   the user a) derives Enum and b) changes the order of their constructors.+--   Long-term, this should be implemented in PostgreSQL as a proper enum+--   anyway, which mostly renders the performance argument moot.+class (Typeable a, Bounded a, Enum a) => SqlEnum a where+  toText :: a -> Text+  fromText :: Text -> a++instance {-# OVERLAPPABLE #-}+    (Typeable a, Bounded a, Enum a, Show a, Read a) => SqlEnum a where+  toText = pack . show+  fromText = read . unpack+ -- | An SQL literal. data Lit a where   LText     :: !Text       -> Lit Text@@ -267,3 +285,9 @@   fromSql (SqlNull) = Nothing   fromSql x         = Just $ fromSql x   defaultValue = LNull++instance {-# OVERLAPPABLE #-} (Typeable a, SqlEnum a) => SqlType a where+  mkLit = LCustom . LText . toText+  sqlType _ = sqlType (Proxy :: Proxy Text)+  fromSql = fromText . fromSql+  defaultValue = LCustom $ mkLit (toText (minBound :: a))

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeOperators, TypeFamilies, OverloadedStrings #-} {-# LANGUAGE UndecidableInstances, FlexibleInstances, ScopedTypeVariables #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} -- | Selda table definition language. module Database.Selda.Table where import Database.Selda.Types@@ -34,20 +34,20 @@ --   non-empty. Column names must be unique per table. data Table a = Table   { -- | Name of the table. NOT guaranteed to be a valid SQL name.-    tableName :: !TableName+    tableName :: TableName     -- | All table columns.     --   Invariant: the 'colAttrs' list of each column is sorted and contains     --   no duplicates.-  , tableCols :: ![ColInfo]+  , tableCols :: [ColInfo]     -- | Does the given table have an auto-incrementing primary key?-  , tableHasAutoPK :: !Bool+  , tableHasAutoPK :: Bool   }  data ColInfo = ColInfo-  { colName  :: !ColName-  , colType  :: !SqlTypeRep-  , colAttrs :: ![ColAttr]-  , colFKs   :: ![(Table (), ColName)]+  { colName  :: ColName+  , colType  :: SqlTypeRep+  , colAttrs :: [ColAttr]+  , colFKs   :: [(Table (), ColName)]   }  newCol :: forall a. SqlType a => ColName -> ColSpec a@@ -135,7 +135,7 @@     , tableHasAutoPK = Prelude.any ((AutoIncrement `elem`) . colAttrs) tcs     }   where-    tcs = validate name $ map tidy $ mergeSpecs (Proxy :: Proxy a) cs+    tcs = map tidy $ mergeSpecs (Proxy :: Proxy a) cs  -- | Remove duplicate attributes. tidy :: ColInfo -> ColInfo

@@ -2,12 +2,13 @@ -- | Generating SQL for creating and deleting tables. module Database.Selda.Table.Compile where import Database.Selda.Table-import Data.List (foldl')+import Data.List ((\\), foldl') import Data.Monoid import Data.Text (Text, intercalate, pack) import qualified Data.Text as Text import Database.Selda.SQL hiding (params, param) import Database.Selda.SQL.Print.Config+import Database.Selda.SqlType (SqlTypeRep(..)) import Database.Selda.Types  data OnError = Fail | Ignore@@ -15,7 +16,7 @@  -- | Compile a @CREATE TABLE@ query from a table definition. compileCreateTable :: PPConfig -> OnError -> Table a -> Text-compileCreateTable customColType ifex tbl = mconcat+compileCreateTable customColType ifex tbl = ensureValid `seq` mconcat   [ "CREATE TABLE ", ifNotExists ifex, fromTableName (tableName tbl), "("   , intercalate ", " (map (compileTableCol customColType) (tableCols tbl))   , case allFKs of@@ -28,6 +29,7 @@     ifNotExists Ignore = "IF NOT EXISTS "     allFKs = [(colName ci, fk) | ci <- tableCols tbl, fk <- colFKs ci]     compFKs = zipWith (uncurry compileFK) allFKs [0..]+    ensureValid = validate (tableName tbl) (tableCols tbl)  -- | Compile a foreign key constraint. compileFK :: ColName -> (Table (), ColName) -> Int -> Text@@ -41,9 +43,16 @@ -- | Compile a table column. compileTableCol :: PPConfig -> ColInfo -> Text compileTableCol cfg ci = Text.unwords-  [ fromColName (colName ci)-  , ppType cfg (colType ci) <> " " <> ppColAttrs cfg (colAttrs ci)-  ]+    [ fromColName (colName ci)+    , ppType' cfg cty <> " " <> ppColAttrs cfg (colAttrs ci)+    ]+  where+    cty = colType ci+    attrs = colAttrs ci+    ppType' +      | cty == TRowID && [Primary, AutoIncrement] `areIn` attrs = ppTypePK+      | otherwise = ppType+    areIn x y = null (x \\ y)  -- | Compile a @DROP TABLE@ query. compileDropTable :: OnError -> Table a -> Text

@@ -1,7 +1,9 @@+{-# LANGUAGE OverloadedStrings #-} -- | Foreign key support. module Database.Selda.Table.Foreign where import Database.Selda.Selectors import Database.Selda.Table+import Unsafe.Coerce  -- | Add a foreign key constraint to the given column, referencing --   the column indicated by the given table and selector.@@ -9,10 +11,20 @@ --   uniqueness constraint, a 'ValidationError' will be thrown --   during validation. fk :: ColSpec a -> (Table t, Selector t a) -> ColSpec a-fk (ColSpec [c]) (Table tn tcs tapk, Selector i) =+fk (ColSpec [c]) (tbl, Selector i) =     ColSpec [c {colFKs = thefk : colFKs c}]   where-    thefk = (Table tn tcs tapk, colName (tcs !! i))+    Table _ tcs _ = tbl+    thefk = (unsafeCoerce tbl, colName (tcs !! i)) fk _ _ =   error "impossible: ColSpec with several columns" +-- | Like 'fk', but for nullable foreign keys.+optFk :: ColSpec (Maybe a) -> (Table t, Selector t a) -> ColSpec (Maybe a)+optFk (ColSpec [c]) (tbl, Selector i) =+    ColSpec [c {colFKs = thefk : colFKs c}]+  where+    Table _ tcs _ = tbl+    thefk = (unsafeCoerce tbl, colName (tcs !! i))+optFk _ _ =+  error "impossible: ColSpec with several columns"