ez-couch 0.4.0 → 0.4.1

raw patch · 6 files changed

+30/−19 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ez-couch.cabal +1/−1
• src/EZCouch.hs +1/−0
• src/EZCouch/Action.hs +1/−0
• src/EZCouch/Entity.hs +11/−11
• src/EZCouch/EntityIsolation.hs +10/−7
• src/EZCouch/Types.hs +6/−0

@@ -1,5 +1,5 @@ name:               ez-couch-version:            0.4.0+version:            0.4.1 cabal-version:      >=1.8 build-type:         Simple license:            MIT

@@ -41,6 +41,7 @@   isolationEntity,   -- * Types   Persisted(..),+  persistedIdHashPart,    -- * Helpers   tryOperation,

@@ -89,6 +89,7 @@     handleHttpException e = case e of       FailedConnectionException host port -> throwIO $ ConnectionException $          "FailedConnectionException: " ++ pack host ++ " " ++ show port+      ResponseTimeout -> throwIO $ ConnectionException $ "ResponseTimeout"       otherwise -> throwIO e     handleIOException e = throwIO $ ConnectionException $        "IOError: " ++ pack (ioeGetErrorString e)

@@ -10,18 +10,18 @@ class (ToJSON a, FromJSON a) => Entity a where   entityType :: a -> Text -  default entityType :: (Generic a, GDoc (Rep a)) => a -> Text-  entityType = gDocType . from+  default entityType :: (Generic a, GEntity (Rep a)) => a -> Text+  entityType = gEntityType . from -class GDoc f where -  gDocType :: f a -> Text+class GEntity f where +  gEntityType :: f a -> Text -instance (GDoc a) => GDoc (M1 i c a) where-  gDocType = gDocType . unM1+instance (GEntity a) => GEntity (M1 i c a) where+  gEntityType = gEntityType . unM1 -instance (Constructor c) => GDoc (C1 c a) where-  gDocType = const . pack $ conName (undefined :: t c a p)+instance (Constructor c) => GEntity (C1 c a) where+  gEntityType = const . pack $ conName (undefined :: t c a p) -instance (GDoc a, GDoc b) => GDoc (a :+: b) where-  gDocType (L1 x) = gDocType x-  gDocType (R1 x) = gDocType x+instance (GEntity a, GEntity b) => GEntity (a :+: b) where+  gEntityType (L1 x) = gEntityType x+  gEntityType (R1 x) = gEntityType x

@@ -56,11 +56,15 @@   -> m ([Maybe (Isolation e)]) isolateEntities timeout entities = do   till <- Time.addUTCTime (fromIntegral timeout) <$> readTime-  results <- createIdentifiedEntities $-    map (entityIsolationId &&& entityIsolationModel till) entities-  forM (List.zip entities results) $ \r -> case r of-    (entity, Right isolation) -> return $ Just $ -      Isolation (persistedIdRev isolation) (persistedIdentified entity)+  results <- createIdentifiedEntities+    $ map (entityIsolationId &&& entityIsolationModel till) entities+  results <- return +    $ List.zipWith (\e r -> (,) <$> pure e <*> r) entities results+  deleteEntities $ map fst $ rights results+  forM results $ \r -> case r of+    Right (entity, isolation) -> do+      return $ Just+        $ Isolation (persistedIdRev isolation) (persistedIdentified entity)     _ -> return Nothing  entityIsolationModel :: (Entity e) @@ -107,6 +111,5 @@ deleteIsolations :: (MonadAction m, Entity e)   => [Isolation e]   -> m ()-deleteIsolations isolations = -  deleteEntitiesByIdRevs $ map isolationIdRev isolations+deleteIsolations = deleteEntitiesByIdRevs . map isolationIdRev 

@@ -7,6 +7,7 @@ import ClassyPrelude  import Data.Aeson import GHC.Generics+import EZCouch.Entity  -- | A wrapper for entity values which preserves the information required for -- identifying the appropriate documents in the db.@@ -20,6 +21,11 @@  persistedIdentified :: Persisted a -> Identified a persistedIdentified (Persisted id _ value) = (id, value)++persistedIdHashPart :: Entity a => Persisted a -> Text+persistedIdHashPart (Persisted id _ value) = +  fromMaybe undefined $ stripPrefix (entityType value ++ "-") id+  type Identified a = (Text, a) identifiedId (id, _) = id