postgresql-orm 0.4.1 → 0.5.0

raw patch · 4 files changed

+41/−14 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/GetField.hs +3/−0
• Data/RequireSelector.hs +5/−1
• Database/PostgreSQL/ORM/Model.hs +32/−12
• postgresql-orm.cabal +1/−1

@@ -8,6 +8,9 @@ #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #endif+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+-- ^ Enables the default implementation of Extractor as of GHC 8.0 {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} 

@@ -1,12 +1,14 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}  module Data.RequireSelector (RequireSelector) where +#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 800) import GHC.Generics  -- | There are intentionally no members of this class, so that placing -- it in a context will always cause an error. class IntentionallyCauseError a+#endif  -- | The point of this class is to ensure that you are using data -- types defined with record selectors (i.e., @data Foo = Foo { unFoo@@ -20,5 +22,7 @@ -- @IntentionallyCauseError@, it means you failed to define one of -- your datatypes using record selector syntax. class RequireSelector a+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 800) instance (IntentionallyCauseError NoSelector) => RequireSelector NoSelector+#endif instance RequireSelector a

@@ -111,6 +111,8 @@ import qualified Data.Aeson as A import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Data.Char import Data.Data import Data.Int@@ -336,7 +338,7 @@   gColumns :: f p -> [S.ByteString] instance GColumns U1 where   gColumns _ = []-instance (Selector c, RequireSelector c) => GColumns (M1 S c f) where+instance (Selector c) => GColumns (M1 S c f) where   gColumns s = [fromString $ selName s] instance (GColumns a, GColumns b) => GColumns (a :*: b) where   gColumns ~(a :*: b) = gColumns a ++ gColumns b@@ -353,7 +355,7 @@ -- of this class, then move the 'DBKey' first in your data structure. class GPrimaryKey0 f where   gPrimaryKey0 :: f p -> DBKey-instance (RequireSelector c) => GPrimaryKey0 (S1 c (K1 i DBKey)) where+instance GPrimaryKey0 (S1 c (K1 i DBKey)) where   {-# INLINE gPrimaryKey0 #-}   gPrimaryKey0 (M1 (K1 k)) = k instance (GPrimaryKey0 a) => GPrimaryKey0 (a :*: b) where@@ -603,6 +605,7 @@     "UPDATE ", modelQTable mi, " SET "     , S.intercalate ", " $ map (<> " = ?") $ modelQWriteColumns mi     , " WHERE ", modelQPrimaryColumn mi, " = ?"+    , " RETURNING ", S.intercalate ", " (modelQColumns mi)   ]  -- | Default SQL insert query for a model.@@ -1119,10 +1122,11 @@                   case rs of [r'] -> return $ Right $ lookupRow r'                              _    -> fail "save: database did not return row"             | otherwise = do-                  n <- execute c (modelUpdateQuery qs) (UpdateRow r)-                  case n of 1 -> return $ Right r-                            _ -> fail $ "save: database updated " ++ show n-                                        ++ " records"+                  rows <- query c (modelUpdateQuery qs) (UpdateRow r)+                  case rows of [r'] -> return $ Right $ lookupRow r'+                               _     -> fail $ "save: database updated "+                                          ++ show (length rows)+                                          ++ " records"   where qs = modelQueries :: ModelQueries r         errors = modelValid r @@ -1130,17 +1134,33 @@ -- the database.  This function only looks at the primary key in the -- data structure.  It is an error to call this function if the -- primary key is not set.-destroy :: forall a. (Model a) => Connection -> a -> IO ()+destroy :: forall a. (Model a)+  => Connection -> a -> IO (Either ValidationError Bool) destroy c a =   case primaryKey a of     NullKey -> fail "destroy: NullKey"-    DBKey k -> void $ execute c-               (modelDeleteQuery (modelQueries :: ModelQueries a)) (Only k)+    DBKey k -> destroyByRef_ "destroy" c (DBRef k :: DBRef a)  -- | Remove a row from the database without fetching it first.-destroyByRef :: forall a rt. (Model a) => Connection -> GDBRef rt a -> IO ()-destroyByRef c a =-  void $ execute c (modelDeleteQuery (modelQueries :: ModelQueries a)) (Only a)+destroyByRef :: forall a rt. (Model a)+  => Connection -> GDBRef rt a -> IO (Either ValidationError Bool)+destroyByRef = destroyByRef_ "destroyByRef"++destroyByRef_ :: forall a rt. (Model a)+  => T.Text -> Connection -> GDBRef rt a -> IO (Either ValidationError Bool)+destroyByRef_ msg c a = action+  where mq     = modelQueries     :: ModelQueries a+        mi     = modelIdentifiers :: ModelIdentifiers a+        pkCol  = modelQPrimaryColumn mi+        action = do+            n <- execute c (modelDeleteQuery mq) (Only a)+            return $ case n of+                0 -> Right False+                1 -> Right True+                _ -> Left $ validationError (T.decodeUtf8 pkCol) $+                    msg <> ": DELETE modified " <> T.pack (show n) <>+                    " rows. This may indicate that your primary key" <>+                    " accessor field is not actually a primary key."  -- | Print to stdout the query statement. printq :: Query -> IO ()

@@ -1,5 +1,5 @@ name: postgresql-orm-version: 0.4.1+version: 0.5.0 cabal-version: >= 1.14 build-type: Simple license: GPL