Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/freckle/graphula
A simple interface for generating persistent data and linking its dependencies
https://github.com/freckle/graphula
haskell terraform-managed testing
Last synced: 4 days ago
JSON representation
A simple interface for generating persistent data and linking its dependencies
- Host: GitHub
- URL: https://github.com/freckle/graphula
- Owner: freckle
- License: mit
- Created: 2017-03-31T21:13:01.000Z (over 7 years ago)
- Default Branch: main
- Last Pushed: 2024-03-01T21:59:10.000Z (8 months ago)
- Last Synced: 2024-10-06T01:34:55.766Z (about 1 month ago)
- Topics: haskell, terraform-managed, testing
- Language: Haskell
- Homepage:
- Size: 1.1 MB
- Stars: 45
- Watchers: 30
- Forks: 11
- Open Issues: 5
-
Metadata Files:
- Readme: README.md
- Changelog: CHANGELOG.md
- License: LICENSE
Awesome Lists containing this project
README
# 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.
## 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)
```
## 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
```