graphula-2.1.3.0: test/README.lhs
# Graphula
[](https://hackage.haskell.org/package/graphula)
[](http://stackage.org/nightly/package/graphula)
[](http://stackage.org/lts/package/graphula)
[](https://github.com/freckle/graphula/actions/workflows/ci.yml)
Graphula is a simple interface for generating persistent data and linking its
dependencies. We use this interface to generate fixtures for automated testing.
<!--
```haskell
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (module Main) where
import Control.Exception (try, Exception(..), SomeException)
#if MIN_VERSION_base(4,20,0)
import Control.Exception (someExceptionContext)
import Control.Exception.Context (getExceptionAnnotations)
#endif
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Logger (NoLoggingT)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Resource (ResourceT)
import Database.Persist.Sqlite
import Database.Persist.TH
import GHC.Generics (Generic)
import Graphula
#if MIN_VERSION_base(4,20,0)
import Graphula.ExceptionContext (GraphulaExceptionContext (..))
#endif
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
instance (ToBackendKey SqlBackend a) => Arbitrary (Key a) where
arbitrary = toSqlKey <$> arbitrary
```
-->
## Arbitrary Data
Graphula utilizes `QuickCheck` to generate random data. We need to declare
`Arbitrary` instances for our models.
```haskell
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
School
name String
deriving Show Eq Generic
Teacher
schoolId SchoolId
name String
deriving Show Eq Generic
Course
schoolId SchoolId
teacherId TeacherId
name String
deriving Show Eq Generic
Student
name String
deriving Show Eq Generic
Question
content String
deriving Show Eq Generic
Answer
questionId QuestionId
studentId StudentId
yes Bool
UniqueAnswer questionId studentId
deriving Show Eq Generic
|]
instance Arbitrary School where
arbitrary = genericArbitrary
instance Arbitrary Teacher where
arbitrary = genericArbitrary
instance Arbitrary Course where
arbitrary = genericArbitrary
instance Arbitrary Student where
arbitrary = genericArbitrary
instance Arbitrary Question where
arbitrary = genericArbitrary
instance Arbitrary Answer where
arbitrary = genericArbitrary
```
## Dependencies
We declare dependencies via the `HasDependencies` typeclass and its associated
type `Dependencies`. If a model does not have any dependencies, we only need to
declare an empty instance.
```haskell
instance HasDependencies School
instance HasDependencies Student
instance HasDependencies Question
```
For single-dependency models, we use the `Only` type.
```haskell
instance HasDependencies Teacher where
type Dependencies Teacher = Only SchoolId
```
Multi-dependency models use tuples. Declare these dependencies in the order they
appear in the model's type definition. `HasDependencies` leverages generic
programming to inject dependencies for you.
```haskell
instance HasDependencies Course where
type Dependencies Course = (SchoolId, TeacherId)
instance HasDependencies Answer where
type Dependencies Answer = (QuestionId, StudentId)
```
## Logging failures
`runGraphulaLogged` will dump generated data to a temporary file. Or
`runGraphulaLoggedWithFileT` can be used to pass an explicit path.
```haskell
loggingSpec :: IO ()
loggingSpec = do
let
logFile :: FilePath
logFile = "test.graphula"
failingGraph :: IO ()
failingGraph = runGraphulaT Nothing runDB . runGraphulaLoggedWithFileT logFile $ do
student <- node @Student () mempty
question <- node @Question () mempty
answer <- node @Answer
(entityKey question, entityKey student)
$ edit $ \a -> a { answerYes = True }
-- Test failures will cause the graph to be logged (not any exception)
liftIO $ answerYes (entityVal answer) `shouldBe` False
failingGraph `shouldThrow` anyException
n <- lines <$> readFile logFile
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 ()
```
## Seed
`HUnitFailure` exceptions will have their reason prefixed by the seed used for
Graphula's arbitrary data, making it visible in expectation-failure messages.
Re-supplying this seed to `runGraphulaT` will reproduce the same graph, to
hopefully reproduce intermittent test failures caused by randomness.
If using `base >= 4.20`, **all** exceptions will also have this seed added to
the [exception's context][ghc-docs]. This won't be visible anywhere (besides
`HUnitFailure`) by default, but can be extracted through custom exception
handling, e.g. in a `SpecHook`. We hope tools like `hspec` make using exception
context more ergonomic in the future.
[ghc-docs]: https://hackage-content.haskell.org/package/base-4.22.0.0/docs/Control-Exception-Context.html
```haskell
seedPrefixesHUnitFailureSpec :: IO ()
seedPrefixesHUnitFailureSpec = do
result <- try $ runGraphulaT (Just 1) runDB $ do
liftIO $ (1 :: Int) `shouldBe` 2
case result :: Either SomeException () of
Left ex -> show ex `shouldContain` "Graphula with seed: 1"
Right () -> expectationFailure "expected an exception"
#if MIN_VERSION_base(4,20,0)
seedExceptionContextSpec :: IO ()
seedExceptionContextSpec = do
result <- try $ runGraphulaT (Just 2) runDB $ do
liftIO $ (1 :: Int) `shouldBe` 2
case result :: Either SomeException () of
Left ex -> seedsInContext ex `shouldBe` [2]
Right () -> expectationFailure "expected an exception"
seedExceptionContextNonHUnitFailureSpec :: IO ()
seedExceptionContextNonHUnitFailureSpec = do
result <- try $ runGraphulaT (Just 3) runDB $ do
liftIO $ ioError $ userError "boom"
case result :: Either SomeException () of
Left ex -> seedsInContext ex `shouldBe` [3]
Right () -> expectationFailure "expected an exception"
seedsInContext :: SomeException -> [Int]
seedsInContext ex =
map graphulaExceptionContextSeed
$ getExceptionAnnotations (someExceptionContext ex)
#endif
```
## Running It
```haskell
simpleSpec :: IO ()
simpleSpec =
runGraphulaT Nothing runDB $ do
school <- node @School () mempty
teacher <- node @Teacher (Only $ entityKey school) mempty
course <- node @Course (entityKey school, entityKey teacher) mempty
student <- node @Student () $ edit $ \s -> s { studentName = "Pat" }
question <- node @Question () mempty
answer <- node @Answer
(entityKey question, entityKey student)
$ edit $ \a -> a { answerYes = True }
liftIO $ do
-- Typically, you would run some other function like "fetch correct
-- answers at school" and assert you found the correct answers you
-- generated. In this example we just assert some things about the data
-- directly:
teacherSchoolId (entityVal teacher) `shouldBe` entityKey school
courseTeacherId (entityVal course) `shouldBe` entityKey teacher
answerYes (entityVal answer) `shouldBe` True
```
<!--
```haskell
main :: IO ()
main = hspec $
describe "graphula" . parallel $ do
it "generates and links arbitrary graphs of data" simpleSpec
it "allows logging graphs" loggingSpec
it "shows informative generation failures" generationFailureSpec
it "prefixes HUnitFailure reasons with the seed" seedPrefixesHUnitFailureSpec
#if MIN_VERSION_base(4,20,0)
it "adds the seed to exception context, for HUnitFailure" seedExceptionContextSpec
it "adds the seed to exception context, for other exceptions" seedExceptionContextNonHUnitFailureSpec
#endif
runDB :: MonadUnliftIO m => ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runDB f = runSqlite "test.db" $ do
runMigration migrateAll
f
```
-->
## Release
To release a new version of this library, push a commit to `main` using a
conventionally-formatted commit message.
- Prefix with `fix:` to release a new patch version,
- Prefix with `feat:` to release a new minor version, or
- Prefix with `feat!:` to release a new major version
To change the "epoch" version, edit it in `package.yaml` and change the
`.releaserc.yaml` tag prefix to match.