├── .github ├── dependabot.yml └── workflows │ └── ci.yml ├── .gitignore ├── .gitmodules ├── .travis.yml ├── Makefile ├── README.md ├── article ├── ArrowArr.tex ├── ArrowCompose.tex ├── CategoryCompose.tex ├── CategoryId.tex ├── EssenceOfLiveCoding.bib ├── EssenceOfLiveCoding.lhs ├── EssenceOfLiveCodingAbstract.lhs ├── EssenceOfLiveCodingAppendix.lhs ├── EssenceOfLiveCodingPresentation.md ├── Exposition.md ├── FRP refactored.png ├── acmart.cls ├── debugger.png ├── essence.cls ├── gears.png ├── tutorial_screenshot.png └── tutorial_screenshot_debugger.png ├── cabal-freeze.sh ├── cabal.project ├── default.nix ├── demos ├── CHANGELOG.md ├── DemoSine.txt ├── DemoSineWait.txt ├── DemoSineWaitChange.txt ├── DemoSinesForever.txt ├── LICENSE ├── Setup.hs ├── app │ ├── DemoSine.hs │ ├── DemoSineWait.hs │ ├── DemoSineWaitChange.hs │ ├── DemoSinesForever.hs │ ├── DemoWai.hs │ ├── DemoWai │ │ ├── DemoWai1.lhs │ │ ├── DemoWai2.lhs │ │ └── Env.lhs │ └── Examples.hs ├── demos.cabal └── stack.yaml ├── essence-of-live-coding-PortMidi ├── CHANGELOG.md ├── LICENSE ├── essence-of-live-coding-PortMidi.cabal └── src │ └── LiveCoding │ ├── PortMidi.hs │ └── PortMidi │ └── Internal.hs ├── essence-of-live-coding-ghci-example ├── .ghci ├── .ghcid ├── CHANGELOG.md ├── LICENSE ├── app │ └── Main.hs └── essence-of-live-coding-ghci-example.cabal ├── essence-of-live-coding-gloss-example ├── .ghci ├── .ghcid ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── app │ └── Main.hs ├── essence-of-live-coding-gloss-example.cabal └── stack.yaml ├── essence-of-live-coding-gloss ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── essence-of-live-coding-gloss.cabal ├── src │ └── LiveCoding │ │ ├── Gloss.hs │ │ └── Gloss │ │ ├── Debugger.hs │ │ └── PictureM.hs └── stack.yaml ├── essence-of-live-coding-pulse-example ├── .ghci ├── .ghcid ├── CHANGELOG.md ├── LICENSE ├── app │ └── Main.hs ├── essence-of-live-coding-pulse-example.cabal └── stack.yaml ├── essence-of-live-coding-pulse ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── essence-of-live-coding-pulse.cabal ├── src │ └── LiveCoding │ │ └── Pulse.hs └── stack.yaml ├── essence-of-live-coding-quickcheck ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── essence-of-live-coding-quickcheck.cabal ├── src │ └── LiveCoding │ │ └── QuickCheck.lhs └── stack.yaml ├── essence-of-live-coding-speedtest-yampa ├── CHANGELOG.md ├── LICENSE ├── app │ ├── SpeedTest.hs │ └── SpeedTestYampa.hs ├── essence-of-live-coding-speedtest-yampa.cabal └── stack.yaml ├── essence-of-live-coding-vivid ├── CHANGELOG.md ├── LICENSE ├── essence-of-live-coding-vivid.cabal └── src │ └── LiveCoding │ └── Vivid.hs ├── essence-of-live-coding-warp ├── .ghcid ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── essence-of-live-coding-warp.cabal ├── src │ └── LiveCoding │ │ └── Warp.hs └── test │ └── Main.hs ├── essence-of-live-coding ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ ├── TestExceptions.hs │ └── TestNonBlocking.hs ├── essence-of-live-coding.cabal ├── src │ ├── LiveCoding.hs │ └── LiveCoding │ │ ├── Bind.lhs │ │ ├── Cell.lhs │ │ ├── Cell │ │ ├── Feedback.lhs │ │ ├── HotCodeSwap.hs │ │ ├── Monad.hs │ │ ├── Monad │ │ │ └── Trans.hs │ │ ├── NonBlocking.hs │ │ ├── Resample.hs │ │ ├── Util.hs │ │ └── Util │ │ │ └── Internal.hs │ │ ├── CellExcept.lhs │ │ ├── Coalgebra.lhs │ │ ├── Debugger.lhs │ │ ├── Debugger │ │ └── StatePrint.hs │ │ ├── Exceptions.lhs │ │ ├── Exceptions │ │ └── Finite.lhs │ │ ├── External.hs │ │ ├── Forever.lhs │ │ ├── GHCi.hs │ │ ├── Handle.hs │ │ ├── Handle │ │ └── Examples.hs │ │ ├── HandlingState.hs │ │ ├── LiveBind.lhs │ │ ├── LiveProgram.lhs │ │ ├── LiveProgram │ │ ├── Except.hs │ │ ├── HotCodeSwap.lhs │ │ └── Monad │ │ │ └── Trans.hs │ │ ├── Migrate.lhs │ │ ├── Migrate │ │ ├── Cell.hs │ │ ├── Debugger.hs │ │ ├── Migration.hs │ │ ├── Monad │ │ │ └── Trans.hs │ │ └── NoMigration.hs │ │ ├── Preliminary │ │ ├── CellExcept.lhs │ │ ├── CellExcept │ │ │ ├── Applicative.lhs │ │ │ ├── Monad.lhs │ │ │ └── Newtype.lhs │ │ └── LiveProgram │ │ │ ├── HotCodeSwap.lhs │ │ │ ├── LiveProgram2.lhs │ │ │ └── LiveProgramPreliminary.lhs │ │ ├── RuntimeIO.lhs │ │ └── RuntimeIO │ │ └── Launch.hs └── test │ ├── Cell.hs │ ├── Cell │ ├── Monad │ │ └── Trans.hs │ ├── Util.hs │ └── Util │ │ └── Traversable.hs │ ├── Feedback.hs │ ├── Handle.hs │ ├── Handle │ └── LiveProgram.hs │ ├── Main.hs │ ├── Migrate.hs │ ├── Migrate │ └── NoMigration.hs │ ├── Monad.hs │ ├── Monad │ └── Trans.hs │ ├── RuntimeIO │ └── Launch.hs │ ├── TestData │ ├── Foo1.hs │ └── Foo2.hs │ ├── Util.hs │ └── Util │ └── LiveProgramMigration.hs ├── fourmolu.yaml ├── gears ├── .ghci ├── .ghcid ├── CHANGELOG.md ├── LICENSE ├── Setup.hs ├── app │ └── Gears.hs ├── gears.cabal └── stack.yaml ├── nix └── common.nix ├── replcommands.txt ├── run_fourmolu.sh ├── shell.nix ├── templates ├── .ghci └── .ghcid ├── test-repl.sh └── travis-build.sh /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | 4 | - package-ecosystem: github-actions 5 | directory: "/" 6 | schedule: 7 | interval: daily 8 | time: '00:00' 9 | timezone: UTC 10 | open-pull-requests-limit: 10 11 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: 4 | - master 5 | push: 6 | branches: 7 | - master 8 | tags: 9 | - v* 10 | name: build 11 | jobs: 12 | fourmolu: 13 | name: "Run fourmolu" 14 | runs-on: ubuntu-latest 15 | steps: 16 | - uses: actions/checkout@v4 17 | - uses: cachix/install-nix-action@v31 18 | with: 19 | nix_path: nixpkgs=channel:nixos-unstable 20 | - name: Set up and run fourmolu 21 | run: | 22 | nix shell nixpkgs#haskellPackages.fourmolu --command fourmolu --mode check . 23 | 24 | generateMatrix: 25 | name: "Generate matrix from cabal" 26 | outputs: 27 | matrix: ${{ steps.set-matrix.outputs.matrix }} 28 | runs-on: ubuntu-latest 29 | steps: 30 | - uses: kleidukos/get-tested@0.1.7.1 31 | id: set-matrix 32 | with: 33 | cabal-file: "essence-of-live-coding/essence-of-live-coding.cabal" 34 | ubuntu: true 35 | version: 0.1.6.0 36 | 37 | build: 38 | runs-on: ubuntu-latest 39 | needs: 40 | - generateMatrix 41 | - fourmolu 42 | strategy: 43 | matrix: ${{ fromJSON(needs.generateMatrix.outputs.matrix) }} 44 | name: Haskell GHC ${{ matrix.ghc }} cabal 45 | steps: 46 | - uses: actions/checkout@v4 47 | - uses: haskell-actions/setup@v2 48 | id: setup 49 | with: 50 | ghc-version: ${{ matrix.ghc }} 51 | - name: update apt 52 | run: sudo apt update 53 | - name: Install dependencies 54 | run: sudo apt-get install -y libxml2-utils libgl1-mesa-dev libglu1-mesa-dev freeglut3-dev libpulse-dev libblas-dev liblapack-dev libasound2-dev wget 55 | 56 | - name: Configure the build 57 | run: | 58 | cabal configure --enable-tests --enable-benchmarks --disable-documentation 59 | cabal build all --dry-run 60 | # The last step generates dist-newstyle/cache/plan.json for the cache key. 61 | 62 | - name: Restore cached dependencies 63 | uses: actions/cache/restore@v4 64 | id: cache 65 | env: 66 | key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }} 67 | with: 68 | path: ${{ steps.setup.outputs.cabal-store }} 69 | key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }} 70 | restore-keys: ${{ env.key }}- 71 | 72 | - name: Install dependencies 73 | # If we had an exact cache hit, the dependencies will be up to date. 74 | if: steps.cache.outputs.cache-hit != 'true' 75 | run: cabal build all --enable-tests --enable-benchmarks --only-dependencies 76 | 77 | # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. 78 | - name: Save cached dependencies 79 | uses: actions/cache/save@v4 80 | # If we had an exact cache hit, trying to save the cache would error because of key clash. 81 | if: steps.cache.outputs.cache-hit != 'true' 82 | with: 83 | path: ${{ steps.setup.outputs.cabal-store }} 84 | key: ${{ steps.cache.outputs.cache-primary-key }} 85 | 86 | - name: Cabal build packages 87 | run: | 88 | cabal build all --enable-tests 89 | 90 | - name: Cabal test 91 | run: | 92 | cabal test all --enable-tests --test-show-details=Always 93 | 94 | success: 95 | name: Successfully build and test 96 | needs: 97 | - build 98 | runs-on: 99 | - ubuntu-latest 100 | steps: 101 | - run: echo "Success" 102 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.txt 2 | *.pdf 3 | *.html 4 | dist/* 5 | dist-newstyle 6 | acmart* 7 | *.png 8 | *.o 9 | *.hi 10 | *.hp 11 | *.prof 12 | *.ps 13 | .stack-work 14 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "article/reveal.js"] 2 | path = article/reveal.js 3 | url = https://github.com/hakimel/reveal.js.git 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | cabal: "3.4" # Temporary pin until a sufficiently recent version is in the standard Travis images 3 | addons: 4 | apt: 5 | packages: 6 | - libgl1-mesa-dev 7 | - libglu1-mesa-dev 8 | - freeglut3-dev 9 | - libpulse-dev 10 | - libblas-dev 11 | - liblapack-dev 12 | - libasound2-dev 13 | sources: 14 | - sourceline: 'ppa:hvr/ghc' 15 | cache: 16 | directories: 17 | - $HOME/.cabal 18 | - $HOME/.stack 19 | - $TRAVIS_BUILD_DIR/.stack-work 20 | 21 | ghc: 22 | - '8.10' 23 | - '8.8' 24 | - '8.6' 25 | 26 | script: 27 | - bash travis-build.sh 28 | 29 | install: skip 30 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | demos: demos/DemoSine.txt demos/DemoSinesForever.txt demos/DemoSineWait.txt demos/DemoSineWaitChange.txt 2 | 3 | demos/%.txt: 4 | cd demos && stack build --exec $* > $*.txt 5 | 6 | speedtest: build 7 | cd essence-of-live-coding-speedtest-yampa && stack build && time stack exec SpeedTest 8 | 9 | build: 10 | cd essence-of-live-coding && stack build 11 | 12 | article: demos latex 13 | 14 | latex: latex-article latex-appendix 15 | 16 | latex-article: 17 | cd article && pdflatex -shell-escape -interact nonstopmode EssenceOfLiveCoding.lhs 18 | 19 | latex-abstract: 20 | cd article && pdflatex -shell-escape -interact nonstopmode EssenceOfLiveCodingAbstract.lhs 21 | 22 | latex-appendix: 23 | cd article && pdflatex -shell-escape -interact nonstopmode EssenceOfLiveCodingAppendix.lhs 24 | 25 | bibtex: 26 | cd article && bibtex EssenceOfLiveCoding && bibtex EssenceOfLiveCodingAppendix && bibtex EssenceOfLiveCodingAbstract 27 | 28 | article/%.png: article/%.tex 29 | cd article && pdflatex -shell-escape $* 30 | 31 | pictures: article/CategoryId.png article/CategoryCompose.png article/ArrowArr.png article/ArrowCompose.png 32 | 33 | git-submodule: 34 | git submodule init && git submodule update --checkout 35 | 36 | revealjs: git-submodule 37 | 38 | presentation: revealjs pictures 39 | cd article && pandoc -s EssenceOfLiveCodingPresentation.md -t revealjs -V theme=serif -i -o EssenceOfLiveCodingPresentation.html 40 | 41 | gears: 42 | cd gears && stack ghci gears:exe:gears 43 | -------------------------------------------------------------------------------- /article/ArrowArr.tex: -------------------------------------------------------------------------------- 1 | \documentclass[convert]{standalone} 2 | 3 | \usepackage{essence-tikz} 4 | \begin{document} 5 | \begin{tikzpicture} 6 | \node[circle, draw, inner sep=0.05cm] (f) {f}; 7 | \node[arrowbox, minimum height=0.6cm] {}; 8 | \draw[arrowarrow] (-1, 0) -- (f) -- (1, 0); 9 | \end{tikzpicture} 10 | \end{document} 11 | -------------------------------------------------------------------------------- /article/ArrowCompose.tex: -------------------------------------------------------------------------------- 1 | \documentclass[convert]{standalone} 2 | 3 | \usepackage{essence-tikz} 4 | \begin{document} 5 | \begin{tikzpicture} 6 | \node[arrowbox] (cell1) at (0, +0.3) {cell1}; 7 | \node[arrowbox] (cell2) at (0, -0.3) {cell2}; 8 | \node[arrowbox, minimum height=1.2cm, minimum width=1.8cm] (cell) {}; 9 | \draw (-1.5, 0) -- (cell); 10 | \draw[<-] ( 1.5, 0) -- (cell); 11 | \draw (cell.west) -- (cell1); 12 | \draw (cell.east) -- (cell1); 13 | \draw (cell.west) -- (cell2); 14 | \draw (cell.east) -- (cell2); 15 | \end{tikzpicture} 16 | \end{document} 17 | -------------------------------------------------------------------------------- /article/CategoryCompose.tex: -------------------------------------------------------------------------------- 1 | \documentclass[convert]{standalone} 2 | 3 | \usepackage{essence-tikz} 4 | \begin{document} 5 | \begin{tikzpicture} 6 | \node[arrowbox] (cell1) at (-0.7, 0) {cell1}; 7 | \node[arrowbox] (cell2) at (+0.7, 0) {cell2}; 8 | \node[arrowbox, minimum width=2.9cm, minimum height=0.8cm] {}; 9 | \draw[arrowarrow] (-1.8, 0) -- (cell1) -- (cell2) -- (1.8, 0); 10 | \end{tikzpicture} 11 | \end{document} 12 | -------------------------------------------------------------------------------- /article/CategoryId.tex: -------------------------------------------------------------------------------- 1 | \documentclass[convert]{standalone} 2 | 3 | \usepackage{essence-tikz} 4 | \begin{document} 5 | \begin{tikzpicture} 6 | \node[arrowbox] {}; 7 | \draw[arrowarrow] (-0.8, 0) -- (0.8, 0); 8 | \end{tikzpicture} 9 | \end{document} 10 | -------------------------------------------------------------------------------- /article/EssenceOfLiveCodingAppendix.lhs: -------------------------------------------------------------------------------- 1 | \documentclass{essence} 2 | 3 | \begin{document} 4 | \title{The essence of live coding: Change the program, keep the state!} 5 | \subtitle{Appendix} 6 | 7 | \begin{abstract} 8 | This file supplies more detailed discussions, 9 | such as the somewhat technical derivations of the \mintinline{haskell}{Applicative} and \mintinline{haskell}{Monad} type classes. 10 | It is not necessary to read it in order to appreciate the main paper, 11 | but some readers may want to satisfy their curiosity. 12 | \end{abstract} 13 | 14 | \maketitle 15 | 16 | \section{Arrows and typeclasses} 17 | 18 | The \mintinline{haskell}{Arrow} type class also allows for data-parallel composition: 19 | \begin{spec} 20 | (***) 21 | :: Monad m 22 | => Cell m a b 23 | -> Cell m c d 24 | -> Cell m (a, c) (b, d) 25 | \end{spec} 26 | As for \mintinline{haskell}{(>>>)}, 27 | the state type of the composed cell is the product type of the constituent states. 28 | In the resulting cell \mintinline{haskell}{cell1 *** cell2}, 29 | two inputs are received. 30 | First, \mintinline{haskell}{cell1} is stepped with the input \mintinline{haskell}{a}, 31 | then \mintinline{haskell}{cell2} is stepped with \mintinline{haskell}{b}. 32 | 33 | The parallel composition operator has a dual, 34 | supplied by the \mintinline{haskell}{ArrowChoice} type class, 35 | \fxwarning{Cite something? For example, we fulfil the noninterference (?) law from "Settable and Non-Interfering Signal Functions for FRP - How a First-Order Switch is More Than Enough"} 36 | which \mintinline{haskell}{Cell}s implement: 37 | \begin{spec} 38 | (+++) 39 | :: Monad m 40 | => Cell m a b 41 | -> Cell m c d 42 | -> Cell m (Either a c) (Either b d) 43 | \end{spec} 44 | Like \mintinline{haskell}{cell1 *** cell2}, 45 | its dual \mintinline{haskell}{cell1 +++ cell2} holds the state of both cells. 46 | But while the former executes both cells, 47 | and consumes input and produces output for both of them, 48 | the latter steps only one of them forward each time, 49 | depending on which input was provided. 50 | This enables basic control flow in arrow expressions, 51 | such as \mintinline{haskell}{if}- and \mintinline{haskell}{case}-statements. 52 | We can momentarily switch from one cell to another, 53 | depending on live input. 54 | For example, the following two cells are equal: 55 | \begin{code} 56 | cellLR = proc lr -> do 57 | case lr of 58 | Left () -> returnA -< "Left!" 59 | Right () -> returnA -< "Right!" 60 | 61 | cellLR' 62 | = arr (const "Left!") 63 | +++ arr (const "Right!") 64 | \end{code} 65 | 66 | The \mintinline{haskell}{ArrowLoop} class exists to enable recursive definitions in arrow expressions, 67 | and once again \mintinline{haskell}{Cell}s implement it: 68 | \begin{spec} 69 | loop 70 | :: MonadFix m 71 | => Cell m (a, s) (b, s) 72 | -> Cell m a b 73 | \end{spec} 74 | A word of caution has to be issued here: 75 | The instance is implemented using the monadic fixed point operator \mintinline{haskell}{mfix} \cite{MonadFix}, 76 | and can thus crash at runtime if the current output of the intermediate value \mintinline{haskell}{s} is calculated strictly from the current input \mintinline{haskell}{s}. 77 | 78 | \input{../essence-of-live-coding/src/LiveCoding/Cell/Feedback.lhs} 79 | \input{../essence-of-live-coding/src/LiveCoding/Coalgebra.lhs} 80 | \fxerror{The transition from coalgebras is a bit rough?} 81 | \fxerror{We've now switched to using runExceptC, so liveBind is implemented in terms of it.} 82 | We would like to adopt this approach here, 83 | but we are forewarned: 84 | \mintinline{haskell}{Cell}s are slightly less expressive than Dunai's stream functions, 85 | due to the \mintinline{haskell}{Data} constraint on the internal state. 86 | \section{Monads for control flow} 87 | \input{../essence-of-live-coding/src/LiveCoding/LiveBind.lhs} 88 | \input{../essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept/Applicative.lhs} 89 | \input{../essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept/Monad.lhs} 90 | 91 | \bibliography{EssenceOfLiveCoding.bib} 92 | \end{document} 93 | -------------------------------------------------------------------------------- /article/FRP refactored.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turion/essence-of-live-coding/c361669bf00a5cff4c988e74d2cd375452a8234e/article/FRP refactored.png -------------------------------------------------------------------------------- /article/debugger.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turion/essence-of-live-coding/c361669bf00a5cff4c988e74d2cd375452a8234e/article/debugger.png -------------------------------------------------------------------------------- /article/essence.cls: -------------------------------------------------------------------------------- 1 | \ProvidesClass{essence} 2 | 3 | \LoadClass[sigplan,screen]{acmart} 4 | 5 | \RequirePackage[utf8]{inputenc} 6 | \RequirePackage{minted} 7 | \setmintedinline{style=bw} 8 | \RequirePackage[nomargin,inline]{fixme} 9 | \RequirePackage{hyperref} 10 | \RequirePackage{verbatim} 11 | \RequirePackage{microtype} 12 | 13 | \bibliographystyle{ACM-Reference-Format} 14 | 15 | \newenvironment{code}{\VerbatimEnvironment\begin{minted}{haskell}}{\end{minted}} 16 | \newenvironment{spec}{\VerbatimEnvironment\begin{minted}{haskell}}{\end{minted}} 17 | -------------------------------------------------------------------------------- /article/gears.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turion/essence-of-live-coding/c361669bf00a5cff4c988e74d2cd375452a8234e/article/gears.png -------------------------------------------------------------------------------- /article/tutorial_screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turion/essence-of-live-coding/c361669bf00a5cff4c988e74d2cd375452a8234e/article/tutorial_screenshot.png -------------------------------------------------------------------------------- /article/tutorial_screenshot_debugger.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turion/essence-of-live-coding/c361669bf00a5cff4c988e74d2cd375452a8234e/article/tutorial_screenshot_debugger.png -------------------------------------------------------------------------------- /cabal-freeze.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | create_cabal_project () { 4 | local compiler=$1 5 | 6 | ln -sf cabal.project "cabal.project.$compiler" 7 | 8 | cabal freeze --enable-tests --project-file="cabal.project.$compiler" -w "ghc-$compiler" 9 | } 10 | 11 | create_cabal_project "8.8.4" 12 | create_cabal_project "8.10.7" 13 | create_cabal_project "9.0.2" 14 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: */*.cabal 2 | tests: true 3 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { compiler ? "ghc884" 2 | , nixpkgs ? import {} 3 | , doBenchmark ? false 4 | }: 5 | 6 | let 7 | inherit (nixpkgs) pkgs lib; 8 | 9 | common = import ./nix/common.nix; 10 | inherit (common) subpkgs; 11 | 12 | haskellPackages = pkgs.haskell.packages.${compiler}; 13 | 14 | toPackage = self: name: lib.nameValuePair name (self.callCabal2nix name (./. + ("/" + name))); 15 | toPackagePath = name: lib.nameValuePair name (./. + ("/" + name)); 16 | 17 | myPkgs = haskellPackages.extend (pkgs.haskell.lib.packageSourceOverrides (lib.listToAttrs (map toPackagePath subpkgs))); 18 | in 19 | myPkgs 20 | -------------------------------------------------------------------------------- /demos/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /demos/DemoSine.txt: -------------------------------------------------------------------------------- 1 | >>= 2 | >>= 3 | >>= 4 | >>= 5 | >>= 6 | >>= 7 | >>= 8 | >>= 9 | >>= 10 | >>= 11 | >>= 12 | >>= 13 | >>= 14 | -------------------------------------------------------------------------------- /demos/DemoSineWait.txt: -------------------------------------------------------------------------------- 1 | Waiting... 2 | Waiting... 3 | >>= 4 | >>= 5 | >>= 6 | >>= 7 | >>= 8 | >>= 9 | >>= 10 | >>= 11 | >>= 12 | >>= 13 | >>= 14 | -------------------------------------------------------------------------------- /demos/DemoSineWaitChange.txt: -------------------------------------------------------------------------------- 1 | Waiting... 2 | Waiting... 3 | >>= 4 | >>= 5 | >>= 6 | >>= 7 | >>= 8 | >>= 9 | >>= 10 | >>= 11 | >>= 12 | >>= 13 | >>= 14 | >>= 15 | >>= 16 | -------------------------------------------------------------------------------- /demos/DemoSinesForever.txt: -------------------------------------------------------------------------------- 1 | Waiting... 2 | >>= 3 | >>= 4 | >>= 5 | >>= 6 | >>= 7 | Waiting... 8 | >>= 9 | >>= 10 | >>= 11 | >>= 12 | >>= 13 | Waiting... 14 | -------------------------------------------------------------------------------- /demos/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /demos/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /demos/app/DemoSine.hs: -------------------------------------------------------------------------------- 1 | -- essence-of-live-coding 2 | import LiveCoding 3 | 4 | t1 :: (Num a) => a 5 | t1 = 4 6 | t2 :: (Num a) => a 7 | t2 = 8 8 | 9 | main = do 10 | (debugger, observer) <- countDebugger 11 | launchedProgram <- launchWithDebugger (printSine t1) $ debugger 12 | await observer $ t1 * stepRate 13 | update launchedProgram $ printSine t2 `withDebugger` debugger 14 | await observer $ (t1 + t2) * stepRate 15 | -------------------------------------------------------------------------------- /demos/app/DemoSineWait.hs: -------------------------------------------------------------------------------- 1 | -- essence-of-live-coding 2 | import LiveCoding 3 | 4 | main = do 5 | (debugger, observer) <- countDebugger 6 | _ <- launchWithDebugger printSineWait $ debugger -- <> gshowDebugger --statePrint 7 | -- await observer 1 8 | await observer $ 12 * stepRate 9 | -------------------------------------------------------------------------------- /demos/app/DemoSineWaitChange.hs: -------------------------------------------------------------------------------- 1 | -- base 2 | import Control.Arrow 3 | 4 | -- essence-of-live-coding 5 | import LiveCoding 6 | 7 | t1 :: (Num a) => a 8 | t1 = 8 9 | t2 :: (Num a) => a 10 | t2 = 4 11 | 12 | printSineWait' t = 13 | liveCell $ 14 | safely (sineWait t) 15 | >>> printEverySecond 16 | 17 | main = do 18 | (debugger, observer) <- countDebugger 19 | launchedProgram <- launchWithDebugger (printSineWait' t1) $ debugger 20 | await observer $ (2 + t1) * stepRate 21 | update launchedProgram $ printSineWait' t2 `withDebugger` debugger 22 | await observer $ (2 + t1 + t2) * stepRate 23 | -------------------------------------------------------------------------------- /demos/app/DemoSinesForever.hs: -------------------------------------------------------------------------------- 1 | -- essence-of-live-coding 2 | import LiveCoding 3 | 4 | main = do 5 | (debugger, observer) <- countDebugger 6 | var <- launchWithDebugger printSinesForever $ debugger 7 | await observer $ 12 * stepRate 8 | 9 | -- putStrLn "[...]" 10 | -------------------------------------------------------------------------------- /demos/app/DemoWai.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | -- base 6 | import Control.Concurrent (forkIO) 7 | import Control.Concurrent.MVar 8 | 9 | -- transformers 10 | import Control.Monad.Trans.Class 11 | import Control.Monad.Trans.Reader 12 | 13 | -- bytestring 14 | import Data.ByteString.Lazy.Char8 (pack) 15 | 16 | -- wai 17 | import Network.HTTP.Types 18 | import Network.Wai 19 | import Network.Wai.Handler.Warp (run) 20 | 21 | -- essence-of-live-coding 22 | import LiveCoding 23 | 24 | import DemoWai.DemoWai1 (oldServer) 25 | import DemoWai.DemoWai2 (newServer) 26 | import DemoWai.Env 27 | 28 | app :: Env -> Application 29 | app Env {..} request respond = do 30 | putMVar requestVar request 31 | response <- takeMVar responseVar 32 | respond 33 | $ responseLBS 34 | status200 35 | [("Content-Type", "text/plain")] 36 | $ pack response 37 | 38 | main :: IO () 39 | main = do 40 | putStrLn "Let's go!" 41 | responseVar <- newEmptyMVar 42 | requestVar <- newEmptyMVar 43 | let env = Env {..} 44 | launchedProgram <- launch $ hoistLiveProgram (flip runReaderT env) oldServer 45 | forkIO $ run 8080 $ app env 46 | _ <- getLine 47 | update launchedProgram $ hoistLiveProgram (flip runReaderT env) newServer 48 | _ <- getLine 49 | putStrLn "That's it" 50 | -------------------------------------------------------------------------------- /demos/app/DemoWai/DemoWai1.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | module DemoWai.DemoWai1 where 8 | 9 | -- base 10 | import Data.Data 11 | import Control.Concurrent.MVar 12 | 13 | -- transformers 14 | import Control.Monad.Trans.Class 15 | import Control.Monad.Trans.Reader 16 | 17 | -- essence-of-live-coding 18 | import LiveCoding hiding (State) 19 | 20 | import DemoWai.Env 21 | \end{code} 22 | \end{comment} 23 | 24 | \begin{figure} 25 | \begin{code} 26 | data State = State 27 | { nVisitors :: Integer 28 | } deriving Data 29 | \end{code} 30 | \begin{code} 31 | oldServer :: LiveProgram (ReaderT Env IO) 32 | oldServer = LiveProgram 33 | { liveState = State 0 34 | , liveStep = \State { .. } -> do 35 | Env { .. } <- ask 36 | _ <- lift $ takeMVar requestVar 37 | let nVisitorsNew = nVisitors + 1 38 | lift $ putMVar responseVar $ unlines 39 | [ "Ye Olde Server greets visitor #" 40 | <> show nVisitorsNew <> "." 41 | ] 42 | return $ State nVisitorsNew 43 | } 44 | \end{code} 45 | \caption{DemoWai1.lhs} 46 | \label{fig:DemoWai1} 47 | \end{figure} 48 | -------------------------------------------------------------------------------- /demos/app/DemoWai/DemoWai2.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | module DemoWai.DemoWai2 where 8 | 9 | -- base 10 | import Control.Concurrent.MVar 11 | import Data.Data 12 | import Data.Maybe (maybeToList) 13 | 14 | -- transformers 15 | import Control.Monad.Trans.Class 16 | import Control.Monad.Trans.Reader 17 | 18 | -- bytestring 19 | import Data.ByteString.Char8 (unpack) 20 | 21 | -- wai 22 | import Network.Wai 23 | 24 | -- essence-of-live-coding 25 | import LiveCoding hiding (State) 26 | 27 | import DemoWai.Env 28 | \end{code} 29 | \end{comment} 30 | 31 | \fxwarning{Can we simplify this server?} 32 | \fxwarning{For fun we could also make a server out of it that says "You again!" when the same user agent comes and doesn't increment the counter. (That would save the fromStrict)} 33 | \begin{figure} 34 | \begin{code} 35 | data State = State 36 | { nVisitors :: Integer 37 | , lastAgent :: Maybe String 38 | } deriving Data 39 | \end{code} 40 | \begin{code} 41 | newServer :: LiveProgram (ReaderT Env IO) 42 | newServer = LiveProgram 43 | { liveState = State 0 Nothing 44 | , liveStep = \State { .. } -> do 45 | Env { .. } <- ask 46 | request <- lift $ takeMVar requestVar 47 | let nVisitorsNew = nVisitors + 1 48 | lastAgentStrings = case lastAgent of 49 | Nothing -> [] 50 | Just str -> ["Last agent: " <> str] 51 | lastAgentNew = fmap unpack 52 | $ lookup "User-Agent" 53 | $ requestHeaders request 54 | lift $ putMVar responseVar $ unlines $ 55 | [ "Fancy Nu $3rv3r says HI to #" 56 | <> show nVisitorsNew <> "." 57 | ] ++ lastAgentStrings 58 | return $ State nVisitorsNew lastAgentNew 59 | } 60 | \end{code} 61 | \caption{DemoWai2.lhs} 62 | \label{fig:DemoWai2} 63 | \end{figure} 64 | -------------------------------------------------------------------------------- /demos/app/DemoWai/Env.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | module DemoWai.Env where 4 | 5 | -- base 6 | import Control.Concurrent.MVar 7 | 8 | -- wai 9 | import Network.Wai 10 | \end{code} 11 | \end{comment} 12 | 13 | The server logic is shown in Figure \ref{fig:DemoWai1}. 14 | It is initialised at 0 visitors. 15 | The step function receives the number of past visitors and blocks on an \mintinline{haskell}{MVar} until a request (which is discarded) to the server arrives. 16 | The number of visitors is incremented by 1, 17 | and baked into a response, 18 | which is in another \mintinline{haskell}{MVar}. 19 | Finally, the updated state (the incremented number of visitors) 20 | is returned, 21 | and passed to the next step. 22 | 23 | We then modify\footnote{% 24 | The function \mintinline{haskell}{unpack} from the \texttt{bytestring} package converts between different kinds of strings. 25 | \mintinline{haskell}{requestHeaders} from the \texttt{wai} package extracts HTTP headers, 26 | such as the user agent name, 27 | from a request.} 28 | the server logic as in Figure \ref{fig:DemoWai2}. 29 | Additionally to the number of visitors, 30 | we also store the last user agent name 31 | in the state, if it was sent. 32 | For this, one more record field is added to the state type. 33 | 34 | \begin{figure} 35 | \begin{code} 36 | data Env = Env 37 | { requestVar :: MVar Request 38 | , responseVar :: MVar String 39 | } 40 | \end{code} 41 | \caption{DemoWai.lhs} 42 | \label{fig:DemoWai} 43 | \end{figure} 44 | 45 | Let us run the old server, 46 | and switch to the new one during execution. 47 | From a console, we access the running server: 48 | \begin{verbatim} 49 | $ curl localhost:8080 50 | Ye Olde Server greets visitor #1. 51 | $ curl localhost:8080 52 | Fancy Nu $3rv3r says HI to #2. 53 | $ curl localhost:8080 54 | Fancy Nu $3rv3r says HI to #3. 55 | Last agent: curl/7.72.0 56 | \end{verbatim} 57 | It correctly remembered the number of past visitors upon reload and initialised the last user agent with the value \mintinline{haskell}{Nothing}. 58 | When accessing the new server again, 59 | it stored the user agent as expected. 60 | -------------------------------------------------------------------------------- /demos/app/Examples.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | module Examples where 4 | 5 | -- base 6 | import Control.Arrow 7 | import Control.Concurrent 8 | 9 | -- essence-of-live-coding 10 | import LiveCoding 11 | 12 | countUpTo :: (Monad m) => Integer -> Cell (ExceptT () m) a Integer 13 | countUpTo n = arr (const 1) >>> sumFrom 0 >>> throwIf_ (>= n) 14 | 15 | countDownFrom :: (Monad m) => Integer -> Cell (ExceptT () m) a Integer 16 | countDownFrom n = arr (const (-1)) >>> sumFrom n >>> throwIf_ (<= 0) 17 | 18 | throwWhenReaches :: 19 | (Monad m) => 20 | Integer -> 21 | Cell (ExceptT () m) Integer Integer 22 | throwWhenReaches amplitude = proc n -> if n == amplitude then throwC -< () else returnA -< n 23 | 24 | saw1 :: (Monad m) => Integer -> Cell m () Integer 25 | saw1 amplitude = foreverC $ runCellExcept $ do 26 | try $ countUpTo amplitude 27 | try $ countDownFrom amplitude 28 | 29 | saw2 :: (Monad m) => Integer -> Cell m () Integer 30 | saw2 amplitude = foreverC $ runCellExcept $ do 31 | try $ countUpTo amplitude 32 | try $ countUpTo amplitude 33 | 34 | example1 :: Integer -> LiveProgram IO 35 | example1 n = liveCell $ sine 1 >>> arrM print >>> constM (threadDelay 10000) 36 | 37 | example2 :: Integer -> LiveProgram IO 38 | example2 n = liveCell $ saw2 n >>> arrM print >>> constM (threadDelay 500000) 39 | 40 | myMapM_ f (a : as) = f a *> myMapM_ f as 41 | myMapM_ _ [] = return () 42 | 43 | listThing :: (Monad m) => Cell m a Integer 44 | listThing = safely $ myMapM_ (try . countUpTo) [3, 5, 6] *> safe count 45 | 46 | example :: LiveProgram IO 47 | example = liveCell $ listThing >>> arrM print >>> constM (threadDelay 500000) 48 | -------------------------------------------------------------------------------- /demos/demos.cabal: -------------------------------------------------------------------------------- 1 | name: demos 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - Demo applications 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains simple demos that are used in the article 17 | (https://www.manuelbaerenz.de/essence-of-live-coding/EssenceOfLiveCoding.pdf), 18 | such as sine generators, control flow and a WAI webserver example. 19 | 20 | license: BSD3 21 | license-file: LICENSE 22 | author: Manuel Bärenz 23 | maintainer: programming@manuelbaerenz.de 24 | homepage: https://www.manuelbaerenz.de/#computerscience 25 | category: FRP, Live coding 26 | build-type: Simple 27 | extra-source-files: CHANGELOG.md 28 | cabal-version: >=1.10 29 | 30 | source-repository head 31 | type: git 32 | location: https://github.com/turion/essence-of-live-coding.git 33 | 34 | source-repository this 35 | type: git 36 | location: https://github.com/turion/essence-of-live-coding.git 37 | tag: v0.2.8 38 | 39 | executable DemoSine 40 | main-is: DemoSine.hs 41 | other-modules: 42 | Examples 43 | hs-source-dirs: app 44 | build-depends: 45 | base >= 4.13 && < 4.21 46 | , essence-of-live-coding 47 | 48 | executable DemoSineWait 49 | main-is: DemoSineWait.hs 50 | other-modules: 51 | Examples 52 | hs-source-dirs: app 53 | build-depends: 54 | base >= 4.13 && < 4.21 55 | , essence-of-live-coding 56 | 57 | executable DemoSineWaitChange 58 | main-is: DemoSineWaitChange.hs 59 | other-modules: 60 | Examples 61 | hs-source-dirs: app 62 | build-depends: 63 | base >= 4.13 && < 4.21 64 | , essence-of-live-coding 65 | 66 | executable DemoSinesForever 67 | main-is: DemoSinesForever.hs 68 | other-modules: 69 | Examples 70 | hs-source-dirs: app 71 | build-depends: 72 | base >= 4.13 && < 4.21 73 | , essence-of-live-coding 74 | 75 | executable DemoWai 76 | main-is: DemoWai.hs 77 | other-modules: 78 | DemoWai.Env 79 | DemoWai.DemoWai1 80 | DemoWai.DemoWai2 81 | hs-source-dirs: app 82 | build-depends: 83 | base >= 4.13 && < 4.21 84 | , essence-of-live-coding >= 0.2.8 85 | , transformers >= 0.5 86 | , wai >= 3.2 87 | , warp >= 3.2 88 | , http-types >= 0.12 89 | , bytestring >= 0.10 90 | -------------------------------------------------------------------------------- /demos/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | extra-deps: 3 | - ../essence-of-live-coding 4 | nix: 5 | enable: true 6 | packages: [zlib] 7 | -------------------------------------------------------------------------------- /essence-of-live-coding-PortMidi/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-PortMidi 2 | 3 | ## 0.2.5 4 | 5 | * Thank you, Miguel Negrão, for extensive support, suggestions, testing, and debugging! 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-PortMidi/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-PortMidi/essence-of-live-coding-PortMidi.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-PortMidi 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - PortMidi backend 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains the backend for PortMidi, a portable MIDI library. 17 | license: BSD3 18 | license-file: LICENSE 19 | author: Manuel Bärenz 20 | maintainer: programming@manuelbaerenz.de 21 | copyright: 2021 Manuel Bärenz 22 | category: Sound 23 | build-type: Simple 24 | cabal-version: >=1.10 25 | extra-source-files: CHANGELOG.md 26 | 27 | library 28 | exposed-modules: 29 | LiveCoding.PortMidi 30 | other-modules: 31 | LiveCoding.PortMidi.Internal 32 | build-depends: 33 | base >= 4.7 && < 5 34 | , transformers >= 0.5 35 | , PortMidi >= 0.2 36 | , essence-of-live-coding >= 0.2.8 37 | hs-source-dirs: src 38 | default-language: Haskell2010 39 | -------------------------------------------------------------------------------- /essence-of-live-coding-PortMidi/src/LiveCoding/PortMidi/Internal.hs: -------------------------------------------------------------------------------- 1 | module LiveCoding.PortMidi.Internal where 2 | 3 | -- base 4 | import Control.Monad (void) 5 | import Control.Monad.IO.Class 6 | 7 | -- PortMidi 8 | import Sound.PortMidi 9 | 10 | -- essence-of-live-coding 11 | import LiveCoding.Handle 12 | 13 | -- | A marker witnessing that PortMidi was initialized 14 | data PortMidiHandle = PortMidiHandle 15 | 16 | portMidiHandle :: (MonadIO m) => Handle m PortMidiHandle 17 | portMidiHandle = 18 | Handle 19 | { create = do 20 | liftIO initialize 21 | return PortMidiHandle 22 | , destroy = const $ liftIO $ void terminate 23 | } 24 | -------------------------------------------------------------------------------- /essence-of-live-coding-ghci-example/.ghci: -------------------------------------------------------------------------------- 1 | ../templates/.ghci -------------------------------------------------------------------------------- /essence-of-live-coding-ghci-example/.ghcid: -------------------------------------------------------------------------------- 1 | ../templates/.ghcid -------------------------------------------------------------------------------- /essence-of-live-coding-ghci-example/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-ghci-example 2 | 3 | ## 0.2.5 4 | 5 | * Integration test for handles & GHCi commands 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-ghci-example/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-ghci-example/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | -- base 4 | import Control.Concurrent (threadDelay) 5 | 6 | -- essence-of-live-coding 7 | import LiveCoding 8 | 9 | liveProgram :: LiveProgram (HandlingStateT IO) 10 | liveProgram = 11 | liveCell $ 12 | handling 13 | Handle 14 | { create = threadDelay 10000 >> putStrLn "Creating" 15 | , destroy = const $ putStrLn "Destroying" 16 | } 17 | 18 | main :: IO () 19 | main = liveMain liveProgram 20 | -------------------------------------------------------------------------------- /essence-of-live-coding-ghci-example/essence-of-live-coding-ghci-example.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.4 2 | name: essence-of-live-coding-ghci-example 3 | version: 0.2.8 4 | 5 | -- A short (one-line) description of the package. 6 | -- synopsis: 7 | 8 | -- A longer description of the package. 9 | -- description: 10 | 11 | -- A URL where users can report bugs. 12 | -- bug-reports: 13 | 14 | -- The license under which the package is released. 15 | -- license: 16 | author: Manuel Bärenz 17 | maintainer: m.baerenz@sonnen.de 18 | 19 | -- A copyright notice. 20 | -- copyright: 21 | -- category: 22 | extra-source-files: CHANGELOG.md 23 | 24 | executable essence-of-live-coding-ghci-example 25 | main-is: Main.hs 26 | 27 | -- Modules included in this executable, other than Main. 28 | -- other-modules: 29 | 30 | -- LANGUAGE extensions used by modules in this package. 31 | -- other-extensions: 32 | build-depends: 33 | base >= 4.13 && < 4.21 34 | , essence-of-live-coding >= 0.2.8 35 | hs-source-dirs: app 36 | default-language: Haskell2010 37 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/.ghci: -------------------------------------------------------------------------------- 1 | ../templates/.ghci -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/.ghcid: -------------------------------------------------------------------------------- 1 | ../templates/.ghcid -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-gloss-example 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/essence-of-live-coding-gloss-example.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-gloss-example 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - Gloss example 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains a little example using the Gloss backend. 17 | 18 | license: BSD3 19 | license-file: LICENSE 20 | author: Manuel Bärenz 21 | maintainer: programming@manuelbaerenz.de 22 | homepage: https://www.manuelbaerenz.de/#computerscience 23 | category: FRP, Live coding 24 | build-type: Simple 25 | extra-source-files: CHANGELOG.md 26 | cabal-version: >=1.10 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/turion/essence-of-live-coding.git 31 | 32 | source-repository this 33 | type: git 34 | location: https://github.com/turion/essence-of-live-coding.git 35 | tag: v0.2.8 36 | 37 | 38 | executable essence-of-live-coding-gloss-example 39 | main-is: Main.hs 40 | build-depends: 41 | base >= 4.13 && < 4.21 42 | , transformers >= 0.5 43 | , gloss >= 1.13 44 | , essence-of-live-coding >= 0.2.8 45 | , essence-of-live-coding-gloss >= 0.2.8 46 | , syb >= 0.7 47 | hs-source-dirs: app 48 | default-language: Haskell2010 49 | default-extensions: StrictData 50 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss-example/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | extra-deps: 3 | - ../essence-of-live-coding 4 | - ../essence-of-live-coding-gloss 5 | nix: 6 | enable: true 7 | packages: [libGL libGLU freeglut] 8 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-gloss 2 | 3 | ## 0.2.4 4 | 5 | * Tweak performance 6 | 7 | ## 0.2.3 8 | 9 | * glossWrapC is now nonblocking. 10 | 11 | ## Earlier versions 12 | 13 | See in essence-of-live-coding/CHANGELOG.md. 14 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/essence-of-live-coding-gloss.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-gloss 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - Gloss backend 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains a backend for Gloss (http://gloss.ouroborus.net/). 17 | 18 | license: BSD3 19 | license-file: LICENSE 20 | author: Manuel Bärenz 21 | maintainer: programming@manuelbaerenz.de 22 | homepage: https://www.manuelbaerenz.de/#computerscience 23 | category: FRP, Live coding 24 | build-type: Simple 25 | extra-source-files: CHANGELOG.md 26 | cabal-version: >=1.10 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/turion/essence-of-live-coding.git 31 | 32 | source-repository this 33 | type: git 34 | location: https://github.com/turion/essence-of-live-coding.git 35 | tag: v0.2.8 36 | 37 | library 38 | exposed-modules: 39 | LiveCoding.Gloss 40 | LiveCoding.Gloss.Debugger 41 | LiveCoding.Gloss.PictureM 42 | build-depends: 43 | base >= 4.13 && < 4.21 44 | , syb >= 0.7 45 | , transformers >= 0.5 46 | , essence-of-live-coding >= 0.2.8 47 | , foreign-store >= 0.2 48 | , gloss >= 1.13 49 | hs-source-dirs: src 50 | default-language: Haskell2010 51 | default-extensions: StrictData 52 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/src/LiveCoding/Gloss.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE TupleSections #-} 4 | 5 | module LiveCoding.Gloss ( 6 | module X, 7 | module LiveCoding.Gloss, 8 | ) where 9 | 10 | -- base 11 | import Control.Concurrent 12 | import Control.Monad (when) 13 | import Data.IORef 14 | import System.Exit (exitSuccess) 15 | 16 | -- transformers 17 | import Control.Arrow (returnA) 18 | import Control.Monad.Trans.State.Strict (StateT) 19 | import Control.Monad.Trans.Writer 20 | 21 | -- gloss 22 | import Graphics.Gloss as X 23 | import Graphics.Gloss.Interface.IO.Game as X 24 | 25 | -- essence-of-live-coding 26 | import LiveCoding 27 | 28 | -- essence-of-live-coding-gloss 29 | import LiveCoding.Gloss.Debugger as X 30 | import LiveCoding.Gloss.PictureM as X 31 | 32 | {- | In a 'Handle', store a separate thread where the gloss main loop is executed, 33 | and several concurrent variables to communicate with it. 34 | -} 35 | data GlossHandle = GlossHandle 36 | { glossThread :: ThreadId 37 | , glossVars :: GlossVars 38 | } 39 | 40 | -- | The concurrent variables needed to communicate with the gloss thread. 41 | data GlossVars = GlossVars 42 | { glossEventsRef :: IORef [Event] 43 | -- ^ Stores all 'Event's that arrived since the last tick 44 | , glossPicRef :: IORef Picture 45 | -- ^ Stores the next 'Picture' to be painted 46 | , glossDTimeVar :: MVar Float 47 | -- ^ Stores the time passed since the last tick 48 | , glossExitRef :: IORef Bool 49 | -- ^ Write 'True' here to stop the gloss thread 50 | } 51 | 52 | {- | Collect all settings that the @gloss@ backend requires. 53 | Taken from @rhine-gloss@. 54 | -} 55 | data GlossSettings = GlossSettings 56 | { displaySetting :: Display 57 | -- ^ Display mode (e.g. 'InWindow' or 'FullScreen'). 58 | , backgroundColor :: Color 59 | -- ^ Background color. 60 | , stepsPerSecond :: Int 61 | -- ^ Number of simulation steps per second of real time. 62 | , debugEvents :: Bool 63 | -- ^ Print all incoming events to the console. 64 | } 65 | 66 | defaultSettings :: GlossSettings 67 | defaultSettings = 68 | GlossSettings 69 | { displaySetting = InWindow "Essence of live coding" (600, 800) (20, 20) 70 | , backgroundColor = black 71 | , stepsPerSecond = 30 72 | , debugEvents = False 73 | } 74 | 75 | {- | Will create a handle for communication with the gloss thread, 76 | and start gloss. 77 | -} 78 | glossHandle :: GlossSettings -> Handle IO GlossHandle 79 | glossHandle GlossSettings {..} = 80 | Handle 81 | { create = do 82 | glossEventsRef <- newIORef [] 83 | glossDTimeVar <- newEmptyMVar 84 | glossPicRef <- newIORef blank 85 | glossExitRef <- newIORef False 86 | let glossVars = GlossVars {..} 87 | glossThread <- 88 | forkIO $ 89 | playIO displaySetting backgroundColor stepsPerSecond glossVars getPicture (handleEvent debugEvents) stepGloss 90 | return GlossHandle {..} 91 | , destroy = \GlossHandle {glossVars = GlossVars {..}, ..} -> writeIORef glossExitRef True 92 | } 93 | 94 | getPicture :: GlossVars -> IO Picture 95 | getPicture GlossVars {..} = readIORef glossPicRef 96 | 97 | handleEvent :: Bool -> Event -> GlossVars -> IO GlossVars 98 | handleEvent debugEvents event vars@GlossVars {..} = do 99 | when debugEvents $ print event 100 | modifyIORef glossEventsRef (event :) 101 | return vars 102 | 103 | stepGloss :: Float -> GlossVars -> IO GlossVars 104 | stepGloss dTime vars@GlossVars {..} = do 105 | putMVar glossDTimeVar dTime 106 | exitNow <- readIORef glossExitRef 107 | when exitNow exitSuccess 108 | return vars 109 | 110 | {- | Given a cell in the gloss monad 'PictureM', 111 | start the gloss backend and connect the cell to it. 112 | 113 | This introduces 'Handle's containing the gloss background thread, 114 | which need to be taken care of by calling 'runHandlingState' 115 | or a similar function. 116 | 117 | The resulting cell never blocks, 118 | but returns 'Nothing' if there currently is no gloss tick. 119 | -} 120 | glossWrapC :: 121 | GlossSettings -> 122 | Cell PictureM a b -> 123 | Cell (HandlingStateT IO) a (Maybe b) 124 | glossWrapC glossSettings cell = proc a -> do 125 | GlossHandle {..} <- handling $ glossHandle glossSettings -< () 126 | liftCell pump -< (glossVars, a) 127 | where 128 | pump = proc (GlossVars {..}, a) -> do 129 | timeMaybe <- arrM tryTakeMVar -< glossDTimeVar 130 | case timeMaybe of 131 | Just _ -> do 132 | events <- arrM $ flip atomicModifyIORef ([],) -< glossEventsRef 133 | (picture, b) <- runPictureT cell -< (events, a) 134 | arrM (uncurry writeIORef) -< (glossPicRef, picture) 135 | returnA -< Just b 136 | Nothing -> do 137 | arrM threadDelay -< 1000 -- Prevent too much CPU load 138 | returnA -< Nothing 139 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/src/LiveCoding/Gloss/Debugger.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | module LiveCoding.Gloss.Debugger where 4 | 5 | -- base 6 | import Control.Arrow 7 | import Data.Data 8 | 9 | -- transformers 10 | import Control.Monad.Trans.Class 11 | import Control.Monad.Trans.State.Strict 12 | import Control.Monad.Trans.Writer.Strict 13 | 14 | -- syb 15 | import Data.Generics.Text 16 | 17 | -- gloss 18 | import Graphics.Gloss 19 | 20 | -- essence-of-live-coding 21 | import LiveCoding 22 | 23 | -- essence-of-live-coding-gloss 24 | import LiveCoding.Gloss.PictureM 25 | 26 | statePicture :: (Data s) => s -> Picture 27 | statePicture = translate (-100) 200 . scale 0.2 0.2 . color red . text . stateShow 28 | 29 | statePlay :: Debugger PictureM 30 | statePlay = Debugger $ liveCell $ every 2 >>> hold blank >>> arrM (lift . lift . tell) 31 | 32 | every :: (Data s) => Integer -> Cell (StateT s PictureM) () (Maybe Picture) 33 | every maxN = proc () -> do 34 | n <- sumC -< 1 35 | if n `mod` maxN == 0 36 | then do 37 | s <- getC -< () 38 | let pic = statePicture s 39 | returnA -< Just pic 40 | else returnA -< Nothing 41 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/src/LiveCoding/Gloss/PictureM.hs: -------------------------------------------------------------------------------- 1 | module LiveCoding.Gloss.PictureM ( 2 | module LiveCoding.Gloss.PictureM, 3 | module X, 4 | ) where 5 | 6 | -- transformers 7 | import Control.Monad.Trans.Class 8 | import Control.Monad.Trans.Reader as X 9 | import Control.Monad.Trans.Writer.Strict 10 | 11 | -- gloss 12 | import Graphics.Gloss 13 | import Graphics.Gloss.Interface.IO.Game 14 | 15 | -- essence-of-live-coding 16 | import LiveCoding 17 | 18 | {- | The monad transformer that captures the effects of gloss, 19 | which are reading events and writing pictures. 20 | 21 | You can call these effects for example by... 22 | 23 | * ...using 'ask' to read the events that occurred, 24 | * ...composing a cell with 'addPicture' to paint a picture. 25 | -} 26 | type PictureT m = ReaderT [Event] (WriterT Picture m) 27 | 28 | -- | 'PictureT' specialised to the 'IO' monad. 29 | type PictureM = PictureT IO 30 | 31 | -- | Run the effects of the gloss monad stack by explicitly passing events and pictures. 32 | runPictureT :: 33 | (Monad m) => 34 | Cell (PictureT m) a b -> 35 | Cell m ([Event], a) (Picture, b) 36 | runPictureT = runWriterC . runReaderC' 37 | 38 | addPicture :: (Monad m) => Cell (PictureT m) Picture () 39 | addPicture = arrM $ lift . tell 40 | -------------------------------------------------------------------------------- /essence-of-live-coding-gloss/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | extra-deps: 3 | - ../essence-of-live-coding 4 | nix: 5 | enable: true 6 | packages: [libGL libGLU freeglut] 7 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/.ghci: -------------------------------------------------------------------------------- 1 | ../templates/.ghci -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/.ghcid: -------------------------------------------------------------------------------- 1 | ../templates/.ghcid -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-pulse 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE TupleSections #-} 3 | 4 | module Main where 5 | 6 | -- base 7 | import Control.Arrow as X 8 | import Control.Concurrent 9 | import Control.Monad (void) 10 | import Control.Monad.Fix 11 | import Data.List.NonEmpty (NonEmpty) 12 | import qualified Data.List.NonEmpty as NonEmpty 13 | 14 | import Prelude hiding ((!)) 15 | 16 | -- transformers 17 | import Control.Monad.Trans.Reader 18 | 19 | -- vector 20 | import Data.Vector ((!)) 21 | import qualified Data.Vector as Vector 22 | 23 | -- pulse-simple 24 | import Sound.Pulse.Simple 25 | 26 | -- essence-of-live-coding 27 | import LiveCoding 28 | 29 | -- essence-of-live-coding-pulse 30 | import LiveCoding.Pulse 31 | 32 | fastSine :: (Data a, Floating a, MonadFix m) => Cell (ReaderT a m) () a 33 | fastSine = proc _ -> do 34 | t <- constM ask -< () 35 | rec let acc = -(2 * pi / t) ^ 2 * pos 36 | vel <- sumC' <<< delay 0 -< acc 37 | pos <- arr (+ 1) <<< sumC' -< vel 38 | returnA -< pos 39 | 40 | sumC' :: (Monad m, Data a, Num a) => Cell m a a 41 | sumC' = 42 | Cell 43 | { cellState = 0 44 | , cellStep = \accum a -> let accum' = accum + a in return (accum', accum') 45 | } 46 | 47 | cellA :: (MonadFix m) => Cell m () Float 48 | cellA = runReaderC (44100 / 440) fastSine 49 | 50 | cellB :: (MonadFix m) => Cell m () Float 51 | cellB = proc _ -> do 52 | fDelta <- runReaderC 10 osc -< () 53 | runReaderC' osc -< (440 + 5 * fDelta, ()) 54 | 55 | short :: (Monad m) => Float -> CellExcept () Float m () 56 | short frequency = try $ proc _ -> do 57 | count <- sumC -< 1 :: Int 58 | if count > 8000 59 | then throwC -< () 60 | else returnA -< frequency 61 | 62 | frequencies :: (Monad m) => Cell m () Float 63 | frequencies = foreverC $ runCellExcept $ sequence $ (short . f) <$> [C, E, G] 64 | 65 | cycleThrough :: (Monad m) => NonEmpty a -> Int -> Cell m () a 66 | cycleThrough bs cycleLength = 67 | let vector = Vector.fromList (NonEmpty.toList bs) 68 | in proc _ -> do 69 | n <- modSum (cycleLength * length bs) -< 1 70 | returnA -< vector ! (n `div` cycleLength) 71 | 72 | frequencies' :: (Monad m) => Cell m () Float 73 | frequencies' = cycleThrough (NonEmpty.fromList $ [f D, f G, o $ f Bb]) 8000 74 | 75 | pulseCell :: (Monad m) => PulseCell m () () 76 | pulseCell = frequencies' >>> osc' >>> addSample 77 | 78 | liveProgram :: LiveProgram (HandlingStateT IO) 79 | liveProgram = liveCell $ pulseWrapC 1024 pulseCell >>> arr (const ()) 80 | 81 | main :: IO () 82 | main = liveMain liveProgram 83 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/essence-of-live-coding-pulse-example.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-pulse-example 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - pulse backend example 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains an example for PulseAudio backend. 17 | 18 | license: BSD3 19 | license-file: LICENSE 20 | author: Manuel Bärenz 21 | maintainer: programming@manuelbaerenz.de 22 | homepage: https://www.manuelbaerenz.de/#computerscience 23 | category: FRP, Live coding 24 | build-type: Simple 25 | extra-source-files: CHANGELOG.md 26 | cabal-version: >=1.10 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/turion/essence-of-live-coding.git 31 | 32 | source-repository this 33 | type: git 34 | location: https://github.com/turion/essence-of-live-coding.git 35 | tag: v0.2.8 36 | 37 | 38 | executable essence-of-live-coding-pulse-example 39 | main-is: Main.hs 40 | build-depends: 41 | base >= 4.13 && < 4.21 42 | , transformers >= 0.5 43 | , pulse-simple >= 0.1 44 | , vector >= 0.12 45 | , essence-of-live-coding >= 0.2.8 46 | , essence-of-live-coding-pulse >= 0.2.8 47 | hs-source-dirs: app 48 | default-language: Haskell2010 49 | default-extensions: StrictData 50 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse-example/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | nix: 3 | pure: false 4 | enable: true 5 | packages: [libpulseaudio pulseaudio] 6 | extra-deps: 7 | - pulse-simple-0.1.14@sha256:cd2397c40feb8959cdc6e806987072ce91e388e41427c47ff09ec2a2cfb466f0 8 | - ../essence-of-live-coding 9 | - ../essence-of-live-coding-pulse 10 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-pulse 2 | 3 | ## 0.2.3 4 | 5 | * Added sawtooth 6 | 7 | ## Earlier versions 8 | 9 | See in essence-of-live-coding/CHANGELOG.md. 10 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse/essence-of-live-coding-pulse.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-pulse 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - pulse backend 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains the backend for PulseAudio. 17 | 18 | license: BSD3 19 | license-file: LICENSE 20 | author: Manuel Bärenz 21 | maintainer: programming@manuelbaerenz.de 22 | homepage: https://www.manuelbaerenz.de/#computerscience 23 | category: FRP, Live coding 24 | build-type: Simple 25 | extra-source-files: CHANGELOG.md 26 | cabal-version: >=1.10 27 | 28 | library 29 | exposed-modules: 30 | LiveCoding.Pulse 31 | build-depends: 32 | base >= 4.13 && < 4.21 33 | , essence-of-live-coding >= 0.2.8 34 | , transformers >= 0.5 35 | , pulse-simple >= 0.1 36 | , foreign-store >= 0.2 37 | hs-source-dirs: src 38 | default-language: Haskell2010 39 | default-extensions: StrictData 40 | -------------------------------------------------------------------------------- /essence-of-live-coding-pulse/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | nix: 3 | pure: false 4 | enable: true 5 | packages: [libpulseaudio pulseaudio] 6 | extra-deps: 7 | - pulse-simple-0.1.14@sha256:cd2397c40feb8959cdc6e806987072ce91e388e41427c47ff09ec2a2cfb466f0 8 | - ../essence-of-live-coding 9 | -------------------------------------------------------------------------------- /essence-of-live-coding-quickcheck/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-quickcheck 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-quickcheck/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-quickcheck/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /essence-of-live-coding-quickcheck/essence-of-live-coding-quickcheck.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-quickcheck 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - QuickCheck integration 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | . 15 | This package contains useful utilities for quickchecking. 16 | 17 | license: BSD3 18 | license-file: LICENSE 19 | author: Manuel Bärenz 20 | maintainer: programming@manuelbaerenz.de 21 | homepage: https://www.manuelbaerenz.de/#computerscience 22 | category: FRP, Live coding 23 | build-type: Simple 24 | extra-source-files: CHANGELOG.md 25 | cabal-version: >=1.10 26 | 27 | source-repository head 28 | type: git 29 | location: https://github.com/turion/essence-of-live-coding.git 30 | 31 | source-repository this 32 | type: git 33 | location: https://github.com/turion/essence-of-live-coding.git 34 | tag: v0.2.8 35 | 36 | 37 | library 38 | exposed-modules: LiveCoding.QuickCheck 39 | build-depends: 40 | base >= 4.13 && < 4.21 41 | , essence-of-live-coding >= 0.2.8 42 | , transformers >= 0.5 43 | , syb >= 0.7 44 | , QuickCheck >= 2.12 45 | , boltzmann-samplers >= 0.1 46 | hs-source-dirs: src 47 | default-language: Haskell2010 48 | default-extensions: StrictData 49 | -------------------------------------------------------------------------------- /essence-of-live-coding-quickcheck/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | nix: 3 | enable: true 4 | packages: [blas liblapack] 5 | extra-deps: 6 | - ../essence-of-live-coding 7 | -------------------------------------------------------------------------------- /essence-of-live-coding-speedtest-yampa/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-speedtest-yampa/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-speedtest-yampa/app/SpeedTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | {- | For a simple speedtest, run e.g. the following command in Linux: 4 | stack build && time stack exec SpeedTest 5 | -} 6 | module Main (main) where 7 | 8 | -- base 9 | import Control.Arrow 10 | import Control.Monad (void) 11 | import Data.Data 12 | import Data.Semigroup 13 | 14 | -- transformers 15 | import Control.Monad.Trans.Class (lift) 16 | import Control.Monad.Trans.Except (runExceptT) 17 | 18 | -- essence-of-live-coding 19 | import LiveCoding 20 | 21 | accum :: (Monad m, Semigroup w, Data w) => w -> Cell m w w 22 | accum w0 = feedback w0 $ arr $ \(w, state) -> (state, w <> state) 23 | 24 | mainCell = proc _ -> do 25 | x <- sine 1 -< () 26 | s <- sumC -< x 27 | m <- accum (Max 0) -< Max x 28 | m' <- accum (Min 0) -< Min x 29 | c <- sumC -< (1 :: Int) 30 | if c > 1000 * 1000 31 | then do 32 | arrM (lift . print) -< (s, getMax m, getMin m') 33 | throwC -< () 34 | else returnA -< () 35 | 36 | main :: IO () 37 | main = void $ runExceptT $ foreground $ liveCell $ runCellExcept $ try mainCell 38 | -------------------------------------------------------------------------------- /essence-of-live-coding-speedtest-yampa/app/SpeedTestYampa.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | module Main (main) where 4 | 5 | -- base 6 | import Data.Maybe (isJust) 7 | 8 | -- yampa 9 | import FRP.Yampa 10 | 11 | sine k = proc () -> do 12 | rec let acc = -k * pos 13 | vel <- integral -< acc 14 | pos <- (+ 1) ^<< integral -< vel 15 | returnA -< pos 16 | 17 | oscillator :: Double -> Double -> SF a Double 18 | oscillator amp period = proc _ -> do 19 | rec let acc = -(2.0 * pi / period) ^ (2 :: Int) * p 20 | v <- integral -< acc 21 | p <- (amp +) ^<< integral -< v 22 | returnA -< p 23 | 24 | timestep :: Double 25 | timestep = 1000 26 | 27 | mainSF = proc _ -> do 28 | -- x <- sine (1 :: Double) -< () 29 | x <- oscillator 1 10 -< () 30 | Event s <- accumBy (+) 0 -< Event x 31 | -- s <- integral -< x 32 | -- Event c <- count -< Event () 33 | c <- integral -< timestep 34 | if s `seq` c > 1000 * 1000 35 | then returnA -< Left s 36 | else returnA -< Right x 37 | 38 | main = 39 | reactimate 40 | (return ()) 41 | (const $ return (1 / timestep, Just ())) 42 | -- (const $ \b -> if isJust b then print b >> return True else return False) 43 | helper 44 | mainSF 45 | where 46 | helper _ (Left s) = print s >> return True 47 | helper _ (Right x) = return False 48 | -------------------------------------------------------------------------------- /essence-of-live-coding-speedtest-yampa/essence-of-live-coding-speedtest-yampa.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-speedtest-yampa 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - Yampa speedtest 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains a simple speed test to compare performance with Yampa. 17 | 18 | license: BSD3 19 | license-file: LICENSE 20 | author: Manuel Bärenz 21 | maintainer: programming@manuelbaerenz.de 22 | homepage: https://www.manuelbaerenz.de/#computerscience 23 | category: FRP, Live coding 24 | build-type: Simple 25 | extra-source-files: CHANGELOG.md 26 | cabal-version: >=1.10 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/turion/essence-of-live-coding.git 31 | 32 | source-repository this 33 | type: git 34 | location: https://github.com/turion/essence-of-live-coding.git 35 | tag: v0.2.8 36 | 37 | 38 | executable SpeedTest 39 | main-is: SpeedTest.hs 40 | hs-source-dirs: app 41 | build-depends: 42 | base >= 4.13 && < 4.21 43 | , essence-of-live-coding 44 | , transformers >= 0.5 45 | default-extensions: StrictData 46 | 47 | executable SpeedTestYampa 48 | main-is: SpeedTestYampa.hs 49 | hs-source-dirs: app 50 | build-depends: 51 | base >= 4.13 && < 4.21 52 | , Yampa >= 0.14 53 | -------------------------------------------------------------------------------- /essence-of-live-coding-speedtest-yampa/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-13.19 2 | nix: 3 | enable: true 4 | packages: [zlib] 5 | extra-deps: 6 | - Yampa-0.13@sha256:0778b6e92adb62cc6fd83f1121a9d9bd1a6f7dac72baa41120b472addc7ec94f 7 | - simple-affine-space-0.1@sha256:09e582f2e12ce9feb251cbdacec57fa1f4a838ec63928026d98b758e89f9abd7 8 | - ../essence-of-live-coding 9 | -------------------------------------------------------------------------------- /essence-of-live-coding-vivid/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-vivid 2 | 3 | ## 0.2.5 4 | 5 | * Thank you, Miguel Negrão, for extensive support, suggestions, testing, and debugging! 6 | -------------------------------------------------------------------------------- /essence-of-live-coding-vivid/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-vivid/essence-of-live-coding-vivid.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-vivid 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - vivid backend 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains the backend for vivid, a Supercollider library. 17 | license: BSD3 18 | license-file: LICENSE 19 | author: Manuel Bärenz 20 | maintainer: programming@manuelbaerenz.de 21 | copyright: 2021 Manuel Bärenz 22 | category: Sound 23 | build-type: Simple 24 | cabal-version: >=1.10 25 | extra-source-files: CHANGELOG.md 26 | 27 | library 28 | exposed-modules: 29 | LiveCoding.Vivid 30 | 31 | build-depends: 32 | base >= 4.7 && < 5 33 | , vivid >= 0.5.2.0 34 | , essence-of-live-coding >= 0.2.8 35 | hs-source-dirs: src 36 | default-language: Haskell2010 37 | -------------------------------------------------------------------------------- /essence-of-live-coding-vivid/src/LiveCoding/Vivid.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE StandaloneDeriving #-} 7 | 8 | {- | Support for [@vivid@](https://hackage.haskell.org/package/vivid), 9 | a Haskell library for [SuperCollider](https://supercollider.github.io/). 10 | 11 | With this module, you can create cells corresponding to synthesizers. 12 | 13 | The synthesizers automatically start and stop on reload. 14 | -} 15 | module LiveCoding.Vivid where 16 | 17 | -- base 18 | import Data.Foldable (traverse_) 19 | import GHC.TypeLits (KnownSymbol) 20 | 21 | -- vivid 22 | import Vivid 23 | 24 | -- essence-of-live-coding 25 | 26 | import LiveCoding 27 | import LiveCoding.Handle 28 | 29 | {- | Whether a synthesizer should currently be running or not. 30 | 31 | Typically, you will either statically supply the value and change it in the code to start and stop the synth, 32 | or you can connect another cell to it. 33 | -} 34 | data SynthState 35 | = Started 36 | | Stopped 37 | deriving (Eq) 38 | 39 | {- | A 'ParametrisedHandle' corresponding to one @vivid@/@SuperCollider@ synthesizer. 40 | 41 | Usually, you will want to use 'liveSynth' instead, it is easier to handle. 42 | -} 43 | vividHandleParametrised :: 44 | (VividAction m, Eq params, VarList params, Subset (InnerVars params) args, Elem "gate" args) => 45 | ParametrisedHandle (params, SynthDef args, SynthState) m (Maybe (Synth args)) 46 | vividHandleParametrised = ParametrisedHandle {..} 47 | where 48 | createParametrised (params, synthDef, Started) = Just <$> synth synthDef params 49 | createParametrised (params, synthDef, Stopped) = defineSD synthDef >> pure Nothing 50 | 51 | destroyParametrised _ synthMaybe = traverse_ release synthMaybe 52 | 53 | -- Only the synth parameters changed and it's still running. 54 | -- So simply set new parameters without stopping it. 55 | changeParametrised (paramsOld, synthDefOld, Started) (paramsNew, synthDefNew, Started) (Just synth) 56 | | paramsOld /= paramsNew && synthDefOld == synthDefNew = do 57 | set synth paramsNew 58 | return $ Just synth 59 | -- Synthdef or start/stop state changed, need to release and reinitialise 60 | changeParametrised old new synth = defaultChange createParametrised destroyParametrised old new synth 61 | 62 | deriving instance Data SynthState 63 | deriving instance (KnownSymbol a) => Data (I a) 64 | 65 | {- | Create a synthesizer. 66 | 67 | When you add 'liveSynth' to your live program, 68 | it will be started upon reload immediately. 69 | 70 | Feed the definition of the synthesizer and its current intended state to this cell. 71 | The input has the form @(params, sdbody, synthState)@. 72 | 73 | * A change in @params@ will reload the synthesizer quickly, 74 | unless the types of the parameters change. 75 | * A change in the @sdbody :: 'SDBody' ...@ or the _types_ of the @params@ will 'release' the synthesizer and start a new one. 76 | * The input @synthState :: 'SynthState'@ represent whether the synthesizer should currently be running or not. 77 | Changes in it quickly start or stop it. 78 | * When it is started, @'Just' synth@ is returned, where @synth@ represents the running synthesizer. 79 | * When it is stopped, 'Nothing' is returned. 80 | 81 | You have to use 'envGate' in your @sdbody@, 82 | or another way of gating your output signals 83 | in order to ensure release of the synths without clipping. 84 | 85 | For an example, have a look at the source code of 'sine'. 86 | -} 87 | liveSynth :: 88 | ( VividAction m 89 | , Eq params 90 | , Typeable params 91 | , VarList params 92 | , Typeable (InnerVars params) 93 | , Subset (InnerVars params) (InnerVars params) 94 | , Elem "gate" (InnerVars params) 95 | , Data params 96 | ) => 97 | Cell 98 | (HandlingStateT m) 99 | (params, SDBody' (InnerVars params) [Signal], SynthState) 100 | (Maybe (Synth (InnerVars params))) 101 | liveSynth = proc (params, sdbody, synthstate) -> do 102 | paramsFirstValue <- holdFirst -< params 103 | handlingParametrised vividHandleParametrised -< (params, sd paramsFirstValue sdbody, synthstate) 104 | 105 | -- | Example sine synthesizer that creates a sine wave at the given input frequency. 106 | sine :: (VividAction m) => Cell (HandlingStateT m) Float () 107 | sine = proc frequency -> do 108 | liveSynth 109 | -< 110 | ( 111 | ( 1 :: I "gate" 112 | , 2 :: I "fadeSecs" 113 | , I frequency :: I "freq" 114 | ) 115 | , out (0 :: Int) [envGate ~* sinOsc (freq_ (V :: V "freq"))] 116 | , Started 117 | ) 118 | returnA -< () 119 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/.ghcid: -------------------------------------------------------------------------------- 1 | --command="cabal repl essence-of-live-coding-warp:test:test" --test main 2 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-warp 2 | 3 | ## 0.2.4 4 | 5 | * Tweak performance 6 | 7 | ## 0.2.2 8 | 9 | * Made backend nonblocking 10 | 11 | ## 0.2.1 12 | 13 | * Simple single-threaded version 14 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/essence-of-live-coding-warp.cabal: -------------------------------------------------------------------------------- 1 | name: essence-of-live-coding-warp 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This library contains a single-threaded interface to the WARP web server. 17 | WAI applications can be run this way. 18 | 19 | license: BSD3 20 | license-file: LICENSE 21 | author: Manuel Bärenz 22 | maintainer: programming@manuelbaerenz.de 23 | homepage: https://www.manuelbaerenz.de/#computerscience 24 | category: FRP, Live coding 25 | build-type: Simple 26 | extra-source-files: CHANGELOG.md 27 | cabal-version: >=1.10 28 | 29 | source-repository head 30 | type: git 31 | location: https://github.com/turion/essence-of-live-coding.git 32 | 33 | source-repository this 34 | type: git 35 | location: https://github.com/turion/essence-of-live-coding.git 36 | tag: v0.2.8 37 | 38 | library 39 | exposed-modules: 40 | LiveCoding.Warp 41 | other-extensions: DeriveDataTypeable 42 | build-depends: 43 | base >= 4.13 && < 4.21 44 | , http-types >= 0.12.3 45 | , wai >= 3.2.2.1 46 | , warp >= 3.3.13 47 | , essence-of-live-coding >= 0.2.8 48 | hs-source-dirs: src 49 | default-language: Haskell2010 50 | default-extensions: StrictData 51 | 52 | test-suite test 53 | type: exitcode-stdio-1.0 54 | main-is: Main.hs 55 | hs-source-dirs: test 56 | build-depends: 57 | base >= 4.13 && < 4.21 58 | , http-client >= 0.6.4.1 59 | , bytestring >= 0.10 60 | , essence-of-live-coding >= 0.2.8 61 | , essence-of-live-coding-warp 62 | default-language: Haskell2010 63 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/src/LiveCoding/Warp.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE TupleSections #-} 4 | 5 | {- | Live coding backend to the [@warp@](https://hackage.haskell.org/package/warp) server. 6 | 7 | If you write a cell that consumes 'Request's and produces 'Response's, 8 | you can use the functions here that run this cell as a @warp@ application. 9 | -} 10 | module LiveCoding.Warp ( 11 | runWarpC, 12 | runWarpC_, 13 | module X, 14 | ) where 15 | 16 | -- base 17 | import Control.Concurrent 18 | import Control.Monad.IO.Class 19 | 20 | -- http-types 21 | import Network.HTTP.Types as X 22 | 23 | -- wai 24 | import Network.Wai as X 25 | 26 | -- warp 27 | import Network.Wai.Handler.Warp 28 | 29 | -- essence-of-live-coding 30 | import LiveCoding 31 | 32 | data WaiHandle = WaiHandle 33 | { requestVar :: MVar Request 34 | , responseVar :: MVar Response 35 | , appThread :: ThreadId 36 | } 37 | 38 | -- I believe there is a bug here where a request is missed if the app blocks because the requestVar isn't emptied, or the response not filled. 39 | 40 | waiHandle :: Port -> Handle IO WaiHandle 41 | waiHandle port = 42 | Handle 43 | { create = do 44 | requestVar <- newEmptyMVar 45 | responseVar <- newEmptyMVar 46 | let app request respond = do 47 | putMVar requestVar request 48 | response <- takeMVar responseVar 49 | respond response 50 | appThread <- forkIO $ run port app 51 | return WaiHandle {..} 52 | , destroy = \WaiHandle {..} -> killThread appThread 53 | } 54 | 55 | {- | Run a 'Cell' as a WARP application. 56 | 57 | 1. Starts a WARP application on the given port in a background thread 58 | 2. Waits until the next request arrives, outputting 'Nothing' in the meantime 59 | 3. Supplies the cell with the input and the current request 60 | 4. Serve the response and return the output 61 | -} 62 | runWarpC :: 63 | Port -> 64 | Cell IO (a, Request) (b, Response) -> 65 | Cell (HandlingStateT IO) a (Maybe b) 66 | runWarpC port cell = proc a -> do 67 | WaiHandle {..} <- handling $ waiHandle port -< () 68 | requestMaybe <- arrM $ liftIO . tryTakeMVar -< requestVar 69 | case requestMaybe of 70 | Just request -> do 71 | (b, response) <- liftCell cell -< (a, request) 72 | arrM $ liftIO . uncurry putMVar -< (responseVar, response) 73 | returnA -< Just b 74 | Nothing -> do 75 | arrM $ liftIO . threadDelay -< 1000 -- Prevent too much CPU load 76 | returnA -< Nothing 77 | 78 | -- | A simple live-codable web application is a cell that consumes HTTP 'Request's and emits 'Response's for each. 79 | type LiveWebApp = Cell IO Request Response 80 | 81 | {- | Like 'runWarpC', but don't consume additional input or produce additional output. 82 | 83 | Suitable for a main program, for example like this: 84 | 85 | @ 86 | mainCell :: Cell IO Request Response 87 | mainCell = undefined 88 | 89 | liveProgram :: LiveProgram (HandlingStateT IO) 90 | liveProgram = liveCell mainCell 91 | 92 | main :: IO () 93 | main = liveMain liveProgram 94 | @ 95 | -} 96 | runWarpC_ :: 97 | Port -> 98 | LiveWebApp -> 99 | Cell (HandlingStateT IO) () () 100 | runWarpC_ port cell = runWarpC port (arr snd >>> cell >>> arr ((),)) >>> arr (const ()) 101 | -------------------------------------------------------------------------------- /essence-of-live-coding-warp/test/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | -- base 4 | import Control.Monad (unless) 5 | import System.Exit 6 | 7 | -- bytestring 8 | import Data.ByteString.Lazy 9 | 10 | -- http-client 11 | import Network.HTTP.Client hiding (Response) 12 | 13 | -- essence-of-live-coding 14 | import LiveCoding 15 | 16 | -- essence-of-live-coding-warp 17 | import LiveCoding.Warp 18 | 19 | response :: ByteString -> Response 20 | response = responseLBS status200 [("Content-Type", "text/plain")] 21 | 22 | liveProgram :: ByteString -> LiveProgram (HandlingStateT IO) 23 | liveProgram = liveCell . runWarpC_ 8080 . arr . const . response 24 | 25 | testRequest :: Manager -> ByteString -> IO () 26 | testRequest manager expected = do 27 | request <- parseRequest "http://localhost:8080" 28 | response <- httpLbs request manager 29 | unless (responseBody response == expected) exitFailure 30 | 31 | main :: IO () 32 | main = do 33 | launchedProgram <- launch $ liveProgram "hai" 34 | manager <- newManager defaultManagerSettings 35 | testRequest manager "hai" 36 | update launchedProgram $ liveProgram "hellooo" 37 | testRequest manager "hellooo" 38 | -------------------------------------------------------------------------------- /essence-of-live-coding/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding 2 | 3 | ## 0.2.8 4 | 5 | * Support GHC 9.10 6 | * Add Selective instances 7 | 8 | ## 0.2.7 9 | 10 | * Add support for GHC 9.2 11 | * Formatting with Fourmolu 12 | * Added `NoMigration` 13 | 14 | ## 0.2.6 15 | 16 | * Add `changes` 17 | * Add support for GHC 9.0.2 18 | 19 | ## 0.2.5 20 | 21 | * Refactored GHCi support 22 | * Add `liveMain` 23 | * Add exception monad for live programs 24 | * Improved some haddocks 25 | 26 | ## 0.2.4 27 | 28 | * Extended testing utilities 29 | * Extended LiveCoding.Cell.Util by buffer, edge, boundedFIFO and other utilities 30 | 31 | ## 0.2.3 32 | 33 | * Added printTimeC debugging utility 34 | 35 | ## 0.2.2 36 | 37 | * Added feedback migration 38 | 39 | ## 0.2.1 40 | 41 | * Adapted pulse backend to handles and refactored 42 | 43 | ## 0.2.0.1 44 | 45 | * Bug fixes 46 | * Version bounds 47 | 48 | ## 0.2.0.0 49 | 50 | * Adapted gloss backend to handles and refactored 51 | * Added a mechanism to make cells nonblocking 52 | * Added handles for nonserialisable values like threads, concurrent variables & device handles 53 | 54 | ## 0.1.0.3 55 | 56 | * First version. 57 | As described in https://www.manuelbaerenz.de/essence-of-live-coding/EssenceOfLiveCoding.pdf. 58 | -------------------------------------------------------------------------------- /essence-of-live-coding/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /essence-of-live-coding/README.md: -------------------------------------------------------------------------------- 1 | # README 2 | -------- 3 | 4 | Here, you will find the main library. 5 | You are probably looking for the main readme [here](https://github.com/turion/essence-of-live-coding). 6 | 7 | -------- 8 | 9 | essence-of-live-coding is a general purpose and type safe live coding framework in Haskell. 10 | You can run programs in it, and edit, recompile and reload them _while_ they're running. 11 | Internally, the state of the live program is automatically migrated when performing hot code swap. 12 | 13 | The library also offers an easy to use FRP interface. 14 | It is parametrized by its side effects, 15 | separates data flow cleanly from control flow, 16 | and allows to develop live programs from reusable, modular components. 17 | There are also useful utilities for debugging and quickchecking. 18 | 19 | -------------------------------------------------------------------------------- /essence-of-live-coding/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /essence-of-live-coding/app/TestExceptions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | -- base 4 | import Control.Arrow 5 | 6 | -- transformers 7 | import Control.Monad.Trans.Class 8 | 9 | -- essence-of-live-coding 10 | import LiveCoding 11 | 12 | liveProgram = liveCell $ 13 | safely $ do 14 | try $ throwingCell 15 | safe $ arr (const (3 :: Integer)) >>> sumC >>> arr (const ()) 16 | 17 | throwingCell = proc _ -> do 18 | n <- sumC -< (1 :: Integer) 19 | if n > 10 20 | then throwC -< () 21 | else returnA -< () 22 | arrM $ lift . print -< n 23 | 24 | main = do 25 | (debugger, observer) <- countDebugger 26 | launchWithDebugger liveProgram $ debugger <> statePrint 27 | await observer 30 28 | -------------------------------------------------------------------------------- /essence-of-live-coding/app/TestNonBlocking.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | module Main ( 4 | module Main, 5 | module X, 6 | ) where 7 | 8 | -- base 9 | import Control.Arrow 10 | import Control.Concurrent 11 | 12 | -- transformers 13 | import Control.Monad.Trans.Class 14 | 15 | -- essence-of-live-coding 16 | import LiveCoding 17 | import LiveCoding.GHCi as X 18 | 19 | -- | An identity function that takes a long time to pass on its value. 20 | slowId :: Cell IO a a 21 | slowId = proc a -> do 22 | arrM threadDelay -< 1000000 23 | returnA -< a 24 | 25 | main :: IO () 26 | main = do 27 | putStrLn "Push return to start a slow calculation." 28 | runHandlingStateT $ foreground $ liveCell mainCell 29 | 30 | {- | Constantly count the number of ticks passed since program start. 31 | Whenever the keyboard return key is pressed, 32 | this number is printed, and passed into a slow "computation" in a separate thread, 33 | while the foreground thread is not blocked. 34 | When the background thread returns, the number is printed again. 35 | -} 36 | mainCell :: Cell (HandlingStateT IO) () () 37 | mainCell = 38 | let keyboard = nonBlocking False $ constM getLine -- Only poll, never abort 39 | mySlowId = nonBlocking True slowId -- Abort and restart when new data arrives 40 | in proc _ -> do 41 | n <- count -< () 42 | lineMaybe <- keyboard -< Just () 43 | let nString = show n <$ lineMaybe 44 | resampleMaybe (arrM $ lift . putStrLn) -< ("Calculating " ++) <$> nString 45 | resultMaybe <- mySlowId -< nString 46 | resampleMaybe (arrM $ lift . putStrLn) -< ("Calculated " ++) <$> resultMaybe 47 | arrM $ lift . threadDelay -< 1000 -- Don't hog CPU 48 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding.hs: -------------------------------------------------------------------------------- 1 | module LiveCoding (module X) 2 | where 3 | 4 | -- base 5 | import Control.Arrow as X hiding (app) 6 | import Data.Data as X 7 | import Data.Profunctor as X hiding (Choice) 8 | import Data.Profunctor.Strong as X 9 | import Data.Profunctor.Traversing as X 10 | 11 | -- essence-of-live-coding 12 | import LiveCoding.Bind as X 13 | import LiveCoding.Cell as X 14 | import LiveCoding.Cell.Feedback as X 15 | import LiveCoding.Cell.HotCodeSwap as X 16 | import LiveCoding.Cell.Monad as X 17 | import LiveCoding.Cell.Monad.Trans as X hiding (State) 18 | import LiveCoding.Cell.NonBlocking as X 19 | import LiveCoding.Cell.Resample as X 20 | import LiveCoding.Cell.Util as X 21 | import LiveCoding.CellExcept as X 22 | import LiveCoding.Coalgebra as X 23 | import LiveCoding.Debugger as X 24 | import LiveCoding.Debugger.StatePrint as X 25 | import LiveCoding.Exceptions as X 26 | import LiveCoding.Exceptions.Finite as X 27 | import LiveCoding.Forever as X 28 | import LiveCoding.Handle as X 29 | import LiveCoding.Handle.Examples as X 30 | import LiveCoding.HandlingState as X ( 31 | Handling (..), 32 | HandlingState (..), 33 | HandlingStateT, 34 | isRegistered, 35 | runHandlingState, 36 | runHandlingStateC, 37 | runHandlingStateT, 38 | ) 39 | import LiveCoding.LiveProgram as X 40 | import LiveCoding.LiveProgram.HotCodeSwap as X 41 | import LiveCoding.LiveProgram.Monad.Trans as X 42 | import LiveCoding.Migrate as X 43 | import LiveCoding.Migrate.Debugger as X 44 | import LiveCoding.Migrate.Migration as X 45 | import LiveCoding.Migrate.NoMigration as X hiding (changes, delay) 46 | import LiveCoding.RuntimeIO as X hiding (update) 47 | import LiveCoding.RuntimeIO.Launch as X hiding (foreground) 48 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Bind.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE Arrows #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE RecordWildCards #-} 7 | module LiveCoding.Bind where 8 | 9 | -- base 10 | import Control.Arrow 11 | import Control.Concurrent (threadDelay) 12 | import Data.Data 13 | import Data.Either (fromRight) 14 | import Data.Void 15 | 16 | -- transformers 17 | import Control.Monad.Trans.Class 18 | import Control.Monad.Trans.Except 19 | import Control.Monad.Trans.Reader 20 | 21 | -- essence-of-live-coding 22 | import LiveCoding.Cell 23 | import LiveCoding.CellExcept 24 | import LiveCoding.Exceptions 25 | import LiveCoding.LiveProgram 26 | \end{code} 27 | \end{comment} 28 | 29 | \begin{comment} 30 | %After this long excursion, 31 | We can finally return to the example. 32 | Let us again change the period of the oscillator, 33 | only this time not manually, 34 | but at the moment the position reaches 0: 35 | 36 | \begin{code} 37 | throwWhen0 38 | :: Monad m 39 | => Cell (ExceptT () m) Double Double 40 | throwWhen0 = proc pos -> 41 | if pos < 0 42 | then throwC -< () 43 | else returnA -< pos 44 | 45 | sineChangeE = do 46 | try $ sine 6 >>> throwWhen0 47 | try $ (constM $ lift $ putStrLn "I changed!") 48 | >>> throwC 49 | safe $ sine 10 50 | \end{code} 51 | \end{comment} 52 | 53 | \begin{code} 54 | sineWait 55 | :: Double -> CellExcept () String IO Void 56 | sineWait t = do 57 | try $ arr (const "Waiting...") >>> wait 2 58 | safe $ sine t >>> arr asciiArt 59 | \end{code} 60 | This \mintinline{haskell}{do}-block can be read intuitively. 61 | Initially, the first cell is executed, 62 | which returns the message \mintinline{haskell}{"Waiting..."} every second. 63 | After three seconds, it throws an exception, 64 | which is handled by activating the sine generator. 65 | Since all exceptions have been handled, 66 | we leave the \mintinline{haskell}{CellExcept} context and run the resulting program: 67 | \begin{code} 68 | printSineWait :: LiveProgram IO 69 | printSineWait = liveCell 70 | $ safely (sineWait 8) 71 | >>> printEverySecond 72 | \end{code} 73 | \verbatiminput{../demos/DemoSineWait.txt} 74 | The crucial advantage of handling control flow this way 75 | is that the \emph{control state} 76 | -- that is, the information which exceptions have been thrown and which cell is currently active -- 77 | is encoded completely in the overall state of the live program, 78 | and can thus be migrated automatically. 79 | Let us rerun the above example, 80 | but after the first \mintinline{haskell}{try} statement has already passed control to the sine generator 81 | we shorten the period length of the sine wave and reload: 82 | \verbatiminput{../demos/DemoSineWaitChange.txt} 83 | The migrated program did not restart and wait again, 84 | but remembered to immediately continue executing the sine generator from the same phase as before. 85 | This is in contrast to simplistic approaches to live coding in which the control flow state is forgotten upon reload, 86 | and restarted each time. 87 | 88 | In most other programming languages where control flow is builtin, 89 | this would typically require reworking the compiler or interpreter, 90 | but in Haskell, we succeed entirely within the language. 91 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/Feedback.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE Arrows #-} 4 | {-# LANGUAGE BangPatterns #-} 5 | {-# LANGUAGE DeriveDataTypeable #-} 6 | {-# LANGUAGE RecordWildCards #-} 7 | 8 | module LiveCoding.Cell.Feedback where 9 | 10 | -- base 11 | import Control.Arrow 12 | import Data.Data 13 | import Data.Maybe (fromMaybe) 14 | 15 | -- essence-of-live-coding 16 | import LiveCoding.Cell 17 | \end{code} 18 | \end{comment} 19 | 20 | We would like to have all basic primitives needed to develop standard synchronous signal processing components, 21 | without touching the \mintinline{haskell}{Cell} constructor anymore. 22 | One crucial bit is missing to achieve this goal: 23 | Encapsulating state. 24 | The most general such construction is the feedback loop: 25 | \begin{code} 26 | feedback 27 | :: (Monad m, Data s) 28 | => s 29 | -> Cell m (a, s) (b, s) 30 | -> Cell m a b 31 | \end{code} 32 | Let us have a look at its internal state: 33 | \begin{code} 34 | data Feedback sPrevious sAdditional = Feedback 35 | { sPrevious :: sPrevious 36 | , sAdditional :: sAdditional 37 | } deriving Data 38 | \end{code} 39 | In \mintinline{haskell}{feedback sAdditional cell}, 40 | the \mintinline{haskell}{cell} has state \mintinline{haskell}{sPrevious}, 41 | and to this state we add \mintinline{haskell}{sAdditional}. 42 | The additional state is received by \mintinline{haskell}{cell} as explicit input, 43 | and \mintinline{haskell}{feedback} hides it. 44 | 45 | Note that \mintinline{haskell}{feedback} and \mintinline{haskell}{loop} are different. 46 | While \mintinline{haskell}{loop} provides immediate recursion, it doesn't add new state. 47 | \mintinline{haskell}{feedback} requires an initial state and delays it, 48 | but in turn it is always safe to use since it does not use \mintinline{haskell}{mfix}. 49 | 50 | \fxwarning{Possibly remark on Data instance of s?} 51 | \begin{comment} 52 | \begin{code} 53 | feedback sAdditional (Cell sPrevious step) = Cell { .. } 54 | where 55 | cellState = Feedback { .. } 56 | cellStep Feedback { .. } a = do 57 | ((!b, !sAdditional'), sPrevious') <- step sPrevious (a, sAdditional) 58 | return (b, Feedback sPrevious' sAdditional') 59 | feedback cellState (ArrM f) = Cell { .. } 60 | where 61 | cellStep state a = f (a, state) 62 | \end{code} 63 | \end{comment} 64 | It enables us to write delays: 65 | \begin{code} 66 | delay :: (Data s, Monad m) => s -> Cell m s s 67 | delay s = feedback s $ arr swap 68 | where 69 | swap (sNew, sOld) = (sOld, sNew) 70 | \end{code} 71 | \mintinline{haskell}{feedback} can be used for accumulation of data. 72 | For example, \mintinline{haskell}{sumC} now becomes: 73 | \begin{code} 74 | sumFeedback 75 | :: (Monad m, Num a, Data a) 76 | => Cell m a a 77 | sumFeedback = feedback 0 $ arr 78 | $ \(a, accum) -> (accum, a + accum) 79 | \end{code} 80 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/HotCodeSwap.hs: -------------------------------------------------------------------------------- 1 | module LiveCoding.Cell.HotCodeSwap where 2 | 3 | -- essence-of-live-coding 4 | import LiveCoding.Cell 5 | import LiveCoding.Migrate 6 | 7 | hotCodeSwapCell :: 8 | Cell m a b -> 9 | Cell m a b -> 10 | Cell m a b 11 | hotCodeSwapCell 12 | (Cell newState newStep) 13 | (Cell oldState _) = 14 | Cell 15 | { cellState = migrate newState oldState 16 | , cellStep = newStep 17 | } 18 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/Monad.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuantifiedConstraints #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE TupleSections #-} 5 | 6 | {- | 7 | Handling monad morphisms. 8 | -} 9 | module LiveCoding.Cell.Monad where 10 | 11 | -- essence-of-live-coding 12 | 13 | import Control.Arrow (Arrow (arr), (>>>)) 14 | import Data.Data (Data, Typeable) 15 | import LiveCoding.Cell 16 | 17 | -- | Apply a monad morphism that also transforms the output to a cell. 18 | hoistCellOutput :: 19 | (Monad m1, Monad m2) => 20 | (forall s. m1 (b1, s) -> m2 (b2, s)) -> 21 | Cell m1 a b1 -> 22 | Cell m2 a b2 23 | hoistCellOutput morph = hoistCellKleisli_ (morph .) 24 | 25 | -- | Apply a transformation of Kleisli morphisms to a cell. 26 | hoistCellKleisli_ :: 27 | (Monad m1, Monad m2) => 28 | (forall s. (a1 -> m1 (b1, s)) -> (a2 -> m2 (b2, s))) -> 29 | Cell m1 a1 b1 -> 30 | Cell m2 a2 b2 31 | hoistCellKleisli_ morph = hoistCellKleisli (morph .) 32 | 33 | -- | Apply a transformation of stateful Kleisli morphisms to a cell. 34 | hoistCellKleisli :: 35 | (Monad m1, Monad m2) => 36 | (forall s. (s -> a1 -> m1 (b1, s)) -> (s -> a2 -> m2 (b2, s))) -> 37 | Cell m1 a1 b1 -> 38 | Cell m2 a2 b2 39 | hoistCellKleisli morph ArrM {..} = 40 | ArrM 41 | { runArrM = (fmap fst .) $ ($ ()) $ morph $ const $ runArrM >>> fmap (,()) 42 | } 43 | hoistCellKleisli morph Cell {..} = 44 | Cell 45 | { cellStep = morph cellStep 46 | , .. 47 | } 48 | 49 | {- | Apply a transformation of stateful Kleisli morphisms to a cell, 50 | changing the state type. 51 | -} 52 | hoistCellKleisliStateChange :: 53 | (Monad m1, Monad m2, Typeable t, (forall s. (Data s) => Data (t s))) => 54 | ( forall s. 55 | (s -> a1 -> m1 (b1, s)) -> 56 | (t s -> a2 -> m2 (b2, t s)) 57 | ) -> 58 | (forall s. (s -> t s)) -> 59 | Cell m1 a1 b1 -> 60 | Cell m2 a2 b2 61 | hoistCellKleisliStateChange morph init Cell {..} = 62 | Cell 63 | { cellStep = morph cellStep 64 | , cellState = init cellState 65 | } 66 | hoistCellKleisliStateChange morph init cell = hoistCellKleisliStateChange morph init $ toCell cell 67 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/Monad/Trans.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {- | 5 | Handling monad transformers. 6 | -} 7 | module LiveCoding.Cell.Monad.Trans where 8 | 9 | -- base 10 | import Control.Arrow (arr, (>>>)) 11 | import Data.Data (Data) 12 | 13 | -- transformers 14 | import Control.Monad.Trans.Reader (ReaderT (..), reader, runReaderT) 15 | import Control.Monad.Trans.State.Strict (StateT (..), evalStateT, runStateT) 16 | import Control.Monad.Trans.Writer.Strict 17 | 18 | -- essence-of-live-coding 19 | import LiveCoding.Cell 20 | import LiveCoding.Cell.Monad 21 | 22 | -- | Push effectful state into the internal state of a cell 23 | runStateC :: 24 | (Data stateT, Monad m) => 25 | -- | A cell with a state effect 26 | Cell (StateT stateT m) a b -> 27 | -- | The initial state 28 | stateT -> 29 | -- | The cell, returning its current state 30 | Cell m a (b, stateT) 31 | runStateC cell stateT = hoistCellKleisliStateChange morph init cell 32 | where 33 | morph step State {..} a = do 34 | ((b, stateInternal), stateT) <- runStateT (step stateInternal a) stateT 35 | return ((b, stateT), State {..}) 36 | init stateInternal = State {..} 37 | 38 | -- | Like 'runStateC', but does not return the current state. 39 | runStateC_ :: 40 | (Data stateT, Monad m) => 41 | -- | A cell with a state effect 42 | Cell (StateT stateT m) a b -> 43 | -- | The initial state 44 | stateT -> 45 | Cell m a b 46 | runStateC_ cell stateT = runStateC cell stateT >>> arr fst 47 | 48 | -- | The internal state of a cell to which 'runStateC' or 'runStateL' has been applied. 49 | data State stateT stateInternal = State 50 | { stateT :: stateT 51 | , stateInternal :: stateInternal 52 | } 53 | deriving (Data, Eq, Show) 54 | 55 | -- | Supply a 'ReaderT' environment before running the cell 56 | runReaderC :: 57 | r -> 58 | Cell (ReaderT r m) a b -> 59 | Cell m a b 60 | runReaderC r = hoistCell $ flip runReaderT r 61 | 62 | -- | Supply a 'ReaderT' environment live 63 | runReaderC' :: 64 | (Monad m) => 65 | Cell (ReaderT r m) a b -> 66 | Cell m (r, a) b 67 | runReaderC' = hoistCellKleisli_ $ \action (r, a) -> runReaderT (action a) r 68 | 69 | -- | Inverse to 'runReaderC'' 70 | readerC' :: 71 | (Monad m) => 72 | Cell m (r, a) b -> 73 | Cell (ReaderT r m) a b 74 | readerC' = hoistCellKleisli_ $ \action a -> ReaderT $ \r -> action (r, a) 75 | 76 | {- | Run the effects of the 'WriterT' monad, 77 | collecting all its output in the second element of the tuple. 78 | -} 79 | runWriterC :: (Monoid w, Monad m) => Cell (WriterT w m) a b -> Cell m a (w, b) 80 | runWriterC = hoistCellOutput $ fmap reorder . runWriterT 81 | where 82 | reorder ((b, s), w) = ((w, b), s) 83 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/NonBlocking.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module LiveCoding.Cell.NonBlocking ( 5 | nonBlocking, 6 | ) 7 | where 8 | 9 | -- base 10 | import Control.Concurrent 11 | import Control.Monad (void, when, (>=>)) 12 | import Data.Data 13 | 14 | -- essence-of-live-coding 15 | import LiveCoding.Cell 16 | import LiveCoding.Handle 17 | import LiveCoding.Handle.Examples 18 | import LiveCoding.HandlingState 19 | 20 | threadVarHandle :: Handle IO (MVar ThreadId) 21 | threadVarHandle = 22 | Handle 23 | { create = newEmptyMVar 24 | , destroy = tryTakeMVar >=> mapM_ killThread 25 | } 26 | 27 | {- | Wrap a cell in a non-blocking way. 28 | Every incoming sample of @nonBlocking cell@ results in an immediate output, 29 | either @Just b@ if the value was computed since the last poll, 30 | or @Nothing@ if no new value was computed yet. 31 | The resulting cell can be polled by sending 'Nothing'. 32 | The boolean flag controls whether the current computation is aborted and restarted when new data arrives. 33 | -} 34 | nonBlocking :: 35 | (Typeable b) => 36 | -- | Pass 'True' to abort the computation when new data arrives. 'False' discards new data. 37 | Bool -> 38 | Cell IO a b -> 39 | Cell (HandlingStateT IO) (Maybe a) (Maybe b) 40 | nonBlocking abort Cell {..} = proc aMaybe -> do 41 | threadVar <- handling threadVarHandle -< () 42 | resultVar <- handling emptyMVarHandle -< () 43 | liftCell Cell {cellStep = nonBlockingStep, ..} -< (aMaybe, threadVar, resultVar) 44 | where 45 | nonBlockingStep s (Nothing, threadVar, resultVar) = do 46 | bsMaybe <- tryTakeMVar resultVar 47 | case bsMaybe of 48 | Just (b, s') -> do 49 | threadId <- takeMVar threadVar 50 | killThread threadId 51 | return (Just b, s') 52 | Nothing -> return (Nothing, s) 53 | nonBlockingStep s (Just a, threadVar, resultVar) = do 54 | noThreadRunning <- 55 | if abort 56 | then -- Abort the current computation if it is still running 57 | do 58 | maybeThreadId <- tryTakeMVar threadVar 59 | mapM_ killThread maybeThreadId 60 | return True 61 | else -- No computation currently running 62 | isEmptyMVar threadVar 63 | when noThreadRunning $ do 64 | threadId <- forkIO $ putMVar resultVar =<< cellStep s a 65 | putMVar threadVar threadId 66 | nonBlockingStep s (Nothing, threadVar, resultVar) 67 | 68 | -- It would have been nice to refactor this with 'hoistCellKleisli', 69 | -- but that would expose the existential state type to the handle. 70 | nonBlocking abort noCell = nonBlocking abort $ toCell noCell 71 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/Resample.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE NamedFieldPuns #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | {- | 6 | Run a cell at a fixed integer multiple speed. 7 | The general approach is to take an existing cell (the "inner" cell) 8 | and produce a new cell (the "outer" cell) that will accept several copies of the input. 9 | The inner cell is stepped for each input. 10 | -} 11 | module LiveCoding.Cell.Resample where 12 | 13 | -- base 14 | import Control.Arrow 15 | import Data.Maybe 16 | import GHC.TypeNats 17 | 18 | -- profunctors 19 | import Data.Profunctor.Traversing (Traversing (traverse')) 20 | 21 | -- vector-sized 22 | import Data.Vector.Sized (Vector, fromList, toList) 23 | 24 | -- essence-of-live-coding 25 | import LiveCoding.Cell 26 | import LiveCoding.Cell.Monad 27 | 28 | -- | Execute the inner cell for n steps per outer step. 29 | resample :: (Monad m, KnownNat n) => Cell m a b -> Cell m (Vector n a) (Vector n b) 30 | resample = traverse' 31 | 32 | -- | Execute the cell for as many steps as the input list is long. 33 | resampleList :: (Monad m) => Cell m a b -> Cell m [a] [b] 34 | resampleList = traverse' 35 | 36 | resampleMaybe :: (Monad m) => Cell m a b -> Cell m (Maybe a) (Maybe b) 37 | resampleMaybe = traverse' 38 | 39 | {- | Create as many cells as the input list is long and execute them in parallel 40 | (in the sense that each one has a separate state). At each tick the list with 41 | the different states grows or shrinks depending on the size of the input list. 42 | 43 | Similar to Yampa's [parC](https://hackage.haskell.org/package/Yampa-0.13.3/docs/FRP-Yampa-Switches.html#v:parC). 44 | -} 45 | resampleListPar :: (Monad m) => Cell m a b -> Cell m [a] [b] 46 | resampleListPar (Cell initial step) = Cell {..} 47 | where 48 | cellState = [] 49 | cellStep s xs = unzip <$> traverse (uncurry step) (zip s' xs) 50 | where 51 | s' = s ++ replicate (length xs - length s) initial 52 | resampleListPar (ArrM f) = ArrM (traverse f) 53 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Cell/Util/Internal.hs: -------------------------------------------------------------------------------- 1 | module LiveCoding.Cell.Util.Internal where 2 | 3 | -- | Helper for 'onChange'. 4 | whenDifferent :: (Eq p, Monad m) => (p -> p -> a -> m b) -> (p, p, a) -> m (Maybe b) 5 | whenDifferent action (pOld, pNew, a) 6 | | pOld == pNew = Just <$> action pOld pNew a 7 | | otherwise = return Nothing 8 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/CellExcept.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE GADTs #-} 4 | 5 | module LiveCoding.CellExcept where 6 | 7 | -- base 8 | import Control.Monad 9 | import Data.Data 10 | import Data.Void 11 | 12 | -- transformers 13 | import Control.Monad.Trans.Except 14 | 15 | -- mmorph 16 | import Control.Monad.Morph 17 | 18 | -- essence-of-live-coding 19 | import LiveCoding.Cell 20 | import LiveCoding.Exceptions 21 | import LiveCoding.Exceptions.Finite 22 | \end{code} 23 | \end{comment} 24 | 25 | We can save on boiler plate by dropping the Coyoneda embedding for an ``operational'' monad: 26 | \fxerror{Cite operational} 27 | \fxerror{Move the following code into appendix?} 28 | \begin{code} 29 | data CellExcept a b m e where 30 | Return :: e -> CellExcept a b m e 31 | Bind 32 | :: CellExcept a b m e1 33 | -> (e1 -> CellExcept a b m e2) 34 | -> CellExcept a b m e2 35 | Try 36 | :: (Data e, Finite e) 37 | => Cell (ExceptT e m) a b 38 | -> CellExcept a b m e 39 | \end{code} 40 | 41 | \begin{comment} 42 | \begin{code} 43 | instance Monad m => Functor (CellExcept a b m) where 44 | fmap = liftM 45 | 46 | instance Monad m => Applicative (CellExcept a b m) where 47 | pure = return 48 | (<*>) = ap 49 | 50 | instance MFunctor (CellExcept a b) where 51 | hoist morphism (Return e) = Return e 52 | hoist morphism (Bind action cont) = Bind 53 | (hoist morphism action) 54 | (hoist morphism . cont) 55 | hoist morphism (Try cell) = Try $ hoistCell (mapExceptT morphism) cell 56 | \end{code} 57 | \end{comment} 58 | The \mintinline{haskell}{Monad} instance is now trivial: 59 | \begin{code} 60 | instance Monad m => Monad (CellExcept a b m) where 61 | return = Return 62 | (>>=) = Bind 63 | \end{code} 64 | As is typical for operational monads, all of the effort now goes into the interpretation function: 65 | \begin{code} 66 | runCellExcept 67 | :: Monad m 68 | => CellExcept a b m e 69 | -> Cell (ExceptT e m) a b 70 | \end{code} 71 | \begin{spec} 72 | runCellExcept (Bind (Try cell) g) 73 | = cell >>>= commute (runCellExcept . g) 74 | runCellExcept ... = ... 75 | \end{spec} 76 | \begin{comment} 77 | \begin{code} 78 | runCellExcept (Return e) = constM $ throwE e 79 | runCellExcept (Try cell) = cell 80 | runCellExcept (Bind (Try cell) g) = cell >>>== commute (runCellExcept . g) 81 | runCellExcept (Bind (Return e) f) = runCellExcept $ f e 82 | runCellExcept (Bind (Bind ce f) g) = runCellExcept $ Bind ce $ \e -> Bind (f e) g 83 | \end{code} 84 | \end{comment} 85 | 86 | As a slight restriction of the framework, 87 | throwing exceptions is now only allowed for finite types: 88 | \begin{code} 89 | try 90 | :: (Data e, Finite e) 91 | => Cell (ExceptT e m) a b 92 | -> CellExcept a b m e 93 | try = Try 94 | \end{code} 95 | In practice however, this is less often a limitation than first assumed, 96 | since in the monad context, 97 | calculations with all types are allowed again. 98 | \fxerror{But the trouble remains that builtin types like Int and Double can't be thrown.} 99 | 100 | \fxfatal{The rest is explained in the main article differently. Merge.} 101 | \begin{comment} 102 | \begin{code} 103 | safely 104 | :: Monad m 105 | => CellExcept a b m Void 106 | -> Cell m a b 107 | safely = hoistCell discardVoid . runCellExcept 108 | discardVoid 109 | :: Functor m 110 | => ExceptT Void m a 111 | -> m a 112 | discardVoid 113 | = fmap (either absurd id) . runExceptT 114 | safe :: Monad m => Cell m a b -> CellExcept a b m Void 115 | safe cell = try $ liftCell cell 116 | 117 | -- | Run a monadic action and immediately raise its result as an exception. 118 | once :: (Monad m, Data e, Finite e) => (a -> m e) -> CellExcept a arbitrary m e 119 | once kleisli = try $ arrM $ ExceptT . (Left <$>) . kleisli 120 | 121 | -- | Like 'once', but the action does not have an input. 122 | once_ :: (Monad m, Data e, Finite e) => m e -> CellExcept a arbitrary m e 123 | once_ = once . const 124 | \end{code} 125 | \end{comment} 126 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Coalgebra.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE GADTs #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | module LiveCoding.Coalgebra where 8 | 9 | -- base 10 | import Control.Arrow (second) 11 | import Data.Data 12 | 13 | -- essence-of-live-coding 14 | import LiveCoding.Cell 15 | 16 | \end{code} 17 | \end{comment} 18 | 19 | \section{Monadic stream functions and final coalgebras} 20 | 21 | \label{sec:msfs and final coalgebras} 22 | 23 | \mintinline{haskell}{Cell}s mimick Dunai's \cite{Dunai} monadic stream functions (\mintinline{haskell}{MSF}s) closely. 24 | But can they fill their footsteps completely in terms of expressiveness? 25 | If not, which programs exactly can be represented as \mintinline{haskell}{MSF}s and which can't? 26 | To find the answer to these questions, 27 | let us reexamine both types. 28 | 29 | With the help of a simple type synonym, 30 | the \mintinline{haskell}{MSF} definition can be recast in explicit fixpoint form: 31 | 32 | \begin{code} 33 | type StateTransition m a b s = a -> m (b, s) 34 | 35 | data MSF m a b = MSF 36 | { unMSF :: StateTransition m a b (MSF m a b) 37 | } 38 | \end{code} 39 | This definition tells us that monadic stream functions are so-called \emph{final coalgebras} of the \mintinline{haskell}{StateTransition} functor 40 | (for fixed \mintinline{haskell}{m}, \mintinline{haskell}{a}, and \mintinline{haskell}{b}). 41 | An ordinary coalgebra for this functor is given by some type \mintinline{haskell}{s} and a coalgebra structure map: 42 | \begin{code} 43 | data Coalg m a b where 44 | Coalg 45 | :: s 46 | -> (s -> StateTransition m a b s) 47 | -> Coalg m a b 48 | \end{code} 49 | But hold on, the astute reader will intercept, 50 | is this not simply the definition of \mintinline{haskell}{Cell}? 51 | Alas, it is not, for it lacks the type class restriction \mintinline{haskell}{Data s}, 52 | which we need so dearly for the type migration. 53 | Any cell is a coalgebra, 54 | but only those coalgebras that satisfy this type class are a cell. 55 | 56 | Oh, if only there were no such distinction. 57 | By the very property of the final coalgebra, 58 | we can embed every coalgebra therein: 59 | \begin{code} 60 | finality :: Monad m => Coalg m a b -> MSF m a b 61 | finality (Coalg state step) = MSF $ \a -> do 62 | (b, state') <- step state a 63 | return (b, finality $ Coalg state' step) 64 | \end{code} 65 | And analogously, every cell can be easily made into an \mintinline{haskell}{MSF} without loss of information: 66 | \begin{code} 67 | finalityC :: Monad m => Cell m a b -> MSF m a b 68 | finalityC Cell { .. } = MSF $ \a -> do 69 | (b, cellState') <- cellStep cellState a 70 | return (b, finalityC $ Cell cellState' cellStep) 71 | \end{code} 72 | And the final coalgebra is of course a mere coalgebra itself: 73 | \begin{code} 74 | coalgebra :: MSF m a b -> Coalg m a b 75 | coalgebra msf = Coalg msf unMSF 76 | \end{code} 77 | But we miss the abilty to encode \mintinline{haskell}{MSF}s as \mintinline{haskell}{Cell}s by just the \mintinline{haskell}{Data} type class: 78 | \begin{code} 79 | coalgebraC 80 | :: Data (MSF m a b) 81 | => MSF m a b 82 | -> Cell m a b 83 | coalgebraC msf = Cell msf unMSF 84 | \end{code} 85 | We are out of luck if we would want to derive an instance of \mintinline{haskell}{Data (MSF m a b)}. 86 | Monadic stream functions are, well, functions, 87 | and therefore have no \mintinline{haskell}{Data} instance. 88 | The price of \mintinline{haskell}{Data} is loss of higher-order state. 89 | Just how big this loss is will be demonstrated in the following section. 90 | 91 | \begin{comment} 92 | \subsection{Initial algebras} 93 | 94 | \begin{code} 95 | type AlgStructure m a b s = StateTransition m a b s -> s 96 | data Alg m a b where 97 | Alg 98 | :: s 99 | -> AlgStructure m a b s 100 | -> Alg m a b 101 | 102 | algMSF :: MSF m a b -> Alg m a b 103 | algMSF msf = Alg msf MSF 104 | 105 | -- TODO Could explain better why this is simpler in the coalgebra case 106 | initiality 107 | :: Functor m 108 | => AlgStructure m a b s 109 | -> MSF m a b 110 | -> s 111 | initiality algStructure = go 112 | where 113 | go msf = algStructure $ \a -> second go <$> unMSF msf a 114 | 115 | \end{code} 116 | \end{comment} 117 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Exceptions/Finite.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE Arrows #-} 4 | {-# LANGUAGE ExistentialQuantification #-} 5 | {-# LANGUAGE DefaultSignatures #-} 6 | {-# LANGUAGE DeriveGeneric #-} 7 | {-# LANGUAGE FlexibleContexts #-} 8 | {-# LANGUAGE RecordWildCards #-} 9 | {-# LANGUAGE TupleSections #-} 10 | {-# LANGUAGE TypeOperators #-} 11 | 12 | module LiveCoding.Exceptions.Finite where 13 | 14 | -- base 15 | import Control.Arrow 16 | import GHC.Generics 17 | import Data.Data 18 | import Data.Void 19 | 20 | -- transformers 21 | import Control.Monad.Trans.Except 22 | import Control.Monad.Trans.Reader 23 | 24 | -- essence-of-live-coding 25 | import LiveCoding.Cell 26 | import LiveCoding.Cell.Monad.Trans 27 | -- import LiveCoding.CellExcept 28 | 29 | {- | A type class for datatypes on which exception handling can branch statically. 30 | 31 | These are exactly finite algebraic datatypes, 32 | i.e. those defined from sums and products without recursion. 33 | If you have a datatype with a 'Data' instance, 34 | and there is no recursion in it, 35 | then it is probably finite. 36 | 37 | Let us assume your data type is: 38 | 39 | @ 40 | data Foo = Bar | Baz { baz1 :: Bool, baz2 :: Maybe () } 41 | @ 42 | 43 | To define the instance you need to add these two lines of boilerplate 44 | (possibly you need to import "GHC.Generics" and enable some language extensions): 45 | 46 | @ 47 | deriving instance Generic Foo 48 | instance Finite Foo 49 | @ 50 | 51 | -} 52 | \end{code} 53 | \end{comment} 54 | 55 | \begin{code} 56 | class Finite e where 57 | commute :: Monad m => (e -> Cell m a b) -> Cell (ReaderT e m) a b 58 | 59 | default commute :: (Generic e, GFinite (Rep e), Monad m) => (e -> Cell m a b) -> Cell (ReaderT e m) a b 60 | commute handler = hoistCell (withReaderT from) $ gcommute $ handler . to 61 | 62 | class GFinite f where 63 | gcommute :: Monad m => (f e -> Cell m a b) -> Cell (ReaderT (f e) m) a b 64 | 65 | instance GFinite f => GFinite (M1 a b f) where 66 | gcommute handler = hoistCell (withReaderT unM1) $ gcommute $ handler . M1 67 | 68 | instance Finite e => GFinite (K1 a e) where 69 | gcommute handler = hoistCell (withReaderT unK1) $ commute $ handler . K1 70 | 71 | instance GFinite V1 where 72 | gcommute _ = error "gcommute: Can't commute with an empty type" 73 | 74 | instance Finite Void where 75 | commute _ = error "Nope" 76 | 77 | instance GFinite U1 where 78 | gcommute handler = liftCell $ handler U1 79 | 80 | instance Finite () where 81 | 82 | instance Finite Bool where 83 | commute handler = proc a -> do 84 | bool <- constM ask -< () 85 | if bool 86 | then liftCell $ handler True -< a 87 | else liftCell $ handler False -< a 88 | 89 | instance (GFinite eL, GFinite eR) => GFinite (eL :+: eR) where 90 | gcommute handler 91 | = let 92 | cellLeft = runReaderC' $ gcommute $ handler . L1 93 | cellRight = runReaderC' $ gcommute $ handler . R1 94 | gdistribute (L1 eR) a = Left (eR, a) 95 | gdistribute (R1 eL) a = Right (eL, a) 96 | in 97 | proc a -> do 98 | either12 <- constM ask -< () 99 | liftCell (cellLeft ||| cellRight) -< gdistribute either12 a 100 | 101 | instance (Finite e1, Finite e2) => Finite (Either e1 e2) where 102 | 103 | instance (GFinite e1, GFinite e2) => GFinite (e1 :*: e2) where 104 | gcommute handler = hoistCell guncurryReader $ gcommute $ gcommute . gcurry handler 105 | where 106 | gcurry f e1 e2 = f (e1 :*: e2) 107 | guncurryReader a = ReaderT $ \(r1 :*: r2) -> runReaderT (runReaderT a r1) r2 108 | \end{code} 109 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/External.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {- | 5 | Utilities for integrating live programs into external loops, using 'IO' concurrency. 6 | The basic idea is two wormholes (see Winograd-Court's thesis). 7 | -} 8 | module LiveCoding.External where 9 | 10 | -- base 11 | import Control.Arrow 12 | import Control.Concurrent 13 | import Control.Monad.IO.Class 14 | 15 | -- transformers 16 | import Control.Monad.Trans.Reader 17 | import Control.Monad.Trans.Writer.Strict 18 | 19 | -- essence-of-live-coding 20 | import LiveCoding.Cell 21 | import LiveCoding.Cell.Monad.Trans 22 | import LiveCoding.Exceptions 23 | 24 | type ExternalCell m eIn eOut a b = Cell (ReaderT eIn (WriterT eOut m)) a b 25 | 26 | type ExternalLoop eIn eOut = Cell IO eIn eOut 27 | 28 | concurrently :: (MonadIO m, Monoid eOut) => ExternalCell m eIn eOut a b -> IO (Cell m a b, ExternalLoop eIn eOut) 29 | concurrently externalCell = do 30 | inVar <- newEmptyMVar 31 | outVar <- newEmptyMVar 32 | let 33 | cell = proc a -> do 34 | eIn <- constM (liftIO $ takeMVar inVar) -< () 35 | (eOut, b) <- runWriterC (runReaderC' externalCell) -< (eIn, a) 36 | arrM (liftIO . putMVar outVar) -< eOut 37 | returnA -< b 38 | externalLoop = arrM (putMVar inVar) >>> constM (takeMVar outVar) 39 | return (cell, externalLoop) 40 | 41 | type CellHandle a b = MVar (Cell IO a b) 42 | 43 | makeHandle :: Cell IO a b -> IO (CellHandle a b) 44 | makeHandle = newMVar 45 | 46 | stepHandle :: CellHandle a b -> a -> IO b 47 | stepHandle handle a = modifyMVar handle $ \cell -> do 48 | (b, cell') <- step cell a 49 | return (cell', b) 50 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/GHCi.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | {- | Support functions to call common live coding functionalities like launching and reloading 7 | from a @ghci@ or @cabal repl@ session. 8 | 9 | You typically don't need to import this module in your code, 10 | but you should load it in your interactive session, 11 | ideally by copying the file `essence-of-live-coding/.ghci` to your project, 12 | adjusting it to your needs and launching @cabal repl@. 13 | -} 14 | module LiveCoding.GHCi where 15 | 16 | -- base 17 | import Control.Concurrent 18 | import Control.Exception (Exception (displayException, toException), SomeException, try) 19 | import Control.Monad (join, void, (>=>)) 20 | import Data.Data 21 | import Data.Function ((&)) 22 | 23 | -- transformers 24 | import Control.Monad.Trans.State.Strict 25 | 26 | -- foreign-store 27 | import Foreign.Store 28 | 29 | -- essence-of-live-coding 30 | import LiveCoding.LiveProgram 31 | import LiveCoding.RuntimeIO.Launch 32 | 33 | proxyFromLiveProgram :: LiveProgram m -> Proxy m 34 | proxyFromLiveProgram _ = Proxy 35 | 36 | -- | An exception type marking the absence of a foreign store of the correct type. 37 | data NoStore = NoStore 38 | deriving (Show) 39 | 40 | instance Exception NoStore 41 | 42 | -- * Retrieving launched programs from the foreign store 43 | 44 | {- | Try to retrieve a 'LiveProgram' of a given type from the 'Store', 45 | handling all 'IO' exceptions. 46 | Returns 'Right Nothing' if the store didn't exist. 47 | -} 48 | possiblyLaunchedProgram :: 49 | (Launchable m) => 50 | Proxy m -> 51 | IO (Either SomeException (LaunchedProgram m)) 52 | possiblyLaunchedProgram _ = do 53 | storeMaybe <- lookupStore 0 54 | fmap join $ try $ traverse readStore $ maybe (Left $ toException NoStore) Right storeMaybe 55 | 56 | {- | Try to load a 'LiveProgram' of a given type from the 'Store'. 57 | If the store doesn't contain a program, it is (re)started. 58 | -} 59 | sync :: (Launchable m) => LiveProgram m -> IO () 60 | sync program = do 61 | launchedProgramPossibly <- possiblyLaunchedProgram $ proxyFromLiveProgram program 62 | case launchedProgramPossibly of 63 | -- Looking up the store failed in some way, restart 64 | Left (e :: SomeException) -> do 65 | putStrLn $ displayException e 66 | launchAndSave program 67 | 68 | -- A program is running, update it 69 | Right launchedProgram -> do 70 | putStrLn "update" 71 | update launchedProgram program 72 | 73 | -- | Launch a 'LiveProgram' and save it in the 'Store'. 74 | launchAndSave :: (Launchable m) => LiveProgram m -> IO () 75 | launchAndSave = launch >=> save 76 | 77 | -- | Save a 'LiveProgram' to the store. 78 | save :: (Launchable m) => LaunchedProgram m -> IO () 79 | save = writeStore $ Store 0 80 | 81 | {- | Try to retrieve a 'LaunchedProgram' from the 'Store', 82 | and if successful, stop it. 83 | -} 84 | stopStored :: 85 | (Launchable m) => 86 | Proxy m -> 87 | IO () 88 | stopStored proxy = do 89 | launchedProgramPossibly <- possiblyLaunchedProgram proxy 90 | either (putStrLn . displayException) stop launchedProgramPossibly 91 | 92 | -- * GHCi commands 93 | 94 | -- ** Debugging 95 | 96 | -- TODO Could also parametrise this and all other commands by the 'liveProgram' 97 | 98 | {- | Initialise a launched program in the store, 99 | but don't start it. 100 | -} 101 | liveinit _ = 102 | return $ 103 | unlines 104 | [ "programVar <- newMVar liveProgram" 105 | , "threadId <- myThreadId" 106 | , "save LaunchedProgram { .. }" 107 | ] 108 | 109 | -- | Run one program step, assuming you have a launched program in a variable @launchedProgram@. 110 | livestep _ = return "stepLaunchedProgram launchedProgram" 111 | 112 | -- ** Running 113 | 114 | -- | Launch or restart a program and save its reference in the store. 115 | livelaunch _ = return "sync liveProgram" 116 | 117 | -- | Reload the code and do hot code swap and migration. 118 | livereload _ = 119 | return $ 120 | unlines 121 | [ ":reload" 122 | , "sync liveProgram" 123 | ] 124 | 125 | -- | Stop the program. 126 | livestop _ = return "stopStored $ proxyFromLiveProgram liveProgram" 127 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Handle/Examples.hs: -------------------------------------------------------------------------------- 1 | module LiveCoding.Handle.Examples where 2 | 3 | -- base 4 | import Control.Concurrent 5 | import Data.Data 6 | import Data.IORef 7 | 8 | -- essence-of-live-coding 9 | import LiveCoding.Handle 10 | 11 | -- | Create an 'IORef', with no special cleanup action. 12 | ioRefHandle :: a -> Handle IO (IORef a) 13 | ioRefHandle a = 14 | Handle 15 | { create = newIORef a 16 | , destroy = const $ return () -- IORefs are garbage collected 17 | } 18 | 19 | -- | Create an uninitialised 'MVar', with no special cleanup action. 20 | emptyMVarHandle :: Handle IO (MVar a) 21 | emptyMVarHandle = 22 | Handle 23 | { create = newEmptyMVar 24 | , destroy = const $ return () -- MVars are garbage collected 25 | } 26 | 27 | {- | Create an 'MVar' initialised to some value @a@, 28 | with no special cleanup action. 29 | -} 30 | newMVarHandle :: a -> Handle IO (MVar a) 31 | newMVarHandle a = 32 | Handle 33 | { create = newMVar a 34 | , destroy = const $ return () -- MVars are garbage collected 35 | } 36 | 37 | {- | Launch a thread executing the given action 38 | and kill it when the handle is removed. 39 | -} 40 | threadHandle :: IO () -> Handle IO ThreadId 41 | threadHandle action = 42 | Handle 43 | { create = forkIO action 44 | , destroy = killThread 45 | } 46 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/LiveProgram/Except.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {- | Live programs in the @'ExceptT' e m@ monad can stop execution by throwing an exception @e@. 5 | 6 | Handling these exceptions is done by realising that live programs in fact form a monad in the exception type. 7 | The interface is analogous to 'CellExcept'. 8 | -} 9 | module LiveCoding.LiveProgram.Except where 10 | 11 | -- base 12 | import Control.Monad (ap, liftM) 13 | import Data.Data 14 | import Data.Void (Void) 15 | 16 | -- transformers 17 | import Control.Monad.Trans.Except 18 | import Control.Monad.Trans.Reader 19 | 20 | -- essence-of-live-coding 21 | import LiveCoding.Cell (constM, hoistCell, liveCell, toLiveCell) 22 | import LiveCoding.CellExcept (CellExcept, once_, runCellExcept) 23 | import qualified LiveCoding.CellExcept as CellExcept 24 | import LiveCoding.Exceptions.Finite (Finite) 25 | import LiveCoding.Forever 26 | import LiveCoding.LiveProgram 27 | 28 | {- | A live program that can throw an exception. 29 | 30 | * @m@: The monad in which the live program operates. 31 | * @e@: The type of exceptions the live program can eventually throw. 32 | 33 | 'LiveProgramExcept' is a monad in the exception type. 34 | This means that it is possible to chain several live programs, 35 | where later programs can handle the exceptions thrown by the earlier ones. 36 | 'return' plays the role of directly throwing an exception. 37 | '(>>=)' lets a handler decide which program to handle the exception with. 38 | 39 | The interface is the basically the same as 'CellExcept', 40 | and it is in fact a newtype around it. 41 | -} 42 | newtype LiveProgramExcept m e = LiveProgramExcept 43 | {unLiveProgramExcept :: CellExcept () () m e} 44 | deriving (Functor, Applicative, Monad) 45 | 46 | -- | Execute a 'LiveProgramExcept', throwing its exceptions in the 'ExceptT' monad. 47 | runLiveProgramExcept :: 48 | (Monad m) => 49 | LiveProgramExcept m e -> 50 | LiveProgram (ExceptT e m) 51 | runLiveProgramExcept LiveProgramExcept {..} = liveCell $ runCellExcept unLiveProgramExcept 52 | 53 | {- | Lift a 'LiveProgram' into the 'LiveProgramExcept' monad. 54 | 55 | Similar to 'LiveProgram.CellExcept.try'. 56 | This will execute the live program until it throws an exception. 57 | -} 58 | try :: 59 | (Data e, Finite e, Functor m) => 60 | LiveProgram (ExceptT e m) -> 61 | LiveProgramExcept m e 62 | try = LiveProgramExcept . CellExcept.try . toLiveCell 63 | 64 | {- | Safely convert to 'LiveProgram's. 65 | 66 | If the type of possible exceptions is empty, 67 | no exceptions can be thrown, 68 | and thus we can safely assume that it is a 'LiveProgram' in @m@. 69 | -} 70 | safely :: 71 | (Monad m) => 72 | LiveProgramExcept m Void -> 73 | LiveProgram m 74 | safely = liveCell . CellExcept.safely . unLiveProgramExcept 75 | 76 | {- | Run a 'LiveProgram' as a 'LiveProgramExcept'. 77 | 78 | This is always safe in the sense that it has no exceptions. 79 | -} 80 | safe :: 81 | (Monad m) => 82 | LiveProgram m -> 83 | LiveProgramExcept m Void 84 | safe = LiveProgramExcept . CellExcept.safe . toLiveCell 85 | 86 | -- | Run a monadic action and immediately raise its result as an exception. 87 | once :: (Monad m, Data e, Finite e) => m e -> LiveProgramExcept m e 88 | once = LiveProgramExcept . once_ 89 | 90 | {- | Run a 'LiveProgramExcept' in a loop. 91 | 92 | In the additional 'ReaderT e' context, 93 | you can read the last thrown exception. 94 | (For the first iteration, 'e' is set to the first argument to 'foreverELiveProgram'.) 95 | 96 | This way, you can create an infinite loop, 97 | with the exception as the loop variable. 98 | -} 99 | foreverELiveProgram :: 100 | (Data e, Monad m) => 101 | -- | The loop initialisation 102 | e -> 103 | -- | The live program to execute indefinitely 104 | LiveProgramExcept (ReaderT e m) e -> 105 | LiveProgram m 106 | foreverELiveProgram e LiveProgramExcept {..} = liveCell $ foreverE e $ hoistCell commute $ runCellExcept unLiveProgramExcept 107 | where 108 | commute :: ExceptT e (ReaderT r m) a -> ReaderT r (ExceptT e m) a 109 | commute action = ReaderT $ ExceptT . runReaderT (runExceptT action) 110 | 111 | -- | Run a 'LiveProgramExcept' in a loop, discarding the exception. 112 | foreverCLiveProgram :: 113 | (Data e, Monad m) => 114 | LiveProgramExcept m e -> 115 | LiveProgram m 116 | foreverCLiveProgram LiveProgramExcept {..} = liveCell $ foreverC $ runCellExcept unLiveProgramExcept 117 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/LiveProgram/HotCodeSwap.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE ExistentialQuantification #-} 5 | 6 | module LiveCoding.LiveProgram.HotCodeSwap where 7 | 8 | -- essence-of-live-coding 9 | import LiveCoding.LiveProgram 10 | import LiveCoding.Migrate 11 | 12 | \end{code} 13 | \end{comment} 14 | \begin{code} 15 | hotCodeSwap 16 | :: LiveProgram m 17 | -> LiveProgram m 18 | -> LiveProgram m 19 | hotCodeSwap 20 | (LiveProgram newState newStep) 21 | (LiveProgram oldState _) 22 | = LiveProgram 23 | { liveState = migrate newState oldState 24 | , liveStep = newStep 25 | } 26 | \end{code} 27 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/LiveProgram/Monad/Trans.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module LiveCoding.LiveProgram.Monad.Trans where 5 | 6 | -- base 7 | import Data.Data 8 | 9 | -- transformers 10 | import Control.Monad.Trans.State.Strict 11 | 12 | -- essence-of-live-coding 13 | 14 | import LiveCoding.Cell.Monad.Trans 15 | import LiveCoding.LiveProgram 16 | 17 | {- | Remove a stateful effect from the monad stack by supplying the initial state. 18 | This state then becomes part of the internal live program state, 19 | and is subject to migration as any other state. 20 | Live programs are automatically migrated to and from applications of 'runStateL'. 21 | -} 22 | runStateL :: 23 | (Data stateT, Monad m) => 24 | LiveProgram (StateT stateT m) -> 25 | stateT -> 26 | LiveProgram m 27 | runStateL LiveProgram {..} stateT = 28 | LiveProgram 29 | { liveState = State {stateInternal = liveState, ..} 30 | , liveStep = \State {..} -> do 31 | (stateInternal, stateT) <- runStateT (liveStep stateInternal) stateT 32 | return State {..} 33 | } 34 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Migrate/Debugger.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module LiveCoding.Migrate.Debugger where 5 | 6 | -- base 7 | import Data.Data 8 | 9 | -- essence-of-live-coding 10 | import LiveCoding.Debugger 11 | import LiveCoding.Migrate.Migration 12 | 13 | maybeMigrateToDebugging :: 14 | (Typeable state', Typeable state) => 15 | Debugging dbgState state -> 16 | state' -> 17 | Maybe (Debugging dbgState state) 18 | maybeMigrateToDebugging Debugging {dbgState} state' = do 19 | state <- cast state' 20 | return Debugging {..} 21 | 22 | -- | Tries to cast the current state into the joint state of debugger and program. 23 | migrationToDebugging :: Migration 24 | migrationToDebugging = migrationTo2 maybeMigrateToDebugging 25 | 26 | maybeMigrateFromDebugging :: 27 | (Typeable state', Typeable state) => 28 | Debugging dbgState state -> 29 | Maybe state' 30 | maybeMigrateFromDebugging Debugging {state} = cast state 31 | 32 | -- | Try to extract a state from the current joint state of debugger and program. 33 | migrationFromDebugging :: Migration 34 | migrationFromDebugging = constMigrationFrom2 maybeMigrateFromDebugging 35 | 36 | -- | Combines 'migrationToDebugging' and 'migrationFromDebugging'. 37 | migrationDebugging :: Migration 38 | migrationDebugging = migrationToDebugging <> migrationFromDebugging 39 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Migrate/Migration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | 3 | module LiveCoding.Migrate.Migration where 4 | 5 | -- base 6 | import Control.Monad (guard) 7 | import Data.Data 8 | import Data.Maybe (fromMaybe) 9 | import Data.Monoid 10 | 11 | -- syb 12 | import Data.Generics.Aliases 13 | import Data.Generics.Schemes (glength) 14 | 15 | data Migration = Migration 16 | {runMigration :: forall a b. (Data a, Data b) => a -> b -> Maybe a} 17 | 18 | -- | Run a migration and insert the new initial state in case of failure. 19 | runSafeMigration :: 20 | (Data a, Data b) => 21 | Migration -> 22 | a -> 23 | b -> 24 | a 25 | runSafeMigration migration a b = fromMaybe a $ runMigration migration a b 26 | 27 | -- | If both migrations would succeed, the result from the first is used. 28 | instance Semigroup Migration where 29 | migration1 <> migration2 = Migration $ \a b -> 30 | getFirst $ 31 | (First $ runMigration migration1 a b) 32 | <> (First $ runMigration migration2 a b) 33 | 34 | instance Monoid Migration where 35 | mempty = Migration $ const $ const Nothing 36 | 37 | -- | Try to migrate by casting the first type into the second 38 | castMigration :: Migration 39 | castMigration = Migration $ const cast 40 | 41 | -- | Migrate a value into a newtype wrapping 42 | newtypeMigration :: Migration 43 | newtypeMigration = Migration $ \a b -> do 44 | -- Is it an algebraic datatype with a single constructor? 45 | AlgRep [_constr] <- return $ dataTypeRep $ dataTypeOf a 46 | -- Does the constructor have a single argument? 47 | guard $ glength a == 1 48 | -- Try to cast the single child to b 49 | gmapM (const $ cast b) a 50 | 51 | {- | If you have a specific type that you would like to be migrated to a specific other type, 52 | you can create a migration for this. 53 | For example: @userMigration (toInteger :: Int -> Integer)@ 54 | -} 55 | userMigration :: 56 | (Typeable c, Typeable d) => 57 | (c -> d) -> 58 | Migration 59 | userMigration specific = Migration $ \_a b -> cast =<< specific <$> cast b 60 | 61 | migrationTo2 :: 62 | (Typeable t) => 63 | (forall a b c. (Typeable a, Typeable b, Typeable c) => t b c -> a -> Maybe (t b c)) -> 64 | Migration 65 | migrationTo2 f = Migration $ \t a -> ext2M (const Nothing) (flip f a) t 66 | 67 | constMigrationFrom2 :: 68 | (Typeable t) => 69 | (forall a b c. (Typeable a, Typeable b, Typeable c) => t b c -> Maybe a) -> 70 | Migration 71 | constMigrationFrom2 f = Migration $ \_ t -> ext2Q (const Nothing) f t 72 | 73 | migrationTo1 :: 74 | (Typeable t) => 75 | (forall a b. (Typeable a, Typeable b) => t b -> a -> Maybe (t b)) -> 76 | Migration 77 | migrationTo1 f = Migration $ \t a -> ext1M (const Nothing) (flip f a) t 78 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Migrate/Monad/Trans.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module LiveCoding.Migrate.Monad.Trans where 5 | 6 | -- base 7 | import Data.Data 8 | 9 | -- essence-of-live-coding 10 | import LiveCoding.Cell.Monad.Trans 11 | import LiveCoding.Migrate.Migration 12 | 13 | maybeMigrateToState :: 14 | (Typeable stateInternal', Typeable stateInternal) => 15 | State stateT stateInternal -> 16 | stateInternal' -> 17 | Maybe (State stateT stateInternal) 18 | maybeMigrateToState State {stateT} stateInternal' = do 19 | stateInternal <- cast stateInternal' 20 | return State {..} 21 | 22 | {- | Tries to cast the current state into the joint state of a program 23 | where a state effect has been absorbed into the internal state with 'runStateL' or 'runStateC'. 24 | -} 25 | migrationToState :: Migration 26 | migrationToState = migrationTo2 maybeMigrateToState 27 | 28 | maybeMigrateFromState :: 29 | (Typeable stateInternal', Typeable stateInternal) => 30 | State stateT stateInternal -> 31 | Maybe stateInternal' 32 | maybeMigrateFromState State {stateInternal} = cast stateInternal 33 | 34 | -- | Try to extract a state from the current joint state of a program wrapped with 'runStateL' or 'runStateC'. 35 | migrationFromState :: Migration 36 | migrationFromState = constMigrationFrom2 maybeMigrateFromState 37 | 38 | -- | Combines 'migrationToState' and 'migrationFromState'. 39 | migrationState :: Migration 40 | migrationState = migrationToState <> migrationFromState 41 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Migrate/NoMigration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE DeriveTraversable #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | {- | 6 | Module : LiveCoding.Migrate.NoMigration 7 | Description : Mechanism to save state in a Cell without requiring a Data instance. 8 | 9 | If a data type is wrapped in 'NoMigration' then it can be used as the state of a 'Cell' 10 | without requiring it to have a 'Data' instance. The consequence is that if the type has changed 11 | in between a livereload, then the previous saved value will be discarded, and no migration attempt 12 | will happen. 13 | 14 | 'LiveCoding' does not export 'delay' and 'changes' from this module. These functions should be 15 | used with a qualified import. 16 | -} 17 | module LiveCoding.Migrate.NoMigration where 18 | 19 | -- base 20 | 21 | import Control.Arrow (Arrow (arr, second), returnA, (>>>)) 22 | import Control.Monad (guard) 23 | import Data.Data ( 24 | Constr, 25 | Data (dataTypeOf, gunfold, toConstr), 26 | DataType, 27 | Fixity (Prefix), 28 | Typeable, 29 | mkConstr, 30 | mkDataType, 31 | ) 32 | 33 | -- essence-of-live-coding 34 | import LiveCoding.Cell 35 | import qualified LiveCoding.Cell.Feedback as Feedback 36 | import LiveCoding.Cell.Monad (hoistCellKleisli) 37 | 38 | -- * 'NoMigration' data type and 'Data' instance. 39 | 40 | {- | Isomorphic to @'Maybe' a@ but has a different 'Data' instance. The 'Data' instance for @'NoMigration' a@ doesn't require a 'Data' instance for @a@. 41 | 42 | If a data type is wrapped in 'NoMigration' then it can be used as the state of a 'Cell' 43 | without requiring it to have a 'Data' instance. The consequence is that if the type has changed 44 | in between a livereload, then the previous saved value will be discarded, and no migration attempt 45 | will happen. 46 | -} 47 | data NoMigration a = Initialized a | Uninitialized 48 | deriving (Show, Eq, Functor, Foldable, Traversable) 49 | 50 | fromNoMigration :: a -> NoMigration a -> a 51 | fromNoMigration _ (Initialized a) = a 52 | fromNoMigration a Uninitialized = a 53 | 54 | dataTypeNoMigration :: DataType 55 | dataTypeNoMigration = mkDataType "NoMigration" [initializedConstr, uninitializedConstr] 56 | 57 | initializedConstr :: Constr 58 | initializedConstr = mkConstr dataTypeNoMigration "Initialized" [] Prefix 59 | 60 | uninitializedConstr :: Constr 61 | uninitializedConstr = mkConstr dataTypeNoMigration "Uninitialized" [] Prefix 62 | 63 | -- | The Data instance for @'NoMigration' a@ doesn't require a 'Data' instance for @a@. 64 | instance (Typeable a) => Data (NoMigration a) where 65 | dataTypeOf _ = dataTypeNoMigration 66 | toConstr (Initialized _) = initializedConstr 67 | toConstr Uninitialized = uninitializedConstr 68 | gunfold _cons nil _ = nil Uninitialized 69 | 70 | -- * Utility functions which internally use 'NoMigration'. 71 | 72 | {- | Like 'Feedback.delay', but doesn't require 'Data' instance, and only migrates the 73 | last value if it still has the same type. 74 | -} 75 | delay :: (Monad m, Typeable a) => a -> Cell m a a 76 | delay a = arr Initialized >>> Feedback.delay Uninitialized >>> arr (fromNoMigration a) 77 | 78 | {- | Like 'Utils.changes', but doesn't require Data instance, and only migrates the last 79 | value if it still is of the same type. 80 | -} 81 | changes :: (Typeable a, Eq a, Monad m) => Cell m a (Maybe a) 82 | changes = proc a -> do 83 | aLast <- delay Nothing -< Just a 84 | returnA 85 | -< do 86 | aLast' <- aLast 87 | guard $ a /= aLast' 88 | return a 89 | 90 | {- | Caching version of 'arrM'. 91 | 92 | Only runs the computation in @m@ when the input value 93 | changes. Meanwhile it keeps outputing the last outputted value. Also runs the computation 94 | on the first tick. Does not require 'Data' instance. On `:livereload` will run action again on 95 | first tick. 96 | -} 97 | arrChangesM :: (Monad m, Typeable a, Typeable b, Eq a) => (a -> m b) -> Cell m a b 98 | arrChangesM f = Cell {cellState = Uninitialized, ..} 99 | where 100 | cellStep Uninitialized a = h a 101 | cellStep (Initialized (a', b)) a = 102 | if a == a' 103 | then return (b, Initialized (a, b)) 104 | else h a 105 | h a = (\b' -> (b', Initialized (a, b'))) <$> f a 106 | 107 | cellNoMigration :: (Typeable s, Functor m) => s -> (s -> a -> m (b, s)) -> Cell m a b 108 | cellNoMigration state step = Cell {cellState = Uninitialized, ..} 109 | where 110 | cellStep Uninitialized a = second Initialized <$> step state a 111 | cellStep (Initialized s) a = second Initialized <$> step s a 112 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | module LiveCoding.Preliminary.CellExcept where 7 | 8 | -- base 9 | import Control.Arrow 10 | import Data.Data 11 | import Data.Either (fromRight) 12 | import Data.Void 13 | 14 | -- transformers 15 | import Control.Monad.Trans.Reader 16 | import Control.Monad.Trans.Except 17 | 18 | -- essence-of-live-coding 19 | import LiveCoding.Cell 20 | import LiveCoding.Preliminary.CellExcept.Applicative 21 | import LiveCoding.Exceptions 22 | \end{code} 23 | \end{comment} 24 | 25 | \paragraph{Using exceptions} 26 | \fxwarning{We didn't mention the newtype in the last paragraph, this is maybe confusing} 27 | We can enter the \mintinline{haskell}{CellExcept} context from an exception-throwing cell, 28 | trying to execute it until the exception occurs: 29 | \fxerror{This doesn't work here anymore because we haven't explained how it's a newtype. 30 | Also we already know that try needs an extra type class. Take this from the monad section.} 31 | \begin{code} 32 | try 33 | :: Data e 34 | => Cell (ExceptT e m) a b 35 | -> CellExcept a b m e 36 | try = CellExcept id 37 | \end{code} 38 | And we can leave it safely once we have proven that there are no exceptions left to throw, 39 | i.e. the exception type is empty (represented in Haskell by \mintinline{haskell}{Void}): 40 | \fxerror{I'm using runCellExcept which wasn't explained yet} 41 | \begin{code} 42 | safely 43 | :: Monad m 44 | => CellExcept a b m Void 45 | -> Cell m a b 46 | safely = hoistCell discardVoid . runCellExcept 47 | 48 | discardVoid 49 | :: Functor m 50 | => ExceptT Void m a 51 | -> m a 52 | discardVoid 53 | = fmap (either absurd id) . runExceptT 54 | \end{code} 55 | One way to prove the absence of further exceptions is, 56 | of course, to run an exception-free cell: 57 | \begin{code} 58 | safe :: Monad m => Cell m a b -> CellExcept a b m void 59 | safe cell = CellExcept 60 | { fmapExcept = absurd 61 | , cellExcept = liftCell cell 62 | } 63 | \end{code} 64 | If we want to leave an exception unhandled, 65 | this is also possible: 66 | \begin{code} 67 | runCellExcept 68 | :: Monad m 69 | => CellExcept a b m e 70 | -> Cell (ExceptT e m) a b 71 | runCellExcept CellExcept { .. } 72 | = hoistCell (withExceptT fmapExcept) 73 | cellExcept 74 | \end{code} 75 | This is especially useful for shutting down a live program gracefully, 76 | using \mintinline{haskell}{e} as the exit code. 77 | \fxerror{But we haven't implemented that yet. And also can only do that with a more general "reactimate"} 78 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept/Applicative.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE TupleSections #-} 6 | 7 | module LiveCoding.Preliminary.CellExcept.Applicative where 8 | 9 | -- base 10 | import Data.Data 11 | 12 | -- transformers 13 | import Control.Monad.Trans.Except 14 | import Control.Monad.Trans.Reader 15 | 16 | -- essence-of-live-coding 17 | import LiveCoding.Cell 18 | import LiveCoding.Exceptions 19 | 20 | \end{code} 21 | \end{comment} 22 | 23 | \paragraph{Applying it to \mintinline{haskell}{Applicative}} 24 | If we are allowed to read the first exception during the execution of the second cell, 25 | we can simply re-raise it once the second exception is thrown: 26 | \begin{code} 27 | andThen 28 | :: (Data e1, Monad m) 29 | => Cell (ExceptT e1 m) a b 30 | -> Cell (ExceptT e2 m) a b 31 | -> Cell (ExceptT (e1, e2) m) a b 32 | cell1 `andThen` Cell { .. } = cell1 >>>= Cell 33 | { cellStep = \state (e1, a) -> 34 | withExceptT (e1, ) $ cellStep state a 35 | , .. 36 | } 37 | \end{code} 38 | 39 | \begin{comment} 40 | \begin{code} 41 | cell1 `andThen` cell2 = cell1 `andThen` toCell cell2 42 | \end{code} 43 | 44 | \begin{spec} 45 | hoistCell readException cell2 46 | where 47 | readException 48 | :: Functor m 49 | => ExceptT e2 m x 50 | -> ReaderT e1 (ExceptT(e1, e2) m) x 51 | readException exception = ReaderT 52 | $ \e1 -> withExceptT (e1, ) exception 53 | \end{spec} 54 | \end{comment} 55 | Given two \mintinline{haskell}{Cell}s, 56 | the first may throw an exception, 57 | upon which the second cell gains control. 58 | As soon as it throws a second exception, 59 | both exceptions are thrown as a tuple. 60 | 61 | At this point, we unfortunately have to give up the efficient \mintinline{haskell}{newtype}. 62 | The spoilsport is, again the type class \mintinline{haskell}{Data}, 63 | to which the exception type \mintinline{haskell}{e1} is subjected 64 | (since the exception must be stored during the execution of the second cell). 65 | But the issue is minor, 66 | it is fixed by defining the \emph{free functor}, 67 | or \emph{Co-Yoneda construction}: 68 | \fxwarning{Maybe cite http://comonad.com/reader/2016/adjoint-triples/ or search something else} 69 | \fxwarning{Possible other names: Mode} 70 | \begin{code} 71 | data CellExcept a b m e = forall e' . 72 | Data e' => CellExcept 73 | { fmapExcept :: e' -> e 74 | , cellExcept :: Cell (ExceptT e' m) a b 75 | } 76 | \end{code} 77 | While ensuring that we only store cells with exceptions that can be \emph{bound}, 78 | we do not restrict the parameter type \mintinline{haskell}{e}. 79 | 80 | It is known that this construction gives rise to a \mintinline{haskell}{Functor} instance for free: 81 | \begin{code} 82 | instance Functor (CellExcept a b m) where 83 | fmap f CellExcept { .. } = CellExcept 84 | { fmapExcept = f . fmapExcept 85 | , .. 86 | } 87 | \end{code} 88 | 89 | The \mintinline{haskell}{Applicative} instance arises from the work we have done so far. 90 | \mintinline{haskell}{pure} is implemented by throwing a unit and transforming it to the required exception, 91 | while sequential application is a bookkeeping exercise around the previously defined function \mintinline{haskell}{andThen}: 92 | \begin{code} 93 | instance Monad m 94 | => Applicative (CellExcept a b m) where 95 | pure e = CellExcept 96 | { fmapExcept = const e 97 | , cellExcept = constM $ throwE () 98 | } 99 | 100 | CellExcept fmap1 cell1 <*> 101 | CellExcept fmap2 cell2 = CellExcept { .. } 102 | where 103 | fmapExcept (e1, e2) = fmap1 e1 104 | $ fmap2 e2 105 | cellExcept = cell1 `andThen` cell2 106 | \end{code} 107 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Preliminary/CellExcept/Newtype.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | module LiveCoding.Preliminary.CellExcept.Newtype where 4 | 5 | -- base 6 | import Control.Arrow 7 | import Data.Void 8 | 9 | -- transformers 10 | import Control.Monad.Trans.Except 11 | 12 | -- essence-of-live-coding 13 | import LiveCoding.Cell 14 | import LiveCoding.Exceptions 15 | \end{code} 16 | \end{comment} 17 | 18 | \subsection{Control Flow Context} 19 | \label{sec:control flow context} 20 | %\paragraph{Wrapping exceptions} 21 | Inspired by \cite[Section 2, "Control Flow through Exceptions"]{Rhine}, 22 | %we create our own control flow context, 23 | %by introducing a newtype: 24 | we introduce a newtype: 25 | 26 | \begin{code} 27 | newtype CellExcept a b m e = CellExcept 28 | { runCellExcept :: Cell (ExceptT e m) a b } 29 | \end{code} 30 | 31 | We can enter the \mintinline{haskell}{CellExcept} context from an exception-throwing cell, 32 | trying to execute it until the exception occurs: 33 | \begin{code} 34 | try 35 | :: Cell (ExceptT e m) a b 36 | -> CellExcept a b m e 37 | try = CellExcept 38 | \end{code} 39 | And we can leave it safely once we have proven that there are no exceptions left to throw, 40 | i.e. the exception type is empty (represented in Haskell by \mintinline{haskell}{Void}): 41 | \begin{code} 42 | safely 43 | :: Monad m 44 | => CellExcept a b m Void 45 | -> Cell m a b 46 | \end{code} 47 | \begin{comment} 48 | \begin{code} 49 | safely = hoistCell discardVoid . runCellExcept 50 | where 51 | discardVoid 52 | = fmap (either absurd id) . runExceptT 53 | \end{code} 54 | \end{comment} 55 | One way to prove the absence of further exceptions is, 56 | of course, to run an exception-free cell: 57 | \begin{code} 58 | safe 59 | :: Monad m 60 | => Cell m a b 61 | -> CellExcept a b m Void 62 | \end{code} 63 | \begin{comment} 64 | \begin{code} 65 | safe cell = CellExcept $ liftCell cell 66 | \end{code} 67 | \end{comment} 68 | 69 | \paragraph{The Return of the Monad} 70 | Our new hope is to give \mintinline{haskell}{Functor}, \mintinline{haskell}{Applicative} and \mintinline{haskell}{Monad} instances to \mintinline{haskell}{CellExcept}. 71 | We will explore now how this allows for rich control flow. 72 | 73 | The \mintinline{haskell}{Functor} instance is not too hard. 74 | When an exception is raised, 75 | we simply apply a given function to it: 76 | \begin{code} 77 | instance Functor m 78 | => Functor (CellExcept a b m) where 79 | fmap f (CellExcept cell) = CellExcept 80 | $ hoistCell (withExceptT f) cell 81 | \end{code} 82 | 83 | The \mintinline{haskell}{pure} function of the \mintinline{haskell}{Applicative} class 84 | (or equivalently, \mintinline{haskell}{return} of the \mintinline{haskell}{Monad}), 85 | is simply throwing an exception, 86 | wrapped in the newtype: 87 | \begin{code} 88 | pure 89 | :: Monad m 90 | => e 91 | -> CellExcept a b m e 92 | pure e = CellExcept $ arr (const e) >>> throwC 93 | \end{code} 94 | 95 | Like the sequential application operator \mintinline{haskell}{<*>} from the \mintinline{haskell}{Applicative} class 96 | can be defined from the bind operator \mintinline{haskell}{>>=}, 97 | it can also be defined from the \emph{live bind} operator \mintinline{haskell}{>>>=} introduced previously. 98 | As a technical tour-de-force, 99 | even a \mintinline{haskell}{Monad} instance for \mintinline{haskell}{CellExcept} can be derived with some modifications. 100 | This is shown at length in an appendix\footnote{% 101 | Available online at \href{https://www.manuelbaerenz.de/essence-of-live-coding/EssenceOfLiveCodingAppendix.pdf}{https://www.manuelbaerenz.de/essence-of-live-coding/EssenceOfLiveCodingAppendix.pdf}. 102 | }. 103 | 104 | But how can \mintinline{haskell}{Applicative} and \mintinline{haskell}{Monad} be put to use? 105 | The foreground value of \mintinline{haskell}{CellExcept} is the thrown exception. 106 | With \mintinline{haskell}{pure}, such values are created, 107 | and \mintinline{haskell}{Functor} allows us to perform computations with them. 108 | With \mintinline{haskell}{Applicative} and \mintinline{haskell}{Monad}, 109 | we \emph{chain} the execution of exception throwing cells: 110 | \fxwarning{Comment on how Monad is even stronger than Applicative?} 111 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Preliminary/LiveProgram/HotCodeSwap.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | module LiveCoding.Preliminary.LiveProgram.HotCodeSwap where 6 | 7 | -- base 8 | import Control.Concurrent 9 | import Control.Monad (forever) 10 | 11 | -- essence-of-live-coding 12 | import LiveCoding.Preliminary.LiveProgram.LiveProgramPreliminary 13 | \end{code} 14 | \end{comment} 15 | 16 | \begin{figure} 17 | \begin{code} 18 | hotCodeSwap 19 | :: (s -> s') 20 | -> LiveProgram m s' 21 | -> LiveProgram m s 22 | -> LiveProgram m s' 23 | hotCodeSwap migrate newProgram oldProgram 24 | = LiveProgram 25 | { liveState = migrate $ liveState oldProgram 26 | , liveStep = liveStep newProgram 27 | } 28 | \end{code} 29 | \caption{\texttt{Preliminary/HotCodeSwap.lhs}} 30 | \label{fig:hot code swap} 31 | \end{figure} 32 | \fxwarning{The thing with the MVar doesn't work on the spot anymore. But it can still work with a "typed" handle. Every time you swap, you get a new handle that carries the currently saved type. Worth commenting upon? 33 | It's somewhat complicated: We have to kill the old MVar and create a new one every time we update. Then we also have to update the ticking function} 34 | \begin{comment} 35 | \begin{code} 36 | type LiveRef s = (MVar (LiveProgram IO s), MVar (IO ())) 37 | launch :: LiveProgram IO s -> IO (LiveRef s) 38 | launch liveProg = do 39 | progVar <- newMVar liveProg 40 | tickVar <- newMVar $ tick progVar 41 | forkIO $ forever $ do 42 | action <- takeMVar tickVar 43 | action 44 | tryPutMVar tickVar action 45 | return (progVar, tickVar) 46 | 47 | tick :: MVar (LiveProgram IO s) -> IO () 48 | tick var = do 49 | LiveProgram {..} <- takeMVar var 50 | liveState' <- liveStep liveState 51 | putMVar var LiveProgram { liveState = liveState', .. } 52 | 53 | swapWith :: (s -> s') -> LiveProgram IO s' -> LiveRef s -> IO (LiveRef s') 54 | swapWith migrate (LiveProgram _newState newStep) (progVar, actionVar) = do 55 | _ <- takeMVar actionVar 56 | LiveProgram oldState oldStep <- takeMVar progVar 57 | let newProg = LiveProgram (migrate oldState) newStep 58 | newProgVar <- newMVar newProg 59 | putMVar actionVar $ tick newProgVar 60 | return (newProgVar, actionVar) 61 | \end{code} 62 | \end{comment} 63 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Preliminary/LiveProgram/LiveProgram2.lhs: -------------------------------------------------------------------------------- 1 | \begin{figure} 2 | \begin{comment} 3 | \begin{code} 4 | {-# LANGUAGE ExistentialQuantification #-} 5 | 6 | module LiveCoding.Preliminary.LiveProgram.LiveProgram2 where 7 | 8 | -- base 9 | import Data.Data 10 | \end{code} 11 | \end{comment} 12 | \begin{code} 13 | data LiveProgram = forall s . Data s 14 | => LiveProgram 15 | { liveState :: s 16 | , liveStep :: s -> IO s 17 | } 18 | \end{code} 19 | \fxerror{Compile these as well} 20 | \caption{\texttt{LiveProgram2.lhs}} 21 | \label{fig:LiveProgram2} 22 | \end{figure} 23 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/Preliminary/LiveProgram/LiveProgramPreliminary.lhs: -------------------------------------------------------------------------------- 1 | \begin{figure} 2 | \begin{comment} 3 | \begin{code} 4 | {-# LANGUAGE RecordWildCards #-} 5 | 6 | module LiveCoding.Preliminary.LiveProgram.LiveProgramPreliminary where 7 | 8 | -- base 9 | import Control.Concurrent 10 | import Control.Monad (forever) 11 | 12 | \end{code} 13 | \end{comment} 14 | \begin{code} 15 | data LiveProgram m s = LiveProgram 16 | { liveState :: s 17 | , liveStep :: s -> m s 18 | } 19 | \end{code} 20 | \begin{code} 21 | stepProgram 22 | :: Monad m 23 | => LiveProgram m s -> m (LiveProgram m s) 24 | stepProgram liveProgram@LiveProgram { .. } = do 25 | liveState' <- liveStep liveState 26 | return liveProgram { liveState = liveState' } 27 | \end{code} 28 | \fxerror{Maybe I should use modifyMVar here?} 29 | \begin{code} 30 | stepProgramMVar 31 | :: MVar (LiveProgram IO s) 32 | -> IO () 33 | stepProgramMVar var = do 34 | currentProgram <- takeMVar var 35 | nextProgram <- stepProgram currentProgram 36 | putMVar var nextProgram 37 | \end{code} 38 | \begin{code} 39 | launch 40 | :: LiveProgram IO s 41 | -> IO (MVar (LiveProgram IO s)) 42 | launch liveProgram = do 43 | var <- newMVar liveProgram 44 | forkIO $ forever $ stepProgramMVar var 45 | return var 46 | \end{code} 47 | \caption{\texttt{LiveProgramPreliminary.lhs}} 48 | \label{fig:LiveProgramPreliminary} 49 | \end{figure} 50 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/RuntimeIO.lhs: -------------------------------------------------------------------------------- 1 | \begin{comment} 2 | \begin{code} 3 | {-# LANGUAGE BangPatterns #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | module LiveCoding.RuntimeIO where 8 | 9 | -- base 10 | import Control.Arrow 11 | import Control.Concurrent 12 | import Control.Monad 13 | import Data.Data 14 | 15 | -- essence-of-live-coding 16 | import LiveCoding.LiveProgram 17 | import LiveCoding.LiveProgram.HotCodeSwap 18 | import LiveCoding.Debugger 19 | import LiveCoding.Migrate 20 | import LiveCoding.RuntimeIO.Launch hiding (foreground) 21 | \end{code} 22 | \end{comment} 23 | 24 | \section{The Runtime} 25 | \label{sec:runtime} 26 | 27 | \subsection{Hands on Interaction} 28 | Enough declaration. 29 | Let us get semantic and run some live programs! 30 | In the preliminary version, 31 | a function \mintinline{haskell}{stepProgram} implemented a single execution step, 32 | and it can be reused here, 33 | up to removing the explicit state type. 34 | The runtime behaviour of a live program is defined by calling this function repeatedly. 35 | We could of course run the program in the foreground thread: 36 | \begin{code} 37 | foreground :: Monad m => LiveProgram m -> m () 38 | foreground liveProgram = do 39 | liveProgram' <- stepProgram liveProgram 40 | foreground liveProgram' 41 | \end{code} 42 | But this would leave no possibility to exchange the program with a new one. 43 | %But this would then become the main loop, 44 | %and leave no control to exchange the program with a new one. 45 | Instead, we can store the program in an \mintinline{haskell}{MVar} 46 | and call \mintinline{haskell}{stepProgramMVar} on it. 47 | Now that we can migrate any \mintinline{haskell}{Data}, 48 | we can follow the original plan of exchanging the live program in mid-execution: 49 | \begin{code} 50 | update 51 | :: MVar (LiveProgram IO) 52 | -> LiveProgram IO 53 | -> IO () 54 | update var newProg = do 55 | oldProg <- takeMVar var 56 | putMVar var $ hotCodeSwap newProg oldProg 57 | \end{code} 58 | The old program is retrieved from the concurrent variable, 59 | migrated to the new state, 60 | and put back for further execution. 61 | And so begins our first live coding session in GHCi 62 | (line breaks added for readability): 63 | \begin{verbatim} 64 | > var <- newMVar $ LiveProgram 0 65 | $ \s -> print s >> return (s + 1) 66 | > stepProgramMVar var 67 | 0 68 | > stepProgramMVar var 69 | 1 70 | > update var $ LiveProgram 0 71 | $ \s -> print s >> return (s - 1) 72 | > stepProgramMVar var 73 | 2 74 | > stepProgramMVar var 75 | 1 76 | > stepProgramMVar var 77 | 0 78 | \end{verbatim} 79 | %When the live program was updated, 80 | Upon updating, 81 | the state was correctly preserved. 82 | The programs were specified in the interactive session here, 83 | but of course we will want to load the program from a file, 84 | and use GHCi's \texttt{:reload} functionality when we have edited it. 85 | But as soon as we do this, 86 | the local binding \mintinline{haskell}{var} is lost. 87 | The package \texttt{foreign-store} \cite{foreign-store} offers a remedy: 88 | \mintinline{haskell}{var} can be stored persistently across reloads. 89 | To facilitate its usage, GHCi macros are defined for the initialisation and reload operations. 90 | 91 | Of course, 92 | it is not intended to enter \texttt{:livestep} repeatedly when coding. 93 | We want to launch a separate thread which executes the steps in the background. 94 | Again, we can reuse the function \mintinline{haskell}{launch}. 95 | (Only the type signature needs updating.) 96 | Using \texttt{ghcid} (``GHCi as a daemon'' \cite{ghcid}), 97 | the launching and reloading operations can be automatically triggered upon starting \texttt{ghcid} and editing the code, 98 | allowing for a smooth live coding experience without any manual intervention. 99 | \fxerror{Update according to the latest sync function} 100 | 101 | In the next subsection, 102 | a full example is shown. 103 | -------------------------------------------------------------------------------- /essence-of-live-coding/src/LiveCoding/RuntimeIO/Launch.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE KindSignatures #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | 7 | module LiveCoding.RuntimeIO.Launch where 8 | 9 | -- base 10 | import Control.Concurrent 11 | import Control.Monad 12 | import Data.Data 13 | 14 | -- transformers 15 | 16 | import Control.Monad.Trans.Except 17 | import Control.Monad.Trans.State.Strict 18 | 19 | -- essence-of-live-coding 20 | 21 | import LiveCoding.Cell.Monad.Trans 22 | import LiveCoding.Debugger 23 | import LiveCoding.Exceptions.Finite (Finite) 24 | import LiveCoding.Handle 25 | import LiveCoding.HandlingState 26 | import LiveCoding.LiveProgram 27 | import LiveCoding.LiveProgram.Except 28 | import LiveCoding.LiveProgram.HotCodeSwap 29 | 30 | {- | Monads in which live programs can be launched in 'IO', 31 | for example when you have special effects that have to be handled on every reload. 32 | 33 | The only thing necessary is to transform the 'LiveProgram' 34 | into one in the 'IO' monad, and the rest is taken care of in the framework. 35 | -} 36 | class (Monad m) => Launchable m where 37 | runIO :: LiveProgram m -> LiveProgram IO 38 | 39 | instance Launchable IO where 40 | runIO = id 41 | 42 | instance (Typeable m, Launchable m) => Launchable (HandlingStateT m) where 43 | runIO = runIO . runHandlingState 44 | 45 | {- | Upon an exception, the program is restarted. 46 | To handle or log the exception, see "LiveCoding.LiveProgram.Except". 47 | -} 48 | instance (Data e, Finite e, Launchable m) => Launchable (ExceptT e m) where 49 | runIO liveProgram = runIO $ foreverCLiveProgram $ try liveProgram 50 | 51 | {- | The standard top level @main@ for a live program. 52 | 53 | Typically, you will define a top level 'LiveProgram' in some monad like @'HandlingStateT' 'IO'@, 54 | and then add these two lines of boiler plate: 55 | 56 | @ 57 | main :: IO () 58 | main = liveMain liveProgram 59 | @ 60 | -} 61 | liveMain :: 62 | (Launchable m) => 63 | LiveProgram m -> 64 | IO () 65 | liveMain = foreground . runIO 66 | 67 | -- | Launch a 'LiveProgram' in the foreground thread (blocking). 68 | foreground :: (Monad m) => LiveProgram m -> m () 69 | foreground liveProgram = 70 | stepProgram liveProgram 71 | >>= foreground 72 | 73 | -- | A launched 'LiveProgram' and the thread in which it is running. 74 | data LaunchedProgram (m :: * -> *) = LaunchedProgram 75 | { programVar :: MVar (LiveProgram IO) 76 | , threadId :: ThreadId 77 | } 78 | 79 | {- | Launch a 'LiveProgram' in a separate thread. 80 | 81 | The 'MVar' can be used to 'update' the program while automatically migrating it. 82 | The 'ThreadId' represents the thread where the program runs in. 83 | You're advised not to kill it directly, but to run 'stop' instead. 84 | -} 85 | launch :: 86 | (Launchable m) => 87 | LiveProgram m -> 88 | IO (LaunchedProgram m) 89 | launch liveProg = do 90 | programVar <- newMVar $ runIO liveProg 91 | threadId <- forkIO $ background programVar 92 | return LaunchedProgram {..} 93 | 94 | -- | Migrate (using 'hotCodeSwap') the 'LiveProgram' to a new version. 95 | update :: 96 | (Launchable m) => 97 | LaunchedProgram m -> 98 | LiveProgram m -> 99 | IO () 100 | update LaunchedProgram {..} newProg = 101 | modifyMVarMasked_ programVar $ 102 | return . hotCodeSwap (runIO newProg) 103 | 104 | {- | Stops a thread where a 'LiveProgram' is being executed. 105 | 106 | Before the thread is killed, an empty program (in the monad @m@) is first inserted and stepped. 107 | This can be used to call cleanup actions encoded in the monad, 108 | such as 'HandlingStateT'. 109 | -} 110 | stop :: 111 | (Launchable m) => 112 | LaunchedProgram m -> 113 | IO () 114 | stop launchedProgram@LaunchedProgram {..} = do 115 | update launchedProgram mempty 116 | stepLaunchedProgram launchedProgram 117 | killThread threadId 118 | 119 | -- | Launch a 'LiveProgram', but first attach a debugger to it. 120 | launchWithDebugger :: 121 | (Monad m, Launchable m) => 122 | LiveProgram m -> 123 | Debugger m -> 124 | IO (LaunchedProgram m) 125 | launchWithDebugger liveProg debugger = launch $ liveProg `withDebugger` debugger 126 | 127 | -- | This is the background task executed by 'launch'. 128 | background :: MVar (LiveProgram IO) -> IO () 129 | background var = forever $ do 130 | liveProg <- takeMVar var 131 | liveProg' <- stepProgram liveProg 132 | putMVar var liveProg' 133 | 134 | -- | Advance a 'LiveProgram' by a single step. 135 | stepProgram :: (Monad m) => LiveProgram m -> m (LiveProgram m) 136 | stepProgram LiveProgram {..} = do 137 | liveState' <- liveStep liveState 138 | return LiveProgram {liveState = liveState', ..} 139 | 140 | -- | Advance a launched 'LiveProgram' by a single step and store the result. 141 | stepLaunchedProgram :: 142 | (Monad m, Launchable m) => 143 | LaunchedProgram m -> 144 | IO () 145 | stepLaunchedProgram LaunchedProgram {..} = modifyMVarMasked_ programVar stepProgram 146 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Cell.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | module Cell where 4 | 5 | -- base 6 | 7 | import Control.Category 8 | import Data.Functor.Identity 9 | import Prelude hiding (id) 10 | 11 | -- transformers 12 | import Control.Monad.Trans.Identity 13 | 14 | -- test-framework 15 | import Test.Framework 16 | 17 | -- test-framework-quickcheck2 18 | import Test.Framework.Providers.QuickCheck2 19 | 20 | -- QuickCheck 21 | import Test.QuickCheck 22 | 23 | -- essence-of-live-coding 24 | import LiveCoding 25 | 26 | import qualified Cell.Monad.Trans 27 | import qualified Cell.Util 28 | import qualified Cell.Util.Traversable 29 | 30 | test = 31 | testGroup 32 | "Cell" 33 | [ testProperty "steps produces outputs" $ 34 | \(inputs :: [Int]) -> inputs === fst (runIdentity $ steps (id :: Cell Identity Int Int) inputs) 35 | , testProperty "sumC works as expected" $ 36 | forAll (vector 100) $ \(inputs :: [Int]) -> 37 | sum (init inputs) 38 | === last (fst (runIdentity $ steps (sumC :: Cell Identity Int Int) inputs)) 39 | , Cell.Util.test 40 | , Cell.Util.Traversable.testTraverse' 41 | , Cell.Monad.Trans.test 42 | ] 43 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Cell/Monad/Trans.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module Cell.Monad.Trans where 5 | 6 | -- transformers 7 | import Control.Monad.Trans.Reader 8 | 9 | -- test-framework 10 | import Test.Framework 11 | 12 | -- test-framework-quickcheck2 13 | import Test.Framework.Providers.QuickCheck2 14 | 15 | -- QuickCheck 16 | import Test.QuickCheck hiding (output) 17 | 18 | -- essence-of-live-coding 19 | import LiveCoding 20 | 21 | import Util 22 | 23 | test = 24 | testGroup 25 | "Cell.Monad.Trans" 26 | [ testProperty "readerC" $ inIdentityT $ proc (n :: Int) -> do 27 | nReader <- runReaderC' $ constM ask -< (n, ()) 28 | returnA -< n === nReader 29 | ] 30 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Cell/Util/Traversable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE AllowAmbiguousTypes #-} 2 | {-# LANGUAGE Arrows #-} 3 | {-# LANGUAGE DataKinds #-} 4 | {-# LANGUAGE DeriveDataTypeable #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE FlexibleInstances #-} 7 | {-# LANGUAGE InstanceSigs #-} 8 | {-# LANGUAGE KindSignatures #-} 9 | {-# LANGUAGE RankNTypes #-} 10 | {-# LANGUAGE RecordWildCards #-} 11 | {-# LANGUAGE ScopedTypeVariables #-} 12 | {-# LANGUAGE TypeApplications #-} 13 | {-# LANGUAGE TypeFamilies #-} 14 | {-# LANGUAGE TypeOperators #-} 15 | 16 | module Cell.Util.Traversable where 17 | 18 | -- base 19 | import qualified Control.Category as C 20 | import Control.Monad 21 | import Data.Functor.Identity 22 | import Data.List 23 | import Data.Maybe 24 | import GHC.TypeLits (KnownNat) 25 | 26 | -- containers 27 | import Data.Map (Map) 28 | import Data.Sequence (Seq) 29 | 30 | -- transformers 31 | import Control.Monad.Trans.Reader 32 | import Control.Monad.Trans.State.Lazy 33 | 34 | -- vector-sized 35 | import qualified Data.Vector.Sized as V 36 | 37 | -- test-framework 38 | import Test.Framework 39 | 40 | -- test-framework-quickcheck2 41 | import Test.Framework.Providers.QuickCheck2 42 | 43 | -- QuickCheck 44 | import Test.QuickCheck hiding (output) 45 | 46 | -- essence-of-live-coding 47 | import LiveCoding 48 | 49 | import Util 50 | 51 | type TestTraversables = Traversables '[Maybe, [], V.Vector 10, Seq, Map Int] 52 | 53 | testTraverse' :: Test 54 | testTraverse' = 55 | testGroup 56 | "Traversing unit tests" 57 | [ genTraversableTests' @TestTraversables "traverse' (arr f) = arr (f <$>)" $ 58 | makeTraversableTest (traverseArrLaw @Int @Int) 59 | , genTraversableTests' @TestTraversables 60 | "traverse' works as expected for any Cell Identy Int Int created with constructor Cell" 61 | $ makeTraversableTest (traverseCellTest @Int @Int @Int) 62 | , testProperty "traverse' by itself does not force the entire list (ArrM)" $ 63 | CellSimulation 64 | { cell = arr head 65 | , input = [1 : error "Bang !"] 66 | , output = [1] 67 | } 68 | , testProperty "traverse' by itself does not force the entire list (Cell)" $ 69 | CellSimulation 70 | { cell = toCell $ arr head 71 | , input = [1 : error "Bang !"] 72 | , output = [1] 73 | } 74 | ] 75 | 76 | traverseArrLaw :: 77 | forall a b t. 78 | (Traversable t) => 79 | Proxy t -> 80 | [t a] -> 81 | Fun a b -> 82 | CellIdentitySimulation (t a) (t b) 83 | traverseArrLaw _ joinInput (Fn f) = 84 | CellIdentitySimulation 85 | { cellL = arr (f <$>) 86 | , cellR = traverse' (arr f) 87 | , .. 88 | } 89 | 90 | traverseCellTest :: 91 | forall s a b t. 92 | (Traversable t, Data s) => 93 | Proxy t -> 94 | s -> 95 | Fun (s, a) (b, s) -> 96 | [t a] -> 97 | CellSimulation (t a) (t b) 98 | traverseCellTest _ s (Fn2 f) input = 99 | CellSimulation 100 | { cell = traverse' (Cell s (\s a -> pure $ f s a)) 101 | , output = runIdentity $ evalStateT (traverse (traverse (\a -> StateT (Identity . (`f` a)))) input) s 102 | , .. 103 | } 104 | 105 | makeTraversableTest :: forall (t :: * -> *) a. (Testable a, Typeable t) => (Proxy t -> a) -> Proxy t -> Test 106 | makeTraversableTest a _ = testProperty (show (typeRep (Proxy :: Proxy t))) (a (Proxy :: Proxy t)) 107 | 108 | -- | A data type to store types which are instances of 'Traversable'. 109 | data Traversables :: [* -> *] -> * 110 | 111 | -- | A type class for induction on the type-level list containing the Traversables. 112 | class GenTests a where 113 | genTraversableTests :: 114 | (forall (t :: * -> *). (Arbitrary (t Int), Show (t Int), Eq (t Int), Traversable t, Typeable t) => Proxy t -> Test) -> 115 | Proxy a -> 116 | [Test] 117 | 118 | instance GenTests (Traversables '[]) where 119 | genTraversableTests _ _ = [] 120 | 121 | instance 122 | (GenTests (Traversables xs), Arbitrary (x Int), Show (x Int), Eq (x Int), Traversable x, Typeable x) => 123 | GenTests (Traversables (x ': xs)) 124 | where 125 | genTraversableTests f _ = f (Proxy :: Proxy x) : genTraversableTests f (Proxy :: Proxy (Traversables xs)) 126 | 127 | genTraversableTests' :: 128 | forall a. 129 | (GenTests a) => 130 | String -> 131 | (forall (t :: * -> *). (Arbitrary (t Int), Show (t Int), Eq (t Int), Traversable t, Typeable t) => Proxy t -> Test) -> 132 | Test 133 | genTraversableTests' message f = testGroup message $ genTraversableTests f (Proxy :: Proxy a) 134 | 135 | instance (Arbitrary a, KnownNat n) => Arbitrary (V.Vector n a) where 136 | arbitrary = V.replicateM arbitrary 137 | shrink = V.mapM shrink 138 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Feedback.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module Feedback where 5 | 6 | -- essence-of-live-coding 7 | import Util 8 | 9 | -- test-framework 10 | import Test.Framework 11 | 12 | -- test-framework-quickcheck2 13 | import Test.Framework.Providers.QuickCheck2 14 | 15 | -- QuickCheck 16 | import Test.QuickCheck 17 | 18 | -- essence-of-live-coding 19 | import LiveCoding 20 | 21 | constCell :: (Monad m) => Int -> Cell m () Int 22 | constCell cellState = 23 | Cell 24 | { cellStep = \state _ -> return (state, state) 25 | , .. 26 | } 27 | 28 | test = 29 | testGroup 30 | "Feedback" 31 | [ testProperty 32 | "Migrates into feedback" 33 | CellMigrationSimulation 34 | { cell1 = constCell 23 35 | , cell2 = feedback [] $ proc ((), ns) -> do 36 | n <- constCell 42 -< () 37 | returnA -< (sum ns, n : ns) 38 | , input1 = replicate 3 () 39 | , input2 = replicate 3 () 40 | , output1 = [23, 23, 23] 41 | , output2 = [0, 23, 46] 42 | } 43 | , testProperty 44 | "Migrates out of feedback" 45 | CellMigrationSimulation 46 | { cell1 = feedback [] $ proc ((), ns) -> do 47 | n <- constCell 23 -< () 48 | returnA -< (sum ns, n : ns) 49 | , cell2 = constCell 42 50 | , input1 = replicate 3 () 51 | , input2 = replicate 3 () 52 | , output1 = [0, 23, 46] 53 | , output2 = [23, 23, 23] 54 | } 55 | ] 56 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Handle/LiveProgram.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | 3 | module Handle.LiveProgram where 4 | 5 | -- base 6 | import Control.Arrow 7 | 8 | -- containers 9 | import qualified Data.IntMap as IntMap 10 | 11 | -- transformers 12 | import Control.Monad.Trans.Class (MonadTrans (lift)) 13 | import Control.Monad.Trans.RWS.Strict (RWS, tell) 14 | import qualified Control.Monad.Trans.RWS.Strict as RWS 15 | import Control.Monad.Trans.State.Strict 16 | 17 | -- test-framework 18 | import Test.Framework 19 | 20 | -- test-framework-quickcheck2 21 | import Test.Framework.Providers.QuickCheck2 22 | 23 | -- essence-of-live-coding 24 | import LiveCoding 25 | import LiveCoding.Handle 26 | import Util.LiveProgramMigration 27 | 28 | testHandle :: Handle (RWS () [String] Int) String 29 | testHandle = 30 | Handle 31 | { create = do 32 | n <- RWS.get 33 | let msg = "Handle #" ++ show n 34 | tell ["Creating " ++ msg] 35 | return msg 36 | , destroy = const $ tell ["Destroyed handle"] 37 | } 38 | 39 | test = 40 | testGroup 41 | "Handle.LiveProgram" 42 | [ testProperty 43 | "Trigger destructors in live program" 44 | LiveProgramMigration 45 | { liveProgram1 = 46 | runHandlingState $ 47 | liveCell $ 48 | handling testHandle >>> arrM (lift . tell . return) >>> constM inspectHandlingState 49 | , liveProgram2 = runHandlingState mempty 50 | , input1 = replicate 3 () 51 | , input2 = replicate 3 () 52 | , output1 = 53 | ["Creating Handle #0", "Handle #0", "Handles: 1", "Destructors: (1,True)"] 54 | : replicate 2 ["Handle #0", "Handles: 1", "Destructors: (1,True)"] 55 | , output2 = [["Destroyed handle"], [], []] 56 | , initialState = 0 57 | } 58 | ] 59 | where 60 | inspectHandlingState = do 61 | HandlingState {..} <- get 62 | lift $ 63 | tell 64 | [ "Handles: " ++ show nHandles 65 | , "Destructors: " ++ unwords (show . second isRegistered <$> IntMap.toList destructors) 66 | ] 67 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Migrate.hs: -------------------------------------------------------------------------------- 1 | module Migrate where 2 | 3 | -- base 4 | import Data.Data (dataTypeName, isAlgType) 5 | 6 | -- QuickCheck 7 | import Test.QuickCheck.Property ((===)) 8 | 9 | -- test-framework 10 | import Test.Framework 11 | 12 | -- test-framework-quickcheck2 13 | import Test.Framework.Providers.QuickCheck2 (testProperty) 14 | 15 | -- essence-of-live-coding 16 | import LiveCoding (Data (dataTypeOf), castMigration, runSafeMigration) 17 | import LiveCoding.Migrate 18 | 19 | import Migrate.NoMigration 20 | import qualified TestData.Foo1 as Foo1 21 | import qualified TestData.Foo2 as Foo2 22 | 23 | test = 24 | testGroup 25 | "Migrate" 26 | [ testGroup 27 | "Internal assumptions" 28 | [ testGroup 29 | "matchingAlgebraicDataTypes" 30 | [ testProperty "True for types with the same name" $ 31 | matchingAlgebraicDataTypes Foo1.foo Foo2.foo 32 | , testGroup 33 | "debugging tests" 34 | [ testProperty "isAlgType" $ isAlgType $ dataTypeOf Foo1.foo 35 | ] 36 | ] 37 | ] 38 | , testGroup 39 | "standard migrations" 40 | [ testGroup 41 | "castMigration" 42 | [ testProperty "Migrates for same data type" $ 43 | runSafeMigration castMigration Foo1.same Foo1.same == Foo1.same 44 | , testProperty "Does not migrate for different data types" $ 45 | runSafeMigration castMigration Foo1.same Foo2.same == Foo1.same 46 | , testProperty "Migrates for same builtin type" $ 47 | runSafeMigration castMigration (23 :: Int) (42 :: Int) == 42 48 | , testProperty "Does not migrate for different builtin types" $ 49 | runSafeMigration castMigration (23 :: Int) (42 :: Integer) == 23 50 | ] 51 | , testGroup 52 | "sameConstructorMigration" 53 | [ testProperty "Migrates when constructor names and arity match" $ 54 | runSafeMigration (sameConstructorMigration castMigration) Foo1.same Foo2.same == Foo1.same' 55 | , testProperty "Migrates for same data type" $ 56 | runSafeMigration (sameConstructorMigration castMigration) Foo1.same Foo1.same' == Foo1.same' 57 | ] 58 | ] 59 | , Migrate.NoMigration.test 60 | ] 61 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Migrate/NoMigration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE TupleSections #-} 5 | {-# LANGUAGE TypeApplications #-} 6 | 7 | module Migrate.NoMigration where 8 | 9 | -- base 10 | import Control.Arrow (Arrow (arr), (>>>)) 11 | import Data.Data (Data) 12 | import Data.Maybe (fromJust) 13 | 14 | -- test-framework 15 | import Test.Framework (testGroup) 16 | 17 | -- test-framework-quickcheck2 18 | import Test.Framework.Providers.QuickCheck2 (testProperty) 19 | 20 | -- essence-of-live-coding 21 | 22 | import qualified LiveCoding.Migrate.NoMigration as NoMigration 23 | import Util 24 | 25 | data Stuff a = Stuff a deriving (Eq, Data) 26 | 27 | test = 28 | testGroup 29 | "NoMigration unit tests" 30 | [ testProperty 31 | "LiveCoding.Migrate.NoMigration.delay migrates correctly to itself" 32 | CellMigrationSimulation 33 | { cell1 = NoMigration.delay 0 34 | , cell2 = NoMigration.delay 0 35 | , input1 = [1 :: Int, 2, 3, 4] 36 | , input2 = [5 :: Int, 6, 7, 8] 37 | , output1 = [0, 1, 2, 3] 38 | , output2 = [4, 5, 6, 7] 39 | } 40 | , testProperty 41 | "LiveCoding.Migrate.NoMigration.delay different type will not migrate" 42 | CellMigrationSimulation 43 | { cell1 = NoMigration.delay 0 44 | , cell2 = arr Stuff >>> NoMigration.delay (Stuff 99) >>> arr (\(Stuff a) -> a) 45 | , input1 = [1 :: Int, 2, 3, 4] 46 | , input2 = [10 :: Int, 10, 10, 10] 47 | , output1 = [0, 1, 2, 3] 48 | , output2 = [99, 10, 10, 10] 49 | } 50 | ] 51 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Monad.hs: -------------------------------------------------------------------------------- 1 | module Monad where 2 | 3 | -- transformers 4 | import Control.Monad.Trans.State.Strict 5 | 6 | -- essence-of-live-coding 7 | import LiveCoding 8 | import LiveCoding.Cell.Monad.Trans 9 | import Util 10 | 11 | import Data.Functor.Identity (Identity) 12 | 13 | -- test-framework-quickcheck2 14 | import Test.Framework.Providers.QuickCheck2 15 | 16 | test = 17 | testProperty 18 | "State effect" 19 | CellMigrationSimulation 20 | { cell1 = flip runStateC (0 :: Int) $ constM (modify (+ 1)) 21 | , cell2 = flip runStateC 23 $ constM (modify (+ 2)) 22 | , input1 = [(), (), ()] 23 | , input2 = [(), (), ()] 24 | , output1 = [((), 1), ((), 2), ((), 3)] 25 | , output2 = [((), 5), ((), 7), ((), 9)] 26 | } 27 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Monad/Trans.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module Monad.Trans where 5 | 6 | -- test-framework 7 | import Test.Framework 8 | 9 | -- test-framework-quickcheck2 10 | import Test.Framework.Providers.QuickCheck2 11 | 12 | -- QuickCheck 13 | import Test.QuickCheck 14 | 15 | -- essence-of-live-coding 16 | import LiveCoding 17 | import LiveCoding.Cell.Monad.Trans (State (State)) 18 | 19 | test = 20 | testGroup 21 | "Monad.Trans" 22 | [ testProperty "Migrates into runStateL" $ 23 | \(stateT :: Int) (stateInternal :: Int) -> 24 | State {..} === migrate State {stateInternal = 23, ..} stateInternal 25 | , testProperty "Migrates from runStateL" $ 26 | \(stateT :: Int) (stateInternal :: Int) -> 27 | stateInternal === migrate 42 State {..} 28 | ] 29 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/RuntimeIO/Launch.hs: -------------------------------------------------------------------------------- 1 | module RuntimeIO.Launch where 2 | 3 | -- base 4 | import Data.IORef 5 | 6 | -- hunit 7 | import Test.HUnit 8 | 9 | -- test-framework-hunit 10 | import Test.Framework.Providers.HUnit 11 | 12 | -- essence-of-live-coding 13 | 14 | import Control.Concurrent (threadDelay) 15 | import LiveCoding 16 | 17 | loggingHandle :: IORef [String] -> Handle IO () 18 | loggingHandle ref = 19 | Handle 20 | { create = modifyIORef ref ("Created handle" :) 21 | , destroy = const $ modifyIORef ref ("Destroyed handle" :) 22 | } 23 | 24 | testProgram :: IORef [String] -> LiveProgram (HandlingStateT IO) 25 | testProgram ref = liveCell $ handling $ loggingHandle ref 26 | 27 | test = testCase "HandlingStateT destroys all handles" $ do 28 | ref <- newIORef [] 29 | launchedProgram <- launch mempty 30 | assertRefContains ref [] 31 | update launchedProgram $ testProgram ref 32 | assertRefContains ref ["Created handle"] 33 | stop launchedProgram 34 | assertRefContains ref ["Destroyed handle", "Created handle"] 35 | 36 | assertRefContains ref messagesExpected = do 37 | threadDelay 100000 38 | messagesRead <- readIORef ref 39 | messagesRead @?= messagesExpected 40 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/TestData/Foo1.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | 3 | module TestData.Foo1 where 4 | 5 | -- base 6 | import Data.Data 7 | import Data.Typeable 8 | 9 | data Same = Same String Int 10 | deriving (Show, Eq, Typeable, Data) 11 | 12 | same = Same "same" 23 13 | same' = Same "the same" 42 14 | 15 | data Foo = Foo Integer Bool 16 | deriving (Show, Eq, Typeable, Data) 17 | 18 | foo = Foo 1 False 19 | foo' = Foo 2 False 20 | 21 | data Bar 22 | = Bar 23 | { barA :: Integer 24 | , barD :: Integer 25 | , barC :: Bool 26 | } 27 | | Baar 28 | { baarB :: Bool 29 | , baarA :: Int 30 | } 31 | deriving (Show, Eq, Typeable, Data) 32 | 33 | bar = 34 | Bar 35 | { barA = 23 36 | , barD = 5 37 | , barC = True 38 | } 39 | 40 | data Baz = Baz 41 | { bazFoo :: Foo 42 | , bazBar :: Bar 43 | } 44 | deriving (Show, Eq, Typeable, Data) 45 | 46 | baz = Baz foo bar 47 | 48 | data Frob = Frob Int 49 | deriving (Show, Eq, Typeable, Data) 50 | 51 | frob = Frob 1 52 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/TestData/Foo2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | 3 | module TestData.Foo2 where 4 | 5 | -- base 6 | import Data.Data 7 | import Data.Typeable 8 | 9 | data Same = Same String Int 10 | deriving (Show, Eq, Typeable, Data) 11 | 12 | same = Same "the same" 42 13 | 14 | data Similar = Similar String Int 15 | deriving (Show, Eq, Typeable, Data) 16 | 17 | similar = Similar "similar" 100 18 | 19 | data Foo 20 | = Fooo Integer 21 | | Foo Integer 22 | deriving (Show, Eq, Typeable, Data) 23 | 24 | foo = Foo 2 25 | foo' = Foo 1 26 | 27 | data Bar 28 | = Bar 29 | { barB :: Integer 30 | , barA :: Integer 31 | , barC :: String 32 | } 33 | | Baar 34 | { baarA :: Int 35 | } 36 | deriving (Show, Eq, Typeable, Data) 37 | 38 | bar = 39 | Bar 40 | { barB = 42 41 | , barA = 100 42 | , barC = "Bar" 43 | } 44 | 45 | bar' = 46 | Bar 47 | { barB = 42 48 | , barA = 23 49 | , barC = "Bar" 50 | } 51 | 52 | data Baz = Baz 53 | { bazBar :: Bar 54 | , bazFoo :: Foo 55 | } 56 | deriving (Show, Eq, Typeable, Data) 57 | 58 | baz = Baz bar foo 59 | baz' = Baz bar' foo' 60 | 61 | data Frob = Frob Integer 62 | deriving (Show, Eq, Typeable, Data) 63 | 64 | frob = Frob 2 65 | frob' = Frob 1 66 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module Util where 5 | 6 | -- base 7 | import Data.Functor.Identity 8 | import System.IO.Unsafe (unsafePerformIO) 9 | 10 | -- QuickCheck 11 | import Test.QuickCheck 12 | 13 | -- essence-of-live-coding 14 | import LiveCoding 15 | 16 | {- | A quickcheckable unit test for migrations of cells. 17 | 18 | You have to specify a cell which will then receive some input, 19 | is fed each input element in a step, and produces some output. 20 | Then the cell is migrated to a second cell, which again consumes input and produces output. 21 | 22 | The test is passed if the same input produces the same output. 23 | 24 | * 'cell1': The cell before the migration 25 | * 'cell2': The cell after the migration 26 | * 'input1': All input the cell before the migration receives 27 | * 'input2': All input the cell after the migration receives 28 | * 'output1': The expected output before the migration 29 | * 'output2': The expected output after the migration 30 | -} 31 | data CellMigrationSimulation a b = CellMigrationSimulation 32 | { cell1 :: Cell Identity a b 33 | , cell2 :: Cell Identity a b 34 | , input1 :: [a] 35 | , input2 :: [a] 36 | , output1 :: [b] 37 | , output2 :: [b] 38 | } 39 | 40 | instance (Eq b, Show b) => Testable (CellMigrationSimulation a b) where 41 | property CellMigrationSimulation {..} = 42 | let Identity (output1', output2') = simulateCellMigration cell1 cell2 input1 input2 43 | in output1 === output1' .&&. output2 === output2' 44 | 45 | {- | Step the first cell with the first input, 46 | migrate it to the second cell, 47 | and step the migration result with the second input. 48 | Return both outputs. 49 | -} 50 | simulateCellMigration :: (Monad m) => Cell m a b -> Cell m a b -> [a] -> [a] -> m ([b], [b]) 51 | simulateCellMigration cell1 cell2 as1 as2 = do 52 | (bs1, cell1') <- steps cell1 as1 53 | let cell2' = hotCodeSwapCell cell2 cell1' 54 | (bs2, _) <- steps cell2' as2 55 | return (bs1, bs2) 56 | 57 | -- FIXME move to essence-of-live-coding-quickcheck 58 | -- https://github.com/turion/essence-of-live-coding/issues/36 59 | instance (Arbitrary a, Testable prop) => Testable (Cell Identity a prop) where 60 | property cell = property $ do 61 | as <- arbitrary 62 | let (props, _) = runIdentity $ steps cell as 63 | return $ conjoin props 64 | 65 | -- | Helper to unify cells to the 'Identity' monad. 66 | inIdentityT :: Cell Identity a prop -> Cell Identity a prop 67 | inIdentityT = id 68 | 69 | {- | Basic unit test for 'Cell's. 70 | Check whether a given 'input' to your 'cell' results in a given 'output'. 71 | -} 72 | data CellSimulation a b = CellSimulation 73 | { cell :: Cell Identity a b 74 | , input :: [a] 75 | , output :: [b] 76 | } 77 | 78 | instance (Eq b, Show b) => Testable (CellSimulation a b) where 79 | property CellSimulation {..} = 80 | property 81 | CellMigrationSimulation 82 | { cell1 = cell 83 | , cell2 = cell 84 | , input1 = input 85 | , input2 = [] 86 | , output1 = output 87 | , output2 = [] 88 | } 89 | 90 | {- | Basic unit test for 'Cell' identities. 91 | Check whether one cell behaves the same as another cell. 92 | -} 93 | data CellIdentitySimulation a b = CellIdentitySimulation 94 | { cellL :: Cell Identity a b 95 | , cellR :: Cell Identity a b 96 | , joinInput :: [a] 97 | } 98 | 99 | instance (Eq b, Show b) => Testable (CellIdentitySimulation a b) where 100 | property CellIdentitySimulation {..} = 101 | let 102 | Identity (outputa, _) = simulateCellMigration cellL cellR joinInput [] 103 | Identity (outputb, _) = simulateCellMigration cellL cellR joinInput [] 104 | in 105 | outputa === outputb 106 | -------------------------------------------------------------------------------- /essence-of-live-coding/test/Util/LiveProgramMigration.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module Util.LiveProgramMigration where 5 | 6 | -- transformers 7 | import Control.Monad.Trans.RWS.Strict (RWS, runRWS) 8 | 9 | -- QuickCheck 10 | import Test.QuickCheck 11 | 12 | -- essence-of-live-coding 13 | import LiveCoding 14 | 15 | data LiveProgramMigration a b = forall s. 16 | LiveProgramMigration 17 | { liveProgram1 :: LiveProgram (RWS a b s) 18 | , liveProgram2 :: LiveProgram (RWS a b s) 19 | , initialState :: s 20 | , input1 :: [a] 21 | , input2 :: [a] 22 | , output1 :: [b] 23 | , output2 :: [b] 24 | } 25 | 26 | stepLiveProgramRWS :: (Monoid b) => LiveProgram (RWS a b s) -> a -> s -> (LiveProgram (RWS a b s), s, b) 27 | stepLiveProgramRWS liveProg = runRWS (stepProgram liveProg) 28 | 29 | stepsLiveProgramRWS :: (Monoid b) => LiveProgram (RWS a b s) -> s -> [a] -> (LiveProgram (RWS a b s), s, [b]) 30 | stepsLiveProgramRWS liveProg s [] = (liveProg, s, []) 31 | stepsLiveProgramRWS liveProg s (a : as) = 32 | let (liveProg', s', b) = stepLiveProgramRWS liveProg a s 33 | in (liveProg', s', b : third (stepsLiveProgramRWS liveProg' s' as)) 34 | 35 | third :: (a, b, c) -> c 36 | third (a, b, c) = c 37 | 38 | instance (Monoid b, Eq b, Show b) => Testable (LiveProgramMigration a b) where 39 | property LiveProgramMigration {..} = 40 | let (liveProg', s', output1') = stepsLiveProgramRWS liveProgram1 initialState input1 41 | liveProg2 = hotCodeSwap liveProgram2 liveProg' 42 | (_, _, output2') = stepsLiveProgramRWS liveProg2 s' input2 43 | in output1 === output1' .&&. output2 === output2' 44 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | indentation: 2 2 | indent-wheres: true 3 | record-brace-space: true 4 | -------------------------------------------------------------------------------- /gears/.ghci: -------------------------------------------------------------------------------- 1 | ../templates/.ghci -------------------------------------------------------------------------------- /gears/.ghcid: -------------------------------------------------------------------------------- 1 | ../templates/.ghcid -------------------------------------------------------------------------------- /gears/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Revision history for essence-of-live-coding-gloss-example 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /gears/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019, Manuel Bärenz 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Manuel Bärenz nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /gears/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /gears/app/Gears.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | -- base 4 | import Control.Arrow 5 | import Control.Monad (void) 6 | import Control.Monad.IO.Class 7 | 8 | -- essence-of-live-coding 9 | import LiveCoding 10 | 11 | -- essence-of-live-coding-gloss 12 | import LiveCoding.Gloss 13 | 14 | -- essence-of-live-coding-pulse 15 | import LiveCoding.Pulse 16 | 17 | glossCell :: Cell PictureM () Float 18 | glossCell = withDebuggerC glossCell' statePlay 19 | 20 | glossCell' :: Cell PictureM () Float 21 | glossCell' = proc () -> do 22 | gearAngle <- integrate -< 30 23 | addPicture -< gear gearAngle 24 | phase <- integrate -< 5 25 | addPicture -< rotate gearAngle $ blinker phase 26 | returnA -< gearAngle 27 | 28 | blinker :: Float -> Picture 29 | blinker phase = 30 | translate 0 100 $ 31 | color (greyN $ 0.7 + 0.2 * (sin phase)) $ 32 | thickCircle 5 10 33 | 34 | gear :: Float -> Picture 35 | gear angle = 36 | scale 3 3 $ 37 | rotate angle $ 38 | pictures 39 | [ color (dim green) $ 40 | pictures $ 41 | thickCircle 20 30 42 | : [rotate blockAngle block | blockAngle <- [0, 45 .. 315]] 43 | , color red $ pictures [wedge, scale (-1) 1 wedge] 44 | ] 45 | where 46 | block = rectangleSolid 85 15 47 | wedge = 48 | polygon 49 | [ (0, -5) 50 | , (0, 20) 51 | , (10, -10) 52 | ] 53 | 54 | tones = [D, F, A] 55 | 56 | pulseCell :: PulseCell IO Float () 57 | pulseCell = proc angle -> do 58 | pulse <- sawtooth -< cycleTones $ round angle 59 | addSample -< pulse 60 | 61 | cycleTones :: Int -> Float 62 | cycleTones angle = 63 | f $ 64 | (tones !!) $ 65 | (`mod` length tones) $ 66 | angle `div` (60 `div` length tones) 67 | 68 | liveProgram :: LiveProgram (HandlingStateT IO) 69 | liveProgram = liveCell mainCell 70 | 71 | mainCell :: Cell (HandlingStateT IO) () () 72 | mainCell = proc () -> do 73 | angleMaybe <- glossWrapC defaultSettings glossCell -< () 74 | angle <- hold 0 -< angleMaybe 75 | pulseWrapC 800 pulseCell -< angle 76 | returnA -< () 77 | 78 | main :: IO () 79 | main = liveMain liveProgram 80 | -------------------------------------------------------------------------------- /gears/gears.cabal: -------------------------------------------------------------------------------- 1 | name: gears 2 | version: 0.2.8 3 | synopsis: General purpose live coding framework - Gears demo application with Gloss and PulseAudio 4 | description: 5 | essence-of-live-coding is a general purpose and type safe live coding framework. 6 | . 7 | You can run programs in it, and edit, recompile and reload them while they're running. 8 | Internally, the state of the live program is automatically migrated when performing hot code swap. 9 | . 10 | The library also offers an easy to use FRP interface. 11 | It is parametrized by its side effects, 12 | separates data flow cleanly from control flow, 13 | and allows to develop live programs from reusable, modular components. 14 | There are also useful utilities for debugging and quickchecking. 15 | . 16 | This package contains an example application including both Gloss vector graphics and a sound backend using PulseAudio. 17 | 18 | license: BSD3 19 | license-file: LICENSE 20 | author: Manuel Bärenz 21 | maintainer: programming@manuelbaerenz.de 22 | homepage: https://www.manuelbaerenz.de/#computerscience 23 | category: FRP, Live coding 24 | build-type: Simple 25 | extra-source-files: CHANGELOG.md 26 | cabal-version: >=1.10 27 | 28 | source-repository head 29 | type: git 30 | location: https://github.com/turion/essence-of-live-coding.git 31 | 32 | source-repository this 33 | type: git 34 | location: https://github.com/turion/essence-of-live-coding.git 35 | tag: v0.2.8 36 | 37 | executable gears 38 | main-is: Gears.hs 39 | build-depends: 40 | base >= 4.13 && < 4.21 41 | , gloss 42 | , transformers 43 | , essence-of-live-coding 44 | , essence-of-live-coding-gloss 45 | , essence-of-live-coding-pulse 46 | hs-source-dirs: app 47 | default-language: Haskell2010 48 | default-extensions: StrictData 49 | -------------------------------------------------------------------------------- /gears/stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-14.7 2 | extra-deps: 3 | - ../essence-of-live-coding 4 | - ../essence-of-live-coding-gloss 5 | - ../essence-of-live-coding-pulse 6 | - pulse-simple-0.1.14@sha256:cd2397c40feb8959cdc6e806987072ce91e388e41427c47ff09ec2a2cfb466f0,773 7 | nix: 8 | enable: true 9 | pure: false 10 | packages: [libpulseaudio pulseaudio libGL libGLU freeglut] 11 | -------------------------------------------------------------------------------- /nix/common.nix: -------------------------------------------------------------------------------- 1 | { 2 | subpkgs = [ 3 | "essence-of-live-coding" 4 | "essence-of-live-coding-gloss" 5 | "essence-of-live-coding-gloss-example" 6 | "essence-of-live-coding-pulse" 7 | "essence-of-live-coding-quickcheck" 8 | "essence-of-live-coding-warp" 9 | "gears" 10 | ]; 11 | } 12 | -------------------------------------------------------------------------------- /replcommands.txt: -------------------------------------------------------------------------------- 1 | :livelaunch 2 | :livereload 3 | :livestop 4 | -------------------------------------------------------------------------------- /run_fourmolu.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Or find all files in a project with git ls-files: 4 | fourmolu --mode inplace $(git ls-files '*.hs') 5 | 6 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let 2 | myPkgs = import ./. {}; 3 | common = import ./nix/common.nix; 4 | inherit (common) subpkgs; 5 | in 6 | myPkgs.shellFor { 7 | packages = p: map (subpkg: p.${subpkg}) subpkgs ++ [ 8 | p.streaming-commons # Why does it not figure these out? Maybe because it's only in the tests? 9 | p.warp 10 | ]; 11 | buildInputs = with myPkgs; [ 12 | ghcid 13 | hlint 14 | ]; 15 | } 16 | -------------------------------------------------------------------------------- /templates/.ghci: -------------------------------------------------------------------------------- 1 | :m + LiveCoding.GHCi Control.Concurrent 2 | :def liveinit liveinit 3 | :def livestep livestep 4 | :def livereload livereload 5 | :def livelaunch livelaunch 6 | :def livestop livestop 7 | -------------------------------------------------------------------------------- /templates/.ghcid: -------------------------------------------------------------------------------- 1 | --warnings --setup=:livelaunch --test=:livereload "--command=cabal repl" 2 | -------------------------------------------------------------------------------- /test-repl.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | set -e 3 | 4 | test_repl() { 5 | start_repl 6 | test_for_errors 7 | } 8 | 9 | start_repl() { 10 | cat ../replcommands.txt | cabal repl &> result.txt 11 | } 12 | 13 | test_for_errors() { 14 | if grep -qE "error|unknown" result.txt; then 15 | cat result.txt 16 | rm result.txt 17 | exit 1 18 | fi 19 | rm result.txt 20 | } 21 | 22 | test_for_handle_messages() { 23 | # See essence-of-live-coding-ghci-example/app/Main.hs 24 | if grep -qE "Creating" result.txt && grep -qE "Destroying" result.txt 25 | then 26 | rm result.txt 27 | else 28 | cat result.txt 29 | rm result.txt 30 | exit 1 31 | fi 32 | } 33 | 34 | pushd gears 35 | test_repl 36 | popd 37 | 38 | pushd essence-of-live-coding-gloss-example 39 | test_repl 40 | popd 41 | 42 | pushd essence-of-live-coding-pulse-example 43 | test_repl 44 | popd 45 | 46 | pushd essence-of-live-coding-ghci-example 47 | start_repl 48 | test_for_handle_messages 49 | popd 50 | -------------------------------------------------------------------------------- /travis-build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | # Cabal 6 | 7 | cabal new-build all --enable-tests 8 | cabal new-test all --enable-tests 9 | git fetch origin master:origin/master 10 | git rebase origin/master --exec "cabal new-build all --enable-tests" 11 | 12 | # Stack 13 | 14 | export STACK_YAML="stack.${TRAVIS_HASKELL_VERSION}.yaml" 15 | 16 | # install stack 17 | curl -sSL https://get.haskellstack.org/ | sh 18 | 19 | # build project with stack 20 | stack --version 21 | stack build --system-ghc --test 22 | git fetch origin master:origin/master 23 | git rebase origin/master --exec "stack build --system-ghc --test" 24 | --------------------------------------------------------------------------------