-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathREADME.lhs
211 lines (168 loc) · 5.8 KB
/
README.lhs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
# Graphula
[![Hackage](https://img.shields.io/hackage/v/graphula.svg?style=flat)](https://hackage.haskell.org/package/graphula)
[![Stackage Nightly](http://stackage.org/package/graphula/badge/nightly)](http://stackage.org/nightly/package/graphula)
[![Stackage LTS](http://stackage.org/package/graphula/badge/lts)](http://stackage.org/lts/package/graphula)
[![CI](https://github.com/freckle/graphula/actions/workflows/ci.yml/badge.svg)](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 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.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
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
import Text.Markdown.Unlit ()
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)
```
## 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
runDB :: MonadUnliftIO m => ReaderT SqlBackend (NoLoggingT (ResourceT m)) a -> m a
runDB f = runSqlite "test.db" $ do
runMigration migrateAll
f
```
-->