persistent 2.8.1 → 2.8.2

raw patch · 6 files changed

+150/−14 lines, 6 filesdep ~base

Dependency ranges changed: base

Files

• ChangeLog.md +4/−0
• Database/Persist/Class/PersistField.hs +47/−3
• Database/Persist/Class/PersistStore.hs +1/−0
• Database/Persist/Quasi.hs +40/−10
• Database/Persist/Sql/Class.hs +57/−0
• persistent.cabal +1/−1

@@ -1,3 +1,7 @@+## 2.8.2++* Added support for `sql=` to the unique constraints quasi-quoter so that users can specify the database names of the constraints.+ ## 2.8.1  * DRY-ed up and exposed several util functions in `Database.Persist.Sql.Util`.

@@ -26,7 +26,6 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime) #endif import Data.ByteString.Char8 (ByteString, unpack, readInt)-import Control.Applicative as A import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word, Word8, Word16, Word32, Word64) import Data.Text (Text)@@ -63,7 +62,52 @@ import Numeric.Natural (Natural) #endif --- | A value which can be marshalled to and from a 'PersistValue'.+-- | This class teaches Persistent how to take a custom type and marshal it to and from a 'PersistValue', allowing it to be stored in a database.+--+-- ==== __Examples__+--+-- ===== Simple Newtype+--+-- You can use @newtype@ to add more type safety/readability to a basis type like 'ByteString'. In these cases, just derive 'PersistField' and @PersistFieldSql@:+--+-- @+-- {-\# LANGUAGE GeneralizedNewtypeDeriving #-}+--+-- newtype HashedPassword = HashedPassword 'ByteString'+--   deriving (Eq, Show, 'PersistField', PersistFieldSql)+-- @+--+-- ===== Smart Constructor Newtype+--+-- In this example, we create a 'PersistField' instance for a newtype following the "Smart Constructor" pattern.+--+-- @+-- {-\# LANGUAGE GeneralizedNewtypeDeriving #-}+-- import qualified "Data.Text" as T+-- import qualified "Data.Char" as C+--+-- -- | An American Social Security Number+-- newtype SSN = SSN 'Text'+--  deriving (Eq, Show, PersistFieldSql)+--+-- mkSSN :: 'Text' -> 'Either' 'Text' SSN+-- mkSSN t = if (T.length t == 9) && (T.all C.isDigit t)+--  then 'Right' $ SSN t+--  else 'Left' $ "Invalid SSN: " <> t+--+-- instance 'PersistField' SSN where+--   'toPersistValue' (SSN t) = 'PersistText' t+--   'fromPersistValue' ('PersistText' t) = mkSSN t+--   -- Handle cases where the database does not give us PersistText+--   'fromPersistValue' x = 'Left' $ "File.hs: When trying to deserialize an SSN: expected PersistText, received: " <> T.pack (show x)+-- @+--+-- Tips:+--+-- * This file contain dozens of 'PersistField' instances you can look at for examples.+-- * Typically custom 'PersistField' instances will only accept a single 'PersistValue' constructor in 'fromPersistValue'. +-- * Internal 'PersistField' instances accept a wide variety of 'PersistValue's to accomodate e.g. storing booleans as integers, booleans or strings.+-- * If you're making a custom instance and using a SQL database, you'll also need @PersistFieldSql@ to specify the type of the database column. class PersistField a where     toPersistValue :: a -> PersistValue     fromPersistValue :: PersistValue -> Either T.Text a@@ -95,7 +139,7 @@ instance PersistField ByteString where     toPersistValue = PersistByteString     fromPersistValue (PersistByteString bs) = Right bs-    fromPersistValue x = TE.encodeUtf8 A.<$> fromPersistValue x+    fromPersistValue x = TE.encodeUtf8 <$> fromPersistValue x  instance PersistField T.Text where     toPersistValue = PersistText

@@ -136,6 +136,7 @@         => Key record -> ReaderT backend m (Maybe record)      -- | Get many records by their respective identifiers, if available.+    --     -- @since 2.8.1     getMany         :: (MonadIO m, PersistRecordBackend record backend)

@@ -23,7 +23,7 @@ import qualified Data.Text as T import Control.Arrow ((&&&)) import qualified Data.Map as M-import Data.List (foldl')+import Data.List (find, foldl') import Data.Monoid (mappend) import Control.Monad (msum, mplus) @@ -462,26 +462,56 @@                 else d         | otherwise = getDef ds t --- Unique UppercaseConstraintName list of lowercasefields+-- Unique UppercaseConstraintName list of lowercasefields terminated+-- by ! or sql= such that a unique constraint can look like:+-- `UniqueTestNull fieldA fieldB sql=ConstraintNameInDatabase !force`+-- Here using sql= sets the name of the constraint. takeUniq :: PersistSettings-          -> Text-          -> [FieldDef]-          -> [Text]-          -> UniqueDef+         -> Text+         -> [FieldDef]+         -> [Text]+         -> UniqueDef takeUniq ps tableName defs (n:rest)     | not (T.null n) && isUpper (T.head n)         = UniqueDef             (HaskellName n)-            (DBName $ psToDBName ps (tableName `T.append` n))+            dbName             (map (HaskellName &&& getDBName defs) fields)             attrs   where-    (fields,attrs) = break ("!" `T.isPrefixOf`) rest-    getDBName [] t = error $ "Unknown column in unique constraint: " ++ show t+    isAttr a =+      "!" `T.isPrefixOf` a+    isSqlName a =+      "sql=" `T.isPrefixOf` a+    isNonField a =+       isAttr a+      || isSqlName a+    (fields, nonFields) =+      break isNonField rest+    attrs = filter isAttr nonFields+    usualDbName =+      DBName $ psToDBName ps (tableName `T.append` n)+    sqlName :: Maybe DBName+    sqlName =+      case find isSqlName nonFields of+        Nothing ->+          Nothing+        (Just t) ->+          case drop 1 $ T.splitOn "=" t of+            (x : _) -> Just (DBName x)+            _ -> Nothing+    dbName = fromMaybe usualDbName sqlName+    getDBName [] t =+      error $ "Unknown column in unique constraint: " ++ show t+              ++ " " ++ show defs ++ show n ++ " " ++ show attrs     getDBName (d:ds) t         | fieldHaskell d == HaskellName t = fieldDB d         | otherwise = getDBName ds t-takeUniq _ tableName _ xs = error $ "invalid unique constraint on table[" ++ show tableName ++ "] expecting an uppercase constraint name xs=" ++ show xs+takeUniq _ tableName _ xs =+  error $ "invalid unique constraint on table["+          ++ show tableName+          ++ "] expecting an uppercase constraint name xs="+          ++ show xs  data UnboundForeignDef = UnboundForeignDef                          { _unboundFields :: [Text] -- ^ fields in other entity

@@ -211,6 +211,63 @@ extractMaybe :: Maybe a -> a extractMaybe = fromMaybe (error "Database.Persist.GenericSql.extractMaybe") +-- | Tells Persistent what database column type should be used to store a Haskell type.+--+-- ==== __Examples__+--+-- ===== Simple Boolean Alternative+--+-- @+-- data Switch = On | Off+--   deriving (Show, Eq)+--+-- instance 'PersistField' Switch where+--   'toPersistValue' s = case s of+--     On -> 'PersistBool' True+--     Off -> 'PersistBool' False+--   'fromPersistValue' ('PersistBool' b) = if b then 'Right' On else 'Right' Off+--   'fromPersistValue' x = Left $ "File.hs: When trying to deserialize a Switch: expected PersistBool, received: " <> T.pack (show x)+--+-- instance 'PersistFieldSql' Switch where+--   'sqlType' _ = 'SqlBool'+-- @+--+-- ===== Non-Standard Database Types+--+-- If your database supports non-standard types, such as Postgres' @uuid@, you can use 'SqlOther' to use them:+--+-- @+-- import qualified Data.UUID as UUID+-- instance 'PersistField' UUID where+--   'toPersistValue' = 'PersistDbSpecific' . toASCIIBytes+--   'fromPersistValue' ('PersistDbSpecific' uuid) =+--     case fromASCIIBytes uuid of+--       'Nothing' -> 'Left' $ "Model/CustomTypes.hs: Failed to deserialize a UUID; received: " <> T.pack (show uuid)+--       'Just' uuid' -> 'Right' uuid'+--   'fromPersistValue' x = Left $ "File.hs: When trying to deserialize a UUID: expected PersistDbSpecific, received: "-- >  <> T.pack (show x)+--+-- instance 'PersistFieldSql' UUID where+--   'sqlType' _ = 'SqlOther' "uuid"+-- @+--+-- ===== User Created Database Types+--+-- Similarly, some databases support creating custom types, e.g. Postgres' <https://www.postgresql.org/docs/current/static/sql-createdomain.html DOMAIN> and <https://www.postgresql.org/docs/current/static/datatype-enum.html ENUM> features. You can use 'SqlOther' to specify a custom type:+--+-- > CREATE DOMAIN ssn AS text+-- >       CHECK ( value ~ '^[0-9]{9}$');+--+-- @+-- instance 'PersistFieldSQL' SSN where+--   'sqlType' _ = 'SqlOther' "ssn"+-- @+--+-- > CREATE TYPE rainbow_color AS ENUM ('red', 'orange', 'yellow', 'green', 'blue', 'indigo', 'violet');+--+-- @+-- instance 'PersistFieldSQL' RainbowColor where+--   'sqlType' _ = 'SqlOther' "rainbow_color"+-- @ class PersistField a => PersistFieldSql a where     sqlType :: Proxy a -> SqlType 

@@ -1,5 +1,5 @@ name:            persistent-version:         2.8.1+version:         2.8.2 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>