├── .gitignore ├── packages.dhall ├── .tidyrc.json ├── test └── Main.purs ├── .editorconfig ├── docs └── README.md ├── spago.dhall ├── .github ├── ISSUE_TEMPLATE │ ├── config.yml │ ├── bug-report.md │ └── change-request.md ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── CONTRIBUTING.md ├── bower.json ├── CHANGELOG.md ├── README.md └── src └── Data └── Machine └── Mealy.purs /.gitignore: -------------------------------------------------------------------------------- 1 | .* 2 | !.gitignore 3 | !.github 4 | !.editorconfig 5 | !.tidyrc.json 6 | 7 | output 8 | generated-docs 9 | bower_components 10 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall 3 | 4 | in upstream 5 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importSort": "source", 3 | "importWrap": "source", 4 | "indent": 2, 5 | "operatorsFile": null, 6 | "ribbon": 1, 7 | "typeArrowPlacement": "first", 8 | "unicode": "never", 9 | "width": null 10 | } 11 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Class.Console (log) 7 | 8 | main :: Effect Unit 9 | main = do 10 | log "🍝" 11 | log "You should add some tests." 12 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # http://editorconfig.org 2 | root = true 3 | 4 | [*] 5 | indent_style = space 6 | indent_size = 2 7 | end_of_line = lf 8 | charset = utf-8 9 | trim_trailing_whitespace = true 10 | insert_final_newline = true 11 | 12 | [*.md] 13 | trim_trailing_whitespace = false 14 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | # Machines Documentation 2 | 3 | This directory contains documentation for `machines`. If you are interested in contributing new documentation, please read the [contributor guidelines](../CONTRIBUTING.md) and [What Nobody Tells You About Documentation](https://documentation.divio.com) for help getting started. 4 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "machines" 2 | , dependencies = 3 | [ "arrays" 4 | , "console" 5 | , "control" 6 | , "effect" 7 | , "lists" 8 | , "maybe" 9 | , "prelude" 10 | , "profunctor" 11 | , "tuples" 12 | , "unfoldable" 13 | ] 14 | , packages = ./packages.dhall 15 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 16 | } 17 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/config.yml: -------------------------------------------------------------------------------- 1 | blank_issues_enabled: false 2 | contact_links: 3 | - name: PureScript Discourse 4 | url: https://discourse.purescript.org/ 5 | about: Ask and answer questions on the PureScript discussion forum. 6 | - name: PureScript Discord 7 | url: https://purescript.org/chat 8 | about: Ask and answer questions on the PureScript chat. 9 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to Machines 2 | 3 | Thanks for your interest in contributing to `machines`! We welcome new contributions regardless of your level of experience or familiarity with PureScript. 4 | 5 | Every library in the Contributors organization shares a simple handbook that helps new contributors get started. With that in mind, please [read the short contributing guide on purescript-contrib/governance](https://github.com/purescript-contrib/governance/blob/main/contributing.md) before contributing to this library. 6 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug-report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Report an issue 4 | title: "" 5 | labels: bug 6 | assignees: "" 7 | --- 8 | 9 | **Describe the bug** 10 | A clear and concise description of the bug. 11 | 12 | **To Reproduce** 13 | A minimal code example (preferably a runnable example on [Try PureScript](https://try.purescript.org)!) or steps to reproduce the issue. 14 | 15 | **Expected behavior** 16 | A clear and concise description of what you expected to happen. 17 | 18 | **Additional context** 19 | Add any other context about the problem here. 20 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/change-request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Change request 3 | about: Propose an improvement to this library 4 | title: "" 5 | labels: "" 6 | assignees: "" 7 | --- 8 | 9 | **Is your change request related to a problem? Please describe.** 10 | A clear and concise description of the problem. 11 | 12 | Examples: 13 | 14 | - It's frustrating to have to [...] 15 | - I was looking for a function to [...] 16 | 17 | **Describe the solution you'd like** 18 | A clear and concise description of what a good solution to you looks like, including any solutions you've already considered. 19 | 20 | **Additional context** 21 | Add any other context about the change request here. 22 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. 3 | 4 | --- 5 | 6 | **Checklist:** 7 | 8 | - [ ] Added the change to the changelog's "Unreleased" section with a link to this PR and your username 9 | - [ ] Linked any existing issues or proposals that this pull request should close 10 | - [ ] Updated or added relevant documentation in the README and/or documentation directory 11 | - [ ] Added a test for the contribution (if applicable) 12 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-machines", 3 | "description": "Mealy Machines in PureScript", 4 | "authors": [ 5 | "John A. De Goes " 6 | ], 7 | "repository": { 8 | "type": "git", 9 | "url": "https://github.com/purescript-contrib/purescript-machines.git" 10 | }, 11 | "license": "MIT", 12 | "dependencies": { 13 | "purescript-arrays": "^7.0.0", 14 | "purescript-control": "^6.0.0", 15 | "purescript-effect": "^4.0.0", 16 | "purescript-lists": "^7.0.0", 17 | "purescript-maybe": "^6.0.0", 18 | "purescript-prelude": "^6.0.0", 19 | "purescript-profunctor": "^6.0.0", 20 | "purescript-tuples": "^7.0.0", 21 | "purescript-unfoldable": "^6.0.0" 22 | }, 23 | "devDependencies": { 24 | "purescript-console": "^6.0.0" 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | 13 | steps: 14 | - uses: actions/checkout@v2 15 | 16 | - name: Set up a PureScript toolchain 17 | uses: purescript-contrib/setup-purescript@main 18 | with: 19 | purescript: "unstable" 20 | purs-tidy: "latest" 21 | 22 | - name: Cache PureScript dependencies 23 | uses: actions/cache@v2 24 | with: 25 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} 26 | path: | 27 | .spago 28 | output 29 | 30 | - name: Install dependencies 31 | run: spago install 32 | 33 | - name: Build source 34 | run: spago build --no-install --purs-args '--censor-lib --strict' 35 | 36 | - name: Run tests 37 | run: spago test --no-install 38 | 39 | - name: Check formatting 40 | run: purs-tidy check src test 41 | 42 | - name: Verify Bower & Pulp 43 | run: | 44 | npm install bower pulp@16.0.0-0 45 | npx bower install 46 | npx pulp build -- --censor-lib --strict 47 | if [ -d "test" ]; then 48 | npx pulp test 49 | fi 50 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | 15 | ## [v7.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v7.0.0) - 2022-04-27 16 | 17 | Breaking changes: 18 | - Update project and deps to PureScript v0.15.0 (#53 by @JordanMartinez) 19 | 20 | New features: 21 | 22 | Bugfixes: 23 | 24 | Other improvements: 25 | - Added `purs-tidy` formatter (#51 by @thomashoneyman) 26 | 27 | ## [v6.1.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v6.1.0) - 2021-05-06 28 | 29 | New features: 30 | - Added `once` to the export list of `Data.Machine.Mealy` (#49 by @PureFunctor) 31 | 32 | Other improvements: 33 | - Removed unused names and exported unused declaration found by the v0.14.1 PureScript release (#49 by @PureFunctor) 34 | 35 | ## [v6.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v6.0.0) - 2021-02-26 36 | 37 | Breaking changes: 38 | - Added support for PureScript 0.14 and dropped support for all previous versions (#46) 39 | - Removed the `MonadZero` instance, as the type class has been deprecated in PureScript 0.14. Use `Monad` + `Alternative` constraints instead. (#46) 40 | 41 | Other improvements: 42 | - Added @paluh as a maintainer and removed @garyb (#27) 43 | - Added a quick start to the README (#38 by @vladciobanu) 44 | - Added module documentation to `Data.Machine.Mealy` (#39 by @vladciobanu) 45 | - Loosened constraints on functions and instances (#43 by @mhmdanas) 46 | - Renamed type variables of `MealyT` (#44 by @paluh) 47 | - Renamed type variables of `Source` and `Sink` to match type arguments of `MealyT` (#26) 48 | - Changed default branch to `main` from `master` 49 | - Updated to comply with Contributors library guidelines by adding new issue and pull request templates, updating documentation, and migrating to Spago for local development and CI (#31, #37) 50 | 51 | ## [v5.1.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v5.1.0) - 2018-06-06 52 | 53 | - Added `hoistMealyT` (@CarstenKoenig) 54 | 55 | ## [v5.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v5.0.0) - 2018-05-25 56 | 57 | - Updated for PureScript 0.12 58 | 59 | ## [v4.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v4.0.0) - 2017-04-03 60 | 61 | - Updated for PureScript 0.11 62 | 63 | ## [v3.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v3.0.0) - 2016-11-25 64 | 65 | - Removed unused `f` from inner function 66 | 67 | ## [v2.0.1](https://github.com/purescript-contrib/purescript-machines/releases/tag/v2.0.1) - 2016-11-22 68 | 69 | - Fixed shadowed name warnings 70 | 71 | ## [v2.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v2.0.0) - 2016-10-17 72 | 73 | - Updated dependencies 74 | 75 | ## [v1.0.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v1.0.0) - 2016-06-02 76 | 77 | - Updated for 1.0 core libraries 78 | 79 | ## [v0.8.1](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.8.1) - 2016-01-06 80 | 81 | - Added `Lazy` instance 82 | 83 | ## [v0.8.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.8.0) - 2015-10-14 84 | 85 | - Added Travis build; fixed name shadowing (#10) 86 | 87 | ## [v0.7.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.7.0) - 2015-07-08 88 | 89 | - Updated for PureScript 0.7 (#9) 90 | 91 | ## [v0.6.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.6.0) - 2015-04-01 92 | 93 | - Updated dependencies (#4) 94 | 95 | ## [v0.5.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.5.0) - 2015-02-21 96 | 97 | - Updated dependencies. **This release requires PureScript v0.6.8 or later.** 98 | 99 | ## [v0.4.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.4.0) - 2015-01-29 100 | 101 | - Updated for changes in `purescript-arrows` 102 | 103 | ## [v0.2.0](https://github.com/purescript-contrib/purescript-machines/releases/tag/v0.2.0) - 2014-12-30 104 | 105 | - Initial versioned release. Bumped `arrays` dependency. 106 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Machines 2 | 3 | [![CI](https://github.com/purescript-contrib/purescript-machines/workflows/CI/badge.svg?branch=main)](https://github.com/purescript-contrib/purescript-machines/actions?query=workflow%3ACI+branch%3Amain) 4 | [![Release](http://img.shields.io/github/release/purescript-contrib/purescript-machines.svg)](https://github.com/purescript-contrib/purescript-machines/releases) 5 | [![Pursuit](http://pursuit.purescript.org/packages/purescript-machines/badge)](http://pursuit.purescript.org/packages/purescript-machines) 6 | [![Maintainer: paluh](https://img.shields.io/badge/maintainer-paluh-teal.svg)](http://github.com/paluh) 7 | 8 | Machines is a library for building finite state machines. Finite state machines are useful for modeling many concerns that developers face. They help you describe a set of possible states and rules for how to transition from one state to another. The result is a complete view of possible states and transitions between states. 9 | 10 | Currently this library implements [Mealy machines](https://en.wikipedia.org/wiki/Mealy_machine) with halting. 11 | 12 | ## Installation 13 | 14 | Install `machines` with [Spago](https://github.com/purescript/spago): 15 | 16 | ```sh 17 | spago install machines 18 | ``` 19 | 20 | ## Quick start 21 | 22 | Mealy machines are finite state machines. The `MealyT f i o` type represents a machine where `f` is the effect used for evaluation, `i` is the input, and `o` is the output value. The examples here use `Identity` as the effect type for simplicity, but you would usually use a different `Monad` such as `Effect`, `Aff`, or `State`. 23 | 24 | There are several ways to build machines. One way is to use `do` syntax, 25 | for example: 26 | 27 | ```purescript 28 | import Prelude 29 | 30 | import Control.MonadZero (guard) 31 | import Data.Machine.Mealy (MealyT, fromArray, toUnfoldable) 32 | import Data.Identity (Identity) 33 | 34 | machine1 :: MealyT Identity Unit String 35 | machine1 = do 36 | number <- fromArray [10, 20, 30, 40, 50, 0, 60, 70] 37 | guard (number /= 0) 38 | let scaled = div number 2 39 | pure $ show scaled 40 | ``` 41 | 42 | This will create a machine `machine1` which goes through the "inputs" 43 | from the array. It then checks and halts on any zero input, and otherwise 44 | scales the inputs (by dividing by 2). The result is then transformed into a string. 45 | 46 | The resulting machine can be materialized via 47 | 48 | ```purescript 49 | > toUnfoldable unit machine1 :: Array String 50 | ["5","10","15","20","25"] 51 | ``` 52 | 53 | Another way to write the same machine is using machine composition. In this example, we will be creating multiple machines using `pureMealy`, which relies on `Step`s. 54 | 55 | A `Step f i o` represents a state transition in the machine. When you run a machine you are executing a series of steps. At each step the machine can stop via the `Halt` constructor or `Emit` a value and construct the rest of the machine. 56 | 57 | ```purescript 58 | import Prelude 59 | 60 | import Data.Identity (Identity) 61 | import Data.Machine.Mealy (MealyT, Step(..), fromArray, pureMealy) 62 | 63 | machine2 :: MealyT Identity Unit String 64 | machine2 = 65 | fromArray [10, 20, 30, 40, 50, 0, 60, 70] 66 | >>> pureMealy haltOn0 67 | >>> pureMealy scale 68 | >>> pureMealy pretty 69 | where 70 | haltOn0 :: Int -> Step Identity Int Int 71 | haltOn0 0 = Halt 72 | haltOn0 n = Emit n $ pureMealy haltOn0 73 | 74 | scale :: Int -> Step Identity Int Int 75 | scale n = Emit (n `div` 2) $ pureMealy scale 76 | 77 | pretty :: Int -> Step Identity Int String 78 | pretty n = Emit (show n) $ pureMealy pretty 79 | ``` 80 | 81 | This machine does the same thing, except it creates multiple machines: 82 | 83 | - `fromArray [10, 20 ...` is a `MealyT Identity Unit Int` which generates 84 | the integerers in the provided array, 85 | - `pureMealy haltOn0` is a `MealyT Int Int` which halts on 0, 86 | - `pureMealy scale` is a `MealyT Int Int` which scales the inputs, and 87 | - `pureMealy pretty` is a `MealyT Int String` which converts inputs 88 | from integers to strings. 89 | 90 | ## Documentation 91 | 92 | `machines` documentation is stored in a few places: 93 | 94 | 1. Module documentation is [published on Pursuit](https://pursuit.purescript.org/packages/purescript-machines). 95 | 2. Written documentation is kept in [the docs directory](./docs). 96 | 3. Usage examples can be found in [the test suite](./test). 97 | 98 | If you get stuck, there are several ways to get help: 99 | 100 | - [Open an issue](https://github.com/purescript-contrib/purescript-machines/issues) if you have encountered a bug or problem. 101 | - Ask general questions on the [PureScript Discourse](https://discourse.purescript.org) forum or the [PureScript Discord](https://purescript.org/chat) chat. 102 | 103 | ## Contributing 104 | 105 | You can contribute to `machines` in several ways: 106 | 107 | 1. If you encounter a problem or have a question, please [open an issue](https://github.com/purescript-contrib/purescript-machines/issues). We'll do our best to work with you to resolve or answer it. 108 | 109 | 2. If you would like to contribute code, tests, or documentation, please [read the contributor guide](./CONTRIBUTING.md). It's a short, helpful introduction to contributing to this library, including development instructions. 110 | 111 | 3. If you have written a library, tutorial, guide, or other resource based on this package, please share it on the [PureScript Discourse](https://discourse.purescript.org)! Writing libraries and learning resources are a great way to help this library succeed. 112 | -------------------------------------------------------------------------------- /src/Data/Machine/Mealy.purs: -------------------------------------------------------------------------------- 1 | -- | This module provides the building blocks required to create 2 | -- | finite state machines. 3 | module Data.Machine.Mealy 4 | ( MealyT 5 | , runMealyT 6 | , hoistMealyT 7 | , Step(..) 8 | , Source 9 | , Sink 10 | , source 11 | , sink 12 | , stepMealy 13 | , runMealy 14 | , pureMealy 15 | , mealy 16 | , halt 17 | , take 18 | , drop 19 | , loop 20 | , toUnfoldable 21 | , zipWith 22 | , scanl 23 | , collect 24 | , singleton 25 | , fromMaybe 26 | , fromArray 27 | , msplit 28 | , interleave 29 | , once 30 | , when 31 | , ifte 32 | , wrapEffect 33 | ) where 34 | 35 | import Prelude 36 | 37 | import Control.Alt (class Alt) 38 | import Control.Alternative (class Alternative) 39 | import Control.Comonad (class Comonad, extract) 40 | import Control.Lazy (class Lazy) 41 | import Control.MonadPlus (class MonadPlus) 42 | import Control.Plus (class Plus) 43 | import Data.Array ((!!), length) 44 | import Data.List (List(..)) 45 | import Data.Maybe (Maybe(..)) 46 | import Data.Profunctor (class Profunctor, dimap) 47 | import Data.Profunctor.Strong (class Strong, first) 48 | import Data.Tuple (Tuple(..), fst, snd, swap) 49 | import Data.Unfoldable (class Unfoldable, unfoldr) 50 | import Effect.Class (class MonadEffect, liftEffect) 51 | 52 | -- | Mealy is a finite state machine, where: 53 | -- | 54 | -- | - `f` is the effect under which we evaluate, 55 | -- | - `i` is the input type and 56 | -- | - `o` is the output type. 57 | newtype MealyT f i o = MealyT (i -> f (Step f i o)) 58 | 59 | runMealyT :: forall f i o. MealyT f i o -> i -> f (Step f i o) 60 | runMealyT (MealyT f) = f 61 | 62 | -- | Transforms a Mealy machine running in the context of `f` into one running 63 | -- | in `g`, given a natural transformation from `f` to `g`. 64 | hoistMealyT :: forall f g i. Functor g => (f ~> g) -> MealyT f i ~> MealyT g i 65 | hoistMealyT f2g (MealyT goF) = MealyT goG 66 | where 67 | goG i = hoistStep f2g <$> f2g (goF i) 68 | 69 | -- | Step is the core for running machines. Machines can either stop 70 | -- | via the `Halt` constructor, or emit a value and recursively 71 | -- | construct the rest of the machine. 72 | data Step f i o = Emit o (MealyT f i o) | Halt 73 | 74 | -- | Transforms a step running in the context of `f` into one running 75 | -- | in `g`, given a natural transformation from `f` to `g`. 76 | hoistStep :: forall f g i. Functor g => (f ~> g) -> Step f i ~> Step g i 77 | hoistStep f2g (Emit v nxt) = Emit v (hoistMealyT f2g nxt) 78 | hoistStep _ Halt = Halt 79 | 80 | -- | Sources are 'initial nodes' in machines. They allow for data 81 | -- | to be generated. 82 | type Source f o = MealyT f Unit o 83 | 84 | -- | Sinks are 'terminator nodes' in machines. They allow for an 85 | -- | effectful computation to be executed on the inputs. 86 | type Sink f i = MealyT f i Unit 87 | 88 | -- | Wrap an effectful value into a source. The effect will be repeated 89 | -- | indefinitely. 90 | -- | 91 | -- | For example, generating ten instances of the value 1: 92 | -- | ```purescript 93 | -- | take 10 $ source (pure 1) 94 | -- | ``` 95 | source :: forall f o. Functor f => f o -> Source f o 96 | source src = mealy $ \_ -> flip Emit (source src) <$> src 97 | 98 | -- | Construct a machine which executes an effectful computation on its inputs. 99 | -- | 100 | -- | For example, logging could be used as a sink: 101 | -- | ```purescript 102 | -- | take 10 $ source (pure 1) >>> sink logShow 103 | -- | ``` 104 | sink :: forall f i. Functor f => (i -> f Unit) -> Sink f i 105 | sink f = mealy $ \i -> const (Emit unit (sink f)) <$> f i 106 | 107 | -- | Run a machine as an effectful computatation. 108 | -- | 109 | -- | For example: 110 | -- | ```purescript 111 | -- | runMealy $ take 10 $ source (pure 1) >>> sink logShow 112 | -- | ``` 113 | runMealy :: forall f. Monad f => MealyT f Unit Unit -> f Unit 114 | runMealy m = stepMealy unit m >>= f 115 | where 116 | f Halt = pure unit 117 | f (Emit _ m') = runMealy m' 118 | 119 | -- | Execute (unroll) a single step on a machine. 120 | stepMealy :: forall f i o. i -> MealyT f i o -> f (Step f i o) 121 | stepMealy = flip runMealyT 122 | 123 | -- | Wrap a pure function into a machine. The function can either 124 | -- | terminate via `Halt`, or `Emit` a value and then decide whether 125 | -- | to `Halt`, continue with a different function, or (usually) wrap 126 | -- | itself via `pureMealy` recursively. 127 | -- | 128 | -- | For example, we can `Halt` on zero: 129 | -- | ```purescript 130 | -- | haltOn0 :: forall f. Applicative f => MealyT f Int Int 131 | -- | haltOn0 = pureMealy go 132 | -- | where 133 | -- | go 0 = Halt 134 | -- | go n = Emit n (pureMealy haltOn0) 135 | -- | ``` 136 | pureMealy :: forall f i o. Applicative f => (i -> Step f i o) -> MealyT f i o 137 | pureMealy = MealyT <<< map pure 138 | 139 | -- | Wrap an effectful function into a machine. See `pureMealy` for 140 | -- | an example using pure functions. 141 | mealy :: forall f i o. (i -> f (Step f i o)) -> MealyT f i o 142 | mealy = MealyT 143 | 144 | -- | A machine which halts for any input. 145 | halt :: forall f i o. Applicative f => MealyT f i o 146 | halt = pureMealy $ const Halt 147 | 148 | -- | Limit the number of outputs of a machine. After using up the `n` 149 | -- | allotted outputs, the machine will halt. 150 | take :: forall f i o. Applicative f => Int -> MealyT f i o -> MealyT f i o 151 | take n m = 152 | if n <= 0 then halt 153 | else mealy $ \i -> f <$> stepMealy i m 154 | where 155 | f Halt = Halt 156 | f (Emit o m') = Emit o (take (n - 1) m') 157 | 158 | -- | Skip a number of outputs for a machine. 159 | drop :: forall f i o. Monad f => Int -> MealyT f i o -> MealyT f i o 160 | drop n m = 161 | if n <= 0 then m 162 | else mealy $ \i -> do 163 | let 164 | f Halt = pure Halt 165 | f (Emit _ m') = stepMealy i (drop (n - 1) m') 166 | 167 | stepMealy i m >>= f 168 | 169 | -- | Loop a machine forever. 170 | loop :: forall f i o. Monad f => MealyT f i o -> MealyT f i o 171 | loop m0 = loop' m0 172 | where 173 | loop' m = mealy $ \i -> 174 | stepMealy i m >>= case _ of 175 | Halt -> stepMealy i (loop m0) 176 | Emit o m' -> pure $ Emit o (loop' m') 177 | 178 | -- | Extract all the outputs of a machine, given some input. 179 | toUnfoldable 180 | :: forall f g i o 181 | . Unfoldable g 182 | => Comonad f 183 | => i 184 | -> MealyT f i o 185 | -> g o 186 | toUnfoldable i = unfoldr stepUnfold 187 | where 188 | stepUnfold m = case extract (runMealyT m i) of 189 | Emit o m' -> Just $ Tuple o m' 190 | Halt -> Nothing 191 | 192 | -- | Zip two machines together under some function `f`. 193 | zipWith :: forall f i a b c. Apply f => (a -> b -> c) -> MealyT f i a -> MealyT f i b -> MealyT f i c 194 | zipWith f a b = f <$> a <*> b 195 | 196 | -- | Accumulate the outputs of a machine into a new machine. 197 | scanl :: forall f i a b. Functor f => (b -> a -> b) -> b -> MealyT f i a -> MealyT f i b 198 | scanl f = go 199 | where 200 | go b m = mealy $ \i -> do 201 | let 202 | g Halt = Halt 203 | g (Emit o m') = (let b' = f b o in Emit b' (go b' m')) 204 | 205 | g <$> stepMealy i m 206 | 207 | -- | Accumulates the outputs of a machine as a `List`. 208 | collect :: forall f i o. Functor f => MealyT f i o -> MealyT f i (List o) 209 | collect = scanl (flip Cons) Nil 210 | 211 | -- | Creates a machine which emits a single value before halting. 212 | singleton :: forall f i o. Applicative f => o -> MealyT f i o 213 | singleton o = pureMealy $ \_ -> Emit o halt 214 | 215 | -- | Creates a machine which either emits a single value before halting 216 | -- | (for `Just`), or just halts (in the case of `Nothing`). 217 | fromMaybe :: forall f i o. Applicative f => Maybe o -> MealyT f i o 218 | fromMaybe Nothing = halt 219 | fromMaybe (Just o) = singleton o 220 | 221 | -- | Creates a machine which emits all the values of the array before 222 | -- | halting. 223 | fromArray :: forall f i o. Monad f => Array o -> MealyT f i o 224 | fromArray o = do 225 | let 226 | len = length o 227 | go n | n < zero || n >= len = halt 228 | go n = fromMaybe (o !! n) <> go (n + one) 229 | 230 | go zero 231 | 232 | -- | Creates a machine which wraps an effectful computation and ignores 233 | -- | its input. 234 | wrapEffect :: forall f i o. Applicative f => f o -> MealyT f i o 235 | wrapEffect fa = MealyT $ const (flip Emit halt <$> fa) 236 | 237 | -- MonadLogic -- TODO: Create a purescript-logic package 238 | -- | Unwrap a machine such that its output is either `Nothing` in case 239 | -- | it would halt, or `Just` the output value and the next computation. 240 | msplit :: forall f i o. Applicative f => MealyT f i o -> MealyT f i (Maybe (Tuple o (MealyT f i o))) 241 | msplit m = mealy $ \i -> f <$> stepMealy i m 242 | where 243 | f Halt = Emit (Nothing) halt 244 | f (Emit o m') = Emit (Just $ Tuple o m') (msplit m') 245 | 246 | -- | Interleaves the values of two machines with matching inputs and 247 | -- | outputs. 248 | interleave :: forall f i o. Monad f => MealyT f i o -> MealyT f i o -> MealyT f i o 249 | interleave m1 m2 = mealy $ \i -> 250 | stepMealy i m1 >>= case _ of 251 | Halt -> stepMealy i m2 252 | Emit o m1' -> pure $ Emit o (interleave m2 m1') 253 | 254 | -- | Takes a single output from a machine. 255 | once :: forall f s a. Applicative f => MealyT f s a -> MealyT f s a 256 | once = take 1 257 | 258 | -- | If then else: given a machine producing `a`, a continuation `f`, 259 | -- | and a machine producing `b`, generate a machine which will 260 | -- | grab outputs from the first machine and pass them over to the 261 | -- | continuation as long as neither halts. 262 | -- | Once the process halts, the second (`b`) machine is returned. 263 | ifte :: forall f i a b. Monad f => MealyT f i a -> (a -> MealyT f i b) -> MealyT f i b -> MealyT f i b 264 | ifte ma f mb = mealy $ \i -> 265 | stepMealy i ma >>= case _ of 266 | Halt -> stepMealy i mb 267 | Emit a ma' -> go ma' <$> stepMealy i (f a) 268 | where 269 | go ma' = case _ of 270 | Halt -> Halt 271 | Emit b fb -> Emit b (fb <> ifte ma' f mb) 272 | 273 | -- | Given a machine and a continuation, it will pass outputs from 274 | -- | the machine to the continuation as long as possible until 275 | -- | one of them halts. 276 | when :: forall f i a b. Monad f => MealyT f i a -> (a -> MealyT f i b) -> MealyT f i b 277 | when ma f = ifte ma f halt 278 | 279 | instance functorMealy :: Functor f => Functor (MealyT f i) where 280 | map f m = mealy $ \i -> g <$> stepMealy i m 281 | where 282 | g (Emit o m') = Emit (f o) (f <$> m') 283 | g Halt = Halt 284 | 285 | instance applyMealy :: Apply f => Apply (MealyT f i) where 286 | apply f x = mealy $ \i -> ap <$> stepMealy i f <*> stepMealy i x 287 | where 288 | ap Halt _ = Halt 289 | ap _ Halt = Halt 290 | ap (Emit f' g) (Emit x' y) = Emit (f' x') (g <*> y) 291 | 292 | instance applicativeMealy :: Applicative f => Applicative (MealyT f i) where 293 | pure t = pureMealy $ \_ -> Emit t halt 294 | 295 | instance profunctorMealy :: Functor f => Profunctor (MealyT f) where 296 | dimap l r = remap 297 | where 298 | remap m = mealy $ \i -> g <$> stepMealy (l i) m 299 | where 300 | g (Emit c m') = Emit (r c) (remap m') 301 | g Halt = Halt 302 | 303 | instance strongMealy :: Functor f => Strong (MealyT f) where 304 | first m = mealy $ \s -> do 305 | let 306 | b = fst s 307 | d = snd s 308 | g (Emit c f') = Emit (Tuple c d) (first f') 309 | g Halt = Halt 310 | 311 | g <$> stepMealy b m 312 | second = dimap swap swap <<< first 313 | 314 | instance semigroupMealy :: Monad f => Semigroup (MealyT f i o) where 315 | append l r = mealy $ \i -> do 316 | let 317 | g (Emit c l') = pure $ Emit c (l' <> r) 318 | g Halt = stepMealy i r 319 | 320 | stepMealy i l >>= g 321 | 322 | instance monoidMealy :: Monad f => Monoid (MealyT f i o) where 323 | mempty = mealy $ \_ -> pure Halt 324 | 325 | instance semigroupoidMealy :: Monad f => Semigroupoid (MealyT f) where 326 | compose f g = 327 | mealy $ \b -> stepMealy b g >>= gb 328 | where 329 | gb Halt = pure Halt 330 | gb (Emit c g') = fc <$> stepMealy c f 331 | where 332 | fc (Emit d f') = Emit d (f' <<< g') 333 | fc Halt = Halt 334 | 335 | instance categoryMealy :: Monad f => Category (MealyT f) where 336 | identity = pureMealy $ \t -> Emit t halt 337 | 338 | instance bindMealy :: Monad f => Bind (MealyT f i) where 339 | bind m f = mealy $ \i -> do 340 | let 341 | g (Emit o m') = h <$> stepMealy i (f o) 342 | where 343 | h (Emit b bi) = Emit b (bi <> (m' >>= f)) 344 | h Halt = Halt 345 | g Halt = pure Halt 346 | 347 | stepMealy i m >>= g 348 | 349 | instance monadMealy :: Monad f => Monad (MealyT f i) 350 | 351 | instance altMealy :: Monad f => Alt (MealyT f i) where 352 | alt x y = mealy $ \i -> do 353 | let 354 | f Halt = stepMealy i y 355 | f (Emit o m') = pure $ Emit o m' 356 | 357 | stepMealy i x >>= f 358 | 359 | instance plusMealy :: Monad f => Plus (MealyT f i) where 360 | empty = halt 361 | 362 | instance alternativeMealy :: Monad f => Alternative (MealyT f i) 363 | 364 | instance monadPlus :: Monad f => MonadPlus (MealyT f i) 365 | 366 | instance monadEffectMealy :: MonadEffect f => MonadEffect (MealyT f i) where 367 | liftEffect = wrapEffect <<< liftEffect 368 | 369 | instance lazyMealy :: Lazy (MealyT f i o) where 370 | defer f = mealy \i -> runMealyT (f unit) i 371 | --------------------------------------------------------------------------------