├── .gitignore ├── bower.json ├── test └── Main.purs ├── src └── Test │ └── Mock │ └── Mockfree.purs └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /.psci* 6 | /src/.webpack.js 7 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-mockfree", 3 | "description": "A purely-functional, strongly-typed functional mocking library for Free programs", 4 | "authors": [ 5 | "John A. De Goes " 6 | ], 7 | "license": "Apache 2", 8 | "version": "0.1.0", 9 | "moduleType": [ 10 | "node" 11 | ], 12 | "ignore": [ 13 | "**/.*", 14 | "node_modules", 15 | "bower_components", 16 | "output" 17 | ], 18 | "dependencies": { 19 | "purescript-profunctor-lenses": "^1.0.0-rc.1", 20 | "purescript-free": "^1.0.0-rc.1", 21 | "purescript-console": "^v1.0.0-rc.1", 22 | "purescript-either": "^v1.0.0-rc.1", 23 | "purescript-maybe": "^1.0.0-rc.1", 24 | "purescript-foldable-traversable": "^1.0.0-rc.1", 25 | "purescript-monoid": "^1.0.0-rc.2", 26 | "purescript-bifunctors": "^1.0.0-rc.1", 27 | "purescript-invariant": "^1.0.0-rc.1", 28 | "purescript-prelude": "^1.0.0-rc.4", 29 | "purescript-control": "^1.0.0-rc.1", 30 | "purescript-transformers": "^1.0.0-rc.1" 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude(Unit, (<>), ($), bind, const, pure, unit) 4 | import Control.Monad.Eff (Eff) 5 | import Control.Monad.Eff.Console (CONSOLE, log) 6 | import Control.Monad.Free(Free(), liftF) 7 | 8 | import Data.Either(either) 9 | import Data.Maybe(Maybe(..)) 10 | import Data.Lens.Prism(prism') 11 | 12 | import Test.Mock.Mockfree(Op(..), OpPrism(), MockSpec(), assertEquals, expectWrite, expectRead, readOp, runMock, writeOp) 13 | 14 | data ConsoleF a 15 | = WriteLine (Op String Unit a) 16 | | ReadLine (Op Unit String a) 17 | 18 | _WriteLine :: OpPrism ConsoleF String Unit 19 | _WriteLine = prism' WriteLine deconstruct 20 | where 21 | deconstruct (WriteLine op) = Just op 22 | deconstruct _ = Nothing 23 | 24 | _ReadLine :: OpPrism ConsoleF Unit String 25 | _ReadLine = prism' ReadLine deconstruct 26 | where 27 | deconstruct (ReadLine op) = Just op 28 | deconstruct _ = Nothing 29 | 30 | readLine :: Free ConsoleF String 31 | readLine = readOp _ReadLine 32 | 33 | writeLine :: String -> Free ConsoleF Unit 34 | writeLine s = writeOp _WriteLine s 35 | 36 | -- | Defines a mock specification for a program in `ConsoleF`. 37 | mockSpec :: MockSpec ConsoleF 38 | mockSpec = do 39 | expectWrite _WriteLine (assertEquals "What is your name?") 40 | expectRead _ReadLine "World" 41 | expectWrite _WriteLine (assertEquals "Hello, World!") 42 | 43 | goodProgram :: Free ConsoleF Unit 44 | goodProgram = do 45 | writeLine "What is your name?" 46 | name <- readLine 47 | writeLine ("Hello, " <> name <> "!") 48 | 49 | informalProgram :: Free ConsoleF Unit 50 | informalProgram = do 51 | writeLine "What is your first name?" 52 | name <- readLine 53 | writeLine ("Hello, " <> name <> "!") 54 | 55 | rudeProgram :: Free ConsoleF Unit 56 | rudeProgram = do 57 | writeLine "What is your name?" 58 | writeLine ("I don't care!") 59 | 60 | dismissiveProgram :: Free ConsoleF Unit 61 | dismissiveProgram = do 62 | writeLine "What is your name?" 63 | name <- readLine 64 | writeLine ("Goodbye, " <> name <> "!") 65 | 66 | emptyProgram :: Free ConsoleF Unit 67 | emptyProgram = pure unit 68 | 69 | testProgram :: Free ConsoleF Unit -> String 70 | testProgram program = either ((<>) "Failure: ") (const "Success!") (runMock mockSpec program) 71 | 72 | main :: forall e. Eff (console :: CONSOLE | e) Unit 73 | main = do 74 | log "Testing good program" 75 | log $ testProgram goodProgram 76 | 77 | log "Testing informal program" 78 | log $ testProgram informalProgram 79 | 80 | log "Testing rude program" 81 | log $ testProgram rudeProgram 82 | 83 | log "Testing dismissive program" 84 | log $ testProgram dismissiveProgram 85 | 86 | log "Testing empty program" 87 | log $ testProgram emptyProgram 88 | -------------------------------------------------------------------------------- /src/Test/Mock/Mockfree.purs: -------------------------------------------------------------------------------- 1 | module Test.Mock.Mockfree 2 | ( Assertion() 3 | , Op(..) 4 | , OpPrism() 5 | , MockOp(..) 6 | , MockSpec() 7 | , assertEquals 8 | , expect 9 | , expectRead 10 | , expectWrite 11 | , op 12 | , readOp 13 | , runMock 14 | , writeOp 15 | ) where 16 | 17 | import Prelude(class Show, class Eq, Unit(), ($), (<<<), (>>=), (<$>), (<>), (==), bind, const, id, pure, show, unit) 18 | 19 | import Data.Either(Either(..)) 20 | import Data.List(List(..), length, reverse) 21 | import Data.Lens.Types(PrismP()) 22 | import Data.Lens.Prism(review) 23 | import Data.Lens.Fold(preview) 24 | import Data.Maybe(maybe) 25 | import Data.Tuple(Tuple(..)) 26 | 27 | import Control.Monad.State.Trans(StateT(), runStateT) 28 | import Control.Monad.Free(Free(), foldFree, liftF) 29 | import Control.Monad.Trans(lift) 30 | import Control.Monad.State(State(), execState, get, modify, put) 31 | 32 | -- *************************************************************************** 33 | data Op a b c = Op a (b -> c) 34 | 35 | type OpPrism f a b = forall c. PrismP (f c) (Op a b c) 36 | 37 | -- | A helper function to create a read-only operation. 38 | readOp :: forall f b. OpPrism f Unit b -> Free f b 39 | readOp p = op p unit 40 | 41 | -- | A helper function to create a write-and-read operation. 42 | op :: forall f a b. OpPrism f a b -> a -> Free f b 43 | op p a = liftF $ review p (Op a id) 44 | 45 | -- | A helper function to create a write-only operation. 46 | writeOp :: forall f a. OpPrism f a Unit -> a -> Free f Unit 47 | writeOp p a = op p a 48 | 49 | -- *************************************************************************** 50 | type Assertion a = a -> Either String Unit 51 | 52 | -- | Creates an assertion that asserts values are equal to the specified 53 | -- | reference value. 54 | assertEquals :: forall a. (Show a, Eq a) => a -> Assertion a 55 | assertEquals e a = if e == a then Right unit else Left $ "Expected " <> show e <> " but found " <> show a 56 | 57 | -- | Creates an expectation for an arbitrary `f` operation. 58 | expect :: forall f a b. OpPrism f a b -> Assertion a -> (a -> b) -> MockSpec f 59 | expect p a f = modify (Cons (MockOp (\f' -> f' p a f))) 60 | 61 | -- | Creates an expectation for a read-only `f` operation. 62 | expectRead :: forall f b. OpPrism f Unit b -> b -> MockSpec f 63 | expectRead p b = expect p (const $ pure unit) (const b) 64 | 65 | -- | Creates an expectation for a write-only `f` operation. 66 | expectWrite :: forall f a. OpPrism f a Unit -> Assertion a -> MockSpec f 67 | expectWrite p a = expect p a (const unit) 68 | 69 | -- *************************************************************************** 70 | data MockOp f = MockOp (forall z. (forall a b. OpPrism f a b -> Assertion a -> (a -> b) -> z) -> z) 71 | 72 | type MockSpec f = State (List (MockOp f)) Unit 73 | 74 | -- | Attempts to execute a single operation using a mock op, returning an 75 | -- | error message if the expectation fails. 76 | runOp :: forall f c. MockOp f -> f c -> Either String c 77 | runOp (MockOp fold) fc = 78 | fold (\prism assert aToB -> maybe (Left "Unexpected operation") (\(Op a bToC) -> const (bToC (aToB a)) <$> assert a) $ preview prism fc) 79 | 80 | -- | Attempts to execute a Free program against a mock spec, returning an 81 | -- | error message if the expectations are not met. 82 | runMock :: forall f a0. MockSpec f -> Free f a0 -> Either String a0 83 | runMock spec program = runStateT (foldFree transform program) (reverse $ execState spec Nil) >>= finalize 84 | where 85 | finalize :: forall a. Tuple a (List (MockOp f)) -> Either String a 86 | finalize (Tuple a Nil) = Right a 87 | finalize (Tuple a v) = Left $ "Unexpected early termination (" <> show (length v) <> " operation(s) remaining)" 88 | 89 | transform :: forall a. f a -> StateT (List (MockOp f)) (Either String) a 90 | transform fa = do 91 | ops <- get 92 | case ops of 93 | Nil -> lift (Left "Unexpected operation after end of mock spec" :: Either String a) 94 | Cons op' ops' -> do 95 | put ops' 96 | lift $ runOp op' fa 97 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-mockfree 2 | 3 | `mockfree` is a purely-functional, strongly-typed mocking library for all PureScript programs that are defined by [Free](https://github.com/purescript/purescript-free) algebras. 4 | 5 | While a proof-of-concept for a [LambdaConf 2016 talk](http://github.com/lambdaconf/lambdaconf-2016-usa), the library is nonetheless completely usable, and demonstrates the power of modeling effectful computation through descriptive data structures. 6 | 7 | - [Module Documentation](docs/Test/Mock/Mockfree.md) 8 | - [Example](test/Main.purs) 9 | 10 | ## Building 11 | 12 | bower install purescript-mockfree 13 | pulp build 14 | pulp test 15 | 16 | ## Introduction 17 | 18 | Integration and system testing often require writing tests that perform *effects*, such as writing to a file system or connecting to a remote API. 19 | 20 | The problem with such tests is that they verify far more than the logic of your program: they test the reliability of third-party software and systems. 21 | 22 | As a result, integration and system tests are often indeterministic and error-prone. In addition, because these tests often run slowly and have complex dependencies, they are not as useful to developers as unit and property tests, which run very fast and have no dependencies. 23 | 24 | The industry has invented *mocking* as a solution to these problems. However, mocking usually sacrifices type safety, and requires a powerful dynamic programming language, or lots of hacks or code rewriting. 25 | 26 | With a purely-functional programming language such as PureScript, we have an alternative: `Free` programs. 27 | 28 | `Free` programs allow us to describe the effects of our program using data structures. These data structures can later be interpreted into effectful operations. However, they can also be interpreted into *non-effectful* operations that do *not* interact with external systems. 29 | 30 | If you program in this style, then `mockfree` will let you trivially test the logic of your programs with purely-functional, strongly-typed mocks, which can be parallelized, which run in-memory, and which are completely deterministic. 31 | 32 | Combined with a way of testing your program's final interpreters, functional mocking can totally transform the way you test functional code that has complex interactions with external systems. 33 | 34 | With `Free`, you can test final interpreters separately, one time, in their own library; and you can test your program logic exclusively through functional mocking. All tests become fast, deterministic, and completely self-contained! 35 | 36 | ## Tutorial 37 | 38 | Let's define a console program with the following operations: 39 | 40 | ```purescript 41 | data ConsoleF a 42 | = WriteLine (Op String Unit a) 43 | | ReadLine (Op Unit String a) 44 | ``` 45 | 46 | Each operation `Op a b c` requires that we supply an `a` in order to get access to a `b`. 47 | 48 | For example, a "write line" operation requires that we supply a `String`, and gives us access to a `Unit` value (i.e. no information), while a "read line" operation requires that we supply a `Unit` (i.e. no information) to get access to a `String`. 49 | 50 | The `mockfree` library requires that we define polymorphic [prisms](http://github.com/purescript-contrib/purescript-profunctor-lenses) for each term in our operational algebra: 51 | 52 | ```purescript 53 | _WriteLine :: OpPrism ConsoleF String Unit 54 | _ReadLine :: OpPrism ConsoleF Unit String 55 | ``` 56 | 57 | While these prisms are required for `mockfree`, they are also useful for working with our algebra, and they can be shared with production code! 58 | 59 | Once the prisms have been defined, we can create a mock spec using some combination of `expect` (for read-write operations), `expectRead` (for read-only operations), and `expectWrite` (for write-only operations): 60 | 61 | ```purescript 62 | mockSpec :: MockSpec ConsoleF 63 | mockSpec = do 64 | expectWrite _WriteLine (assertEquals "What is your name?") 65 | expectRead _ReadLine "World" 66 | expectWrite _WriteLine (assertEquals "Hello, World!") 67 | ``` 68 | 69 | These specs can be run against a program using `runMock`: 70 | 71 | ```purescript 72 | runMock mockSpec program :: Either String Unit 73 | ``` 74 | 75 | where `program` is a program defined by sequential execution of the individual operations: 76 | 77 | ```purescript 78 | program :: Free ConsoleF Unit 79 | program = do 80 | writeOp _WriteLine "What is your name?" 81 | name <- readOp _ReadLine 82 | writeOp _WriteLine ("Hello, " ++ name ++ "!") 83 | ``` 84 | 85 | ## Future Work 86 | 87 | There are several ways this library could be improved: 88 | 89 | 1. **Add support for branching programs.** Currently, the mock spec is a linear sequence of instructions. Ideally, it would be a tree that forks based on runtime values and allows alternatives. 90 | 2. **Add support for infinite mock specs.** Currently, the mock spec can only model finite, bounded programs. 91 | 3. **Factor out Assertion into a library.** Currently, there is no PureScript library for non-effectful assertions that generate nice, composable errors. 92 | 4. **Factor out the Op type & helpers into a library.** These could be useful in building `Free` programs, not just in testing them. 93 | --------------------------------------------------------------------------------