graphula 2.1.1.0 → 2.1.2.0

raw patch · 7 files changed

+132/−47 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +24/−0
• graphula.cabal +1/−1
• src/Graphula.hs +22/−18
• src/Graphula/Class.hs +25/−0
• src/Graphula/Dependencies.hs +16/−4
• src/Graphula/Node.hs +20/−24
• test/README.lhs +24/−0

@@ -32,6 +32,7 @@  module Main (module Main) where +import Control.Exception (try, Exception(..)) import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Logger (NoLoggingT)@@ -170,6 +171,28 @@   n `shouldSatisfy` (not . null) ``` +## Generation Failures++Generating the graph can fail if you ask it do impossible things, such as+generate entities that collide on a unique constraint. In such cases, you will+receive an informative error:++```haskell+generationFailureSpec :: IO ()+generationFailureSpec = do+  result <- try $ runGraphulaT Nothing runDB $ do+    school <- node @School () mempty++    -- collision that will never resolve+    nodeKeyed @School (entityKey school) () mempty++  case result of+    Left ex ->+      displayException @GenerationFailure ex+        `shouldBe` "GenerationFailureMaxAttemptsToInsert (Just \"entity already exists by this key\") School"+    Right _ -> pure ()+```+ ## Running It  ```haskell@@ -202,6 +225,7 @@   describe "graphula" . parallel $ do     it "generates and links arbitrary graphs of data" simpleSpec     it "allows logging graphs" loggingSpec+    it "shows informative generation failures" generationFailureSpec  runDB :: MonadUnliftIO m => ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a runDB f = runSqlite "test.db" $ do

@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               graphula-version:            2.1.1.0+version:            2.1.2.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education

@@ -211,38 +211,42 @@   logNode _ = pure ()  instance (MonadIO m, MonadIO n) => MonadGraphulaFrontend (GraphulaT n m) where-  insert mKey n = do+  insertEither mKey n = do     RunDB runDB <- asks dbRunner     lift . runDB $ case mKey of       Nothing ->         insertUnique n >>= \case-          Nothing -> pure Nothing-          Just key -> getEntity key+          Nothing -> pure $ Left "entity violated a unique constraint"+          Just key -> maybe (Left "inserted entity not found") Right <$> getEntity key       Just key -> do         existingKey <- get key-        whenNothing existingKey $ do-          existingUnique <- checkUnique n-          whenNothing existingUnique $ do-            Persist.insertKey key n-            getEntity key+        case existingKey of+          Just _ -> pure $ Left "entity already exists by this key"+          Nothing -> do+            existingUnique <- checkUnique n+            case existingUnique of+              Just _ -> pure $ Left "entity would violate unique constraint"+              Nothing -> do+                Persist.insertKey key n+                maybe (Left "inserted entity not found") Right <$> getEntity key -  insertKeyed key n = do+  insertKeyedEither key n = do     RunDB runDB <- asks dbRunner     lift . runDB $ do       existingKey <- get key-      whenNothing existingKey $ do-        existingUnique <- checkUnique n-        whenNothing existingUnique $ do-          Persist.insertKey key n-          getEntity key+      case existingKey of+        Just _ -> pure $ Left "entity already exists by this key"+        Nothing -> do+          existingUnique <- checkUnique n+          case existingUnique of+            Just _ -> pure $ Left "entity would violate unique constraint"+            Nothing -> do+              Persist.insertKey key n+              maybe (Left "inserted entity not found") Right <$> getEntity key    remove key = do     RunDB runDB <- asks dbRunner     lift . runDB $ delete key--whenNothing :: Applicative m => Maybe a -> m (Maybe b) -> m (Maybe b)-whenNothing Nothing f = f-whenNothing (Just _) _ = pure Nothing  runGraphulaT   :: MonadUnliftIO m

@@ -66,7 +66,19 @@     => Maybe (Key a)     -> a     -> m (Maybe (Entity a))+  insert mk a = either (const Nothing) Just <$> insertEither mk a +  insertEither+    :: ( PersistEntityBackend a ~ SqlBackend+       , PersistEntity a+       , Monad m+       , GraphulaSafeToInsert a+       )+    => Maybe (Key a)+    -> a+    -> m (Either String (Entity a))+  insertEither mk a = maybe (Left "Unable to insert entity") Right <$> insert mk a+   insertKeyed     :: ( PersistEntityBackend a ~ SqlBackend        , PersistEntity a@@ -75,11 +87,24 @@     => Key a     -> a     -> m (Maybe (Entity a))+  insertKeyed k a = either (const Nothing) Just <$> insertKeyedEither k a +  insertKeyedEither+    :: ( PersistEntityBackend a ~ SqlBackend+       , PersistEntity a+       , Monad m+       )+    => Key a+    -> a+    -> m (Either String (Entity a))+  insertKeyedEither k a = maybe (Left "Unable to insert keyed entity") Right <$> insertKeyed k a+   remove     :: (PersistEntityBackend a ~ SqlBackend, PersistEntity a, Monad m)     => Key a     -> m ()++  {-# MINIMAL (insert | insertEither), (insertKeyed | insertKeyedEither), remove #-}  class MonadGraphulaBackend m where   type Logging m :: Type -> Constraint

@@ -107,10 +107,10 @@     :: ( HasEot a        , HasEot (Dependencies a)        , GHasDependencies-          (Proxy a)-          (Proxy (Dependencies a))-          (Eot a)-          (Eot (Dependencies a))+           (Proxy a)+           (Proxy (Dependencies a))+           (Eot a)+           (Eot (Dependencies a))        )     => a     -> Dependencies a@@ -177,16 +177,28 @@     => requirement (Key record)     -> record     -> m (Maybe (Entity record))+  insertWithPossiblyRequiredKeyEither+    :: ( PersistEntityBackend record ~ SqlBackend+       , PersistEntity record+       , Monad m+       , MonadGraphulaFrontend m+       , InsertConstraint requirement record+       )+    => requirement (Key record)+    -> record+    -> m (Either String (Entity record))   justKey :: key -> requirement key  instance InsertWithPossiblyRequiredKey Optional where   type InsertConstraint Optional = GraphulaSafeToInsert   insertWithPossiblyRequiredKey (Optional key) = MonadGraphulaFrontend.insert key+  insertWithPossiblyRequiredKeyEither (Optional key) = MonadGraphulaFrontend.insertEither key   justKey = Optional . Just  instance InsertWithPossiblyRequiredKey Required where   type InsertConstraint Required = NoConstraint   insertWithPossiblyRequiredKey (Required key) = MonadGraphulaFrontend.insertKeyed key+  insertWithPossiblyRequiredKeyEither (Required key) = MonadGraphulaFrontend.insertKeyedEither key   justKey = Required  -- | Abstract constraint that some @a@ can generate a key

@@ -142,22 +142,20 @@   -> Int   -> m (Maybe (KeyForInsert a, a))   -> m (Entity a)-attempt maxEdits maxInserts source = loop 0 0+attempt maxEdits maxInserts source = loop 0 0 Nothing  where-  loop :: Int -> Int -> m (Entity a)-  loop numEdits numInserts-    | numEdits >= maxEdits = die GenerationFailureMaxAttemptsToConstrain-    | numInserts >= maxInserts = die GenerationFailureMaxAttemptsToInsert+  loop :: Int -> Int -> Maybe String -> m (Entity a)+  loop numEdits numInserts mmsg+    | numEdits >= maxEdits = die $ GenerationFailureMaxAttemptsToConstrain mmsg+    | numInserts >= maxInserts = die $ GenerationFailureMaxAttemptsToInsert mmsg     | otherwise =         source >>= \case-          Nothing -> loop (succ numEdits) numInserts+          Nothing -> loop (succ numEdits) numInserts Nothing           --               ^ failed to edit, only increments this           Just (mKey, value) ->-            insertWithPossiblyRequiredKey mKey value >>= \case-              Nothing -> loop (succ numEdits) (succ numInserts)-              --               ^ failed to insert, but also increments this. Are we-              --                 sure that's what we want?-              Just a -> pure a+            insertWithPossiblyRequiredKeyEither mKey value >>= \case+              Left msg -> loop (succ numEdits) (succ numInserts) $ Just msg+              Right a -> pure a  -- | Generate a node with an explictly-given key --@@ -198,22 +196,20 @@   -> Key a   -> m (Maybe a)   -> m (Entity a)-attempt' maxEdits maxInserts key source = loop 0 0+attempt' maxEdits maxInserts key source = loop 0 0 Nothing  where-  loop :: Int -> Int -> m (Entity a)-  loop numEdits numInserts-    | numEdits >= maxEdits = die GenerationFailureMaxAttemptsToConstrain-    | numInserts >= maxInserts = die GenerationFailureMaxAttemptsToInsert+  loop :: Int -> Int -> Maybe String -> m (Entity a)+  loop numEdits numInserts mmsg+    | numEdits >= maxEdits = die $ GenerationFailureMaxAttemptsToConstrain mmsg+    | numInserts >= maxInserts = die $ GenerationFailureMaxAttemptsToInsert mmsg     | otherwise =         source >>= \case-          Nothing -> loop (succ numEdits) numInserts+          Nothing -> loop (succ numEdits) numInserts Nothing           --               ^ failed to edit, only increments this           Just value ->-            insertKeyed key value >>= \case-              Nothing -> loop (succ numEdits) (succ numInserts)-              --               ^ failed to insert, but also increments this. Are we-              --                 sure that's what we want?-              Just a -> pure a+            insertKeyedEither key value >>= \case+              Left msg -> loop (succ numEdits) (succ numInserts) $ Just msg+              Right a -> pure a  die   :: forall a m@@ -224,9 +220,9 @@  data GenerationFailure   = -- | Could not satisfy constraints defined using 'ensure'-    GenerationFailureMaxAttemptsToConstrain TypeRep+    GenerationFailureMaxAttemptsToConstrain (Maybe String) TypeRep   | -- | Could not satisfy database constraints on 'insert'-    GenerationFailureMaxAttemptsToInsert TypeRep+    GenerationFailureMaxAttemptsToInsert (Maybe String) TypeRep   deriving stock (Show, Eq)  instance Exception GenerationFailure

@@ -32,6 +32,7 @@  module Main (module Main) where +import Control.Exception (try, Exception(..)) import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Logger (NoLoggingT)@@ -170,6 +171,28 @@   n `shouldSatisfy` (not . null) ``` +## Generation Failures++Generating the graph can fail if you ask it do impossible things, such as+generate entities that collide on a unique constraint. In such cases, you will+receive an informative error:++```haskell+generationFailureSpec :: IO ()+generationFailureSpec = do+  result <- try $ runGraphulaT Nothing runDB $ do+    school <- node @School () mempty++    -- collision that will never resolve+    nodeKeyed @School (entityKey school) () mempty++  case result of+    Left ex ->+      displayException @GenerationFailure ex+        `shouldBe` "GenerationFailureMaxAttemptsToInsert (Just \"entity already exists by this key\") School"+    Right _ -> pure ()+```+ ## Running It  ```haskell@@ -202,6 +225,7 @@   describe "graphula" . parallel $ do     it "generates and links arbitrary graphs of data" simpleSpec     it "allows logging graphs" loggingSpec+    it "shows informative generation failures" generationFailureSpec  runDB :: MonadUnliftIO m => ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a runDB f = runSqlite "test.db" $ do