├── exercises
├── chapter9
│ ├── test
│ │ ├── data
│ │ │ ├── tree
│ │ │ │ ├── b
│ │ │ │ │ ├── a.txt
│ │ │ │ │ ├── c
│ │ │ │ │ │ └── a.txt
│ │ │ │ │ └── b.txt
│ │ │ │ ├── c
│ │ │ │ │ ├── a
│ │ │ │ │ │ └── a.txt
│ │ │ │ │ └── unused.txt
│ │ │ │ ├── a.txt
│ │ │ │ ├── unused.txt
│ │ │ │ ├── root.txt
│ │ │ │ └── expected.txt
│ │ │ ├── many
│ │ │ │ ├── file1.txt
│ │ │ │ ├── file2.txt
│ │ │ │ ├── file3.txt
│ │ │ │ ├── file4.txt
│ │ │ │ ├── file5.txt
│ │ │ │ ├── file6.txt
│ │ │ │ ├── file7.txt
│ │ │ │ ├── file8.txt
│ │ │ │ └── file9.txt
│ │ │ ├── foo.txt
│ │ │ ├── nbChars.txt
│ │ │ ├── bar.txt
│ │ │ ├── manyConcat.txt
│ │ │ └── user.txt
│ │ ├── data-out
│ │ │ └── foo.txt
│ │ ├── MySolutions.purs
│ │ ├── HTTP.purs
│ │ ├── ParallelFetch.purs
│ │ ├── ParallelDelay.purs
│ │ ├── Copy.purs
│ │ ├── no-peeking
│ │ │ └── Solutions.purs
│ │ └── Main.purs
│ ├── src
│ │ └── Main.purs
│ ├── .gitignore
│ ├── packages.dhall
│ ├── package.json
│ └── spago.dhall
├── chapter4
│ ├── test
│ │ ├── MySolutions.purs
│ │ ├── no-peeking
│ │ │ └── Solutions.purs
│ │ └── Main.purs
│ ├── src
│ │ ├── Data
│ │ │ ├── Person.purs
│ │ │ └── Picture.purs
│ │ ├── Main.purs
│ │ └── ChapterExamples.purs
│ ├── .gitignore
│ ├── packages.dhall
│ └── spago.dhall
├── chapter2
│ ├── test
│ │ ├── MySolutions.purs
│ │ ├── no-peeking
│ │ │ └── Solutions.purs
│ │ └── Main.purs
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ └── Euler.purs
│ ├── packages.dhall
│ └── spago.dhall
├── chapter10
│ ├── src
│ │ ├── index.js
│ │ ├── Effect
│ │ │ ├── Alert.js
│ │ │ ├── Alert.purs
│ │ │ ├── Storage.js
│ │ │ └── Storage.purs
│ │ ├── index.html
│ │ ├── Data
│ │ │ ├── AddressBook.purs
│ │ │ └── AddressBook
│ │ │ │ └── Validation.purs
│ │ └── Main.purs
│ ├── test
│ │ ├── URI.js
│ │ ├── MySolutions.js
│ │ ├── URI.purs
│ │ ├── MySolutions.purs
│ │ ├── no-peeking
│ │ │ ├── Solutions.js
│ │ │ └── Solutions.purs
│ │ ├── Examples.js
│ │ └── Examples.purs
│ ├── .gitignore
│ ├── packages.dhall
│ ├── html
│ │ └── index.html
│ ├── package.json
│ └── spago.dhall
├── chapter8
│ ├── src
│ │ ├── index.js
│ │ ├── index.html
│ │ ├── Data
│ │ │ ├── AddressBook.purs
│ │ │ └── AddressBook
│ │ │ │ └── Validation.purs
│ │ └── Main.purs
│ ├── test
│ │ ├── MySolutions.purs
│ │ ├── Random.purs
│ │ ├── Examples.purs
│ │ ├── no-peeking
│ │ │ └── Solutions.purs
│ │ └── Main.purs
│ ├── .gitignore
│ ├── packages.dhall
│ ├── package.json
│ └── spago.dhall
├── chapter3
│ ├── test
│ │ ├── MySolutions.purs
│ │ ├── no-peeking
│ │ │ └── Solutions.purs
│ │ └── Main.purs
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ └── Data
│ │ │ └── AddressBook.purs
│ ├── packages.dhall
│ └── spago.dhall
├── chapter5
│ ├── test
│ │ ├── MySolutions.purs
│ │ ├── Examples.purs
│ │ └── no-peeking
│ │ │ └── Solutions.purs
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ └── Data
│ │ │ └── Path.purs
│ ├── packages.dhall
│ └── spago.dhall
├── chapter6
│ ├── test
│ │ └── MySolutions.purs
│ ├── .gitignore
│ ├── packages.dhall
│ ├── src
│ │ ├── Main.purs
│ │ └── Data
│ │ │ └── Hashable.purs
│ └── spago.dhall
├── chapter7
│ ├── test
│ │ ├── MySolutions.purs
│ │ └── no-peeking
│ │ │ └── Solutions.purs
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ └── Data
│ │ │ ├── AddressBook.purs
│ │ │ └── AddressBook
│ │ │ └── Validation.purs
│ ├── packages.dhall
│ └── spago.dhall
├── chapter11
│ ├── test
│ │ ├── MySolutions.purs
│ │ ├── no-peeking
│ │ │ └── Solutions.purs
│ │ └── Main.purs
│ ├── .gitignore
│ ├── packages.dhall
│ ├── src
│ │ ├── Data
│ │ │ ├── GameEnvironment.purs
│ │ │ ├── GameItem.purs
│ │ │ ├── Coords.purs
│ │ │ └── GameState.purs
│ │ ├── Split.purs
│ │ ├── Main.purs
│ │ └── Game.purs
│ └── spago.dhall
├── chapter12
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ └── Example
│ │ │ ├── Rectangle.purs
│ │ │ ├── Random.purs
│ │ │ ├── Shapes.purs
│ │ │ ├── Refs.purs
│ │ │ └── LSystem.purs
│ ├── packages.dhall
│ ├── test
│ │ └── Main.purs
│ ├── html
│ │ └── index.html
│ └── spago.dhall
├── chapter13
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ ├── Sorted.purs
│ │ ├── Merge.purs
│ │ └── Tree.purs
│ ├── packages.dhall
│ ├── spago.dhall
│ └── test
│ │ └── Main.purs
├── chapter14
│ ├── .gitignore
│ ├── src
│ │ ├── Main.purs
│ │ └── Data
│ │ │ └── DOM
│ │ │ ├── Simple.purs
│ │ │ ├── Smart.purs
│ │ │ ├── Phantom.purs
│ │ │ ├── Free.purs
│ │ │ └── Name.purs
│ ├── packages.dhall
│ ├── test
│ │ └── Main.purs
│ └── spago.dhall
└── LICENSE
├── deploy_key.enc
├── .gitignore
├── .markdownlint.json
├── text
├── LICENSE
├── SUMMARY.md
└── chapter2.md
├── scripts
├── packages.dhall
├── testAll.sh
├── buildAll.sh
├── updatePackages.sh
└── prepareExercises.sh
├── book.toml
├── CONTRIBUTING.md
├── .github
└── workflows
│ ├── mdbook.yml
│ └── tests.yml
├── purescriptbook.code-workspace
└── README.md
/exercises/chapter9/test/data/tree/b/a.txt:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/b/c/a.txt:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/c/a/a.txt:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/a.txt:
--------------------------------------------------------------------------------
1 | b/b.txt
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/b/b.txt:
--------------------------------------------------------------------------------
1 | c/a.txt
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/c/unused.txt:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/unused.txt:
--------------------------------------------------------------------------------
1 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file1.txt:
--------------------------------------------------------------------------------
1 | 1
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file2.txt:
--------------------------------------------------------------------------------
1 | 2
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file3.txt:
--------------------------------------------------------------------------------
1 | 3
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file4.txt:
--------------------------------------------------------------------------------
1 | 4
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file5.txt:
--------------------------------------------------------------------------------
1 | 5
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file6.txt:
--------------------------------------------------------------------------------
1 | 6
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file7.txt:
--------------------------------------------------------------------------------
1 | 7
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file8.txt:
--------------------------------------------------------------------------------
1 | 8
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/many/file9.txt:
--------------------------------------------------------------------------------
1 | 9
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/root.txt:
--------------------------------------------------------------------------------
1 | a.txt
2 | b/a.txt
3 | c/a/a.txt
--------------------------------------------------------------------------------
/exercises/chapter4/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/foo.txt:
--------------------------------------------------------------------------------
1 | This is some file data.
2 | And another line.
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/nbChars.txt:
--------------------------------------------------------------------------------
1 | A bunch of letters to count with a script.
--------------------------------------------------------------------------------
/exercises/chapter9/test/data-out/foo.txt:
--------------------------------------------------------------------------------
1 | This is some file data.
2 | And another line.
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/bar.txt:
--------------------------------------------------------------------------------
1 | This is some more data.
2 | And a few
3 | more lines.
--------------------------------------------------------------------------------
/deploy_key.enc:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/purescript-contrib/purescript-book/HEAD/deploy_key.enc
--------------------------------------------------------------------------------
/exercises/chapter2/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/index.js:
--------------------------------------------------------------------------------
1 | import { main } from "../output/Main/index.js";
2 |
3 | main();
4 |
--------------------------------------------------------------------------------
/exercises/chapter8/src/index.js:
--------------------------------------------------------------------------------
1 | import { main } from "../output/Main/index.js";
2 |
3 | main();
4 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/manyConcat.txt:
--------------------------------------------------------------------------------
1 | 1
2 | 2
3 | 3
4 | 4
5 | 5
6 | 6
7 | 7
8 | 8
9 | 9
10 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | deploy_key
2 | package-lock.json
3 | dist
4 | .parcel-cache
5 | .cache
6 | /index.html
7 | /book
8 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/URI.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | export const _encodeURIComponent = encodeURIComponent;
4 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/MySolutions.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | // Note to reader: Add your solutions to this file
4 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/URI.purs:
--------------------------------------------------------------------------------
1 | module Test.URI where
2 |
3 | foreign import _encodeURIComponent :: String -> String
4 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/Effect/Alert.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | export const alert = msg => () =>
4 | window.alert(msg);
5 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/tree/expected.txt:
--------------------------------------------------------------------------------
1 | ./root.txt
2 | ./a.txt
3 | ./b/a.txt
4 | ./b/b.txt
5 | ./b/c/a.txt
6 | ./c/a/a.txt
--------------------------------------------------------------------------------
/exercises/chapter9/test/data/user.txt:
--------------------------------------------------------------------------------
1 | {
2 | "userId": 1,
3 | "id": 1,
4 | "title": "delectus aut autem",
5 | "completed": false
6 | }
--------------------------------------------------------------------------------
/exercises/chapter3/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter5/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter6/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter7/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter8/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader: Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/exercises/chapter11/test/MySolutions.purs:
--------------------------------------------------------------------------------
1 | module Test.MySolutions where
2 |
3 | import Prelude
4 |
5 | -- Note to reader : Add your solutions to this file
6 |
--------------------------------------------------------------------------------
/.markdownlint.json:
--------------------------------------------------------------------------------
1 | {
2 | "line-length": false,
3 | "no-duplicate-heading": false,
4 | "no-trailing-punctuation": false,
5 | "commands-show-output": false
6 | }
7 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/Effect/Alert.purs:
--------------------------------------------------------------------------------
1 | module Effect.Alert where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 |
7 | foreign import alert :: String -> Effect Unit
8 |
--------------------------------------------------------------------------------
/exercises/chapter4/src/Data/Person.purs:
--------------------------------------------------------------------------------
1 | module Data.Person where
2 |
3 | type Address = { street :: String, city :: String }
4 |
5 | type Person = { name :: String, address :: Address }
6 |
--------------------------------------------------------------------------------
/exercises/chapter9/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 | import Effect (Effect)
5 | import Effect.Class.Console (log)
6 |
7 | main :: Effect Unit
8 | main = log "hello"
9 |
--------------------------------------------------------------------------------
/exercises/chapter10/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter12/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter13/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter14/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter2/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter3/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter4/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter5/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter6/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter7/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 |
--------------------------------------------------------------------------------
/exercises/chapter2/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 | import Euler (answer)
5 | import Effect.Console (log)
6 |
7 | main = do
8 | log ("The answer is " <> show (answer 1000))
9 |
--------------------------------------------------------------------------------
/exercises/chapter11/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 | /index.js
--------------------------------------------------------------------------------
/exercises/chapter12/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/exercises/chapter13/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/exercises/chapter14/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/exercises/chapter3/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/exercises/chapter4/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/exercises/chapter5/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/exercises/chapter7/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 |
--------------------------------------------------------------------------------
/text/LICENSE:
--------------------------------------------------------------------------------
1 | The text of this book is licensed under the Creative Commons
2 | Attribution-NonCommercial-ShareAlike 3.0 Unported License:
3 |
4 | https://creativecommons.org/licenses/by-nc-sa/3.0/deed.en_US
5 |
--------------------------------------------------------------------------------
/exercises/chapter9/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 | /test/data-out/*
12 |
--------------------------------------------------------------------------------
/exercises/chapter8/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc-package/
7 | /.psc*
8 | /.purs*
9 | /.psa*
10 | /.spago
11 | /.cache/
12 | /dist/
13 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/Effect/Storage.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | export const setItem = key => value => () =>
4 | window.localStorage.setItem(key, value);
5 |
6 | export const getItem = key => () =>
7 | window.localStorage.getItem(key);
8 |
--------------------------------------------------------------------------------
/scripts/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter10/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter11/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter12/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter12/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Class.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 | log "You should add some tests."
12 |
--------------------------------------------------------------------------------
/exercises/chapter13/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter14/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter14/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Class.Console (log)
7 |
8 | main :: Effect Unit
9 | main = do
10 | log "🍝"
11 | log "You should add some tests."
12 |
--------------------------------------------------------------------------------
/exercises/chapter2/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter3/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter4/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter5/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter6/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter7/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter8/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter9/packages.dhall:
--------------------------------------------------------------------------------
1 | let upstream =
2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220615/packages.dhall
3 | sha256:6b62a899c22125a2735a7c354bbb66a2fe24ff45cec0a8b8b890769a01a99210
4 |
5 | in upstream
6 |
--------------------------------------------------------------------------------
/exercises/chapter8/test/Random.purs:
--------------------------------------------------------------------------------
1 | module Test.Random where
2 |
3 | import Prelude
4 | import Effect (Effect)
5 | import Effect.Random (random)
6 | import Effect.Console (logShow)
7 |
8 | main :: Effect Unit
9 | main = do
10 | n <- random
11 | logShow n
12 |
--------------------------------------------------------------------------------
/book.toml:
--------------------------------------------------------------------------------
1 | [book]
2 | authors = ["Phil Freeman"]
3 | language = "en"
4 | multilingual = false
5 | src = "text"
6 | title = "PureScript by Example"
7 | [output.html]
8 | git-repository-url = "https://github.com/purescript-contrib/purescript-book"
9 | mathjax-support = true
10 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/Effect/Storage.purs:
--------------------------------------------------------------------------------
1 | module Effect.Storage where
2 |
3 | import Prelude
4 | import Data.Argonaut (Json)
5 | import Effect (Effect)
6 |
7 | foreign import setItem :: String -> String -> Effect Unit
8 |
9 | foreign import getItem :: String -> Effect Json
10 |
--------------------------------------------------------------------------------
/exercises/chapter2/src/Euler.purs:
--------------------------------------------------------------------------------
1 | module Euler where
2 |
3 | import Prelude
4 | import Data.List (range, filter)
5 | import Data.Foldable (sum)
6 |
7 | ns n = range 0 (n - 1)
8 |
9 | multiples n = filter (\n -> mod n 3 == 0 || mod n 5 == 0) (ns n)
10 |
11 | answer n = sum (multiples n)
12 |
--------------------------------------------------------------------------------
/exercises/chapter2/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 | import Data.Int (rem)
5 | import Data.Number (pi, sqrt)
6 |
7 | -- ANCHOR: diagonal
8 | diagonal w h = sqrt (w * w + h * h)
9 | -- ANCHOR_END: diagonal
10 |
11 | circleArea r = pi * r * r
12 |
13 | leftoverCents n = rem n 100
14 |
--------------------------------------------------------------------------------
/exercises/chapter10/html/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Address Book
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
--------------------------------------------------------------------------------
/exercises/chapter9/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-book-chapter12",
3 | "version": "0.1.0",
4 | "description": "Asynchronous Effects",
5 | "main": "",
6 | "private": true,
7 | "author": "Phil Freeman",
8 | "license": "Creative,Commons,Attribution-NonCommercial-ShareAlike,4.0,International,License",
9 | "dependencies": {
10 | "xhr2": "^0.2.1"
11 | }
12 | }
13 |
--------------------------------------------------------------------------------
/exercises/chapter3/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "console"
8 | , "control"
9 | , "effect"
10 | , "lists"
11 | , "maybe"
12 | , "prelude"
13 | , "test-unit"
14 | ]
15 | , packages = ./packages.dhall
16 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
17 | }
18 |
--------------------------------------------------------------------------------
/scripts/testAll.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | # Echo commands to shell
4 | set -x
5 | # Exit on first failure
6 | set -e
7 |
8 | # For all chapters
9 | for d in exercises/*; do
10 | # if directory (excludes LICENSE file)
11 | if [ -d $d ]; then
12 | # enter directory
13 | pushd $d
14 | # build
15 | spago test
16 | # exit directory
17 | popd
18 | fi
19 | done
20 |
--------------------------------------------------------------------------------
/exercises/chapter12/html/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | 2D Graphics Demo
6 |
7 |
8 |
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/exercises/chapter8/src/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Address Book
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Address Book
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
--------------------------------------------------------------------------------
/exercises/chapter13/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "effect"
10 | , "foldable-traversable"
11 | , "functions"
12 | , "lists"
13 | , "prelude"
14 | , "quickcheck"
15 | ]
16 | , packages = ./packages.dhall
17 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
18 | }
19 |
--------------------------------------------------------------------------------
/exercises/chapter2/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "console"
8 | , "effect"
9 | , "foldable-traversable"
10 | , "integers"
11 | , "lists"
12 | , "numbers"
13 | , "prelude"
14 | , "test-unit"
15 | ]
16 | , packages = ./packages.dhall
17 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
18 | }
19 |
--------------------------------------------------------------------------------
/exercises/chapter14/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "effect"
10 | , "foldable-traversable"
11 | , "free"
12 | , "maybe"
13 | , "prelude"
14 | , "strings"
15 | , "transformers"
16 | ]
17 | , packages = ./packages.dhall
18 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
19 | }
20 |
--------------------------------------------------------------------------------
/CONTRIBUTING.md:
--------------------------------------------------------------------------------
1 | # Contributing
2 |
3 | Please open PRs or Issues if you find anything to improve in the book.
4 |
5 | We appreciate your feedback.
6 |
7 | ## Editing chapter text
8 |
9 | To test changes to the text locally, install [mdbook](https://github.com/rust-lang/mdBook), then run this command from repo root:
10 |
11 | ```sh
12 | mdbook serve -o
13 | ```
14 |
15 | The rendered webpage will automatically refresh with any changes to readme files.
16 |
--------------------------------------------------------------------------------
/exercises/chapter4/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "effect"
10 | , "foldable-traversable"
11 | , "integers"
12 | , "maybe"
13 | , "numbers"
14 | , "partial"
15 | , "prelude"
16 | , "test-unit"
17 | ]
18 | , packages = ./packages.dhall
19 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
20 | }
21 |
--------------------------------------------------------------------------------
/exercises/chapter6/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Class.Console (logShow)
7 | import Data.Hashable (hash, hashEqual)
8 |
9 | main :: Effect Unit
10 | main = do
11 | logShow $ hash 123
12 | logShow (hash true)
13 | logShow (hash [1, 2, 3])
14 | logShow (hash "testing")
15 | logShow (hash 'a')
16 | logShow ("foo" `hashEqual` "foo")
17 | logShow ("foo" `hashEqual` "bar")
18 |
--------------------------------------------------------------------------------
/exercises/chapter5/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "control"
10 | , "effect"
11 | , "foldable-traversable"
12 | , "integers"
13 | , "maybe"
14 | , "prelude"
15 | , "strings"
16 | , "test-unit"
17 | , "tuples"
18 | ]
19 | , packages = ./packages.dhall
20 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
21 | }
22 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Data/GameEnvironment.purs:
--------------------------------------------------------------------------------
1 | module Data.GameEnvironment where
2 |
3 | -- ANCHOR: env
4 | type PlayerName = String
5 |
6 | newtype GameEnvironment = GameEnvironment
7 | { playerName :: PlayerName
8 | , debugMode :: Boolean
9 | }
10 | -- ANCHOR_END: env
11 |
12 | gameEnvironment :: PlayerName -> Boolean -> GameEnvironment
13 | gameEnvironment playerName debugMode = GameEnvironment
14 | { playerName : playerName
15 | , debugMode : debugMode
16 | }
17 |
--------------------------------------------------------------------------------
/scripts/buildAll.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | # Echo commands to shell
4 | set -x
5 | # Exit on first failure
6 | set -e
7 |
8 | # For all chapters
9 | for d in exercises/*; do
10 | # if directory (excludes LICENSE file)
11 | if [ -d $d ]; then
12 | # enter directory
13 | pushd $d
14 | # build
15 | # if node project
16 | if [ -f package.json ]; then
17 | npm install
18 | fi
19 | spago build
20 | # exit directory
21 | popd
22 | fi
23 | done
24 |
--------------------------------------------------------------------------------
/exercises/chapter13/src/Sorted.purs:
--------------------------------------------------------------------------------
1 | module Sorted where
2 |
3 | import Prelude
4 |
5 | import Data.Array (sort)
6 | import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary)
7 |
8 | newtype Sorted a = Sorted (Array a)
9 |
10 | sorted :: forall a. Sorted a -> Array a
11 | sorted (Sorted xs) = xs
12 |
13 | instance Show a => Show (Sorted a) where
14 | show = show <<< sorted
15 |
16 | instance (Arbitrary a, Ord a) => Arbitrary (Sorted a) where
17 | arbitrary = map (Sorted <<< sort) arbitrary
18 |
--------------------------------------------------------------------------------
/exercises/chapter6/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "effect"
10 | , "either"
11 | , "foldable-traversable"
12 | , "lists"
13 | , "maybe"
14 | , "newtype"
15 | , "partial"
16 | , "prelude"
17 | , "strings"
18 | , "test-unit"
19 | , "tuples"
20 | ]
21 | , packages = ./packages.dhall
22 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
23 | }
24 |
--------------------------------------------------------------------------------
/scripts/updatePackages.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | # Run this script from purescript book repo root
4 |
5 | # Echo commands to shell
6 | set -x
7 | # Exit on first failure
8 | set -e
9 |
10 | # Update package set
11 | pushd scripts
12 | spago upgrade-set
13 | popd
14 |
15 | # For all chapters
16 | for d in exercises/*; do
17 | # if directory (excludes LICENSE file)
18 | if [ -d $d ]; then
19 | # copy updated packages.dhall to chapter
20 | cp scripts/packages.dhall $d/packages.dhall
21 | fi
22 | done
23 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/HTTP.purs:
--------------------------------------------------------------------------------
1 | module Test.HTTP where
2 |
3 | -- ANCHOR: getUrl
4 | import Prelude
5 | import Affjax.Node as AN
6 | import Affjax.ResponseFormat as ResponseFormat
7 | import Data.Either (Either(..))
8 | import Effect.Aff (Aff)
9 |
10 | getUrl :: String -> Aff String
11 | getUrl url = do
12 | result <- AN.get ResponseFormat.string url
13 | pure case result of
14 | Left err -> "GET /api response failed to decode: " <> AN.printError err
15 | Right response -> response.body
16 | -- ANCHOR_END: getUrl
17 |
--------------------------------------------------------------------------------
/exercises/chapter7/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "effect"
10 | , "either"
11 | , "foldable-traversable"
12 | , "integers"
13 | , "lists"
14 | , "maybe"
15 | , "prelude"
16 | , "strings"
17 | , "test-unit"
18 | , "transformers"
19 | , "tuples"
20 | , "validation"
21 | ]
22 | , packages = ./packages.dhall
23 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
24 | }
25 |
--------------------------------------------------------------------------------
/exercises/chapter12/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "canvas"
9 | , "console"
10 | , "effect"
11 | , "foldable-traversable"
12 | , "integers"
13 | , "maybe"
14 | , "numbers"
15 | , "partial"
16 | , "prelude"
17 | , "random"
18 | , "refs"
19 | , "web-dom"
20 | , "web-events"
21 | , "web-html"
22 | ]
23 | , packages = ./packages.dhall
24 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
25 | }
26 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/ParallelFetch.purs:
--------------------------------------------------------------------------------
1 | module Test.ParallelFetch where
2 |
3 | -- ANCHOR: fetchPar
4 | import Prelude
5 |
6 | import Control.Parallel (parTraverse)
7 | import Effect (Effect)
8 | import Effect.Aff (launchAff_)
9 | import Effect.Class.Console (logShow)
10 | import Test.HTTP (getUrl)
11 |
12 | fetchPar :: Effect Unit
13 | fetchPar =
14 | launchAff_ do
15 | let
16 | urls = map (\n -> "https://reqres.in/api/users/" <> show n) [ 1, 2 ]
17 | res <- parTraverse getUrl urls
18 | logShow res
19 | -- ANCHOR_END: fetchPar
20 |
--------------------------------------------------------------------------------
/exercises/chapter8/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-book-chapter8",
3 | "version": "0.1.0",
4 | "description": "The Effect Monad",
5 | "main": "output/Main/index.js",
6 | "private": true,
7 | "author": "Phil Freeman",
8 | "license": "Creative,Commons,Attribution-NonCommercial-ShareAlike,4.0,International,License",
9 | "dependencies": {
10 | "react": "^16.13.1",
11 | "react-dom": "^16.13.1"
12 | },
13 | "devDependencies": {
14 | "process": "^0.11.10"
15 | },
16 | "alias": {
17 | "process": false
18 | }
19 | }
20 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Data/GameItem.purs:
--------------------------------------------------------------------------------
1 | module Data.GameItem where
2 |
3 | import Prelude
4 |
5 | import Data.Maybe (Maybe(..))
6 |
7 | -- ANCHOR: GameItem
8 | data GameItem = Candle | Matches
9 | -- ANCHOR_END: GameItem
10 |
11 | instance Show GameItem where
12 | show Candle = "Candle"
13 | show Matches = "Matches"
14 |
15 | derive instance Eq GameItem
16 | derive instance Ord GameItem
17 |
18 | readItem :: String -> Maybe GameItem
19 | readItem "Candle" = Just Candle
20 | readItem "Matches" = Just Matches
21 | readItem _ = Nothing
22 |
--------------------------------------------------------------------------------
/exercises/chapter10/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-book-chapter10",
3 | "version": "0.1.0",
4 | "description": "The Foreign Function Interface",
5 | "main": "output/Main/index.js",
6 | "private": true,
7 | "author": "Phil Freeman",
8 | "license": "Creative,Commons,Attribution-NonCommercial-ShareAlike,4.0,International,License",
9 | "dependencies": {
10 | "react": "^16.13.1",
11 | "react-dom": "^16.13.1"
12 | },
13 | "devDependencies": {
14 | "process": "^0.11.10"
15 | },
16 | "alias": {
17 | "process": false
18 | }
19 | }
20 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/ParallelDelay.purs:
--------------------------------------------------------------------------------
1 | module Test.ParallelDelay where
2 |
3 | -- ANCHOR: delays
4 | import Prelude
5 |
6 | import Control.Parallel (parSequence_)
7 | import Data.Array (replicate)
8 | import Data.Foldable (sequence_)
9 | import Effect (Effect)
10 | import Effect.Aff (Aff, Milliseconds(..), delay, launchAff_)
11 |
12 | delayArray :: Array (Aff Unit)
13 | delayArray = replicate 100 $ delay $ Milliseconds 10.0
14 |
15 | seqDelay :: Effect Unit
16 | seqDelay = launchAff_ $ sequence_ delayArray
17 |
18 | parDelay :: Effect Unit
19 | parDelay = launchAff_ $ parSequence_ delayArray
20 | -- ANCHOR_END: delays
21 |
--------------------------------------------------------------------------------
/exercises/chapter11/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "control"
10 | , "effect"
11 | , "either"
12 | , "foldable-traversable"
13 | , "identity"
14 | , "lists"
15 | , "maybe"
16 | , "newtype"
17 | , "node-readline"
18 | , "optparse"
19 | , "ordered-collections"
20 | , "prelude"
21 | , "strings"
22 | , "test-unit"
23 | , "transformers"
24 | , "tuples"
25 | ]
26 | , packages = ./packages.dhall
27 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
28 | }
29 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Data/Coords.purs:
--------------------------------------------------------------------------------
1 | module Data.Coords where
2 |
3 | import Prelude
4 |
5 | newtype Coords = Coords
6 | { x :: Int
7 | , y :: Int
8 | }
9 |
10 | instance Show Coords where
11 | show (Coords p) = "Coords " <>
12 | "{ x: " <> show p.x <>
13 | ", y: " <> show p.y <>
14 | " }"
15 |
16 | derive instance Eq Coords
17 | derive instance Ord Coords
18 |
19 | coords :: Int -> Int -> Coords
20 | coords x y = Coords { x: x, y: y }
21 |
22 | prettyPrintCoords :: Coords -> String
23 | prettyPrintCoords (Coords p) = "(" <> show p.x <> ", " <> show p.y <> ")"
24 |
--------------------------------------------------------------------------------
/text/SUMMARY.md:
--------------------------------------------------------------------------------
1 | # Summary
2 |
3 | [Foreword](../README.md)
4 |
5 | * [Introduction](chapter1.md)
6 | * [Getting Started](chapter2.md)
7 | * [Functions and Records](chapter3.md)
8 | * [Pattern Matching](chapter4.md)
9 | * [Recursion, Maps And Folds](chapter5.md)
10 | * [Type Classes](chapter6.md)
11 | * [Applicative Validation](chapter7.md)
12 | * [The Effect Monad](chapter8.md)
13 | * [Asynchronous Effects](chapter9.md)
14 | * [The Foreign Function Interface](chapter10.md)
15 | * [Monadic Adventures](chapter11.md)
16 | * [Canvas Graphics](chapter12.md)
17 | * [Generative Testing](chapter13.md)
18 | * [Domain-Specific Languages](chapter14.md)
19 |
--------------------------------------------------------------------------------
/exercises/chapter9/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "aff"
8 | , "affjax"
9 | , "affjax-node"
10 | , "arrays"
11 | , "bifunctors"
12 | , "console"
13 | , "effect"
14 | , "either"
15 | , "exceptions"
16 | , "foldable-traversable"
17 | , "functions"
18 | , "maybe"
19 | , "node-buffer"
20 | , "node-fs-aff"
21 | , "node-path"
22 | , "ordered-collections"
23 | , "parallel"
24 | , "prelude"
25 | , "strings"
26 | , "test-unit"
27 | ]
28 | , packages = ./packages.dhall
29 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
30 | }
31 |
--------------------------------------------------------------------------------
/exercises/chapter8/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "arrays"
8 | , "console"
9 | , "control"
10 | , "effect"
11 | , "either"
12 | , "exceptions"
13 | , "foldable-traversable"
14 | , "integers"
15 | , "lists"
16 | , "numbers"
17 | , "maybe"
18 | , "prelude"
19 | , "random"
20 | , "react-basic"
21 | , "react-basic-dom"
22 | , "react-basic-hooks"
23 | , "st"
24 | , "strings"
25 | , "test-unit"
26 | , "tuples"
27 | , "validation"
28 | , "web-dom"
29 | , "web-html"
30 | ]
31 | , packages = ./packages.dhall
32 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
33 | }
34 |
--------------------------------------------------------------------------------
/exercises/chapter13/src/Merge.purs:
--------------------------------------------------------------------------------
1 | module Merge where
2 |
3 | import Prelude
4 |
5 | import Data.List (List(..), fromFoldable, toUnfoldable, reverse)
6 |
7 | merge :: Array Int -> Array Int -> Array Int
8 | merge = mergePoly
9 |
10 | mergePoly :: forall a. Ord a => Array a -> Array a -> Array a
11 | mergePoly = mergeWith identity
12 |
13 | mergeWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a -> Array a
14 | mergeWith f = \xs ys ->
15 | toUnfoldable (go Nil (fromFoldable xs) (fromFoldable ys))
16 | where
17 | go acc Nil ys = reverse acc <> ys
18 | go acc xs Nil = reverse acc <> xs
19 | go acc xs@(Cons x xs') ys@(Cons y ys') =
20 | case compare (f x) (f y) of
21 | LT -> go (Cons x acc) xs' ys
22 | _ -> go (Cons y acc) xs ys'
23 |
--------------------------------------------------------------------------------
/exercises/chapter12/src/Example/Rectangle.purs:
--------------------------------------------------------------------------------
1 | module Example.Rectangle where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Data.Maybe (Maybe(..))
7 | import Graphics.Canvas (rect, fillPath, setFillStyle, getContext2D,
8 | getCanvasElementById)
9 | import Partial.Unsafe (unsafePartial)
10 |
11 | -- ANCHOR: main
12 | main :: Effect Unit
13 | main = void $ unsafePartial do
14 | Just canvas <- getCanvasElementById "canvas"
15 | ctx <- getContext2D canvas
16 | -- ANCHOR_END: main
17 |
18 | -- ANCHOR: setFillStyle
19 | setFillStyle ctx "#00F"
20 | -- ANCHOR_END: setFillStyle
21 |
22 | -- ANCHOR: fillPath
23 | fillPath ctx $ rect ctx
24 | { x: 250.0
25 | , y: 250.0
26 | , width: 100.0
27 | , height: 100.0
28 | }
29 | -- ANCHOR_END: fillPath
30 |
--------------------------------------------------------------------------------
/exercises/chapter10/spago.dhall:
--------------------------------------------------------------------------------
1 | {-
2 | Welcome to a Spago project!
3 | You can edit this file as you like.
4 | -}
5 | { name = "my-project"
6 | , dependencies =
7 | [ "aff"
8 | , "aff-promise"
9 | , "argonaut"
10 | , "argonaut-generic"
11 | , "arrays"
12 | , "bifunctors"
13 | , "console"
14 | , "control"
15 | , "effect"
16 | , "either"
17 | , "exceptions"
18 | , "foldable-traversable"
19 | , "free"
20 | , "functions"
21 | , "maybe"
22 | , "ordered-collections"
23 | , "pairs"
24 | , "prelude"
25 | , "react-basic"
26 | , "react-basic-dom"
27 | , "react-basic-hooks"
28 | , "strings"
29 | , "test-unit"
30 | , "tuples"
31 | , "validation"
32 | , "web-dom"
33 | , "web-html"
34 | ]
35 | , packages = ./packages.dhall
36 | , sources = [ "src/**/*.purs", "test/**/*.purs" ]
37 | }
38 |
--------------------------------------------------------------------------------
/scripts/prepareExercises.sh:
--------------------------------------------------------------------------------
1 | #!/usr/bin/env bash
2 |
3 | # This script removes meta information that is not intended for readers of the book
4 |
5 | # Echo commands to shell
6 | set -x
7 | # Exit on first failure
8 | set -e
9 |
10 | # For all chapters
11 | for d in exercises/chapter*; do
12 | # All .purs & .js files of chapter exercises
13 | FILES=$(find $d/src $d/test -name '*.purs' -o -name '*.js')
14 |
15 | for f in $FILES; do
16 | # Delete lines starting with an 'ANCHOR' comment
17 | perl -ni -e 'print if !/^\s*(--|\/\/) ANCHOR/' $f
18 |
19 | # Delete lines with a note to delete them
20 | perl -ni -e 'print if !/This line should have been automatically deleted/' $f
21 | done
22 |
23 | # If there's a no-peeking directory
24 | if [ -d $d/test/no-peeking ]; then
25 | # Move 'no-peeking' sources out of the compilation path
26 | mv $d/test/no-peeking $d
27 | fi
28 | done
29 |
--------------------------------------------------------------------------------
/exercises/chapter8/test/Examples.purs:
--------------------------------------------------------------------------------
1 | module Test.Examples where
2 |
3 | import Prelude
4 | import Control.Plus (empty)
5 | import Data.List (List(..), (:))
6 | import Data.Maybe (Maybe(..))
7 | import Data.Array ((..))
8 |
9 | {-| Monads and Do Notation -}
10 | -- ANCHOR: countThrows
11 | countThrows :: Int -> Array (Array Int)
12 | countThrows n = do
13 | x <- 1 .. 6
14 | y <- 1 .. 6
15 | if x + y == n
16 | then pure [ x, y ]
17 | else empty
18 | -- ANCHOR_END: countThrows
19 |
20 | {-| Folding With Monads -}
21 | foldM :: forall m a b
22 | . Monad m
23 | => (a -> b -> m a)
24 | -> a
25 | -> List b
26 | -> m a
27 | foldM _ a Nil = pure a
28 | foldM f a (b : bs) = do
29 | a' <- f a b
30 | foldM f a' bs
31 |
32 | -- ANCHOR: safeDivide
33 | safeDivide :: Int -> Int -> Maybe Int
34 | safeDivide _ 0 = Nothing
35 | safeDivide a b = Just (a / b)
36 | -- ANCHOR_END: safeDivide
37 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/Copy.purs:
--------------------------------------------------------------------------------
1 | module Test.Copy where
2 |
3 | -- ANCHOR: copyFile
4 | import Prelude
5 | import Data.Either (Either(..))
6 | import Effect.Aff (Aff, attempt, message, launchAff_)
7 | import Effect (Effect)
8 | import Effect.Class.Console (log)
9 | import Node.Encoding (Encoding(..))
10 | import Node.FS.Aff (readTextFile, writeTextFile)
11 | import Node.Path (FilePath)
12 |
13 | main :: Effect Unit
14 | main = launchAff_ program
15 |
16 | program :: Aff Unit
17 | program = do
18 | result <- attempt $ copyFile "file1.txt" "file2.txt"
19 | case result of
20 | Left e -> log $ "There was a problem with copyFile: " <> message e
21 | _ -> pure unit
22 |
23 | copyFile :: FilePath -> FilePath -> Aff Unit
24 | copyFile file1 file2 = do
25 | my_data <- readTextFile UTF8 file1
26 | writeTextFile UTF8 file2 my_data
27 | -- ANCHOR_END: copyFile
28 |
29 | -- Main is unused, and is only linked to in text
30 |
--------------------------------------------------------------------------------
/.github/workflows/mdbook.yml:
--------------------------------------------------------------------------------
1 | name: Build Book
2 |
3 | on:
4 | push:
5 | branches: [master]
6 | pull_request:
7 |
8 | jobs:
9 | deploy:
10 | runs-on: ubuntu-latest
11 | steps:
12 | - uses: actions/checkout@v2
13 |
14 | - name: Setup mdBook
15 | uses: peaceiris/actions-mdbook@v1
16 | with:
17 | mdbook-version: 'latest'
18 |
19 | - name: Set up PureScript toolchain
20 | uses: purescript-contrib/setup-purescript@main
21 |
22 | - name: Add version section
23 | run: |
24 | version=$(purs --version)
25 | today=$(date -I)
26 | echo -e "\n## Release\n" >> README.md
27 | echo -e "PureScript v$version\n" >> README.md
28 | echo -e "Published on $today" >> README.md
29 |
30 | - run: mdbook build
31 |
32 | - name: Deploy
33 | uses: peaceiris/actions-gh-pages@v3
34 | if: github.ref == 'refs/heads/master'
35 | with:
36 | github_token: ${{ secrets.GITHUB_TOKEN }}
37 | publish_dir: ./book
38 | cname: book.purescript.org
39 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Data/GameState.purs:
--------------------------------------------------------------------------------
1 | module Data.GameState where
2 |
3 | import Prelude
4 |
5 | import Data.Coords (Coords(..), coords)
6 | import Data.GameItem (GameItem(..))
7 | -- ANCHOR: imports
8 | import Data.Map as M
9 | import Data.Set as S
10 | -- ANCHOR_END: imports
11 | import Data.Tuple (Tuple(..))
12 |
13 | -- ANCHOR: GameState
14 | newtype GameState = GameState
15 | { items :: M.Map Coords (S.Set GameItem)
16 | , player :: Coords
17 | , inventory :: S.Set GameItem
18 | }
19 | -- ANCHOR_END: GameState
20 |
21 | instance Show GameState where
22 | show (GameState o) =
23 | "GameState " <>
24 | "{ items: " <> show o.items <>
25 | ", player: " <> show o.player <>
26 | ", inventory: " <> show o.inventory <>
27 | " }"
28 |
29 | initialGameState :: GameState
30 | initialGameState = GameState
31 | { items : M.fromFoldable [ Tuple (coords 0 1) (S.singleton Candle)
32 | , Tuple (coords 0 0) (S.singleton Matches)
33 | ]
34 | , player : Coords { x: 0, y: 0 }
35 | , inventory : S.empty
36 | }
37 |
--------------------------------------------------------------------------------
/exercises/LICENSE:
--------------------------------------------------------------------------------
1 | The MIT License (MIT)
2 |
3 | Copyright (c) 2014-16 Phil Freeman
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy
6 | of this software and associated documentation files (the "Software"), to deal
7 | in the Software without restriction, including without limitation the rights
8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 |
12 | The above copyright notice and this permission notice shall be included in
13 | all copies or substantial portions of the Software.
14 |
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
21 | THE SOFTWARE.
22 |
--------------------------------------------------------------------------------
/exercises/chapter14/src/Data/DOM/Simple.purs:
--------------------------------------------------------------------------------
1 | module Data.DOM.Simple where
2 |
3 | import Prelude
4 |
5 | import Data.Maybe (Maybe(..))
6 | import Data.String (joinWith)
7 |
8 | newtype Element = Element
9 | { name :: String
10 | , attribs :: Array Attribute
11 | , content :: Maybe (Array Content)
12 | }
13 |
14 | data Content
15 | = TextContent String
16 | | ElementContent Element
17 |
18 | newtype Attribute = Attribute
19 | { key :: String
20 | , value :: String
21 | }
22 |
23 | render :: Element -> String
24 | render (Element e) =
25 | "<" <> e.name <>
26 | " " <> joinWith " " (map renderAttribute e.attribs) <>
27 | renderContent e.content
28 | where
29 | renderAttribute :: Attribute -> String
30 | renderAttribute (Attribute x) = x.key <> "=\"" <> x.value <> "\""
31 |
32 | renderContent :: Maybe (Array Content) -> String
33 | renderContent Nothing = " />"
34 | renderContent (Just content) =
35 | ">" <> joinWith "" (map renderContentItem content) <>
36 | " e.name <> ">"
37 | where
38 | renderContentItem :: Content -> String
39 | renderContentItem (TextContent s) = s
40 | renderContentItem (ElementContent e') = render e'
41 |
--------------------------------------------------------------------------------
/purescriptbook.code-workspace:
--------------------------------------------------------------------------------
1 | {
2 | "folders": [
3 | {
4 | "path": "."
5 | },
6 | {
7 | "path": "exercises/chapter2"
8 | },
9 | {
10 | "path": "exercises/chapter3"
11 | },
12 | {
13 | "path": "exercises/chapter4"
14 | },
15 | {
16 | "path": "exercises/chapter5"
17 | },
18 | {
19 | "path": "exercises/chapter6"
20 | },
21 | {
22 | "path": "exercises/chapter7"
23 | },
24 | {
25 | "path": "exercises/chapter8"
26 | },
27 | {
28 | "path": "exercises/chapter9"
29 | },
30 | {
31 | "path": "exercises/chapter10"
32 | },
33 | {
34 | "path": "exercises/chapter11"
35 | },
36 | {
37 | "path": "exercises/chapter12"
38 | },
39 | {
40 | "path": "exercises/chapter13"
41 | },
42 | {
43 | "path": "exercises/chapter14"
44 | }
45 | ],
46 | "settings": {
47 | "files.exclude": {
48 | "**/.git": true,
49 | "**/.svn": true,
50 | "**/.hg": true,
51 | "**/CVS": true,
52 | "**/.DS_Store": true,
53 | "exercises": true
54 | }
55 | },
56 | "extensions": {
57 | "recommendations": [
58 | "nwolverson.ide-purescript",
59 | "nwolverson.language-purescript",
60 | "mvakula.vscode-purty"
61 | ]
62 | }
63 | }
64 |
--------------------------------------------------------------------------------
/exercises/chapter12/src/Example/Random.purs:
--------------------------------------------------------------------------------
1 | module Example.Random where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Random (random)
7 | import Data.Array ((..))
8 | import Data.Foldable (for_)
9 | import Data.Maybe (Maybe(..))
10 | import Graphics.Canvas (strokePath, fillPath, arc, setStrokeStyle,
11 | setFillStyle, getContext2D, getCanvasElementById)
12 | import Data.Number as Number
13 | import Partial.Unsafe (unsafePartial)
14 |
15 | main :: Effect Unit
16 | main = void $ unsafePartial do
17 | Just canvas <- getCanvasElementById "canvas"
18 | ctx <- getContext2D canvas
19 |
20 | -- ANCHOR: style
21 | setFillStyle ctx "#F00"
22 | setStrokeStyle ctx "#000"
23 | -- ANCHOR_END: style
24 |
25 | -- ANCHOR: for
26 | for_ (1 .. 100) \_ -> do
27 | -- ANCHOR_END: for
28 | -- ANCHOR: random
29 | x <- random
30 | y <- random
31 | r <- random
32 | -- ANCHOR_END: random
33 |
34 | -- ANCHOR: path
35 | let path = arc ctx
36 | { x : x * 600.0
37 | , y : y * 600.0
38 | , radius : r * 50.0
39 | , start : 0.0
40 | , end : Number.tau
41 | , useCounterClockwise: false
42 | }
43 |
44 | fillPath ctx path
45 | strokePath ctx path
46 | -- ANCHOR_END: path
47 |
--------------------------------------------------------------------------------
/exercises/chapter8/src/Data/AddressBook.purs:
--------------------------------------------------------------------------------
1 | module Data.AddressBook where
2 |
3 | import Prelude
4 | import Data.Generic.Rep (class Generic)
5 | import Data.Show.Generic (genericShow)
6 |
7 | type Address
8 | = { street :: String
9 | , city :: String
10 | , state :: String
11 | }
12 |
13 | address :: String -> String -> String -> Address
14 | address street city state = { street, city, state }
15 |
16 | data PhoneType
17 | = HomePhone
18 | | WorkPhone
19 | | CellPhone
20 | | OtherPhone
21 |
22 | derive instance Generic PhoneType _
23 |
24 | instance Show PhoneType where
25 | show = genericShow
26 |
27 | type PhoneNumber
28 | = { "type" :: PhoneType
29 | , number :: String
30 | }
31 |
32 | phoneNumber :: PhoneType -> String -> PhoneNumber
33 | phoneNumber ty number =
34 | { "type": ty
35 | , number: number
36 | }
37 |
38 | type Person
39 | = { firstName :: String
40 | , lastName :: String
41 | , homeAddress :: Address
42 | , phones :: Array PhoneNumber
43 | }
44 |
45 | person :: String -> String -> Address -> Array PhoneNumber -> Person
46 | person firstName lastName homeAddress phones = { firstName, lastName, homeAddress, phones }
47 |
48 | examplePerson :: Person
49 | examplePerson =
50 | person "John" "Smith"
51 | (address "123 Fake St." "FakeTown" "CA")
52 | [ phoneNumber HomePhone "555-555-5555"
53 | , phoneNumber CellPhone "555-555-0000"
54 | ]
55 |
--------------------------------------------------------------------------------
/exercises/chapter13/src/Tree.purs:
--------------------------------------------------------------------------------
1 | module Tree where
2 |
3 | import Prelude
4 |
5 | import Data.Foldable (foldr)
6 | import Test.QuickCheck.Arbitrary (class Coarbitrary, class Arbitrary, coarbitrary, arbitrary)
7 |
8 | data Tree a
9 | = Leaf
10 | | Branch (Tree a) a (Tree a)
11 |
12 | instance (Arbitrary a, Ord a) => Arbitrary (Tree a) where
13 | arbitrary = map fromArray arbitrary
14 |
15 | instance (Coarbitrary a) => Coarbitrary (Tree a) where
16 | coarbitrary Leaf = identity
17 | coarbitrary (Branch l a r) =
18 | coarbitrary l <<<
19 | coarbitrary a <<<
20 | coarbitrary r
21 |
22 | insert :: forall a. (Ord a) => a -> Tree a -> Tree a
23 | insert a Leaf = Branch Leaf a Leaf
24 | insert a (Branch l a1 r) | a < a1 = Branch (insert a l) a1 r
25 | insert a (Branch l a1 r) = Branch l a1 (insert a r)
26 |
27 | member :: forall a. (Ord a) => a -> Tree a -> Boolean
28 | member _ Leaf = false
29 | member a (Branch _ a1 _) | a == a1 = true
30 | member a (Branch l a1 _) | a < a1 = a `member` l
31 | member a (Branch _ _ r) = a `member` r
32 |
33 | toArray :: forall a. Tree a -> Array a
34 | toArray Leaf = []
35 | toArray (Branch l a r) = toArray l <> [a] <> toArray r
36 |
37 | fromArray :: forall a. (Ord a) => Array a -> Tree a
38 | fromArray = foldr insert Leaf
39 |
40 | anywhere :: forall a. (Tree a -> Boolean) -> Tree a -> Boolean
41 | anywhere f Leaf = f Leaf
42 | anywhere f t@(Branch l _ r) = anywhere f l || f t || anywhere f r
43 |
--------------------------------------------------------------------------------
/exercises/chapter12/src/Example/Shapes.purs:
--------------------------------------------------------------------------------
1 | module Example.Shapes where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Data.Maybe (Maybe(..))
7 | import Graphics.Canvas (closePath, lineTo, moveTo, fillPath,
8 | setFillStyle, arc, rect, getContext2D,
9 | getCanvasElementById)
10 | import Data.Number as Number
11 | import Partial.Unsafe (unsafePartial)
12 |
13 | -- ANCHOR: translate
14 | translate
15 | :: forall r
16 | . Number
17 | -> Number
18 | -> { x :: Number, y :: Number | r }
19 | -> { x :: Number, y :: Number | r }
20 | translate dx dy shape = shape
21 | { x = shape.x + dx
22 | , y = shape.y + dy
23 | }
24 | -- ANCHOR_END: translate
25 |
26 | main :: Effect Unit
27 | main = void $ unsafePartial do
28 | Just canvas <- getCanvasElementById "canvas"
29 | ctx <- getContext2D canvas
30 |
31 | setFillStyle ctx "#00F"
32 |
33 | fillPath ctx $ rect ctx $ translate (-200.0) (-200.0)
34 | { x: 250.0
35 | , y: 250.0
36 | , width: 100.0
37 | , height: 100.0
38 | }
39 |
40 | setFillStyle ctx "#0F0"
41 |
42 | fillPath ctx $ arc ctx $ translate 200.0 200.0
43 | { x: 300.0
44 | , y: 300.0
45 | , radius: 50.0
46 | , start: 0.0
47 | , end: Number.tau * 2.0 / 3.0
48 | , useCounterClockwise: false
49 | }
50 |
51 | -- ANCHOR: path
52 | setFillStyle ctx "#F00"
53 |
54 | fillPath ctx $ do
55 | moveTo ctx 300.0 260.0
56 | lineTo ctx 260.0 340.0
57 | lineTo ctx 340.0 340.0
58 | closePath ctx
59 | -- ANCHOR_END: path
60 |
--------------------------------------------------------------------------------
/exercises/chapter5/src/Data/Path.purs:
--------------------------------------------------------------------------------
1 | module Data.Path
2 | ( Path(..)
3 | , root
4 | , ls
5 | , filename
6 | , isDirectory
7 | , size
8 | ) where
9 |
10 | import Prelude
11 |
12 | import Data.Maybe (Maybe(..))
13 |
14 | data Path
15 | = Directory String (Array Path)
16 | | File String Int
17 |
18 | instance Show Path where
19 | show = filename
20 |
21 | root :: Path
22 | root =
23 | Directory "/"
24 | [ Directory "/bin/"
25 | [ File "/bin/cp" 24800
26 | , File "/bin/ls" 34700
27 | , File "/bin/mv" 20200
28 | ]
29 | , Directory "/etc/"
30 | [ File "/etc/hosts" 300
31 | ]
32 | , Directory "/home/"
33 | [ Directory "/home/user/"
34 | [ File "/home/user/todo.txt" 1020
35 | , Directory "/home/user/code/"
36 | [ Directory "/home/user/code/js/"
37 | [ File "/home/user/code/js/test.js" 40000
38 | ]
39 | , Directory "/home/user/code/haskell/"
40 | [ File "/home/user/code/haskell/test.hs" 5000
41 | ]
42 | ]
43 | ]
44 | ]
45 | ]
46 |
47 | filename :: Path -> String
48 | filename (File name _) = name
49 | filename (Directory name _) = name
50 |
51 | isDirectory :: Path -> Boolean
52 | isDirectory (Directory _ _) = true
53 | isDirectory _ = false
54 |
55 | ls :: Path -> Array Path
56 | ls (Directory _ xs) = xs
57 | ls _ = []
58 |
59 | size :: Path -> Maybe Int
60 | size (File _ bytes) = Just bytes
61 | size _ = Nothing
62 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Split.purs:
--------------------------------------------------------------------------------
1 | module Split where
2 |
3 | import Prelude
4 |
5 | import Control.Monad.Except (runExcept)
6 | import Control.Monad.Except.Trans (ExceptT, throwError)
7 | import Control.Monad.State.Trans (StateT, runStateT, get, put)
8 | import Control.Monad.Writer.Trans (WriterT, runWriterT, tell)
9 | import Control.MonadPlus (guard)
10 | import Data.Either (Either)
11 | import Data.Identity (Identity)
12 | import Data.String (take, drop, toUpper, toLower)
13 | import Data.Tuple (Tuple)
14 |
15 | type Errors = Array String
16 |
17 | type Log = Array String
18 |
19 | type Parser = StateT String (WriterT Log (ExceptT Errors Identity))
20 |
21 | -- ANCHOR: split
22 | split :: Parser String
23 | split = do
24 | s <- get
25 | tell ["The state is " <> show s]
26 | case s of
27 | "" -> throwError ["Empty string"]
28 | _ -> do
29 | put (drop 1 s)
30 | pure (take 1 s)
31 | -- ANCHOR_END: split
32 |
33 | eof :: Parser Unit
34 | eof = do
35 | s <- get
36 | tell ["The state is " <> show s]
37 | case s of
38 | "" -> pure unit
39 | _ -> throwError ["Expected end-of-file"]
40 |
41 | -- ANCHOR: upper
42 | upper :: Parser String
43 | upper = do
44 | s <- split
45 | guard $ toUpper s == s
46 | pure s
47 | -- ANCHOR_END: upper
48 |
49 | -- ANCHOR: lower
50 | lower :: Parser String
51 | lower = do
52 | s <- split
53 | guard $ toLower s == s
54 | pure s
55 | -- ANCHOR_END: lower
56 |
57 | runParser :: forall a. Parser a -> String -> Either Errors (Tuple (Tuple a String) Log)
58 | runParser p = runExcept <<< runWriterT <<< runStateT p
59 |
--------------------------------------------------------------------------------
/exercises/chapter3/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 | import Data.AddressBook (AddressBook, Entry)
5 | import Data.List (filter, head, nubByEq, null)
6 | import Data.Maybe (Maybe)
7 |
8 | findEntryByStreet :: String -> AddressBook -> Maybe Entry
9 | -- Equivalent: findEntryByStreet streetName book = head (filter filterEntry book)
10 | -- Equivalent: findEntryByStreet streetName book = head $ filter filterEntry book
11 | findEntryByStreet streetName = head <<< filter filterEntry
12 | where
13 | filterEntry :: Entry -> Boolean
14 | filterEntry e = e.address.street == streetName
15 |
16 | -- Example alternative implementation using property accessor
17 | findEntryByStreet' :: String -> AddressBook -> Maybe Entry
18 | findEntryByStreet' streetName = head <<< filter (_.address.street >>> eq streetName)
19 |
20 | isInBook :: String -> String -> AddressBook -> Boolean
21 | -- Equivalent: isInBook firstName lastName book = not null $ filter filterEntry book
22 | isInBook firstName lastName = not null <<< filter filterEntry
23 | where
24 | filterEntry :: Entry -> Boolean
25 | filterEntry entry =
26 | entry.firstName == firstName &&
27 | entry.lastName == lastName
28 |
29 | removeDuplicates :: AddressBook -> AddressBook
30 | -- Equivalent: removeDuplicates book = nubByEq entriesAreDuplicated book
31 | removeDuplicates = nubByEq entriesAreDuplicated
32 | where
33 | entriesAreDuplicated :: Entry -> Entry -> Boolean
34 | entriesAreDuplicated e1 e2 =
35 | e1.firstName == e2.firstName &&
36 | e1.lastName == e2.lastName
37 |
--------------------------------------------------------------------------------
/exercises/chapter2/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 | import Test.MySolutions
5 | import Test.NoPeeking.Solutions -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
6 | import Effect (Effect)
7 | import Euler (answer)
8 | import Test.Unit (suite, test)
9 | import Test.Unit.Assert as Assert
10 | import Test.Unit.Main (runTest)
11 |
12 | main :: Effect Unit
13 | main = do
14 | runTest do
15 | suite "Euler - Sum of Multiples" do
16 | test "below 10" do
17 | Assert.equal 23 (answer 10)
18 | test "below 1000" do
19 | Assert.equal 233168 (answer 1000)
20 | {- Move this block comment starting point to enable more tests
21 | This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. -}
22 | -- ANCHOR: diagonalTests
23 | suite "diagonal" do
24 | test "3 4 5" do
25 | Assert.equal 5.0 (diagonal 3.0 4.0)
26 | test "5 12 13" do
27 | Assert.equal 13.0 (diagonal 5.0 12.0)
28 | -- ANCHOR_END: diagonalTests
29 | suite "circleArea" do
30 | test "radius 1" do
31 | Assert.equal 3.141592653589793 (circleArea 1.0)
32 | test "radius 3" do
33 | Assert.equal 28.274333882308138 (circleArea 3.0)
34 | suite "leftoverCents" do
35 | test "23" do
36 | Assert.equal 23 (leftoverCents 23)
37 | test "456" do
38 | Assert.equal 56 (leftoverCents 456)
39 | test "-789" do
40 | Assert.equal (-89) (leftoverCents (-789))
41 |
42 | {- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
43 | -}
44 |
--------------------------------------------------------------------------------
/.github/workflows/tests.yml:
--------------------------------------------------------------------------------
1 | name: Run PR Tests
2 |
3 | on:
4 | pull_request:
5 | push:
6 | branches: [master]
7 |
8 | jobs:
9 | build:
10 | runs-on: ubuntu-latest
11 |
12 | steps:
13 | - uses: actions/checkout@v2
14 |
15 | - name: Set up PureScript toolchain
16 | uses: purescript-contrib/setup-purescript@main
17 |
18 | - name: Cache PureScript dependencies
19 | uses: actions/cache@v2
20 | with:
21 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}
22 | path: |
23 | exercises/*/.spago
24 | exercises/*/output
25 |
26 | - name: Set up Node toolchain
27 | uses: actions/setup-node@v1
28 | with:
29 | node-version: "14.x"
30 |
31 | - name: Cache NPM dependencies
32 | uses: actions/cache@v2
33 | env:
34 | cache-name: cache-node-modules
35 | with:
36 | path: ~/.npm
37 | key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/package.json') }}
38 | restore-keys: |
39 | ${{ runner.os }}-build-${{ env.cache-name }}-
40 | ${{ runner.os }}-build-
41 | ${{ runner.os }}-
42 |
43 | - name: Install NPM dependencies
44 | run: npm install purescript spago markdownlint-cli@0.37.0
45 |
46 | - name: Run Build
47 | run: ./scripts/buildAll.sh
48 |
49 | - name: Run tests
50 | run: ./scripts/testAll.sh
51 |
52 | - name: Prepare exercises
53 | run: ./scripts/prepareExercises.sh
54 |
55 | - name: Run tests again
56 | run: ./scripts/testAll.sh
57 |
58 | - name: Run Markdown lint
59 | run: npx markdownlint **/*.md
60 |
--------------------------------------------------------------------------------
/exercises/chapter8/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 | import Control.Monad.ST.Ref (modify, new, read, write)
5 | import Control.Monad.ST (ST, for, run)
6 | import Data.Array (foldM, head, nub, sort, tail)
7 | import Data.Int (even, toNumber)
8 | import Data.List (List(..), (:))
9 | import Data.Maybe (Maybe)
10 | import Effect (Effect)
11 | import Effect.Exception (error, throwException)
12 |
13 | third :: forall a. Array a -> Maybe a
14 | third arr = do
15 | skip1st <- tail arr
16 | skip2nd <- tail skip1st
17 | head skip2nd
18 |
19 | possibleSums :: Array Int -> Array Int
20 | possibleSums xs = nub $ sort $ foldM (\acc i -> [ acc, acc + i ]) 0 xs
21 |
22 | filterM :: forall a m. Monad m => (a -> m Boolean) -> List a -> m (List a)
23 | filterM _ Nil = pure Nil
24 |
25 | filterM f (x : xs) = do
26 | b <- f x
27 | xs' <- filterM f xs
28 | pure if b then x : xs' else xs'
29 |
30 | exceptionDivide :: Int -> Int -> Effect Int
31 | exceptionDivide _ 0 = throwException $ error "div zero"
32 | exceptionDivide a b = pure $ a / b
33 |
34 | estimatePi :: Int -> Number
35 | estimatePi n =
36 | run do
37 | accRef <- new 0.0
38 | for 1 (n + 1) \k ->
39 | let
40 | sign = if even k then -1.0 else 1.0
41 | in
42 | modify (\acc -> acc + sign / (2.0 * toNumber k - 1.0)) accRef
43 | final <- read accRef
44 | pure $ final * 4.0
45 |
46 | fibonacci :: Int -> Int
47 | fibonacci 0 = 0
48 | fibonacci 1 = 1
49 | fibonacci n =
50 | run
51 | ( do
52 | x <- new 0
53 | y <- new 1
54 | for 2 n \k -> do
55 | x' <- read x
56 | y' <- read y
57 | _ <- write (x' + y') y
58 | write y' x
59 | x' <- read x
60 | y' <- read y
61 | pure $ x' + y'
62 | )
63 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/Data/AddressBook.purs:
--------------------------------------------------------------------------------
1 | module Data.AddressBook where
2 |
3 | import Prelude
4 |
5 | -- ANCHOR: import
6 | import Data.Argonaut (class DecodeJson, class EncodeJson)
7 | import Data.Argonaut.Decode.Generic (genericDecodeJson)
8 | import Data.Argonaut.Encode.Generic (genericEncodeJson)
9 | import Data.Generic.Rep (class Generic)
10 | -- ANCHOR_END: import
11 | import Data.Show.Generic (genericShow)
12 |
13 | type Address
14 | = { street :: String
15 | , city :: String
16 | , state :: String
17 | }
18 |
19 | address :: String -> String -> String -> Address
20 | address street city state = { street, city, state }
21 |
22 | data PhoneType
23 | = HomePhone
24 | | WorkPhone
25 | | CellPhone
26 | | OtherPhone
27 |
28 | -- ANCHOR: PhoneType_generic
29 | derive instance Generic PhoneType _
30 |
31 | instance EncodeJson PhoneType where encodeJson = genericEncodeJson
32 | instance DecodeJson PhoneType where decodeJson = genericDecodeJson
33 | -- ANCHOR_END: PhoneType_generic
34 | instance Show PhoneType where show = genericShow
35 |
36 | type PhoneNumber
37 | = { "type" :: PhoneType
38 | , number :: String
39 | }
40 |
41 | phoneNumber :: PhoneType -> String -> PhoneNumber
42 | phoneNumber ty number =
43 | { "type": ty
44 | , number: number
45 | }
46 |
47 | type Person
48 | = { firstName :: String
49 | , lastName :: String
50 | , homeAddress :: Address
51 | , phones :: Array PhoneNumber
52 | }
53 |
54 | person :: String -> String -> Address -> Array PhoneNumber -> Person
55 | person firstName lastName homeAddress phones = { firstName, lastName, homeAddress, phones }
56 |
57 | examplePerson :: Person
58 | examplePerson =
59 | person "John" "Smith"
60 | (address "123 Fake St." "FakeTown" "CA")
61 | [ phoneNumber HomePhone "555-555-5555"
62 | , phoneNumber CellPhone "555-555-0000"
63 | ]
64 |
--------------------------------------------------------------------------------
/exercises/chapter13/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 |
5 | import Data.Array (sort, sortBy)
6 | import Data.Foldable (foldr)
7 | import Data.Function (on)
8 | import Data.List (List(..), fromFoldable)
9 | import Effect (Effect)
10 | import Merge (mergeWith, mergePoly, merge)
11 | import Sorted (sorted)
12 | import Test.QuickCheck (quickCheck, ())
13 | import Tree (Tree, member, insert, toArray, anywhere)
14 |
15 | isSorted :: forall a. (Ord a) => Array a -> Boolean
16 | isSorted = go <<< fromFoldable
17 | where
18 | go (Cons x1 t@(Cons x2 _)) = x1 <= x2 && go t
19 | go _ = true
20 |
21 | ints :: Array Int -> Array Int
22 | ints = identity
23 |
24 | intToBool :: (Int -> Boolean) -> Int -> Boolean
25 | intToBool = identity
26 |
27 | treeOfInt :: Tree Int -> Tree Int
28 | treeOfInt = identity
29 |
30 | main :: Effect Unit
31 | main = do
32 | -- Tests for module 'Merge'
33 |
34 | quickCheck \xs ys ->
35 | let
36 | result = merge (sort xs) (sort ys)
37 | expected = sort $ xs <> ys
38 | in
39 | eq result expected "Result:\n" <> show result <> "\nnot equal to expected:\n" <> show expected
40 |
41 | quickCheck \xs ys ->
42 | eq (merge (sorted xs) (sorted ys)) (sort $ sorted xs <> sorted ys)
43 |
44 | quickCheck \xs ys ->
45 | eq (ints $ mergePoly (sorted xs) (sorted ys)) (sort $ sorted xs <> sorted ys)
46 |
47 | quickCheck \xs ys f ->
48 | let
49 | result = map f $ mergeWith (intToBool f) (sortBy (compare `on` f) xs) (sortBy (compare `on` f) ys)
50 | expected = map f $ sortBy (compare `on` f) $ xs <> ys
51 | in
52 | eq result expected
53 |
54 | -- Tests for module 'Tree'
55 |
56 | quickCheck \t a -> member a $ insert a $ treeOfInt t
57 | quickCheck \t xs -> isSorted $ toArray $ foldr insert t $ ints xs
58 |
59 | quickCheck \f g t ->
60 | anywhere (\s -> f s || g s) t ==
61 | anywhere f (treeOfInt t) || anywhere g t
--------------------------------------------------------------------------------
/exercises/chapter7/src/Data/AddressBook.purs:
--------------------------------------------------------------------------------
1 | module Data.AddressBook where
2 |
3 | import Prelude
4 | import Data.Generic.Rep (class Generic)
5 | import Data.Show.Generic (genericShow)
6 |
7 | type Address
8 | = { street :: String
9 | , city :: String
10 | , state :: String
11 | }
12 |
13 | -- ANCHOR: address_anno
14 | address :: String -> String -> String -> Address
15 | -- ANCHOR_END: address_anno
16 | address street city state = { street, city, state }
17 |
18 | -- ANCHOR: PhoneType
19 | data PhoneType
20 | = HomePhone
21 | | WorkPhone
22 | | CellPhone
23 | | OtherPhone
24 | -- ANCHOR_END: PhoneType
25 |
26 | {-
27 | Eq and Show instances are needed by unit tests to
28 | compare and report differences between PhoneType values
29 | (HomePhone, WorkPhone, etc).
30 | -}
31 | derive instance Eq PhoneType
32 |
33 | -- Generic Show instance
34 | derive instance Generic PhoneType _
35 |
36 | instance Show PhoneType where
37 | show = genericShow
38 | {-
39 | -- Manually-written Show instance
40 | instance Show PhoneType where
41 | show HomePhone = "HomePhone"
42 | show WorkPhone = "WorkPhone"
43 | show CellPhone = "CellPhone"
44 | show OtherPhone = "OtherPhone"
45 | -}
46 |
47 | type PhoneNumber
48 | = { "type" :: PhoneType
49 | , number :: String
50 | }
51 |
52 | -- ANCHOR: phoneNumber_anno
53 | phoneNumber :: PhoneType -> String -> PhoneNumber
54 | -- ANCHOR_END: phoneNumber_anno
55 | phoneNumber ty number =
56 | { "type": ty
57 | , number: number
58 | }
59 |
60 | type Person
61 | = { firstName :: String
62 | , lastName :: String
63 | , homeAddress :: Address
64 | , phones :: Array PhoneNumber
65 | }
66 |
67 | -- ANCHOR: person_anno
68 | person :: String -> String -> Address -> Array PhoneNumber -> Person
69 | -- ANCHOR_END: person_anno
70 | person firstName lastName homeAddress phones = { firstName, lastName, homeAddress, phones }
71 |
72 | -- ANCHOR: examplePerson
73 | examplePerson :: Person
74 | examplePerson =
75 | person "John" "Smith"
76 | (address "123 Fake St." "FakeTown" "CA")
77 | [ phoneNumber HomePhone "555-555-5555"
78 | , phoneNumber CellPhone "555-555-0000"
79 | ]
80 | -- ANCHOR_END: examplePerson
81 |
--------------------------------------------------------------------------------
/exercises/chapter5/test/Examples.purs:
--------------------------------------------------------------------------------
1 | module Test.Examples where
2 |
3 | import Prelude
4 | import Control.Alternative (guard)
5 | import Data.Array (concatMap, filter, null, tail, (..), (:))
6 | import Data.Foldable (product)
7 | import Data.Maybe (fromMaybe)
8 | import Data.Path (Path, ls)
9 |
10 | -- ANCHOR: factorial
11 | factorial :: Int -> Int
12 | factorial 0 = 1
13 | factorial n = n * factorial (n - 1)
14 | -- ANCHOR_END: factorial
15 |
16 | -- ANCHOR: fib
17 | fib :: Int -> Int
18 | fib 0 = 0
19 | fib 1 = 1
20 | fib n = fib (n - 1) + fib (n - 2)
21 | -- ANCHOR_END: fib
22 |
23 | -- ANCHOR: length
24 | length :: forall a. Array a -> Int
25 | length [] = 0
26 | length arr = 1 + (length $ fromMaybe [] $ tail arr)
27 | -- ANCHOR_END: length
28 |
29 | -- ANCHOR: factors
30 | factors :: Int -> Array (Array Int)
31 | factors n = filter (\xs -> product xs == n) do
32 | i <- 1 .. n
33 | j <- i .. n
34 | pure [ i, j ]
35 | -- ANCHOR_END: factors
36 |
37 | -- ANCHOR: factorsV2
38 | factorsV2 :: Int -> Array (Array Int)
39 | factorsV2 n = filter (\xs -> product xs == n) do
40 | i <- 1 .. n
41 | j <- i .. n
42 | [ [ i, j ] ]
43 | -- ANCHOR_END: factorsV2
44 |
45 | -- ANCHOR: factorsV3
46 | factorsV3 :: Int -> Array (Array Int)
47 | factorsV3 n = do
48 | i <- 1 .. n
49 | j <- i .. n
50 | guard $ i * j == n
51 | pure [ i, j ]
52 | -- ANCHOR_END: factorsV3
53 |
54 | -- ANCHOR: factorialTailRec
55 | factorialTailRec :: Int -> Int -> Int
56 | factorialTailRec 0 acc = acc
57 | factorialTailRec n acc = factorialTailRec (n - 1) (acc * n)
58 | -- ANCHOR_END: factorialTailRec
59 |
60 | -- ANCHOR: lengthTailRec
61 | lengthTailRec :: forall a. Array a -> Int
62 | lengthTailRec arr = length' arr 0
63 | where
64 | length' :: Array a -> Int -> Int
65 | length' [] acc = acc
66 | length' arr' acc = length' (fromMaybe [] $ tail arr') (acc + 1)
67 | -- ANCHOR_END: lengthTailRec
68 |
69 | -- ANCHOR: allFiles_signature
70 | allFiles :: Path -> Array Path
71 | -- ANCHOR_END: allFiles_signature
72 | -- ANCHOR: allFiles_implementation
73 | allFiles file = file : concatMap allFiles (ls file)
74 | -- ANCHOR_END: allFiles_implementation
75 |
76 | -- ANCHOR: allFiles_2
77 | allFiles' :: Path -> Array Path
78 | allFiles' file = file : do
79 | child <- ls file
80 | allFiles' child
81 | -- ANCHOR_END: allFiles_2
82 |
--------------------------------------------------------------------------------
/exercises/chapter6/src/Data/Hashable.purs:
--------------------------------------------------------------------------------
1 | module Data.Hashable
2 | ( HashCode
3 | , hashCode
4 | , class Hashable
5 | , hash
6 | , hashEqual
7 | , combineHashes
8 | ) where
9 |
10 | import Prelude
11 |
12 | import Data.Char (toCharCode)
13 | import Data.Either (Either(..))
14 | import Data.Foldable (foldl)
15 | import Data.Function (on)
16 | import Data.Maybe (Maybe(..))
17 | import Data.String.CodeUnits (toCharArray)
18 | import Data.Tuple (Tuple(..))
19 |
20 | -- ANCHOR: Hashable
21 | newtype HashCode = HashCode Int
22 |
23 | instance Eq HashCode where
24 | eq (HashCode a) (HashCode b) = a == b
25 |
26 | hashCode :: Int -> HashCode
27 | hashCode h = HashCode (h `mod` 65535)
28 |
29 | class Eq a <= Hashable a where
30 | hash :: a -> HashCode
31 | -- ANCHOR_END: Hashable
32 |
33 | instance Show HashCode where
34 | show (HashCode h) = "(HashCode " <> show h <> ")"
35 |
36 | -- ANCHOR: combineHashes
37 | combineHashes :: HashCode -> HashCode -> HashCode
38 | combineHashes (HashCode h1) (HashCode h2) = hashCode (73 * h1 + 51 * h2)
39 | -- ANCHOR_END: combineHashes
40 |
41 | -- ANCHOR: hashEqual
42 | hashEqual :: forall a. Hashable a => a -> a -> Boolean
43 | hashEqual = eq `on` hash
44 | -- ANCHOR_END: hashEqual
45 |
46 | -- ANCHOR: hashChar
47 | instance Hashable Char where
48 | hash = hash <<< toCharCode
49 | -- ANCHOR_END: hashChar
50 |
51 | -- ANCHOR: hashString
52 | instance Hashable String where
53 | hash = hash <<< toCharArray
54 | -- ANCHOR_END: hashString
55 |
56 | -- ANCHOR: hashInt
57 | instance Hashable Int where
58 | hash = hashCode
59 | -- ANCHOR_END: hashInt
60 |
61 | -- ANCHOR: hashBoolean
62 | instance Hashable Boolean where
63 | hash false = hashCode 0
64 | hash true = hashCode 1
65 | -- ANCHOR_END: hashBoolean
66 |
67 | -- ANCHOR: hashArray
68 | instance Hashable a => Hashable (Array a) where
69 | hash = foldl combineHashes (hashCode 0) <<< map hash
70 | -- ANCHOR_END: hashArray
71 |
72 | instance Hashable a => Hashable (Maybe a) where
73 | hash Nothing = hashCode 0
74 | hash (Just a) = hashCode 1 `combineHashes` hash a
75 |
76 | instance (Hashable a, Hashable b) => Hashable (Tuple a b) where
77 | hash (Tuple a b) = hash a `combineHashes` hash b
78 |
79 | instance (Hashable a, Hashable b) => Hashable (Either a b) where
80 | hash (Left a) = hashCode 0 `combineHashes` hash a
81 | hash (Right b) = hashCode 1 `combineHashes` hash b
82 |
--------------------------------------------------------------------------------
/exercises/chapter10/src/Data/AddressBook/Validation.purs:
--------------------------------------------------------------------------------
1 | module Data.AddressBook.Validation where
2 |
3 | import Prelude
4 |
5 | import Data.AddressBook (Address, Person, PhoneNumber, address, person, phoneNumber)
6 | import Data.Either (Either)
7 | import Data.String (length)
8 | import Data.String.Regex (Regex, test)
9 | import Data.String.Regex.Flags (noFlags)
10 | import Data.String.Regex.Unsafe (unsafeRegex)
11 | import Data.Traversable (traverse)
12 | import Data.Validation.Semigroup (V, invalid, toEither)
13 |
14 | type Errors
15 | = Array String
16 |
17 | nonEmpty :: String -> String -> V Errors String
18 | nonEmpty field "" = invalid [ "Field '" <> field <> "' cannot be empty" ]
19 | nonEmpty _ value = pure value
20 |
21 | validatePhoneNumbers :: String -> Array PhoneNumber -> V Errors (Array PhoneNumber)
22 | validatePhoneNumbers field [] =
23 | invalid [ "Field '" <> field <> "' must contain at least one value" ]
24 | validatePhoneNumbers _ phones =
25 | traverse validatePhoneNumber phones
26 |
27 | lengthIs :: String -> Int -> String -> V Errors String
28 | lengthIs field len value | length value /= len =
29 | invalid [ "Field '" <> field <> "' must have length " <> show len ]
30 | lengthIs _ _ value = pure value
31 |
32 | phoneNumberRegex :: Regex
33 | phoneNumberRegex = unsafeRegex "^\\d{3}-\\d{3}-\\d{4}$" noFlags
34 |
35 | matches :: String -> Regex -> String -> V Errors String
36 | matches _ regex value | test regex value
37 | = pure value
38 | matches field _ _ = invalid [ "Field '" <> field <> "' did not match the required format" ]
39 |
40 | validateAddress :: Address -> V Errors Address
41 | validateAddress a =
42 | address <$> nonEmpty "Street" a.street
43 | <*> nonEmpty "City" a.city
44 | <*> lengthIs "State" 2 a.state
45 |
46 | validatePhoneNumber :: PhoneNumber -> V Errors PhoneNumber
47 | validatePhoneNumber pn =
48 | phoneNumber <$> pure pn."type"
49 | <*> matches "Number" phoneNumberRegex pn.number
50 |
51 | validatePerson :: Person -> V Errors Person
52 | validatePerson p =
53 | person <$> nonEmpty "First Name" p.firstName
54 | <*> nonEmpty "Last Name" p.lastName
55 | <*> validateAddress p.homeAddress
56 | <*> validatePhoneNumbers "Phone Numbers" p.phones
57 |
58 | validatePerson' :: Person -> Either Errors Person
59 | validatePerson' p = toEither $ validatePerson p
60 |
--------------------------------------------------------------------------------
/exercises/chapter8/src/Data/AddressBook/Validation.purs:
--------------------------------------------------------------------------------
1 | module Data.AddressBook.Validation where
2 |
3 | import Prelude
4 |
5 | import Data.AddressBook (Address, Person, PhoneNumber, address, person, phoneNumber)
6 | import Data.Either (Either)
7 | import Data.String (length)
8 | import Data.String.Regex (Regex, test)
9 | import Data.String.Regex.Flags (noFlags)
10 | import Data.String.Regex.Unsafe (unsafeRegex)
11 | import Data.Traversable (traverse)
12 | import Data.Validation.Semigroup (V, invalid, toEither)
13 |
14 | type Errors
15 | = Array String
16 |
17 | nonEmpty :: String -> String -> V Errors String
18 | nonEmpty field "" = invalid [ "Field '" <> field <> "' cannot be empty" ]
19 | nonEmpty _ value = pure value
20 |
21 | validatePhoneNumbers :: String -> Array PhoneNumber -> V Errors (Array PhoneNumber)
22 | validatePhoneNumbers field [] =
23 | invalid [ "Field '" <> field <> "' must contain at least one value" ]
24 | validatePhoneNumbers _ phones =
25 | traverse validatePhoneNumber phones
26 |
27 | lengthIs :: String -> Int -> String -> V Errors String
28 | lengthIs field len value | length value /= len =
29 | invalid [ "Field '" <> field <> "' must have length " <> show len ]
30 | lengthIs _ _ value = pure value
31 |
32 | phoneNumberRegex :: Regex
33 | phoneNumberRegex = unsafeRegex "^\\d{3}-\\d{3}-\\d{4}$" noFlags
34 |
35 | matches :: String -> Regex -> String -> V Errors String
36 | matches _ regex value | test regex value
37 | = pure value
38 | matches field _ _ = invalid [ "Field '" <> field <> "' did not match the required format" ]
39 |
40 | validateAddress :: Address -> V Errors Address
41 | validateAddress a =
42 | address <$> nonEmpty "Street" a.street
43 | <*> nonEmpty "City" a.city
44 | <*> lengthIs "State" 2 a.state
45 |
46 | validatePhoneNumber :: PhoneNumber -> V Errors PhoneNumber
47 | validatePhoneNumber pn =
48 | phoneNumber <$> pure pn."type"
49 | <*> matches "Number" phoneNumberRegex pn.number
50 |
51 | validatePerson :: Person -> V Errors Person
52 | validatePerson p =
53 | person <$> nonEmpty "First Name" p.firstName
54 | <*> nonEmpty "Last Name" p.lastName
55 | <*> validateAddress p.homeAddress
56 | <*> validatePhoneNumbers "Phone Numbers" p.phones
57 |
58 | validatePerson' :: Person -> Either Errors Person
59 | validatePerson' p = toEither $ validatePerson p
60 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/no-peeking/Solutions.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | export const volumeFn = function (x, y, z) {
4 | return x * y * z;
5 | }
6 |
7 | export const volumeArrow = x => y => z =>
8 | x * y * z;
9 |
10 | export const cumulativeSumsComplex = arr => {
11 | let sum = { real: 0, imag: 0 }
12 | let sums = []
13 | arr.forEach(x => {
14 | sum = {
15 | real: sum.real + x.real,
16 | imag: sum.imag + x.imag
17 | };
18 | sums.push(sum);
19 | });
20 | return sums;
21 | };
22 |
23 | export const quadraticRootsImpl = mkPair => poly => {
24 | let { a, b, c } = poly;
25 | let radicand = b * b - 4 * a * c;
26 | if (radicand >= 0) {
27 | let rt = Math.sqrt(radicand);
28 | return mkPair
29 | ({ real: (-b + rt) / (2 * a), imag: 0 })
30 | ({ real: (-b - rt) / (2 * a), imag: 0 });
31 | } else {
32 | let rt = Math.sqrt(-radicand);
33 | return mkPair
34 | ({ real: -b / (2 * a), imag: rt / (2 * a) })
35 | ({ real: -b / (2 * a), imag: -rt / (2 * a) });
36 | }
37 | };
38 |
39 | export const toMaybeImpl = just => nothing => undefined$ => {
40 | if (undefined$ === undefined) {
41 | return nothing
42 | } else {
43 | return just(undefined$)
44 | }
45 | }
46 |
47 | export const valuesOfMapJson = j => {
48 | let m = new Map(j);
49 | let s = new Set(m.values())
50 | return Array.from(s);
51 | };
52 |
53 | export const quadraticRootsSetJson = poly => {
54 | let { a, b, c } = poly;
55 | let radicand = b * b - 4 * a * c;
56 | if (radicand >= 0) {
57 | let rt = Math.sqrt(radicand);
58 | return Array.from(new Set([
59 | { real: (-b + rt) / (2 * a), imag: 0 },
60 | { real: (-b - rt) / (2 * a), imag: 0 }]));
61 | } else {
62 | let rt = Math.sqrt(-radicand);
63 | return Array.from(new Set([
64 | { real: -b / (2 * a), imag: rt / (2 * a) },
65 | { real: -b / (2 * a), imag: -rt / (2 * a) }]));
66 | }
67 | };
68 |
69 | export const quadraticRootsSafeJson = poly => {
70 | let { a, b, c } = poly;
71 | let radicand = b * b - 4 * a * c;
72 | if (radicand >= 0) {
73 | let rt = Math.sqrt(radicand);
74 | return [
75 | { real: (-b + rt) / (2 * a), imag: 0 },
76 | { real: (-b - rt) / (2 * a), imag: 0 }];
77 | } else {
78 | let rt = Math.sqrt(-radicand);
79 | return [
80 | { real: -b / (2 * a), imag: rt / (2 * a) },
81 | { real: -b / (2 * a), imag: -rt / (2 * a) }];
82 | }
83 | };
84 |
--------------------------------------------------------------------------------
/exercises/chapter12/src/Example/Refs.purs:
--------------------------------------------------------------------------------
1 | module Example.Refs where
2 |
3 | import Prelude
4 |
5 | import Effect (Effect)
6 | import Effect.Console (logShow)
7 | import Effect.Ref as Ref
8 | import Data.Int (toNumber)
9 | import Data.Maybe (Maybe(..))
10 | import Graphics.Canvas (Context2D, getContext2D, getCanvasElementById,
11 | rect, fillPath, translate, scale, rotate, withContext,
12 | setFillStyle)
13 | import Data.Number as Number
14 | import Partial.Unsafe (unsafePartial)
15 | import Web.DOM.Document (toParentNode)
16 | import Web.DOM.Element (toEventTarget)
17 | import Web.DOM.ParentNode (QuerySelector(..), querySelector)
18 | import Web.Event.Event (EventType(..))
19 | import Web.Event.EventTarget (addEventListener, eventListener)
20 | import Web.HTML (window)
21 | import Web.HTML.HTMLDocument (toDocument)
22 | import Web.HTML.Window (document)
23 |
24 | render :: Context2D -> Int -> Effect Unit
25 | render ctx count = void do
26 | setFillStyle ctx "#FFF"
27 |
28 | fillPath ctx $ rect ctx
29 | { x: 0.0
30 | , y: 0.0
31 | , width: 600.0
32 | , height: 600.0
33 | }
34 |
35 | setFillStyle ctx "#0F0"
36 |
37 | -- ANCHOR: withContext
38 | withContext ctx do
39 | let scaleX = Number.sin (toNumber count * Number.tau / 8.0) + 1.5
40 | let scaleY = Number.sin (toNumber count * Number.tau / 12.0) + 1.5
41 |
42 | translate ctx { translateX: 300.0, translateY: 300.0 }
43 | rotate ctx (toNumber count * Number.tau / 36.0)
44 | scale ctx { scaleX: scaleX, scaleY: scaleY }
45 | translate ctx { translateX: -100.0, translateY: -100.0 }
46 |
47 | fillPath ctx $ rect ctx
48 | { x: 0.0
49 | , y: 0.0
50 | , width: 200.0
51 | , height: 200.0
52 | }
53 | -- ANCHOR_END: withContext
54 |
55 | main :: Effect Unit
56 | main = void $ unsafePartial do
57 | Just canvas <- getCanvasElementById "canvas"
58 | ctx <- getContext2D canvas
59 |
60 | -- ANCHOR: clickCount
61 | clickCount <- Ref.new 0
62 | -- ANCHOR_END: clickCount
63 |
64 | render ctx 0
65 | doc <- map (toParentNode <<< toDocument) (document =<< window)
66 | Just node <- querySelector (QuerySelector "#canvas") doc
67 |
68 | clickListener <- eventListener $ \_ -> do
69 | logShow "Mouse clicked!"
70 | -- ANCHOR: count
71 | count <- Ref.modify (\count -> count + 1) clickCount
72 | -- ANCHOR_END: count
73 | render ctx count
74 |
75 | addEventListener (EventType "click") clickListener true (toEventTarget node)
76 |
--------------------------------------------------------------------------------
/exercises/chapter3/src/Data/AddressBook.purs:
--------------------------------------------------------------------------------
1 | -- ANCHOR: imports
2 | module Data.AddressBook where
3 |
4 | import Prelude
5 |
6 | import Control.Plus (empty)
7 | import Data.List (List(..), filter, head)
8 | import Data.Maybe (Maybe)
9 | -- ANCHOR_END: imports
10 |
11 | -- ANCHOR: Address
12 | type Address =
13 | { street :: String
14 | , city :: String
15 | , state :: String
16 | }
17 | -- ANCHOR_END: Address
18 |
19 | -- ANCHOR: Entry
20 | type Entry =
21 | { firstName :: String
22 | , lastName :: String
23 | , address :: Address
24 | }
25 | -- ANCHOR_END: Entry
26 |
27 | -- ANCHOR: AddressBook
28 | type AddressBook = List Entry
29 | -- ANCHOR_END: AddressBook
30 |
31 | -- ANCHOR: showAddress
32 | showAddress :: Address -> String
33 | showAddress addr = addr.street <> ", " <>
34 | addr.city <> ", " <>
35 | addr.state
36 | -- ANCHOR_END: showAddress
37 |
38 | -- ANCHOR: showEntry_signature
39 | showEntry :: Entry -> String
40 | -- ANCHOR_END: showEntry_signature
41 | -- ANCHOR: showEntry_implementation
42 | showEntry entry = entry.lastName <> ", " <>
43 | entry.firstName <> ": " <>
44 | showAddress entry.address
45 | -- ANCHOR_END: showEntry_implementation
46 |
47 | -- ANCHOR: emptyBook
48 | emptyBook :: AddressBook
49 | emptyBook = empty
50 | -- ANCHOR_END: emptyBook
51 |
52 | -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. NOTE TO MAINTAINER: If editing `insertEntry`, remember to also update the non-anchored (and unsimplified) version of this function that is hardcoded in the book text.
53 | -- ANCHOR: insertEntry
54 | -- ANCHOR: insertEntry_signature
55 | insertEntry :: Entry -> AddressBook -> AddressBook
56 | -- ANCHOR_END: insertEntry_signature
57 | insertEntry = Cons
58 | -- ANCHOR_END: insertEntry
59 |
60 | -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. NOTE TO MAINTAINER: If editing `findEntry`, remember to also update the non-anchored (and unsimplified) version of this function that is hardcoded in the book text.
61 | -- ANCHOR: findEntry_signature
62 | findEntry :: String -> String -> AddressBook -> Maybe Entry
63 | -- ANCHOR_END: findEntry_signature
64 | -- ANCHOR: findEntry_implementation
65 | findEntry firstName lastName = head <<< filter filterEntry
66 | where
67 | -- ANCHOR_END: findEntry_implementation
68 | filterEntry :: Entry -> Boolean
69 | filterEntry entry = entry.firstName == firstName && entry.lastName == lastName
70 |
71 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 | import Affjax as AX
5 | import Affjax.ResponseFormat as AXRF
6 | import Affjax.Node as AN
7 | import Control.Parallel (parOneOf, parTraverse)
8 | import Data.Array (concat, (:))
9 | import Data.Either (Either(..), hush)
10 | import Data.Maybe (Maybe(..))
11 | import Data.String (Pattern(..), length, split)
12 | import Data.Traversable (fold, traverse)
13 | import Effect.Aff (Aff, Error, Milliseconds(..), attempt, delay)
14 | import Node.Encoding (Encoding(..))
15 | import Node.FS.Aff (readTextFile, writeTextFile)
16 | import Node.Path (FilePath)
17 | import Node.Path as Path
18 |
19 | -- Group: Async PS
20 | concatenateFiles :: FilePath -> FilePath -> FilePath -> Aff Unit
21 | concatenateFiles f1 f2 fConcat = do
22 | f1Data <- readTextFile UTF8 f1
23 | f2Data <- readTextFile UTF8 f2
24 | writeTextFile UTF8 fConcat $ f1Data <> f2Data
25 |
26 | concatenateMany :: Array FilePath -> FilePath -> Aff Unit
27 | concatenateMany arr out = do
28 | arrContents <- traverse (readTextFile UTF8) arr
29 | writeTextFile UTF8 out $ fold arrContents
30 |
31 | countCharacters :: FilePath -> Aff (Either Error Int)
32 | countCharacters file =
33 | attempt do
34 | contents <- readTextFile UTF8 file
35 | pure $ length contents
36 |
37 | -- Group: HTTP
38 | writeGet :: String -> FilePath -> Aff Unit
39 | writeGet url out = do
40 | result <- AN.get AXRF.string url
41 | let
42 | str = case result of
43 | Left err -> "GET /api response failed to decode: " <> AX.printError err
44 | Right response -> response.body
45 | writeTextFile UTF8 out str
46 |
47 | -- Group: Parallel
48 | concatenateManyParallel :: Array FilePath -> FilePath -> Aff Unit
49 | concatenateManyParallel arr out = do
50 | arrContents <- parTraverse (readTextFile UTF8) arr
51 | writeTextFile UTF8 out $ fold arrContents
52 |
53 | getWithTimeout :: Number -> String -> Aff (Maybe String)
54 | getWithTimeout ms url =
55 | parOneOf
56 | [ AN.get AXRF.string url <#> hush <#> map _.body
57 | , delay (Milliseconds ms) $> Nothing
58 | ]
59 |
60 | recurseFiles :: FilePath -> Aff (Array FilePath)
61 | recurseFiles file = do
62 | contents <- readTextFile UTF8 file
63 | case contents of
64 | "" -> pure [ file ]
65 | c -> do
66 | let
67 | dir = Path.dirname file
68 |
69 | files = split (Pattern "\n") contents
70 |
71 | filesFromRoot = map (\f -> Path.concat [ dir, f ]) files
72 | arrarr <- parTraverse recurseFiles filesFromRoot
73 | pure $ file : concat arrarr
74 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Control.Monad.RWS (RWSResult(..), runRWS)
6 | import Data.Foldable (fold, for_)
7 | import Data.GameEnvironment (GameEnvironment, gameEnvironment)
8 | import Data.GameState (GameState, initialGameState)
9 | import Data.Newtype (wrap)
10 | import Data.String (split)
11 | import Effect (Effect)
12 | import Effect.Console (log)
13 | import Game (game)
14 | -- ANCHOR: import_RL
15 | import Node.ReadLine as RL
16 | -- ANCHOR_END: import_RL
17 | import Options.Applicative ((<**>))
18 | import Options.Applicative as OP
19 |
20 | -- ANCHOR: runGame_sig
21 | runGame :: GameEnvironment -> Effect Unit
22 | -- ANCHOR_END: runGame_sig
23 | -- ANCHOR: runGame_interface
24 | runGame env = do
25 | interface <- RL.createConsoleInterface RL.noCompletion
26 | -- ANCHOR_END: runGame_interface
27 | -- ANCHOR: runGame_prompt
28 | RL.setPrompt "> " interface
29 | -- ANCHOR_END: runGame_prompt
30 |
31 | let
32 | -- ANCHOR: runGame_lineHandler
33 | lineHandler :: GameState -> String -> Effect Unit
34 | lineHandler currentState input = do
35 | case runRWS (game (split (wrap " ") input)) env currentState of
36 | RWSResult state _ written -> do
37 | for_ written log
38 | RL.setLineHandler (lineHandler state) $ interface
39 | RL.prompt interface
40 | pure unit
41 | -- ANCHOR_END: runGame_lineHandler
42 |
43 | -- ANCHOR: runGame_attach_handler
44 | RL.setLineHandler (lineHandler initialGameState) interface
45 | RL.prompt interface
46 | -- ANCHOR_END: runGame_attach_handler
47 |
48 | pure unit
49 |
50 | main :: Effect Unit
51 | -- ANCHOR: main
52 | main = OP.customExecParser prefs argParser >>= runGame
53 | -- ANCHOR_END: main
54 | where
55 |
56 | -- ANCHOR: argParser
57 | argParser :: OP.ParserInfo GameEnvironment
58 | argParser = OP.info (env <**> OP.helper) parserOptions
59 | -- ANCHOR_END: argParser
60 |
61 | -- ANCHOR: env
62 | env :: OP.Parser GameEnvironment
63 | env = gameEnvironment <$> player <*> debug
64 |
65 | player :: OP.Parser String
66 | player = OP.strOption $ fold
67 | [ OP.long "player"
68 | , OP.short 'p'
69 | , OP.metavar ""
70 | , OP.help "The player's name "
71 | ]
72 |
73 | debug :: OP.Parser Boolean
74 | debug = OP.switch $ fold
75 | [ OP.long "debug"
76 | , OP.short 'd'
77 | , OP.help "Use debug mode"
78 | ]
79 | -- ANCHOR_END: env
80 |
81 | prefs = OP.prefs OP.showHelpOnEmpty
82 | -- ANCHOR: parserOptions
83 | parserOptions = fold
84 | [ OP.fullDesc
85 | , OP.progDesc "Play the game as "
86 | , OP.header "Monadic Adventures! A game to learn monad transformers"
87 | ]
88 | -- ANCHOR_END: parserOptions
89 |
--------------------------------------------------------------------------------
/exercises/chapter12/src/Example/LSystem.purs:
--------------------------------------------------------------------------------
1 | module Example.LSystem where
2 |
3 | import Prelude
4 |
5 | import Data.Maybe (Maybe(..))
6 | import Data.Array (concatMap, foldM)
7 | import Effect (Effect)
8 | import Graphics.Canvas (strokePath, setStrokeStyle, lineTo, moveTo,
9 | getContext2D, getCanvasElementById)
10 | import Data.Number as Number
11 | import Partial.Unsafe (unsafePartial)
12 |
13 | -- ANCHOR: lsystem_anno
14 | lsystem :: forall a m s
15 | . Monad m
16 | => Array a
17 | -> (a -> Array a)
18 | -> (s -> a -> m s)
19 | -> Int
20 | -> s
21 | -> m s
22 | -- ANCHOR_END: lsystem_anno
23 | -- ANCHOR: lsystem_impl
24 | lsystem init prod interpret n state = go init n
25 | where
26 | -- ANCHOR_END: lsystem_impl
27 | -- ANCHOR: lsystem_go_s_0
28 | go s 0 = foldM interpret state s
29 | -- ANCHOR_END: lsystem_go_s_0
30 | -- ANCHOR: lsystem_go_s_i
31 | go s i = go (concatMap prod s) (i - 1)
32 | -- ANCHOR_END: lsystem_go_s_i
33 |
34 | -- ANCHOR: letter
35 | data Letter = L | R | F
36 | -- ANCHOR_END: letter
37 |
38 | -- ANCHOR: sentence
39 | type Sentence = Array Letter
40 | -- ANCHOR_END: sentence
41 |
42 | -- ANCHOR: state
43 | type State =
44 | { x :: Number
45 | , y :: Number
46 | , theta :: Number
47 | }
48 | -- ANCHOR_END: state
49 |
50 | -- ANCHOR: initial
51 | initial :: Sentence
52 | initial = [F, R, R, F, R, R, F, R, R]
53 | -- ANCHOR_END: initial
54 |
55 | -- ANCHOR: productions
56 | productions :: Letter -> Sentence
57 | productions L = [L]
58 | productions R = [R]
59 | productions F = [F, L, F, R, R, F, L, F]
60 | -- ANCHOR_END: productions
61 |
62 | -- ANCHOR: initialState
63 | initialState :: State
64 | initialState = { x: 120.0, y: 200.0, theta: 0.0 }
65 | -- ANCHOR_END: initialState
66 |
67 | main :: Effect Unit
68 | main = void $ unsafePartial do
69 | Just canvas <- getCanvasElementById "canvas"
70 | ctx <- getContext2D canvas
71 |
72 | let
73 | -- ANCHOR: interpret_anno
74 | interpret :: State -> Letter -> Effect State
75 | -- ANCHOR_END: interpret_anno
76 | -- ANCHOR: interpretLR
77 | interpret state L = pure $ state { theta = state.theta - Number.tau / 6.0 }
78 | interpret state R = pure $ state { theta = state.theta + Number.tau / 6.0 }
79 | -- ANCHOR_END: interpretLR
80 | -- ANCHOR: interpretF
81 | interpret state F = do
82 | let x = state.x + Number.cos state.theta * 1.5
83 | y = state.y + Number.sin state.theta * 1.5
84 | moveTo ctx state.x state.y
85 | lineTo ctx x y
86 | pure { x, y, theta: state.theta }
87 | -- ANCHOR_END: interpretF
88 |
89 | setStrokeStyle ctx "#000"
90 |
91 | -- ANCHOR: strokePath
92 | strokePath ctx $ lsystem initial productions interpret 5 initialState
93 | -- ANCHOR_END: strokePath
94 |
--------------------------------------------------------------------------------
/exercises/chapter14/src/Data/DOM/Smart.purs:
--------------------------------------------------------------------------------
1 | module Data.DOM.Smart
2 | ( Element
3 | , Attribute
4 | , Content
5 | , AttributeKey
6 |
7 | , a
8 | , p
9 | , img
10 |
11 | , href
12 | , _class
13 | , src
14 | , width
15 | , height
16 |
17 | , attribute, (:=)
18 | , text
19 | , elem
20 |
21 | , render
22 | ) where
23 |
24 | import Prelude
25 |
26 | import Data.Maybe (Maybe(..))
27 | import Data.String (joinWith)
28 |
29 | newtype Element = Element
30 | { name :: String
31 | , attribs :: Array Attribute
32 | , content :: Maybe (Array Content)
33 | }
34 |
35 | data Content
36 | = TextContent String
37 | | ElementContent Element
38 |
39 | newtype Attribute = Attribute
40 | { key :: String
41 | , value :: String
42 | }
43 |
44 | element :: String -> Array Attribute -> Maybe (Array Content) -> Element
45 | element name attribs content = Element
46 | { name: name
47 | , attribs: attribs
48 | , content: content
49 | }
50 |
51 | text :: String -> Content
52 | text = TextContent
53 |
54 | elem :: Element -> Content
55 | elem = ElementContent
56 |
57 | newtype AttributeKey = AttributeKey String
58 |
59 | attribute :: AttributeKey -> String -> Attribute
60 | attribute (AttributeKey key) value = Attribute
61 | { key: key
62 | , value: value
63 | }
64 |
65 | infix 4 attribute as :=
66 |
67 | a :: Array Attribute -> Array Content -> Element
68 | a attribs content = element "a" attribs (Just content)
69 |
70 | p :: Array Attribute -> Array Content -> Element
71 | p attribs content = element "p" attribs (Just content)
72 |
73 | img :: Array Attribute -> Element
74 | img attribs = element "img" attribs Nothing
75 |
76 | href :: AttributeKey
77 | href = AttributeKey "href"
78 |
79 | _class :: AttributeKey
80 | _class = AttributeKey "class"
81 |
82 | src :: AttributeKey
83 | src = AttributeKey "src"
84 |
85 | width :: AttributeKey
86 | width = AttributeKey "width"
87 |
88 | height :: AttributeKey
89 | height = AttributeKey "height"
90 |
91 | render :: Element -> String
92 | render (Element e) =
93 | "<" <> e.name <>
94 | " " <> joinWith " " (map renderAttribute e.attribs) <>
95 | renderContent e.content
96 | where
97 | renderAttribute :: Attribute -> String
98 | renderAttribute (Attribute x) = x.key <> "=\"" <> x.value <> "\""
99 |
100 | renderContent :: Maybe (Array Content) -> String
101 | renderContent Nothing = " />"
102 | renderContent (Just content) =
103 | ">" <> joinWith "" (map renderContentItem content) <>
104 | " e.name <> ">"
105 | where
106 | renderContentItem :: Content -> String
107 | renderContentItem (TextContent s) = s
108 | renderContentItem (ElementContent e') = render e'
109 |
--------------------------------------------------------------------------------
/exercises/chapter3/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 | import Test.MySolutions
5 | import Test.NoPeeking.Solutions -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
6 | import Data.AddressBook (AddressBook, Entry, emptyBook, findEntry, insertEntry)
7 | import Data.Maybe (Maybe(..))
8 | import Effect (Effect)
9 | import Test.Unit (TestSuite, suite, test)
10 | import Test.Unit.Assert as Assert
11 | import Test.Unit.Main (runTest)
12 |
13 | john :: Entry
14 | john =
15 | { firstName: "John"
16 | , lastName: "Smith"
17 | , address:
18 | { street: "123 Fake St.", city: "Faketown", state: "CA" }
19 | }
20 |
21 | peggy :: Entry
22 | peggy =
23 | { firstName: "Peggy"
24 | , lastName: "Hill"
25 | , address:
26 | { street: "84 Rainey St.", city: "Arlen", state: "TX" }
27 | }
28 |
29 | ned :: Entry
30 | ned =
31 | { firstName: "Ned"
32 | , lastName: "Flanders"
33 | , address:
34 | { street: "740 Evergreen Terrace", city: "Springfield", state: "USA" }
35 | }
36 |
37 | book :: AddressBook
38 | book =
39 | insertEntry john
40 | $ insertEntry peggy
41 | $ insertEntry ned
42 | emptyBook
43 |
44 | otherJohn :: Entry
45 | otherJohn =
46 | { firstName: "John"
47 | , lastName: "Smith"
48 | , address:
49 | { street: "678 Fake Rd.", city: "Fakeville", state: "NY" }
50 | }
51 |
52 |
53 | bookWithDuplicate :: AddressBook
54 | bookWithDuplicate =
55 | insertEntry john
56 | $ insertEntry otherJohn
57 | book
58 |
59 | main :: Effect Unit
60 | main =
61 | runTest do
62 | runChapterExamples
63 | {- Move this block comment starting point to enable more tests
64 | This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. -}
65 | suite "Exercise - findEntryByStreet" do
66 | test "Lookup existing" do
67 | Assert.equal (Just john)
68 | $ findEntryByStreet john.address.street book
69 | test "Lookup missing" do
70 | Assert.equal Nothing
71 | $ findEntryByStreet "456 Nothing St." book
72 | suite "Exercise - isInBook" do
73 | test "Check existing" do
74 | Assert.equal true
75 | $ isInBook ned.firstName ned.lastName book
76 | test "Check missing" do
77 | Assert.equal false
78 | $ isInBook "unknown" "person" book
79 | test "Exercise - removeDuplicates" do
80 | Assert.equal book
81 | $ removeDuplicates bookWithDuplicate
82 |
83 | {- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
84 | -}
85 | runChapterExamples :: TestSuite
86 | runChapterExamples = do
87 | test "Todo for book maintainers - Add tests for chapter examples" do
88 | Assert.equal true true
89 | suite "findEntry" do
90 | test "Lookup existing"
91 | $ Assert.equal (Just ned)
92 | $ findEntry ned.firstName ned.lastName book
93 | test "Lookup missing"
94 | $ Assert.equal Nothing
95 | $ findEntry "unknown" "person" book
96 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # PureScript by Example
2 |
3 | This repository contains a [community fork](https://github.com/purescript-contrib/purescript-book/) of _PureScript by Example_ by Phil Freeman, also known as "the PureScript book". This version differs from the original in that it has been updated so that the code and exercises work with up-to-date versions of the compiler, libraries, and tools. Some chapters have also been rewritten to showcase the latest features of the PureScript ecosystem.
4 |
5 | If you enjoyed the book or found it useful, please consider buying a copy of [the original on Leanpub](https://leanpub.com/purescript).
6 |
7 | Translations: [日本語 (Japanese)](https://gemmaro.github.io/purescript-book/)
8 |
9 | ## Status
10 |
11 | This book is being continuously updated as the language evolves, so please report any [issues](https://github.com/purescript-contrib/purescript-book/issues) you discover with the material. We appreciate any feedback you have to share, even if it's as simple as pointing out a confusing section that we could make more beginner-friendly.
12 |
13 | Unit tests are also being added to each chapter so you can check if your answers to the exercises are correct. See [#79](https://github.com/purescript-contrib/purescript-book/issues/79) for the latest status on tests.
14 |
15 | ## About the Book
16 |
17 | PureScript is a small, strongly, statically typed programming language with expressive types, written in and inspired by Haskell, and compiling to Javascript.
18 |
19 | Functional programming in JavaScript has seen quite a lot of popularity recently, but large-scale application development is hindered by the lack of a disciplined environment in which to write code. PureScript aims to solve that problem by bringing the power of strongly-typed functional programming to the world of JavaScript development.
20 |
21 | This book will show you how to get started with the PureScript programming language, from the basics (setting up a development environment) to the advanced.
22 |
23 | Each chapter will be motivated by a particular problem, and in the course of solving that problem, new functional programming tools and techniques will be introduced. Here are some examples of problems that will be solved in this book:
24 |
25 | - Transforming data structures with maps and folds
26 | - Form field validation using applicative functors
27 | - Testing code with QuickCheck
28 | - Using the canvas
29 | - Domain specific language implementation
30 | - Working with the DOM
31 | - JavaScript interoperability
32 | - Parallel asynchronous execution
33 |
34 | ## License
35 |
36 | Copyright (c) 2014-2017 Phil Freeman.
37 |
38 | The text of this book is licensed under the Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License: .
39 |
40 | Some text is derived from the [PureScript Documentation Repo](https://github.com/purescript/documentation), which uses the same license, and is copyright [various contributors](https://github.com/purescript/documentation/blob/master/CONTRIBUTORS.md).
41 |
42 | The exercises are licensed under the MIT license.
43 |
--------------------------------------------------------------------------------
/exercises/chapter14/src/Data/DOM/Phantom.purs:
--------------------------------------------------------------------------------
1 | module Data.DOM.Phantom
2 | ( Element
3 | , Attribute
4 | , Content
5 | , AttributeKey
6 | , class IsValue
7 | , toValue
8 |
9 | , a
10 | , p
11 | , img
12 |
13 | , href
14 | , _class
15 | , src
16 | , width
17 | , height
18 |
19 | , attribute, (:=)
20 | , text
21 | , elem
22 |
23 | , render
24 | ) where
25 |
26 | import Prelude
27 |
28 | import Data.Maybe (Maybe(..))
29 | import Data.String (joinWith)
30 |
31 | newtype Element = Element
32 | { name :: String
33 | , attribs :: Array Attribute
34 | , content :: Maybe (Array Content)
35 | }
36 |
37 | data Content
38 | = TextContent String
39 | | ElementContent Element
40 |
41 | newtype Attribute = Attribute
42 | { key :: String
43 | , value :: String
44 | }
45 |
46 | newtype AttributeKey a = AttributeKey String
47 |
48 | element :: String -> Array Attribute -> Maybe (Array Content) -> Element
49 | element name attribs content = Element
50 | { name: name
51 | , attribs: attribs
52 | , content: content
53 | }
54 |
55 | text :: String -> Content
56 | text = TextContent
57 |
58 | elem :: Element -> Content
59 | elem = ElementContent
60 |
61 | class IsValue a where
62 | toValue :: a -> String
63 |
64 | instance IsValue String where
65 | toValue = identity
66 |
67 | instance IsValue Int where
68 | toValue = show
69 |
70 | attribute :: forall a. IsValue a => AttributeKey a -> a -> Attribute
71 | attribute (AttributeKey key) value = Attribute
72 | { key: key
73 | , value: toValue value
74 | }
75 |
76 | infix 4 attribute as :=
77 |
78 | a :: Array Attribute -> Array Content -> Element
79 | a attribs content = element "a" attribs (Just content)
80 |
81 | p :: Array Attribute -> Array Content -> Element
82 | p attribs content = element "p" attribs (Just content)
83 |
84 | img :: Array Attribute -> Element
85 | img attribs = element "img" attribs Nothing
86 |
87 | href :: AttributeKey String
88 | href = AttributeKey "href"
89 |
90 | _class :: AttributeKey String
91 | _class = AttributeKey "class"
92 |
93 | src :: AttributeKey String
94 | src = AttributeKey "src"
95 |
96 | width :: AttributeKey Int
97 | width = AttributeKey "width"
98 |
99 | height :: AttributeKey Int
100 | height = AttributeKey "height"
101 |
102 | render :: Element -> String
103 | render (Element e) =
104 | "<" <> e.name <>
105 | " " <> joinWith " " (map renderAttribute e.attribs) <>
106 | renderContent e.content
107 | where
108 | renderAttribute :: Attribute -> String
109 | renderAttribute (Attribute x) = x.key <> "=\"" <> x.value <> "\""
110 |
111 | renderContent :: Maybe (Array Content) -> String
112 | renderContent Nothing = " />"
113 | renderContent (Just content) =
114 | ">" <> joinWith "" (map renderContentItem content) <>
115 | " e.name <> ">"
116 | where
117 | renderContentItem :: Content -> String
118 | renderContentItem (TextContent s) = s
119 | renderContentItem (ElementContent e') = render e'
120 |
--------------------------------------------------------------------------------
/exercises/chapter4/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 |
5 | import ChapterExamples (Amp(..), Volt(..), Coulomb(..))
6 | import Data.Maybe (Maybe(Just, Nothing))
7 | import Data.Person (Person)
8 | import Data.Picture
9 | ( Bounds
10 | , Picture
11 | , Point
12 | , Shape(Circle, Rectangle, Line, Text)
13 | , bounds
14 | , getCenter
15 | , intersect
16 | , origin
17 | )
18 | import Data.Picture as DataP
19 | import Data.Number as Number
20 |
21 | factorial :: Int -> Int
22 | factorial 0 = 1
23 | factorial n = n * factorial (n - 1)
24 |
25 | binomial :: Int -> Int -> Int
26 | binomial _ 0 = 1
27 | binomial 0 _ = 0
28 | binomial n k | n < k = 0
29 | | otherwise = factorial n / (factorial k * (factorial (n - k)))
30 |
31 | pascal :: Int -> Int -> Int
32 | pascal _ 0 = 1
33 | pascal 0 _ = 0
34 | pascal n k
35 | = pascal (n-1) k + pascal (n - 1) (k - 1)
36 | {-
37 | Most general type for sameCity and livesInLA functions taking into account row polymorphism:
38 |
39 | sameCity
40 | :: forall r1 s1. { address :: { city :: String | s1 } | r1 }
41 | -> forall r2 s2. { address :: { city :: String | s2 } | r2 }
42 | -> Boolean
43 |
44 | livesInLA
45 | :: forall r s. { address :: { city :: String | s } | r }
46 | -> Boolean
47 | -}
48 |
49 | sameCity :: Person -> Person -> Boolean
50 | sameCity { address: { city: c1 } } { address: { city: c2 } }
51 | | c1 == c2 = true
52 | | otherwise = false
53 |
54 | fromSingleton :: forall a. a -> Array a -> a
55 | fromSingleton a [b] = b
56 | fromSingleton a _ = a
57 |
58 | circleAtOrigin :: Shape
59 | circleAtOrigin = Circle origin 10.0
60 |
61 | centerShape :: Shape -> Shape
62 | centerShape (Circle c r) = Circle origin r
63 | centerShape (Rectangle c w h) = Rectangle origin w h
64 | centerShape line@(Line s e) = Line (s - delta) (e - delta)
65 | where
66 | delta = getCenter line
67 | centerShape (Text loc text) = Text origin text
68 |
69 | scaleShape :: Number -> Shape -> Shape
70 | scaleShape i (Circle c r) = Circle c (r * i)
71 | scaleShape i (Rectangle c w h) = Rectangle c (w * i) (h * i)
72 | scaleShape i (Line s e) = Line (s * scale) (e * scale)
73 | where
74 | scale = {x: i, y: i}
75 | scaleShape i text = text
76 |
77 | doubleScaleAndCenter :: Shape -> Shape
78 | doubleScaleAndCenter = centerShape <<< scaleShape 2.0
79 |
80 | shapeText :: Shape -> Maybe String
81 | shapeText (Text _ text) = Just text
82 | shapeText _ = Nothing
83 |
84 | area :: Shape -> Number
85 | area (Circle _ r) = Number.pi * r * r
86 | area (Rectangle _ h w) = h * w
87 | area _ = 0.0
88 |
89 | {-
90 | The real solution for this exercise just requires adding the
91 | `Clipped` constructor to `Shape` directly in `Picture.purs`.
92 | But we're using `ShapeExt` here as a workaround so we don't need to edit
93 | code outside of this file.
94 | -}
95 | data ShapeExt
96 | = Clipped Picture Point Number Number
97 | | Shape Shape
98 |
99 | {-
100 | Your solution should edit `shapeBounds` in `Picture.purs`.
101 | -}
102 | shapeBounds :: ShapeExt -> Bounds
103 | shapeBounds (Clipped pic pt w h) = intersect (bounds pic) (DataP.shapeBounds (Rectangle pt w h))
104 | shapeBounds (Shape shape) = DataP.shapeBounds shape
105 |
106 | newtype Watt = Watt Number
107 |
108 | calculateWattage :: Amp -> Volt -> Watt
109 | calculateWattage (Amp i) (Volt v) = Watt $ i * v
110 |
--------------------------------------------------------------------------------
/exercises/chapter4/src/ChapterExamples.purs:
--------------------------------------------------------------------------------
1 | module ChapterExamples where
2 |
3 | import Prelude hiding (gcd)
4 | -- ANCHOR: lzsImport
5 | import Data.Array (tail)
6 | import Data.Foldable (sum)
7 | import Data.Maybe (fromMaybe)
8 | -- ANCHOR_END: lzsImport
9 | -- ANCHOR: unsafePartialImport
10 | import Partial.Unsafe (unsafePartial)
11 | -- ANCHOR_END: unsafePartialImport
12 |
13 | -- ANCHOR: gcd
14 | gcd :: Int -> Int -> Int
15 | gcd n 0 = n
16 | gcd 0 m = m
17 | gcd n m = if n > m
18 | then gcd (n - m) m
19 | else gcd n (m - n)
20 | -- ANCHOR_END: gcd
21 |
22 | -- ANCHOR: fromString
23 | fromString :: String -> Boolean
24 | fromString "true" = true
25 | fromString _ = false
26 | -- ANCHOR_END: fromString
27 |
28 | -- ANCHOR: toString
29 | toString :: Boolean -> String
30 | toString true = "true"
31 | toString false = "false"
32 | -- ANCHOR_END: toString
33 |
34 | -- ANCHOR: gcdV2
35 | gcdV2 :: Int -> Int -> Int
36 | gcdV2 n 0 = n
37 | gcdV2 0 n = n
38 | gcdV2 n m | n > m = gcdV2 (n - m) m
39 | | otherwise = gcdV2 n (m - n)
40 | -- ANCHOR_END: gcdV2
41 |
42 | -- ANCHOR: isEmpty
43 | isEmpty :: forall a. Array a -> Boolean
44 | isEmpty [] = true
45 | isEmpty _ = false
46 | -- ANCHOR_END: isEmpty
47 |
48 | -- ANCHOR: takeFive
49 | takeFive :: Array Int -> Int
50 | takeFive [0, 1, a, b, _] = a * b
51 | takeFive _ = 0
52 | -- ANCHOR_END: takeFive
53 |
54 | -- ANCHOR: showPerson
55 | showPerson :: { first :: String, last :: String } -> String
56 | showPerson { first: x, last: y } = y <> ", " <> x
57 | -- ANCHOR_END: showPerson
58 |
59 | -- ANCHOR: showPersonV2
60 | showPersonV2 :: { first :: String, last :: String } -> String
61 | showPersonV2 { first, last } = last <> ", " <> first
62 | -- ANCHOR_END: showPersonV2
63 |
64 | -- ANCHOR: unknownPerson
65 | unknownPerson :: { first :: String, last :: String }
66 | unknownPerson = { first, last }
67 | where
68 | first = "Jane"
69 | last = "Doe"
70 | -- ANCHOR_END: unknownPerson
71 |
72 | -- ANCHOR: livesInLA
73 | type Address = { street :: String, city :: String }
74 |
75 | type Person = { name :: String, address :: Address }
76 |
77 | livesInLA :: Person -> Boolean
78 | livesInLA { address: { city: "Los Angeles" } } = true
79 | livesInLA _ = false
80 | -- ANCHOR_END: livesInLA
81 |
82 | -- ANCHOR: sortPair
83 | sortPair :: Array Int -> Array Int
84 | sortPair arr@[x, y]
85 | | x <= y = arr
86 | | otherwise = [y, x]
87 | sortPair arr = arr
88 | -- ANCHOR_END: sortPair
89 |
90 | -- ANCHOR: lzs
91 | lzs :: Array Int -> Array Int
92 | lzs [] = []
93 | lzs xs = case sum xs of
94 | 0 -> xs
95 | _ -> lzs (fromMaybe [] $ tail xs)
96 | -- ANCHOR_END: lzs
97 |
98 | -- ANCHOR: partialFunction
99 | partialFunction :: Boolean -> Boolean
100 | partialFunction = unsafePartial \true -> true
101 | -- ANCHOR_END: partialFunction
102 |
103 | -- ANCHOR: electricalUnits
104 | newtype Volt = Volt Number
105 | newtype Ohm = Ohm Number
106 | newtype Amp = Amp Number
107 | -- ANCHOR_END: electricalUnits
108 |
109 | -- ANCHOR: calculateCurrent
110 | calculateCurrent :: Volt -> Ohm -> Amp
111 | calculateCurrent (Volt v) (Ohm r) = Amp (v / r)
112 |
113 | battery :: Volt
114 | battery = Volt 1.5
115 |
116 | lightbulb :: Ohm
117 | lightbulb = Ohm 500.0
118 |
119 | current :: Amp
120 | current = calculateCurrent battery lightbulb
121 | -- ANCHOR_END: calculateCurrent
122 |
123 | -- ANCHOR: Coulomb
124 | newtype Coulomb = MakeCoulomb Number
125 | -- ANCHOR_END: Coulomb
126 |
127 | -- These are to enable testing. Will be explained in Ch6.
128 | derive newtype instance Eq Amp
129 | derive newtype instance Show Amp
130 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/Examples.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | // ANCHOR: square
4 | export const square = function (n) {
5 | return n * n;
6 | };
7 | // ANCHOR_END: square
8 |
9 | // ANCHOR: diagonal
10 | export const diagonal = function (w) {
11 | return function (h) {
12 | return Math.sqrt(w * w + h * h);
13 | };
14 | };
15 | // ANCHOR_END: diagonal
16 |
17 | // ANCHOR: diagonal_arrow
18 | export const diagonalArrow = w => h =>
19 | Math.sqrt(w * w + h * h);
20 | // ANCHOR_END: diagonal_arrow
21 |
22 | // ANCHOR: diagonal_uncurried
23 | export const diagonalUncurried = function (w, h) {
24 | return Math.sqrt(w * w + h * h);
25 | };
26 | // ANCHOR_END: diagonal_uncurried
27 |
28 | export const cumulativeSums = arr => {
29 |
30 | let sum = 0
31 | let sums = []
32 | arr.forEach(x => {
33 | sum += x;
34 | sums.push(sum);
35 | });
36 | return sums;
37 | };
38 |
39 |
40 | export const addComplex = a => b => {
41 | return {
42 | real: a.real + b.real,
43 | imag: a.imag + b.imag
44 | }
45 | };
46 |
47 | export const maybeHeadImpl = just => nothing => arr => {
48 | if (arr.length) {
49 | return just(arr[0]);
50 | } else {
51 | return nothing;
52 | }
53 | };
54 |
55 | export const undefinedHead = arr =>
56 | arr[0];
57 |
58 | export const isUndefined = value =>
59 | value === undefined;
60 |
61 | export const unsafeHead = arr => {
62 | if (arr.length) {
63 | return arr[0];
64 | } else {
65 | throw new Error('unsafeHead: empty array');
66 | }
67 | };
68 |
69 |
70 | export const boldImpl = show => x =>
71 | show(x).toUpperCase() + "!!!";
72 |
73 | export const showEqualityImpl = eq => show => a => b => {
74 | if (eq(a)(b)) {
75 | return "Equivalent";
76 | } else {
77 | return show(a) + " is not equal to " + show(b);
78 | }
79 | }
80 |
81 | export const yellImpl = show => x => () =>
82 | console.log(show(x).toUpperCase() + "!!!");
83 |
84 | export const diagonalLog = function (w, h) {
85 | let result = Math.sqrt(w * w + h * h);
86 | console.log("Diagonal is " + result);
87 | return result;
88 | };
89 |
90 | const wait = ms => new Promise(resolve => setTimeout(resolve, ms));
91 |
92 | export const sleepImpl = ms => () =>
93 | wait(ms);
94 |
95 | async function diagonalWait(delay, w, h) {
96 | await wait(delay);
97 | return Math.sqrt(w * w + h * h);
98 | }
99 |
100 | export const diagonalAsyncImpl = delay => w => h => () =>
101 | diagonalWait(delay, w, h);
102 |
103 |
104 | export const cumulativeSumsBroken = arr => {
105 | let sum = 0
106 | let sums = []
107 | arr.forEach(x => {
108 | sum += x;
109 | sums.push(sum);
110 | });
111 | sums.push("Broken"); // Bug
112 | return sums;
113 | };
114 |
115 |
116 | export const addComplexBroken = a => b => {
117 | return {
118 | real: a.real + b.real,
119 | broken: a.imag + b.imag // Bug
120 | }
121 | };
122 |
123 | export const cumulativeSumsJson = cumulativeSumsBroken
124 | // Try the non-broken version too
125 | //export const cumulativeSumsJson = cumulativeSums
126 |
127 | export const addComplexJson = addComplexBroken
128 | // Try the non-broken version too
129 | //export const addComplexJson = addComplex
130 |
131 |
132 | export const mapSetFooJson = j => {
133 | let m = new Map(j);
134 | m.set("Foo", 42);
135 | return Array.from(m);
136 | };
137 |
138 | /*
139 | These versions always point to either the working or broken versions
140 | to enable automated testing.
141 | The examples accompanying the text are meant to be swapped
142 | between versions by the reader.
143 | */
144 | export const cumulativeSumsJsonBroken = cumulativeSumsBroken
145 | export const addComplexJsonBroken = addComplexBroken
146 | export const cumulativeSumsJsonWorking = cumulativeSums
147 | export const addComplexJsonWorking = addComplex
148 |
--------------------------------------------------------------------------------
/exercises/chapter14/src/Data/DOM/Free.purs:
--------------------------------------------------------------------------------
1 | module Data.DOM.Free
2 | ( Element
3 | , Attribute
4 | , Content
5 | , ContentF
6 | , AttributeKey
7 | , class IsValue
8 | , toValue
9 |
10 | , a
11 | , p
12 | , img
13 |
14 | , href
15 | , _class
16 | , src
17 | , width
18 | , height
19 |
20 | , attribute, (:=)
21 | , text
22 | , elem
23 |
24 | , render
25 | ) where
26 |
27 | import Prelude
28 |
29 | import Control.Monad.Free (Free, runFreeM, liftF)
30 | import Control.Monad.Writer (Writer, execWriter)
31 | import Control.Monad.Writer.Class (tell)
32 | import Data.Foldable (for_)
33 | import Data.Maybe (Maybe(..))
34 |
35 | newtype Element = Element
36 | { name :: String
37 | , attribs :: Array Attribute
38 | , content :: Maybe (Content Unit)
39 | }
40 |
41 | data ContentF a
42 | = TextContent String a
43 | | ElementContent Element a
44 |
45 | instance Functor ContentF where
46 | map f (TextContent s x) = TextContent s (f x)
47 | map f (ElementContent e x) = ElementContent e (f x)
48 |
49 | type Content = Free ContentF
50 |
51 | newtype Attribute = Attribute
52 | { key :: String
53 | , value :: String
54 | }
55 |
56 | newtype AttributeKey a = AttributeKey String
57 |
58 | element :: String -> Array Attribute -> Maybe (Content Unit) -> Element
59 | element name attribs content = Element
60 | { name: name
61 | , attribs: attribs
62 | , content: content
63 | }
64 |
65 | text :: String -> Content Unit
66 | text s = liftF $ TextContent s unit
67 |
68 | elem :: Element -> Content Unit
69 | elem e = liftF $ ElementContent e unit
70 |
71 | class IsValue a where
72 | toValue :: a -> String
73 |
74 | instance IsValue String where
75 | toValue = identity
76 |
77 | instance IsValue Int where
78 | toValue = show
79 |
80 | attribute :: forall a. IsValue a => AttributeKey a -> a -> Attribute
81 | attribute (AttributeKey key) value = Attribute
82 | { key: key
83 | , value: toValue value
84 | }
85 |
86 | infix 4 attribute as :=
87 |
88 | a :: Array Attribute -> Content Unit -> Element
89 | a attribs content = element "a" attribs (Just content)
90 |
91 | p :: Array Attribute -> Content Unit -> Element
92 | p attribs content = element "p" attribs (Just content)
93 |
94 | img :: Array Attribute -> Element
95 | img attribs = element "img" attribs Nothing
96 |
97 | href :: AttributeKey String
98 | href = AttributeKey "href"
99 |
100 | _class :: AttributeKey String
101 | _class = AttributeKey "class"
102 |
103 | src :: AttributeKey String
104 | src = AttributeKey "src"
105 |
106 | width :: AttributeKey Int
107 | width = AttributeKey "width"
108 |
109 | height :: AttributeKey Int
110 | height = AttributeKey "height"
111 |
112 | render :: Element -> String
113 | render = execWriter <<< renderElement
114 | where
115 | renderElement :: Element -> Writer String Unit
116 | renderElement (Element e) = do
117 | tell "<"
118 | tell e.name
119 | for_ e.attribs $ \x -> do
120 | tell " "
121 | renderAttribute x
122 | renderContent e.content
123 | where
124 | renderAttribute :: Attribute -> Writer String Unit
125 | renderAttribute (Attribute x) = do
126 | tell x.key
127 | tell "=\""
128 | tell x.value
129 | tell "\""
130 |
131 | renderContent :: Maybe (Content Unit) -> Writer String Unit
132 | renderContent Nothing = tell " />"
133 | renderContent (Just content) = do
134 | tell ">"
135 | runFreeM renderContentItem content
136 | tell ""
139 |
140 | renderContentItem :: forall a. ContentF (Content a) -> Writer String (Content a)
141 | renderContentItem (TextContent s rest) = do
142 | tell s
143 | pure rest
144 | renderContentItem (ElementContent e' rest) = do
145 | renderElement e'
146 | pure rest
147 |
--------------------------------------------------------------------------------
/exercises/chapter5/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 | import Control.Alternative (guard)
5 | import Data.Array (cons, filter, head, length, null, tail, (..), (:))
6 | import Data.Foldable (foldl)
7 | import Data.Maybe (Maybe(..), fromMaybe)
8 | import Data.Path (Path, filename, isDirectory, ls, size)
9 | import Data.Tuple (Tuple(..))
10 | import Test.Examples
11 |
12 | isEven :: Int -> Boolean
13 | isEven n =
14 | if n < 0
15 | then isEven (-n)
16 | else if n == 0
17 | then true
18 | else not (isEven (n - 1))
19 |
20 | oneIfEven :: Int -> Int
21 | oneIfEven n = if isEven n then 1 else 0
22 |
23 | countEven :: Array Int -> Int
24 | countEven xs =
25 | if null xs then 0
26 | else oneIfEven (fromMaybe 1 $ head xs ) + countEven (fromMaybe [] $ tail xs)
27 |
28 | squared :: Array Number -> Array Number
29 | squared arr = map (\n -> n * n) arr
30 |
31 | keepNonNegative :: Array Number -> Array Number
32 | keepNonNegative arr = filter (\n -> n >= 0.0) arr
33 |
34 | infix 4 filter as <$?>
35 |
36 | keepNonNegativeRewrite :: Array Number -> Array Number
37 | keepNonNegativeRewrite arr = (\n -> n >= 0.0) <$?> arr
38 |
39 | isPrime :: Int -> Boolean
40 | isPrime n = n > 1 && length (factors n) == 1
41 |
42 | cartesianProduct :: ∀ a. Array a -> Array a -> Array (Array a)
43 | cartesianProduct left right = do
44 | a_ <- left
45 | b_ <- right
46 | [ [ a_, b_ ] ]
47 |
48 | triples :: Int -> Array (Array Int)
49 | triples n = do
50 | i <- 1 .. n
51 | j <- i .. n
52 | k <- j .. n
53 | guard $ i * i + j * j == k * k
54 | pure [ i, j, k ]
55 |
56 | -- | Provide the prime numbers that, multiplied together, make the argument.
57 | primeFactors :: Int -> Array Int
58 | primeFactors n = factorize 2 n
59 | where
60 | factorize :: Int -> Int -> Array Int
61 | factorize _ 1 = []
62 | factorize divisor dividend =
63 | if dividend `mod` divisor == 0 then
64 | cons divisor $ factorize (divisor) (dividend / divisor)
65 | else
66 | factorize (divisor + 1) dividend
67 |
68 | allTrue :: Array Boolean -> Boolean
69 | allTrue bools = foldl (\acc bool -> acc && bool) true bools
70 |
71 | {-
72 | Answer to array characterization question:
73 | `foldl (==) false xs` returns true when `xs` contains ...
74 | ... an odd number of `false` elements.
75 | -}
76 | fibTailRec :: Int -> Int
77 | fibTailRec 0 = 0
78 | fibTailRec 1 = 1
79 | fibTailRec n = fib' n 2 0 1
80 | where
81 | fib' :: Int -> Int -> Int -> Int -> Int
82 | fib' limit count n1 n2 =
83 | if limit == count then
84 | n1 + n2
85 | else
86 | fib' limit (count + 1) n2 (n1 + n2)
87 |
88 | reverse :: ∀ a. Array a -> Array a
89 | reverse = foldl (\xs x -> [ x ] <> xs) []
90 |
91 | onlyFiles :: Path -> Array Path
92 | onlyFiles path = filter (not isDirectory) (allFiles path)
93 |
94 | allSizes :: Array Path -> Array (Tuple String Int)
95 | allSizes paths =
96 | map
97 | ( \p -> case size p of
98 | Just n -> Tuple (filename p) n
99 | Nothing -> Tuple (filename p) 0
100 | )
101 | paths
102 |
103 | whereIs :: Path -> String -> Maybe Path
104 | whereIs path fileName = head $ do
105 | path' <- allFiles path
106 | child <- ls path'
107 | guard $ filename child == filename path' <> fileName
108 | pure path'
109 |
110 | largestSmallest :: Path -> Array Path
111 | largestSmallest path = foldl loop [] (onlyFiles path) where
112 | loop :: Array Path -> Path -> Array Path
113 | loop [largest, smallest] current | size current < size smallest = [largest, current]
114 | | size current > size largest = [current, smallest]
115 | | otherwise = [largest, smallest]
116 | loop [last] current | size current < size last = [current, last]
117 | | otherwise = [last, current]
118 | loop arr current = current : arr
119 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 |
5 | import Control.Alt (alt)
6 | import Control.Apply (lift2)
7 | import Data.Argonaut (class DecodeJson, class EncodeJson, Json, JsonDecodeError(..), decodeJson, encodeJson, jsonParser, printJsonDecodeError)
8 | import Data.Argonaut.Decode.Generic (genericDecodeJson)
9 | import Data.Argonaut.Encode.Generic (genericEncodeJson)
10 | import Data.Bifunctor (lmap)
11 | import Data.Either (Either(..))
12 | import Data.Eq.Generic (genericEq)
13 | import Data.Foldable (foldr)
14 | import Data.Function.Uncurried (Fn3)
15 | import Data.Generic.Rep (class Generic)
16 | import Data.Map (Map)
17 | import Data.Maybe (Maybe(..))
18 | import Data.Pair (Pair(..))
19 | import Data.Set (Set)
20 | import Data.Show.Generic (genericShow)
21 | import Test.Examples (Complex, Quadratic, Undefined)
22 |
23 | foreign import volumeFn :: Fn3 Number Number Number Number
24 |
25 | foreign import volumeArrow :: Number -> Number -> Number -> Number
26 |
27 | foreign import cumulativeSumsComplex :: Array Complex -> Array Complex
28 |
29 | foreign import quadraticRootsImpl :: (forall a. a -> a -> Pair a) -> Quadratic -> Pair Complex
30 |
31 | quadraticRoots :: Quadratic -> Pair Complex
32 | quadraticRoots poly = quadraticRootsImpl Pair poly
33 |
34 | foreign import toMaybeImpl :: forall a. (forall x. x -> Maybe x) -> (forall x. Maybe x) -> Undefined a -> Maybe a
35 |
36 | toMaybe :: forall a. Undefined a -> Maybe a
37 | toMaybe = toMaybeImpl Just Nothing
38 |
39 | foreign import valuesOfMapJson :: Json -> Json
40 |
41 | valuesOfMap :: Map String Int -> Either JsonDecodeError (Set Int)
42 | valuesOfMap = encodeJson >>> valuesOfMapJson >>> decodeJson
43 |
44 | valuesOfMapGeneric ::
45 | forall k v.
46 | EncodeJson k =>
47 | EncodeJson v =>
48 | DecodeJson v =>
49 | Ord k =>
50 | Ord v =>
51 | Map k v ->
52 | Either JsonDecodeError (Set v)
53 | valuesOfMapGeneric = encodeJson >>> valuesOfMapJson >>> decodeJson
54 |
55 | foreign import quadraticRootsSetJson :: Json -> Json
56 |
57 | quadraticRootsSet :: Quadratic -> Either JsonDecodeError (Set Complex)
58 | quadraticRootsSet = encodeJson >>> quadraticRootsSetJson >>> decodeJson
59 |
60 | foreign import quadraticRootsSafeJson :: Json -> Json
61 |
62 | newtype WrapPair a
63 | = WrapPair (Pair a)
64 |
65 | instance DecodeJson a => DecodeJson (WrapPair a) where
66 | decodeJson j = do
67 | decoded <- decodeJson j
68 | case decoded of
69 | [ a, b ] -> map WrapPair $ lift2 Pair (decodeJson a) (decodeJson b)
70 | [ ] -> Left $ AtIndex 0 MissingValue
71 | [ a ] -> Left $ AtIndex 1 MissingValue
72 | _ -> Left $ AtIndex 2 $ UnexpectedValue j
73 |
74 | quadraticRootsSafeWrap :: Quadratic -> Either JsonDecodeError (WrapPair Complex)
75 | quadraticRootsSafeWrap = encodeJson >>> quadraticRootsSafeJson >>> decodeJson
76 |
77 | quadraticRootsSafe :: Quadratic -> Either JsonDecodeError (Pair Complex)
78 | quadraticRootsSafe = quadraticRootsSafeWrap >>> map (\(WrapPair p) -> p)
79 |
80 | parseAndDecodeArray2D :: String -> Either String (Array (Array Int))
81 | parseAndDecodeArray2D str = do
82 | j <- jsonParser str
83 | lmap printJsonDecodeError $ decodeJson j
84 |
85 | data Tree a
86 | = Leaf a
87 | | Branch (Tree a) (Tree a)
88 |
89 | derive instance Generic (Tree a) _
90 |
91 | instance EncodeJson a => EncodeJson (Tree a) where
92 | encodeJson t = genericEncodeJson t
93 |
94 | instance DecodeJson a => DecodeJson (Tree a) where
95 | decodeJson t = genericDecodeJson t
96 |
97 | instance Eq a => Eq (Tree a) where
98 | eq t = genericEq t
99 |
100 | instance Show a => Show (Tree a) where
101 | show t = genericShow t
102 |
103 | data IntOrString
104 | = IntOrString_Int Int
105 | | IntOrString_String String
106 |
107 | instance EncodeJson IntOrString where
108 | encodeJson (IntOrString_Int i) = encodeJson i
109 | encodeJson (IntOrString_String s) = encodeJson s
110 |
111 | instance DecodeJson IntOrString where
112 | decodeJson j =
113 | foldr alt (Left $ TypeMismatch "Not Int or String")
114 | [ map IntOrString_Int $ decodeJson j
115 | , map IntOrString_String $ decodeJson j
116 | ]
117 |
118 | derive instance Generic IntOrString _
119 |
120 | instance Eq IntOrString where
121 | eq = genericEq
122 |
123 | instance Show IntOrString where
124 | show = genericShow
125 |
--------------------------------------------------------------------------------
/exercises/chapter11/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 |
5 | import Control.Alt ((<|>))
6 | import Control.Monad.Except (ExceptT, throwError)
7 | import Control.Monad.Reader (Reader, ReaderT, ask, lift, local, runReader, runReaderT)
8 | import Control.Monad.State (State, StateT, get, put, execState, modify_)
9 | import Control.Monad.Writer (Writer, WriterT, tell, runWriter, execWriterT)
10 | import Data.Array (some)
11 | import Data.Foldable (fold, foldl)
12 | import Data.GameState (GameState(..))
13 | import Data.Identity (Identity)
14 | import Data.List ((:))
15 | import Data.List as L
16 | import Data.Map as M
17 | import Data.Maybe (Maybe(..))
18 | import Data.Monoid (power)
19 | import Data.Monoid.Additive (Additive(..))
20 | import Data.Newtype (unwrap)
21 | import Data.Set as S
22 | import Data.String (joinWith)
23 | import Data.String.CodeUnits (stripPrefix, toCharArray)
24 | import Data.String.Pattern (Pattern(..))
25 | import Data.Traversable (sequence, traverse_)
26 | import Data.Tuple (Tuple)
27 | import Game (Game)
28 |
29 | --
30 |
31 | testParens :: String -> Boolean
32 | testParens str =
33 | let
34 | openTally :: Char -> Int -> Int
35 | -- Open parens only considered if not already in deficit.
36 | -- No recovery from too-many closed parens.
37 | openTally '(' tally | tally >= 0 = tally + 1
38 | openTally ')' tally = tally - 1
39 | -- Non-parens has no effect
40 | openTally _ tally = tally
41 |
42 | sumParens :: Array Char -> State Int Unit
43 | sumParens = traverse_ \c -> modify_ $ openTally c
44 |
45 | finalTally :: Int
46 | finalTally = execState (sumParens $ toCharArray str) 0
47 | in
48 | finalTally == 0
49 |
50 | --
51 |
52 | type Level = Int
53 | type Doc = (Reader Level) String
54 |
55 | line :: String -> Doc
56 | line str = do
57 | level <- ask
58 | pure $ (power " " level) <> str
59 |
60 | indent :: Doc -> Doc
61 | indent = local $ (+) 1
62 |
63 | cat :: Array Doc -> Doc
64 | cat = sequence >=> joinWith "\n" >>> pure
65 |
66 | render :: Doc -> String
67 | render doc = runReader doc 0
68 |
69 | --
70 |
71 | sumArrayWriter :: Array Int -> Writer (Additive Int) Unit
72 | sumArrayWriter = traverse_ \n -> do
73 | tell $ Additive n
74 | pure unit
75 |
76 | --
77 |
78 | collatz :: Int -> Tuple Int (Array Int)
79 | collatz c = runWriter $ cltz 0 c
80 | where
81 | cltz :: Int -> Int -> Writer (Array Int) Int
82 | cltz i 1 = do
83 | tell [ 1 ]
84 | pure i
85 | cltz i n = do
86 | tell [ n ]
87 | if mod n 2 == 0
88 | then cltz (i + 1) (n / 2)
89 | else cltz (i + 1) ((3 * n) + 1)
90 |
91 | --
92 |
93 | safeDivide :: Int -> Int -> ExceptT String Identity Int
94 | safeDivide _ 0 = throwError "Divide by zero!"
95 | safeDivide a b = pure $ a / b
96 |
97 | --
98 |
99 | type Errors = Array String
100 | type Log = Array String
101 | type Parser = StateT String (WriterT Log (ExceptT Errors Identity))
102 |
103 | string :: String -> Parser String
104 | string prefix = do
105 | st <- get
106 | lift $ tell ["The state is " <> st]
107 | case stripPrefix (Pattern prefix) st of
108 | Just rest -> do
109 | put rest
110 | pure prefix
111 | _ -> do
112 | lift $ lift $ throwError ["Could not parse"]
113 |
114 | --
115 |
116 | type Level' = Int
117 | type Doc' = (WriterT (Array String) (ReaderT Level' Identity)) Unit
118 |
119 | line' :: String -> Doc'
120 | line' s = do
121 | level <- lift $ ask
122 | tell [ (power " " level) <> s ]
123 | pure unit
124 |
125 | indent' :: Doc' -> Doc'
126 | indent' = local $ (+) 1
127 |
128 | render' :: Doc' -> String
129 | render' doct = joinWith "\n" $ unwrap $ runReaderT (execWriterT doct) 0
130 |
131 | asFollowedByBs :: Parser String
132 | asFollowedByBs = do
133 | as <- some $ string "a"
134 | bs <- some $ string "b"
135 | pure $ fold $ as <> bs
136 |
137 | asOrBs :: Parser String
138 | asOrBs = fold <$> some (string "a" <|> string "b")
139 |
140 | -- Note, that this function should be defined in Game.purs to avoid creating a circular dependency.
141 | cheat :: Game Unit
142 | cheat = do
143 | GameState state <- get
144 | let newInventory = foldl S.union state.inventory state.items
145 | tell $ foldl (\acc x -> ("You now have the " <> show x) : acc) L.Nil $ S.unions state.items
146 | put $ GameState state { items = M.empty, inventory = newInventory }
147 |
--------------------------------------------------------------------------------
/exercises/chapter11/src/Game.purs:
--------------------------------------------------------------------------------
1 | module Game where
2 |
3 | import Prelude
4 |
5 | import Control.Monad.RWS (RWS)
6 | import Control.Monad.Reader (ask)
7 | import Control.Monad.State (get, modify_, put)
8 | import Control.Monad.Writer (tell)
9 | import Data.Coords (Coords(..), prettyPrintCoords, coords)
10 | import Data.Foldable (for_)
11 | import Data.GameEnvironment (GameEnvironment(..))
12 | import Data.GameItem (GameItem(..), readItem)
13 | import Data.GameState (GameState(..))
14 | import Data.List as L
15 | import Data.Map as M
16 | import Data.Maybe (Maybe(..))
17 | import Data.Set as S
18 |
19 | -- ANCHOR: Game
20 | type Log = L.List String
21 |
22 | type Game = RWS GameEnvironment Log GameState
23 | -- ANCHOR_END: Game
24 |
25 | describeRoom :: Game Unit
26 | describeRoom = do
27 | GameState state <- get
28 | case state.player of
29 | Coords { x: 0, y: 0 } -> tell (L.singleton "You are in a dark forest. You see a path to the north.")
30 | Coords { x: 0, y: 1 } -> tell (L.singleton "You are in a clearing.")
31 | _ -> tell (L.singleton "You are deep in the forest.")
32 |
33 | -- ANCHOR: pickup_start
34 | pickUp :: GameItem -> Game Unit
35 | pickUp item = do
36 | GameState state <- get
37 | -- ANCHOR_END: pickup_start
38 | -- ANCHOR: pickup_case
39 | case state.player `M.lookup` state.items of
40 | -- ANCHOR_END: pickup_case
41 | -- ANCHOR: pickup_Just
42 | Just items | item `S.member` items -> do
43 | -- ANCHOR_END: pickup_Just
44 | -- ANCHOR: pickup_body
45 | let newItems = M.update (Just <<< S.delete item) state.player state.items
46 | newInventory = S.insert item state.inventory
47 | put $ GameState state { items = newItems
48 | , inventory = newInventory
49 | }
50 | tell (L.singleton ("You now have the " <> show item))
51 | -- ANCHOR_END: pickup_body
52 | -- ANCHOR: pickup_err
53 | _ -> tell (L.singleton "I don't see that item here.")
54 | -- ANCHOR_END: pickup_err
55 |
56 | move :: Int -> Int -> Game Unit
57 | move dx dy = modify_ (\(GameState state) -> GameState (state { player = updateCoords state.player }))
58 | where
59 | updateCoords :: Coords -> Coords
60 | updateCoords (Coords p) = coords (p.x + dx) (p.y + dy)
61 |
62 | -- ANCHOR: has
63 | has :: GameItem -> Game Boolean
64 | has item = do
65 | GameState state <- get
66 | pure $ item `S.member` state.inventory
67 | -- ANCHOR_END: has
68 |
69 | use :: GameItem -> Game Unit
70 | use Candle = tell (L.singleton "I don't know what you want me to do with that.")
71 | use Matches = do
72 | hasCandle <- has Candle
73 | if hasCandle
74 | then do
75 | GameEnvironment env <- ask
76 | tell (L.fromFoldable [ "You light the candle."
77 | , "Congratulations, " <> env.playerName <> "!"
78 | , "You win!"
79 | ])
80 | else tell (L.singleton "You don't have anything to light.")
81 |
82 | -- ANCHOR: game_sig
83 | game :: Array String -> Game Unit
84 | -- ANCHOR_END: game_sig
85 | game ["look"] = do
86 | GameState state <- get
87 | tell (L.singleton ("You are at " <> prettyPrintCoords state.player))
88 | describeRoom
89 | for_ (M.lookup state.player state.items) $ \items ->
90 | tell (map (\item -> "You can see the " <> show item <> ".") (S.toUnfoldable items :: L.List GameItem))
91 | game ["inventory"] = do
92 | GameState state <- get
93 | tell (map (\item -> "You have the " <> show item <> ".") (S.toUnfoldable state.inventory :: L.List GameItem))
94 | game ["north"] = move 0 1
95 | game ["south"] = move 0 (-1)
96 | game ["west"] = move (-1) 0
97 | game ["east"] = move 1 0
98 | game ["take", item] =
99 | case readItem item of
100 | Nothing -> tell (L.singleton "I don't know what item you are referring to.")
101 | Just gameItem -> pickUp gameItem
102 | game ["use", item] =
103 | case readItem item of
104 | Nothing -> tell (L.singleton "I don't know what item you are referring to.")
105 | Just gameItem -> do
106 | hasItem <- has gameItem
107 | if hasItem
108 | then use gameItem
109 | else tell (L.singleton "You don't have that item.")
110 | game ["debug"] = do
111 | -- ANCHOR: debug
112 | GameEnvironment env <- ask
113 | if env.debugMode
114 | then do
115 | state :: GameState <- get
116 | tell (L.singleton (show state))
117 | else tell (L.singleton "Not running in debug mode.")
118 | -- ANCHOR_END: debug
119 | game [] = pure unit
120 | game _ = tell (L.singleton "I don't understand.")
121 |
--------------------------------------------------------------------------------
/exercises/chapter4/src/Data/Picture.purs:
--------------------------------------------------------------------------------
1 | -- ANCHOR: module_picture
2 | module Data.Picture where
3 |
4 | import Prelude
5 | import Data.Foldable (foldl)
6 | import Data.Number (infinity)
7 | -- ANCHOR_END: module_picture
8 | -- ANCHOR: picture_import_as
9 | import Data.Number as Number
10 | -- ANCHOR_END: picture_import_as
11 |
12 | -- ANCHOR: Point
13 | type Point =
14 | { x :: Number
15 | , y :: Number
16 | }
17 | -- ANCHOR_END: Point
18 |
19 | -- ANCHOR: showPoint
20 | showPoint :: Point -> String
21 | showPoint { x, y } =
22 | "(" <> show x <> ", " <> show y <> ")"
23 | -- ANCHOR_END: showPoint
24 |
25 | -- ANCHOR: Shape
26 | data Shape
27 | = Circle Point Number
28 | | Rectangle Point Number Number
29 | | Line Point Point
30 | | Text Point String
31 | -- ANCHOR_END: Shape
32 |
33 | -- ANCHOR: showShape
34 | showShape :: Shape -> String
35 | showShape (Circle c r) =
36 | "Circle [center: " <> showPoint c <> ", radius: " <> show r <> "]"
37 | showShape (Rectangle c w h) =
38 | "Rectangle [center: " <> showPoint c <> ", width: " <> show w <> ", height: " <> show h <> "]"
39 | showShape (Line start end) =
40 | "Line [start: " <> showPoint start <> ", end: " <> showPoint end <> "]"
41 | showShape (Text loc text) =
42 | "Text [location: " <> showPoint loc <> ", text: " <> show text <> "]"
43 | -- ANCHOR_END: showShape
44 |
45 | -- ANCHOR: exampleLine
46 | exampleLine :: Shape
47 | exampleLine = Line p1 p2
48 | where
49 | p1 :: Point
50 | p1 = { x: 0.0, y: 0.0 }
51 |
52 | p2 :: Point
53 | p2 = { x: 100.0, y: 50.0 }
54 | -- ANCHOR_END: exampleLine
55 |
56 | -- ANCHOR: origin
57 | origin :: Point
58 | origin = { x, y }
59 | where
60 | x = 0.0
61 | y = 0.0
62 | -- ANCHOR_END: origin
63 | -- Would generally write it like this instead:
64 | -- origin = { x: 0.0, y: 0.0 }
65 |
66 | getCenter :: Shape -> Point
67 | getCenter (Circle c r) = c
68 | getCenter (Rectangle c w h) = c
69 | getCenter (Line s e) = (s + e) * {x: 0.5, y: 0.5}
70 | getCenter (Text loc text) = loc
71 |
72 | -- ANCHOR: Picture
73 | type Picture = Array Shape
74 | -- ANCHOR_END: Picture
75 |
76 | -- ANCHOR: showPicture
77 | showPicture :: Picture -> Array String
78 | showPicture = map showShape
79 | -- ANCHOR_END: showPicture
80 |
81 | -- ANCHOR: Bounds
82 | type Bounds =
83 | { top :: Number
84 | , left :: Number
85 | , bottom :: Number
86 | , right :: Number
87 | }
88 | -- ANCHOR_END: Bounds
89 |
90 | showBounds :: Bounds -> String
91 | showBounds b =
92 | "Bounds [top: " <> show b.top <>
93 | ", left: " <> show b.left <>
94 | ", bottom: " <> show b.bottom <>
95 | ", right: " <> show b.right <>
96 | "]"
97 |
98 | shapeBounds :: Shape -> Bounds
99 | shapeBounds (Circle { x, y } r) =
100 | { top: y - r
101 | , left: x - r
102 | , bottom: y + r
103 | , right: x + r
104 | }
105 | shapeBounds (Rectangle { x, y } w h) =
106 | { top: y - h / 2.0
107 | , left: x - w / 2.0
108 | , bottom: y + h / 2.0
109 | , right: x + w / 2.0
110 | }
111 | shapeBounds (Line p1 p2) =
112 | { top: Number.min p1.y p2.y
113 | , left: Number.min p1.x p2.x
114 | , bottom: Number.max p1.y p2.y
115 | , right: Number.max p1.x p2.x
116 | }
117 | shapeBounds (Text { x, y } _) =
118 | { top: y
119 | , left: x
120 | , bottom: y
121 | , right: x
122 | }
123 |
124 | union :: Bounds -> Bounds -> Bounds
125 | union b1 b2 =
126 | { top: Number.min b1.top b2.top
127 | , left: Number.min b1.left b2.left
128 | , bottom: Number.max b1.bottom b2.bottom
129 | , right: Number.max b1.right b2.right
130 | }
131 |
132 | intersect :: Bounds -> Bounds -> Bounds
133 | intersect b1 b2 =
134 | { top: Number.max b1.top b2.top
135 | , left: Number.max b1.left b2.left
136 | , bottom: Number.min b1.bottom b2.bottom
137 | , right: Number.min b1.right b2.right
138 | }
139 |
140 | emptyBounds :: Bounds
141 | emptyBounds =
142 | { top: infinity
143 | , left: infinity
144 | , bottom: -infinity
145 | , right: -infinity
146 | }
147 |
148 | infiniteBounds :: Bounds
149 | infiniteBounds =
150 | { top: -infinity
151 | , left: -infinity
152 | , bottom: infinity
153 | , right: infinity
154 | }
155 |
156 | -- ANCHOR: bounds
157 | bounds :: Picture -> Bounds
158 | bounds = foldl combine emptyBounds
159 | where
160 | combine :: Bounds -> Shape -> Bounds
161 | combine b shape = union (shapeBounds shape) b
162 | -- ANCHOR_END: bounds
163 |
164 | {-
165 | These `instance`s are to enable testing.
166 | Feel free to ignore these.
167 | They'll make more sense in the next chapter.
168 | -}
169 | derive instance Eq Shape
170 |
171 | instance Show Shape where
172 | show shape = showShape shape
173 |
--------------------------------------------------------------------------------
/exercises/chapter14/src/Data/DOM/Name.purs:
--------------------------------------------------------------------------------
1 | module Data.DOM.Name
2 | ( Element
3 | , Attribute
4 | , Name
5 | , Content
6 | , ContentF
7 | , AttributeKey
8 | , class IsValue
9 | , toValue
10 | , Href(..)
11 |
12 | , a
13 | , p
14 | , img
15 |
16 | , href
17 | , _class
18 | , src
19 | , width
20 | , height
21 | , name
22 |
23 | , attribute, (:=)
24 | , text
25 | , elem
26 | , newName
27 |
28 | , render
29 | ) where
30 |
31 | import Prelude
32 |
33 | import Control.Monad.Free (Free, runFreeM, liftF)
34 | import Control.Monad.State (State, evalState)
35 | import Control.Monad.State.Trans (put, get)
36 | import Control.Monad.Writer.Trans (WriterT, execWriterT, tell)
37 | import Data.Foldable (for_)
38 | import Data.Maybe (Maybe(..))
39 |
40 | newtype Element = Element
41 | { name :: String
42 | , attribs :: Array Attribute
43 | , content :: Maybe (Content Unit)
44 | }
45 |
46 | newtype Name = Name String
47 |
48 | data ContentF a
49 | = TextContent String a
50 | | ElementContent Element a
51 | | NewName (Name -> a)
52 |
53 | instance Functor ContentF where
54 | map f (TextContent s x) = TextContent s (f x)
55 | map f (ElementContent e x) = ElementContent e (f x)
56 | map f (NewName k) = NewName (f <<< k)
57 |
58 | type Content = Free ContentF
59 |
60 | newtype Attribute = Attribute
61 | { key :: String
62 | , value :: String
63 | }
64 |
65 | newtype AttributeKey a = AttributeKey String
66 |
67 | element :: String -> Array Attribute -> Maybe (Content Unit) -> Element
68 | element name_ attribs content = Element { name: name_, attribs, content }
69 |
70 | text :: String -> Content Unit
71 | text s = liftF $ TextContent s unit
72 |
73 | elem :: Element -> Content Unit
74 | elem e = liftF $ ElementContent e unit
75 |
76 | newName :: Content Name
77 | newName = liftF $ NewName identity
78 |
79 | class IsValue a where
80 | toValue :: a -> String
81 |
82 | instance IsValue String where
83 | toValue = identity
84 |
85 | instance IsValue Int where
86 | toValue = show
87 |
88 | instance IsValue Name where
89 | toValue (Name n) = n
90 |
91 | attribute :: forall a. IsValue a => AttributeKey a -> a -> Attribute
92 | attribute (AttributeKey key) value = Attribute
93 | { key: key
94 | , value: toValue value
95 | }
96 |
97 | infix 4 attribute as :=
98 |
99 | a :: Array Attribute -> Content Unit -> Element
100 | a attribs content = element "a" attribs (Just content)
101 |
102 | p :: Array Attribute -> Content Unit -> Element
103 | p attribs content = element "p" attribs (Just content)
104 |
105 | img :: Array Attribute -> Element
106 | img attribs = element "img" attribs Nothing
107 |
108 | data Href
109 | = URLHref String
110 | | AnchorHref Name
111 |
112 | instance IsValue Href where
113 | toValue (URLHref url) = url
114 | toValue (AnchorHref (Name nm)) = "#" <> nm
115 |
116 | href :: AttributeKey Href
117 | href = AttributeKey "href"
118 |
119 | name :: AttributeKey Name
120 | name = AttributeKey "name"
121 |
122 | _class :: AttributeKey String
123 | _class = AttributeKey "class"
124 |
125 | src :: AttributeKey String
126 | src = AttributeKey "src"
127 |
128 | width :: AttributeKey Int
129 | width = AttributeKey "width"
130 |
131 | height :: AttributeKey Int
132 | height = AttributeKey "height"
133 |
134 | type Interp = WriterT String (State Int)
135 |
136 | render :: Element -> String
137 | render = \e -> evalState (execWriterT (renderElement e)) 0
138 | where
139 | renderElement :: Element -> Interp Unit
140 | renderElement (Element e) = do
141 | tell "<"
142 | tell e.name
143 | for_ e.attribs $ \x -> do
144 | tell " "
145 | renderAttribute x
146 | renderContent e.content
147 | where
148 | renderAttribute :: Attribute -> Interp Unit
149 | renderAttribute (Attribute x) = do
150 | tell x.key
151 | tell "=\""
152 | tell x.value
153 | tell "\""
154 |
155 | renderContent :: Maybe (Content Unit) -> Interp Unit
156 | renderContent Nothing = tell " />"
157 | renderContent (Just content) = do
158 | tell ">"
159 | runFreeM renderContentItem content
160 | tell ""
163 |
164 | renderContentItem :: forall a. ContentF (Content a) -> Interp (Content a)
165 | renderContentItem (TextContent s rest) = do
166 | tell s
167 | pure rest
168 | renderContentItem (ElementContent e' rest) = do
169 | renderElement e'
170 | pure rest
171 | renderContentItem (NewName k) = do
172 | n <- get
173 | let fresh = Name $ "name" <> show n
174 | put $ n + 1
175 | pure (k fresh)
176 |
--------------------------------------------------------------------------------
/exercises/chapter8/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 | import Test.MySolutions
5 | import Test.NoPeeking.Solutions -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
6 |
7 | import Data.Either (Either(..), fromLeft, fromRight)
8 | import Data.List (List(..), foldM, (:))
9 | import Data.Maybe (Maybe(..))
10 | import Effect (Effect)
11 | import Effect.Exception (error, message, try)
12 | import Effect.Unsafe (unsafePerformEffect)
13 | import Data.Number (abs, pi)
14 | import Test.Examples (countThrows, safeDivide)
15 | import Test.Unit (TestSuite, suite, test)
16 | import Test.Unit.Assert as Assert
17 | import Test.Unit.Main (runTest)
18 |
19 | main :: Effect Unit
20 | main =
21 | runTest do
22 | runChapterExamples
23 | {- Move this block comment starting point to enable more tests
24 | This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. -}
25 | suite "Exercises Group - Monads and Applicatives" do
26 | suite "third" do
27 | test "No elements"
28 | $ Assert.equal Nothing
29 | $ third ([] :: Array Int)
30 | test "1 element"
31 | $ Assert.equal Nothing
32 | $ third [ 1 ]
33 | test "2 elements"
34 | $ Assert.equal Nothing
35 | $ third [ 1, 2 ]
36 | test "3 elements"
37 | $ Assert.equal (Just 3)
38 | $ third [ 1, 2, 3 ]
39 | test "4 elements"
40 | $ Assert.equal (Just 4)
41 | $ third [ 1, 2, 4, 3 ]
42 | suite "possibleSums" do
43 | test "[]"
44 | $ Assert.equal [ 0 ]
45 | $ possibleSums []
46 | test "[1, 2, 10]"
47 | $ Assert.equal [ 0, 1, 2, 3, 10, 11, 12, 13 ]
48 | $ possibleSums [ 1, 2, 10 ]
49 | suite "filterM" do
50 | suite "Array Monad" do
51 | let
52 | onlyPositives :: Int -> Array Boolean
53 | onlyPositives i = [ i >= 0 ]
54 | test "Empty"
55 | $ Assert.equal [ Nil ]
56 | $ filterM
57 | onlyPositives
58 | Nil
59 | test "Not Empty"
60 | $ Assert.equal [ (2 : 4 : Nil) ]
61 | $ filterM
62 | onlyPositives
63 | (2 : (-1) : 4 : Nil)
64 | suite "Maybe Monad" do
65 | let
66 | -- This is an impractical filtering function,
67 | -- and could be simplified, but it's fine for
68 | -- testing purposes.
69 | onlyPositiveEvenIntegers :: Int -> Maybe Boolean
70 | onlyPositiveEvenIntegers i = if i < 0 then Nothing else Just $ 0 == i `mod` 2
71 | test "Nothing"
72 | $ Assert.equal Nothing
73 | $ filterM
74 | onlyPositiveEvenIntegers
75 | (2 : 3 : (-1) : 4 : Nil)
76 | test "Just positive even integers"
77 | $ Assert.equal (Just (2 : 4 : Nil))
78 | $ filterM
79 | onlyPositiveEvenIntegers
80 | (2 : 3 : 4 : Nil)
81 | suite "exceptionDivide" do
82 | test "6 / 3"
83 | $ Assert.equal 2
84 | $ fromRight 0
85 | $ unsafePerformEffect
86 | $ try $ exceptionDivide 6 3
87 | test "6 / 0"
88 | $ Assert.equal "div zero"
89 | $ message
90 | $ fromLeft (error "")
91 | $ unsafePerformEffect
92 | $ try $ exceptionDivide 6 0
93 | suite "ST" do
94 | suite "estimatePi" do
95 | test "1000 terms of Gregory Series"
96 | $ Assert.assert "Estimated value of pi not within threshold"
97 | (abs (estimatePi 1000 - pi) < 0.002)
98 | test "1000000 terms of Gregory Series"
99 | $ Assert.assert "Estimated value of pi not within threshold"
100 | (abs (estimatePi 1000000 - pi) < 0.000002)
101 | suite "fibonacci" do
102 | test "40th Fibonacci number"
103 | $ Assert.equal 102334155 (fibonacci 40)
104 | test "45th Fibonacci number"
105 | $ Assert.equal 1134903170 (fibonacci 45)
106 |
107 | {- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
108 | -}
109 | runChapterExamples :: TestSuite
110 | runChapterExamples =
111 | -- Testing chapter examples in book - for reader reference only
112 | suite "Chapter Examples" do
113 | suite "countThrows" do
114 | test "10" do
115 | Assert.equal [ [ 4, 6 ], [ 5, 5 ], [ 6, 4 ] ]
116 | $ countThrows 10
117 | test "12" do
118 | Assert.equal [ [ 6, 6 ] ]
119 | $ countThrows 12
120 | suite "safeDivide" do
121 | test "Just" do
122 | Assert.equal (Just 5)
123 | $ safeDivide 10 2
124 | test "Nothing" do
125 | Assert.equal Nothing
126 | $ safeDivide 10 0
127 | suite "foldM with safeDivide" do
128 | test "[5, 2, 2] has a Just answer" do
129 | Assert.equal (Just 5)
130 | $ foldM safeDivide 100 (5 : 2 : 2 : Nil)
131 | test "[5, 0, 2] has a Nothing answer" do
132 | Assert.equal (Nothing)
133 | $ foldM safeDivide 100 (5 : 0 : 2 : Nil)
134 |
--------------------------------------------------------------------------------
/exercises/chapter10/test/Examples.purs:
--------------------------------------------------------------------------------
1 | module Test.Examples where
2 |
3 | import Prelude
4 |
5 | import Control.Promise (Promise, toAffE)
6 | import Data.Argonaut (Json, JsonDecodeError, decodeJson, encodeJson)
7 | import Data.Either (Either)
8 | import Data.Function.Uncurried (Fn2, mkFn2, runFn2)
9 | import Data.Map (Map)
10 | import Data.Maybe (Maybe(..))
11 | import Effect (Effect)
12 | import Effect.Aff (Aff)
13 | import Effect.Uncurried (EffectFn2)
14 |
15 | foreign import square :: Number -> Number
16 |
17 | -- ANCHOR: diagonal
18 | foreign import diagonal :: Number -> Number -> Number
19 | -- ANCHOR_END: diagonal
20 |
21 | -- ANCHOR: diagonal_arrow
22 | foreign import diagonalArrow :: Number -> Number -> Number
23 | -- ANCHOR_END: diagonal_arrow
24 |
25 | -- ANCHOR: diagonal_uncurried
26 | foreign import diagonalUncurried :: Fn2 Number Number Number
27 | -- ANCHOR_END: diagonal_uncurried
28 |
29 | -- ANCHOR: uncurried_add
30 | uncurriedAdd :: Fn2 Int Int Int
31 | uncurriedAdd = mkFn2 \n m -> m + n
32 | -- ANCHOR_END: uncurried_add
33 |
34 | -- ANCHOR: uncurried_sum
35 | uncurriedSum :: Int
36 | uncurriedSum = runFn2 uncurriedAdd 3 10
37 | -- ANCHOR_END: uncurried_sum
38 |
39 | -- ANCHOR: curried_add
40 | curriedAdd :: Int -> Int -> Int
41 | curriedAdd n m = m + n
42 |
43 | curriedSum :: Int
44 | curriedSum = curriedAdd 3 10
45 | -- ANCHOR_END: curried_add
46 |
47 | foreign import cumulativeSums :: Array Int -> Array Int
48 |
49 | type Complex
50 | = { real :: Number
51 | , imag :: Number
52 | }
53 |
54 | foreign import addComplex :: Complex -> Complex -> Complex
55 |
56 | foreign import maybeHeadImpl :: forall a. (forall x. x -> Maybe x) -> (forall x. Maybe x) -> Array a -> Maybe a
57 |
58 | maybeHead :: forall a. Array a -> Maybe a
59 | maybeHead arr = maybeHeadImpl Just Nothing arr
60 |
61 | foreign import data Undefined :: Type -> Type
62 |
63 | foreign import undefinedHead :: forall a. Array a -> Undefined a
64 |
65 | foreign import isUndefined :: forall a. Undefined a -> Boolean
66 |
67 | isEmpty :: forall a. Array a -> Boolean
68 | isEmpty = isUndefined <<< undefinedHead
69 |
70 | foreign import unsafeHead :: forall a. Array a -> a
71 |
72 | type Quadratic
73 | = { a :: Number
74 | , b :: Number
75 | , c :: Number
76 | }
77 |
78 | foreign import boldImpl :: forall a. (a -> String) -> a -> String
79 |
80 | bold :: forall a. Show a => a -> String
81 | bold = boldImpl show
82 |
83 | foreign import showEqualityImpl :: forall a. (a -> a -> Boolean) -> (a -> String) -> a -> a -> String
84 |
85 | showEquality :: forall a. Eq a => Show a => a -> a -> String
86 | showEquality = showEqualityImpl eq show
87 |
88 | foreign import yellImpl :: forall a. (a -> String) -> a -> Effect Unit
89 |
90 | yell :: forall a. Show a => a -> Effect Unit
91 | yell = yellImpl show
92 |
93 | foreign import diagonalLog :: EffectFn2 Number Number Number
94 |
95 | foreign import sleepImpl :: Int -> Effect (Promise Unit)
96 |
97 | sleep :: Int -> Aff Unit
98 | sleep = sleepImpl >>> toAffE
99 |
100 | foreign import diagonalAsyncImpl :: Int -> Number -> Number -> Effect (Promise Number)
101 |
102 | diagonalAsync :: Int -> Number -> Number -> Aff Number
103 | diagonalAsync i x y = toAffE $ diagonalAsyncImpl i x y
104 |
105 | foreign import cumulativeSumsBroken :: Array Int -> Array Int
106 |
107 | foreign import addComplexBroken :: Complex -> Complex -> Complex
108 |
109 | foreign import cumulativeSumsJson :: Array Int -> Json
110 |
111 | -- ANCHOR: cumulativeSumsDecoded
112 | cumulativeSumsDecoded :: Array Int -> Either JsonDecodeError (Array Int)
113 | cumulativeSumsDecoded arr = decodeJson $ cumulativeSumsJson arr
114 | -- ANCHOR_END: cumulativeSumsDecoded
115 |
116 | foreign import addComplexJson :: Complex -> Complex -> Json
117 |
118 | -- ANCHOR: addComplexDecoded
119 | addComplexDecoded :: Complex -> Complex -> Either JsonDecodeError Complex
120 | addComplexDecoded a b = decodeJson $ addComplexJson a b
121 | -- ANCHOR_END: addComplexDecoded
122 |
123 | -- ANCHOR: mapSetFooJson
124 | foreign import mapSetFooJson :: Json -> Json
125 |
126 | mapSetFoo :: Map String Int -> Either JsonDecodeError (Map String Int)
127 | mapSetFoo json = decodeJson $ mapSetFooJson $ encodeJson json
128 | -- ANCHOR_END: mapSetFooJson
129 |
130 | {-
131 | These versions always point to either the working or broken versions
132 | to enable automated testing.
133 | The examples accompanying the text are meant to be swapped
134 | between versions by the reader.
135 | -}
136 | foreign import cumulativeSumsJsonBroken :: Array Int -> Json
137 |
138 | cumulativeSumsDecodedBroken :: Array Int -> Either JsonDecodeError (Array Int)
139 | cumulativeSumsDecodedBroken = cumulativeSumsJsonBroken >>> decodeJson
140 |
141 | foreign import addComplexJsonBroken :: Complex -> Complex -> Json
142 |
143 | addComplexDecodedBroken :: Complex -> Complex -> Either JsonDecodeError Complex
144 | addComplexDecodedBroken a b = decodeJson $ addComplexJsonBroken a b
145 |
146 | foreign import cumulativeSumsJsonWorking :: Array Int -> Json
147 |
148 | cumulativeSumsDecodedWorking :: Array Int -> Either JsonDecodeError (Array Int)
149 | cumulativeSumsDecodedWorking = cumulativeSumsJsonWorking >>> decodeJson
150 |
151 | foreign import addComplexJsonWorking :: Complex -> Complex -> Json
152 |
153 | addComplexDecodedWorking :: Complex -> Complex -> Either JsonDecodeError Complex
154 | addComplexDecodedWorking a b = decodeJson $ addComplexJsonWorking a b
155 |
--------------------------------------------------------------------------------
/exercises/chapter7/test/no-peeking/Solutions.purs:
--------------------------------------------------------------------------------
1 | module Test.NoPeeking.Solutions where
2 |
3 | import Prelude
4 |
5 | import Control.Apply (lift2)
6 | import Data.AddressBook (Address, PhoneNumber, address)
7 | import Data.AddressBook.Validation (Errors, matches, nonEmpty, validateAddress, validatePhoneNumbers)
8 | import Data.Generic.Rep (class Generic)
9 | import Data.Show.Generic (genericShow)
10 | import Data.Maybe (Maybe(..))
11 | import Data.String.Regex (Regex)
12 | import Data.String.Regex.Flags (noFlags)
13 | import Data.String.Regex.Unsafe (unsafeRegex)
14 | import Data.Traversable (class Foldable, class Traversable, foldMap, foldl, foldr, sequence, traverse)
15 | import Data.Validation.Semigroup (V)
16 |
17 | {-| Exercise Group 1 -}
18 | -- Exercise 1
19 | addMaybe :: forall a. Semiring a => Maybe a -> Maybe a -> Maybe a
20 | addMaybe = lift2 add
21 |
22 | subMaybe :: forall a. Ring a => Maybe a -> Maybe a -> Maybe a
23 | subMaybe = lift2 sub
24 |
25 | mulMaybe :: forall a. Semiring a => Maybe a -> Maybe a -> Maybe a
26 | mulMaybe = lift2 mul
27 |
28 | divMaybe :: forall a. EuclideanRing a => Maybe a -> Maybe a -> Maybe a
29 | divMaybe = lift2 div
30 |
31 | -- Exercise 2
32 | addApply :: forall f a. Apply f => Semiring a => f a -> f a -> f a
33 | addApply = lift2 add
34 |
35 | mulApply :: forall f a. Apply f => Semiring a => f a -> f a -> f a
36 | mulApply = lift2 mul
37 |
38 | subApply :: forall f a. Apply f => Ring a => f a -> f a -> f a
39 | subApply = lift2 sub
40 |
41 | divApply :: forall f a. Apply f => EuclideanRing a => f a -> f a -> f a
42 | divApply = lift2 div
43 |
44 | -- Exercise 3
45 | combineMaybe :: forall a f. Applicative f => Maybe (f a) -> f (Maybe a)
46 | combineMaybe (Just x) = map Just x
47 |
48 | combineMaybe _ = pure Nothing
49 |
50 | {-| Exercise Group 2 -}
51 | -- Exercise 1
52 | stateRegex :: Regex
53 | stateRegex = unsafeRegex "^[a-zA-Z]{2}$" noFlags
54 |
55 | -- Exercise 2
56 | nonEmptyRegex :: Regex
57 | nonEmptyRegex = unsafeRegex "\\S" noFlags
58 |
59 | -- Exercise 3
60 | validateAddressImproved :: Address -> V Errors Address
61 | validateAddressImproved a =
62 | address
63 | <$> matches "Street" nonEmptyRegex a.street
64 | <*> matches "City" nonEmptyRegex a.city
65 | <*> matches "State" stateRegex a.state
66 |
67 | {-| Exercise Group 3 -}
68 | -- Exercise 1
69 | data Tree a
70 | = Leaf
71 | | Branch (Tree a) a (Tree a)
72 |
73 | -- Solution using derived instances:
74 |
75 | derive instance Eq a => Eq (Tree a)
76 |
77 | derive instance Generic (Tree a) _
78 |
79 | instance Show a => Show (Tree a) where
80 | show t = genericShow t
81 |
82 | {-
83 | -- Solution using manually-written instances:
84 |
85 | instance Eq a => Eq (Tree a) where
86 | eq Leaf Leaf = true
87 | eq (Branch t1a va t2a) (Branch t1b vb t2b)
88 | = t1a == t1b
89 | && va == vb
90 | && t2a == t2b
91 | eq _ _ = false
92 |
93 | instance Show a => Show (Tree a) where
94 | show Leaf = "Leaf"
95 | show (Branch t1 v t2) =
96 | "(Branch " <> show t1 <> " " <> show v <> " " <> show t2 <> ")"
97 | -}
98 |
99 | -- Exercise 2
100 | instance Functor Tree where
101 | map _ Leaf = Leaf
102 | map f (Branch t1 v t2) = Branch (map f t1) (f v) (map f t2)
103 |
104 | instance Foldable Tree where
105 | foldl _ acc Leaf = acc
106 | foldl f acc (Branch t1 v t2) = foldl f (f (foldl f acc t1) v) t2
107 | foldr _ acc Leaf = acc
108 | foldr f acc (Branch t1 v t2) = foldr f (f v (foldr f acc t2)) t1
109 | foldMap _ Leaf = mempty
110 | foldMap f (Branch t1 v t2) = foldMap f t1 <> f v <> foldMap f t2
111 |
112 | instance Traversable Tree where
113 | traverse _ Leaf = pure Leaf
114 | traverse f (Branch t1 v t2) = ado
115 | mt1 <- traverse f t1
116 | mv <- f v
117 | mt2 <- traverse f t2
118 | in Branch mt1 mv mt2
119 | -- Equivalent
120 | --traverse f (Branch t1 v t2) = Branch <$> traverse f t1 <*> f v <*> traverse f t2
121 | sequence Leaf = pure Leaf
122 | sequence (Branch t1 v t2) = ado
123 | mt1 <- sequence t1
124 | mv <- v
125 | mt2 <- sequence t2
126 | in Branch mt1 mv mt2
127 |
128 | -- Exercise 3
129 | traversePreOrder :: forall a m b. Applicative m => (a -> m b) -> Tree a -> m (Tree b)
130 | traversePreOrder _ Leaf = pure Leaf
131 |
132 | traversePreOrder f (Branch t1 v t2) = ado
133 | mv <- f v
134 | mt1 <- traversePreOrder f t1
135 | mt2 <- traversePreOrder f t2
136 | in Branch mt1 mv mt2
137 |
138 | -- Exercise 4
139 | traversePostOrder :: forall a m b. Applicative m => (a -> m b) -> Tree a -> m (Tree b)
140 | traversePostOrder _ Leaf = pure Leaf
141 |
142 | traversePostOrder f (Branch t1 v t2) = ado
143 | mt1 <- traversePostOrder f t1
144 | mt2 <- traversePostOrder f t2
145 | mv <- f v
146 | in Branch mt1 mv mt2
147 |
148 | -- Exercise 5
149 | type PersonOptionalAddress
150 | = { firstName :: String
151 | , lastName :: String
152 | , homeAddress :: Maybe Address
153 | , phones :: Array PhoneNumber
154 | }
155 |
156 | personOptionalAddress :: String -> String -> Maybe Address -> Array PhoneNumber -> PersonOptionalAddress
157 | personOptionalAddress firstName lastName homeAddress phones = { firstName, lastName, homeAddress, phones }
158 |
159 | validatePersonOptionalAddress :: PersonOptionalAddress -> V Errors PersonOptionalAddress
160 | validatePersonOptionalAddress p =
161 | personOptionalAddress
162 | <$> nonEmpty "First Name" p.firstName
163 | <*> nonEmpty "Last Name" p.lastName
164 | <*> traverse validateAddress p.homeAddress
165 | <*> validatePhoneNumbers "Phone Numbers" p.phones
166 |
167 | -- Exercise 6
168 | sequenceUsingTraverse :: forall a m t. Traversable t => Applicative m => t (m a) -> m (t a)
169 | sequenceUsingTraverse t = traverse identity t
170 |
171 | -- Exercise 7
172 | traverseUsingSequence :: forall a b m t. Traversable t => Applicative m => (a -> m b) -> t a -> m (t b)
173 | traverseUsingSequence f t = sequence $ map f t
174 |
--------------------------------------------------------------------------------
/exercises/chapter7/src/Data/AddressBook/Validation.purs:
--------------------------------------------------------------------------------
1 | module Data.AddressBook.Validation where
2 |
3 | import Prelude
4 |
5 | import Data.AddressBook (Address, Person, PhoneNumber, address, person, phoneNumber)
6 | import Data.Either (Either(..))
7 | import Data.String (length)
8 | import Data.String.Regex (Regex, test)
9 | import Data.String.Regex.Flags (noFlags)
10 | import Data.String.Regex.Unsafe (unsafeRegex)
11 | import Data.Traversable (traverse)
12 | import Data.Validation.Semigroup (V, invalid)
13 |
14 | -----------------
15 | -- Some simple early examples returning `Either` instead of `V`:
16 |
17 | -- ANCHOR: nonEmpty1
18 | nonEmpty1 :: String -> Either String String
19 | nonEmpty1 "" = Left "Field cannot be empty"
20 | nonEmpty1 value = Right value
21 | -- ANCHOR_END: nonEmpty1
22 |
23 | -- ANCHOR: validatePerson1
24 | validatePerson1 :: Person -> Either String Person
25 | validatePerson1 p =
26 | person <$> nonEmpty1 p.firstName
27 | <*> nonEmpty1 p.lastName
28 | <*> pure p.homeAddress
29 | <*> pure p.phones
30 | -- ANCHOR_END: validatePerson1
31 |
32 | -- ANCHOR: validatePerson1Ado
33 | validatePerson1Ado :: Person -> Either String Person
34 | validatePerson1Ado p = ado
35 | f <- nonEmpty1 p.firstName
36 | l <- nonEmpty1 p.lastName
37 | in person f l p.homeAddress p.phones
38 | -- ANCHOR_END: validatePerson1Ado
39 |
40 | -----------------
41 |
42 | -- ANCHOR: Errors
43 | type Errors
44 | = Array String
45 | -- ANCHOR_END: Errors
46 |
47 | -- ANCHOR: nonEmpty
48 | nonEmpty :: String -> String -> V Errors String
49 | nonEmpty field "" = invalid [ "Field '" <> field <> "' cannot be empty" ]
50 | nonEmpty _ value = pure value
51 | -- ANCHOR_END: nonEmpty
52 |
53 | -- ANCHOR: validatePhoneNumbers
54 | validatePhoneNumbers :: String -> Array PhoneNumber -> V Errors (Array PhoneNumber)
55 | validatePhoneNumbers field [] =
56 | invalid [ "Field '" <> field <> "' must contain at least one value" ]
57 | validatePhoneNumbers _ phones =
58 | traverse validatePhoneNumber phones
59 | -- ANCHOR_END: validatePhoneNumbers
60 |
61 | -- ANCHOR: lengthIs
62 | lengthIs :: String -> Int -> String -> V Errors String
63 | lengthIs field len value | length value /= len =
64 | invalid [ "Field '" <> field <> "' must have length " <> show len ]
65 | lengthIs _ _ value = pure value
66 | -- ANCHOR_END: lengthIs
67 |
68 | -- ANCHOR: phoneNumberRegex
69 | -- | We use `Data.String.Regex.Unsafe.unsafeRegex` here instead of `Data.String.Regex.regex`
70 | -- | in order to simplify the code.
71 | -- |
72 | -- | The safe function has this signature:
73 | -- |
74 | -- | ```purescript
75 | -- | regex :: String -> RegexFlags -> Either String Regex
76 | -- | ```
77 | -- |
78 | -- | which can fail if passed an invalid regex `String`. This potential failure is worth
79 | -- | checking for at runtime when working with a user-provided regex `String`.
80 | -- | But in our case, we hardcode a literal regex `String`, so it's not as problematic
81 | -- | to use this more convenient "unsafe" version that may throw an exception:
82 | -- |
83 | -- | ```purescript
84 | -- | unsafeRegex :: String -> RegexFlags -> Regex
85 | -- | ```
86 | -- |
87 | -- | We can achieve a bit more safety by binding our `Regex` values at the top level,
88 | -- | so any potential runtime exceptions are thrown as soon as our application starts.
89 | -- | This is better than defining these values in a local context, where the error may
90 | -- | not be encountered until later on during application execution.
91 | phoneNumberRegex :: Regex
92 | phoneNumberRegex = unsafeRegex "^\\d{3}-\\d{3}-\\d{4}$" noFlags
93 | -- ANCHOR_END: phoneNumberRegex
94 |
95 | -- ANCHOR: matches
96 | matches :: String -> Regex -> String -> V Errors String
97 | matches _ regex value | test regex value
98 | = pure value
99 | matches field _ _ = invalid [ "Field '" <> field <> "' did not match the required format" ]
100 | -- ANCHOR_END: matches
101 |
102 | -- ANCHOR: validateAddress
103 | validateAddress :: Address -> V Errors Address
104 | validateAddress a =
105 | address <$> nonEmpty "Street" a.street
106 | <*> nonEmpty "City" a.city
107 | <*> lengthIs "State" 2 a.state
108 | -- ANCHOR_END: validateAddress
109 |
110 | -- ANCHOR: validateAddressAdo
111 | validateAddressAdo :: Address -> V Errors Address
112 | validateAddressAdo a = ado
113 | street <- nonEmpty "Street" a.street
114 | city <- nonEmpty "City" a.city
115 | state <- lengthIs "State" 2 a.state
116 | in address street city state
117 | -- ANCHOR_END: validateAddressAdo
118 |
119 | -- ANCHOR: validatePhoneNumber
120 | validatePhoneNumber :: PhoneNumber -> V Errors PhoneNumber
121 | validatePhoneNumber pn =
122 | phoneNumber <$> pure pn."type"
123 | <*> matches "Number" phoneNumberRegex pn.number
124 | -- ANCHOR_END: validatePhoneNumber
125 |
126 | -- ANCHOR: validatePhoneNumberAdo
127 | validatePhoneNumberAdo :: PhoneNumber -> V Errors PhoneNumber
128 | validatePhoneNumberAdo pn = ado
129 | tpe <- pure pn."type"
130 | number <- matches "Number" phoneNumberRegex pn.number
131 | in phoneNumber tpe number
132 | -- ANCHOR_END: validatePhoneNumberAdo
133 |
134 | -- ANCHOR: validatePerson
135 | validatePerson :: Person -> V Errors Person
136 | validatePerson p =
137 | person <$> nonEmpty "First Name" p.firstName
138 | <*> nonEmpty "Last Name" p.lastName
139 | <*> validateAddress p.homeAddress
140 | <*> validatePhoneNumbers "Phone Numbers" p.phones
141 | -- ANCHOR_END: validatePerson
142 |
143 | -- ANCHOR: validatePersonAdo
144 | validatePersonAdo :: Person -> V Errors Person
145 | validatePersonAdo p = ado
146 | firstName <- nonEmpty "First Name" p.firstName
147 | lastName <- nonEmpty "Last Name" p.lastName
148 | address <- validateAddress p.homeAddress
149 | numbers <- validatePhoneNumbers "Phone Numbers" p.phones
150 | in person firstName lastName address numbers
151 | -- ANCHOR_END: validatePersonAdo
152 |
--------------------------------------------------------------------------------
/exercises/chapter8/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Data.AddressBook (PhoneNumber, examplePerson)
6 | import Data.AddressBook.Validation (Errors, validatePerson')
7 | import Data.Array (mapWithIndex, updateAt)
8 | import Data.Either (Either(..))
9 | import Data.Maybe (Maybe(..), fromMaybe)
10 | import Data.Tuple (Tuple(..))
11 | import Effect (Effect)
12 | import Effect.Console (log)
13 | import Effect.Exception (throw)
14 | import React.Basic.DOM as D
15 | import React.Basic.DOM.Events (targetValue)
16 | import React.Basic.Events (handler)
17 | import React.Basic.Hooks (ReactComponent, element, reactComponent, useState)
18 | import React.Basic.Hooks as R
19 | import Web.DOM.NonElementParentNode (getElementById)
20 | import Web.HTML (window)
21 | import Web.HTML.HTMLDocument (toNonElementParentNode)
22 | import Web.HTML.Window (document)
23 |
24 | -- Note that there's a Purty formatting bug that
25 | -- adds an unwanted blank line
26 | -- https://gitlab.com/joneshf/purty/issues/77
27 | -- ANCHOR: renderValidationErrors
28 | renderValidationErrors :: Errors -> Array R.JSX
29 | renderValidationErrors [] = []
30 | renderValidationErrors xs =
31 | let
32 | renderError :: String -> R.JSX
33 | renderError err = D.li_ [ D.text err ]
34 | in
35 | [ D.div
36 | { className: "alert alert-danger row"
37 | , children: [ D.ul_ (map renderError xs) ]
38 | }
39 | ]
40 | -- ANCHOR_END: renderValidationErrors
41 |
42 | -- Helper function to render a single form field with an
43 | -- event handler to update
44 | -- ANCHOR: formField
45 | formField :: String -> String -> String -> (String -> Effect Unit) -> R.JSX
46 | formField name placeholder value setValue =
47 | D.div
48 | { className: "form-group row"
49 | , children:
50 | [ D.label
51 | { className: "col-sm col-form-label"
52 | , htmlFor: name
53 | , children: [ D.text name ]
54 | }
55 | , D.div
56 | { className: "col-sm"
57 | , children:
58 | [ D.input
59 | { className: "form-control"
60 | , id: name
61 | , placeholder
62 | , value
63 | , onChange:
64 | let
65 | handleValue :: Maybe String -> Effect Unit
66 | handleValue (Just v) = setValue v
67 | handleValue Nothing = pure unit
68 | in
69 | handler targetValue handleValue
70 | }
71 | ]
72 | }
73 | ]
74 | }
75 | -- ANCHOR_END: formField
76 |
77 | mkAddressBookApp :: Effect (ReactComponent {})
78 | mkAddressBookApp =
79 | -- incoming \props are unused
80 | reactComponent "AddressBookApp" \props -> R.do
81 | -- `useState` takes a default initial value and returns the
82 | -- current value and a way to update the value.
83 | -- Consult react-hooks docs for a more detailed explanation of `useState`.
84 | Tuple person setPerson <- useState examplePerson
85 | let
86 | errors = case validatePerson' person of
87 | Left e -> e
88 | Right _ -> []
89 |
90 | -- helper-function to return array unchanged instead of Nothing if index is out of bounds
91 | updateAt' :: forall a. Int -> a -> Array a -> Array a
92 | updateAt' i x xs = fromMaybe xs (updateAt i x xs)
93 |
94 | -- helper-function to render a single phone number at a given index
95 | renderPhoneNumber :: Int -> PhoneNumber -> R.JSX
96 | renderPhoneNumber index phone =
97 | formField
98 | (show phone."type")
99 | "XXX-XXX-XXXX"
100 | phone.number
101 | (\s -> setPerson _ { phones = updateAt' index phone { number = s } person.phones })
102 |
103 | -- helper-function to render all phone numbers
104 | renderPhoneNumbers :: Array R.JSX
105 | renderPhoneNumbers = mapWithIndex renderPhoneNumber person.phones
106 | -- ANCHOR: mkAddressBookApp_pure
107 | pure
108 | $ D.div
109 | { className: "container"
110 | , children:
111 | renderValidationErrors errors
112 | <> [ D.div
113 | { className: "row"
114 | , children:
115 | [ D.form_
116 | $ [ D.h3_ [ D.text "Basic Information" ]
117 | , formField "First Name" "First Name" person.firstName \s ->
118 | setPerson _ { firstName = s }
119 | , formField "Last Name" "Last Name" person.lastName \s ->
120 | setPerson _ { lastName = s }
121 | , D.h3_ [ D.text "Address" ]
122 | , formField "Street" "Street" person.homeAddress.street \s ->
123 | setPerson _ { homeAddress { street = s } }
124 | , formField "City" "City" person.homeAddress.city \s ->
125 | setPerson _ { homeAddress { city = s } }
126 | , formField "State" "State" person.homeAddress.state \s ->
127 | setPerson _ { homeAddress { state = s } }
128 | , D.h3_ [ D.text "Contact Information" ]
129 | ]
130 | <> renderPhoneNumbers
131 | ]
132 | , key: "person-form"
133 | }
134 | ]
135 | }
136 | -- ANCHOR_END: mkAddressBookApp_pure
137 |
138 | -- ANCHOR: main
139 | main :: Effect Unit
140 | main = do
141 | log "Rendering address book component"
142 | -- Get window object
143 | w <- window
144 | -- Get window's HTML document
145 | doc <- document w
146 | -- Get "container" element in HTML
147 | ctr <- getElementById "container" $ toNonElementParentNode doc
148 | case ctr of
149 | Nothing -> throw "Container element not found."
150 | Just c -> do
151 | -- Create AddressBook react component
152 | addressBookApp <- mkAddressBookApp
153 | let
154 | -- Create JSX node from react component. Pass-in empty props
155 | app = element addressBookApp {}
156 | -- Render AddressBook JSX node in DOM "container" element
157 | D.render app c
158 | -- ANCHOR_END: main
159 |
--------------------------------------------------------------------------------
/exercises/chapter9/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 | import Test.MySolutions
5 | import Test.NoPeeking.Solutions -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
6 |
7 | import Data.Array ((..))
8 | import Data.Bifunctor (lmap)
9 | import Data.Either (Either(..))
10 | import Data.Foldable (for_)
11 | import Data.Maybe (Maybe(..))
12 | import Data.Set as Set
13 | import Data.String (Pattern(..), split)
14 | import Effect (Effect)
15 | import Effect.Exception (message)
16 | import Node.Encoding (Encoding(..))
17 | import Node.FS.Aff (readTextFile, readdir, realpath, unlink)
18 | import Node.Path (FilePath)
19 | import Node.Path as Path
20 | import Test.Copy (copyFile)
21 | import Test.HTTP (getUrl)
22 | import Test.Unit (TestSuite, suite, test)
23 | import Test.Unit.Assert as Assert
24 | import Test.Unit.Main (runTest)
25 |
26 | inDir :: FilePath
27 | inDir = Path.concat [ "test", "data" ]
28 |
29 | outDir :: FilePath
30 | outDir = Path.concat [ "test", "data-out" ]
31 |
32 | -- If, for any reason, you want or need to run this test offline, or without
33 | -- full internet access, you can create this API endpoint locally by installing
34 | -- http-server (npm i -g http-server) and running it in the "/test/data"
35 | -- directory (http-server -p 42524)
36 | reqUrl :: String
37 | reqUrl =
38 | -- Both http and https work for this API endpoint.
39 | "https://jsonplaceholder.typicode.com/todos/1"
40 | -- If you want or need to use the http version (not the https), just
41 | -- remove the 's' from `https://`:
42 | --"http://jsonplaceholder.typicode.com/todos/1"
43 | -- Use this url for the http-server solution:
44 | --"http://localhost:42524/user.txt"
45 |
46 | main :: Effect Unit
47 | main =
48 | runTest do
49 | test "setup" do
50 | -- Clear test output directory
51 | files <- readdir outDir
52 | for_ files \f -> unlink $ Path.concat [ outDir, f ]
53 | runChapterExamples
54 | {- Move this block comment starting point to enable more tests
55 | This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. -}
56 | test "concatenateFiles" do
57 | let
58 | inFoo = Path.concat [ inDir, "foo.txt" ]
59 |
60 | inBar = Path.concat [ inDir, "bar.txt" ]
61 |
62 | outFooBar = Path.concat [ outDir, "foobar.txt" ]
63 | concatenateFiles inFoo inBar outFooBar
64 | -- Check for valid concat
65 | inFooTxt <- readTextFile UTF8 inFoo
66 | inBarTxt <- readTextFile UTF8 inBar
67 | outFooBarTxt <- readTextFile UTF8 outFooBar
68 | Assert.equal (inFooTxt <> inBarTxt) outFooBarTxt
69 | test "concatenateMany" do
70 | let
71 | inFiles = map (\i -> Path.concat [ inDir, "many", "file" <> show i <> ".txt" ]) $ 1 .. 9
72 |
73 | outFile = Path.concat [ outDir, "manyConcat.txt" ]
74 |
75 | expectedOutFile = Path.concat [ inDir, "manyConcat.txt" ]
76 | concatenateMany inFiles outFile
77 | -- Check for valid concat
78 | actualOutTxt <- readTextFile UTF8 outFile
79 | expectedOutTxt <- readTextFile UTF8 expectedOutFile
80 | Assert.equal expectedOutTxt actualOutTxt
81 | suite "countCharacters" do
82 | test "exists" do
83 | chars <- countCharacters $ Path.concat [ inDir, "nbChars.txt" ]
84 | Assert.equal (Right 42) $ lmap message chars
85 | test "missing" do
86 | absolutePath <- realpath $ Path.concat [ inDir ]
87 | chars <- countCharacters $ Path.concat [ absolutePath, "foof.txt" ]
88 | Assert.equal (Left ("ENOENT: no such file or directory, open '" <> absolutePath <> Path.sep <> "foof.txt'")) $ lmap message chars
89 | test "writeGet" do
90 | let
91 | outFile = Path.concat [ outDir, "user.txt" ]
92 |
93 | expectedOutFile = Path.concat [ inDir, "user.txt" ]
94 | writeGet reqUrl outFile
95 | -- Check for valid write
96 | actualOutTxt <- readTextFile UTF8 outFile
97 | expectedOutTxt <- readTextFile UTF8 expectedOutFile
98 | Assert.equal expectedOutTxt actualOutTxt
99 | test "concatenateManyParallel" do
100 | let
101 | inFiles = map (\i -> Path.concat [ inDir, "many", "file" <> show i <> ".txt" ]) $ 1 .. 9
102 |
103 | outFile = Path.concat [ outDir, "manyConcatParallel.txt" ]
104 |
105 | expectedOutFile = Path.concat [ inDir, "manyConcat.txt" ]
106 | concatenateManyParallel inFiles outFile
107 | -- Check for valid concat
108 | actualOutTxt <- readTextFile UTF8 outFile
109 | expectedOutTxt <- readTextFile UTF8 expectedOutFile
110 | Assert.equal expectedOutTxt actualOutTxt
111 | suite "getWithTimeout" do
112 | test "valid site" do
113 | let
114 | expectedOutFile = Path.concat [ inDir, "user.txt" ]
115 | actual <- getWithTimeout 10000.0 reqUrl
116 | expected <- Just <$> readTextFile UTF8 expectedOutFile
117 | Assert.equal expected actual
118 | test "no response" do
119 | actual <- getWithTimeout 10.0 "https://example.com:81"
120 | Assert.equal Nothing actual
121 | suite "recurseFiles" do
122 | let
123 | recurseDir = Path.concat [ inDir, "tree" ]
124 | test "many files" do
125 | expectedTxt <- readTextFile UTF8 $ Path.concat [ recurseDir, "expected.txt" ]
126 | let
127 | expected = Path.normalize <$> split (Pattern "\n") expectedTxt
128 | actual <- recurseFiles $ Path.concat [ recurseDir, "root.txt" ]
129 | let
130 | actualRelative = map (\f -> Path.relative recurseDir f) actual
131 | Assert.equal (Set.fromFoldable expected) $ Set.fromFoldable actualRelative
132 | test "one file" do
133 | let
134 | file = Path.concat [ recurseDir, "c", "unused.txt" ]
135 |
136 | expected = [ file ]
137 | actual <- recurseFiles file
138 | Assert.equal (Set.fromFoldable expected) $ Set.fromFoldable actual
139 |
140 | {- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
141 | -}
142 | runChapterExamples :: TestSuite
143 | runChapterExamples = do
144 | test "copyFile" do
145 | let
146 | inFoo = Path.concat [ inDir, "foo.txt" ]
147 |
148 | outFoo = Path.concat [ outDir, "foo.txt" ]
149 | copyFile inFoo outFoo
150 | -- Check for valid copy
151 | inFooTxt <- readTextFile UTF8 inFoo
152 | outFooTxt <- readTextFile UTF8 outFoo
153 | Assert.equal inFooTxt outFooTxt
154 | test "getUrl" do
155 | let
156 | expectedOutFile = Path.concat [ inDir, "user.txt" ]
157 | str <- getUrl reqUrl
158 | -- Check for valid read
159 | expectedOutTxt <- readTextFile UTF8 expectedOutFile
160 | Assert.equal expectedOutTxt str
161 |
--------------------------------------------------------------------------------
/text/chapter2.md:
--------------------------------------------------------------------------------
1 | # Getting Started
2 |
3 | ## Chapter Goals
4 |
5 | In this chapter, we'll set up a working PureScript development environment, solve some exercises, and use the tests provided with this book to check our answers. You may also find a [video walkthrough of this chapter](https://www.youtube.com/watch?v=GPjPwb6d-70) helpful if that better suits your learning style.
6 |
7 | ## Environment Setup
8 |
9 | First, work through this [Getting Started Guide](https://github.com/purescript/documentation/blob/master/guides/Getting-Started.md) in the Documentation Repo to setup your environment and learn a few basics about the language. Don't worry if the code in the example solution to the [Project Euler](http://projecteuler.net/problem=1) problem is confusing or contains unfamiliar syntax. We'll cover all of this in great detail in the upcoming chapters.
10 |
11 | ### Editor support
12 |
13 | You can use your preferred editor to write PureScript (for example, to solve the book exercises). See [Editor Support Documentation](https://github.com/purescript/documentation/blob/master/ecosystem/Editor-and-tool-support.md#editor-support).
14 |
15 | > Note that some editors expect a `spago.dhall` file in the root of the opened project for full IDE support. For example, you should open the `chapter2` directory to work on the exercises in this chapter.
16 | >
17 | > If you use VS Code, you can use the provided workspace to open all the chapters simultaneously.
18 |
19 | ## Solving Exercises
20 |
21 | Now that you've installed the necessary development tools, clone this book's repo.
22 |
23 | ```sh
24 | git clone https://github.com/purescript-contrib/purescript-book.git
25 | ```
26 |
27 | The book repo contains PureScript example code and unit tests for the exercises that accompany each chapter. There's some initial setup required to reset the exercise solutions so they are ready to be solved by you. Use the `prepareExercises.sh` script to simplify this process:
28 |
29 | ```sh
30 | cd purescript-book
31 | ./scripts/prepareExercises.sh
32 | git add .
33 | git commit --all --message "Exercises ready to be solved"
34 | ```
35 |
36 | Now run the tests for this chapter:
37 |
38 | ```sh
39 | cd exercises/chapter2
40 | spago test
41 | ```
42 |
43 | You should see the following successful test output:
44 |
45 | ```sh
46 | → Suite: Euler - Sum of Multiples
47 | ✓ Passed: below 10
48 | ✓ Passed: below 1000
49 |
50 | All 2 tests passed! 🎉
51 | ```
52 |
53 | Note that the `answer` function (found in `src/Euler.purs`) has been modified to find the multiples of 3 and 5 below any integer. The test suite (located in `test/Main.purs`) for this `answer` function is more comprehensive than the test in the earlier getting-started guide. Don't worry about understanding how this test framework code works while reading these early chapters.
54 |
55 | The remainder of the book contains lots of exercises. If you write your solutions in the `Test.MySolutions` module (`test/MySolutions.purs`), you can check your work against the provided test suite.
56 |
57 | Let's work through this next exercise together in a test-driven-development style.
58 |
59 | ## Exercise
60 |
61 | 1. (Medium) Write a `diagonal` function to compute the length of the diagonal (or hypotenuse) of a right-angled triangle when given the lengths of the two other sides.
62 |
63 | ## Solution
64 |
65 | We'll start by enabling the tests for this exercise. Move the start of the block-comment down a few lines, as shown below. Block comments start with `{-` and end with `-}`:
66 |
67 | ```hs
68 | {{#include ../exercises/chapter2/test/Main.purs:diagonalTests}}
69 | {- Move this block comment starting point to enable more tests
70 | ```
71 |
72 | If we attempt to run the test now, we'll encounter a compilation error because we have not yet implemented our `diagonal` function.
73 |
74 | ```sh
75 | $ spago test
76 |
77 | Error found:
78 | in module Test.Main
79 | at test/Main.purs:21:27 - 21:35 (line 21, column 27 - line 21, column 35)
80 |
81 | Unknown value diagonal
82 | ```
83 |
84 | Let's first look at what happens with a faulty version of this function. Add the following code to `test/MySolutions.purs`:
85 |
86 | ```hs
87 | import Data.Number (sqrt)
88 |
89 | diagonal w h = sqrt (w * w + h)
90 | ```
91 |
92 | And check our work by running `spago test`:
93 |
94 | ```hs
95 | → Suite: diagonal
96 | ☠ Failed: 3 4 5 because expected 5.0, got 3.605551275463989
97 | ☠ Failed: 5 12 13 because expected 13.0, got 6.082762530298219
98 |
99 | 2 tests failed:
100 | ```
101 |
102 | Uh-oh, that's not quite right. Let's fix this with the correct application of the Pythagorean formula by changing the function to:
103 |
104 | ```hs
105 | {{#include ../exercises/chapter2/test/no-peeking/Solutions.purs:diagonal}}
106 | ```
107 |
108 | Trying `spago test` again now shows all tests are passing:
109 |
110 | ```hs
111 | → Suite: Euler - Sum of Multiples
112 | ✓ Passed: below 10
113 | ✓ Passed: below 1000
114 | → Suite: diagonal
115 | ✓ Passed: 3 4 5
116 | ✓ Passed: 5 12 13
117 |
118 | All 4 tests passed! 🎉
119 | ```
120 |
121 | Success! Now you're ready to try these next exercises on your own.
122 |
123 | ## Exercises
124 |
125 | 1. (Easy) Write a function `circleArea` which computes the area of a circle with a given radius. Use the `pi` constant, which is defined in the `Numbers` module. _Hint_: don't forget to import `pi` by modifying the `import Data.Number` statement.
126 | 1. (Medium) Write a function `leftoverCents` which takes an `Int` and returns what's leftover after dividing by `100`. Use the `rem` function. Search [Pursuit](https://pursuit.purescript.org/) for this function to learn about usage and which module to import it from. _Note:_ Your IDE may support auto-importing of this function if you accept the auto-completion suggestion.
127 |
128 | ## Conclusion
129 |
130 | In this chapter, we installed the PureScript compiler and the Spago tool. We also learned how to write solutions to exercises and check these for correctness.
131 |
132 | There will be many more exercises in the chapters ahead, and working through those helps with learning the material. If any of the exercises stumps you, please reach out to any of the community resources listed in the [Getting Help](https://book.purescript.org/chapter1.html#getting-help) section of this book, or even file an issue in this [book's repo](https://github.com/purescript-contrib/purescript-book/issues). This reader feedback on which exercises could be made more approachable helps us improve the book.
133 |
134 | Once you solve all the exercises in a chapter, you may compare your answers against those in the `no-peeking/Solutions.purs`. No peeking, please, without putting in an honest effort to solve these yourself. And even if you are stuck, try asking a community member for help first, as we would prefer to give you a small hint rather than spoil the exercise. If you found a more elegant solution (that only requires knowledge of the covered content), please send us a PR.
135 |
136 | The repo is continuously being revised, so be sure to check for updates before starting each new chapter.
137 |
--------------------------------------------------------------------------------
/exercises/chapter4/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude hiding (gcd)
4 | import Test.MySolutions
5 | import Test.NoPeeking.Solutions -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
6 |
7 | import ChapterExamples (Amp(..), current, fromString, gcd, gcdV2, isEmpty, livesInLA, lzs, partialFunction, showPerson, showPersonV2, sortPair, takeFive, toString, unknownPerson, Volt(..))
8 | import Data.Int (round)
9 | import Data.Maybe (Maybe(Just, Nothing))
10 | import Data.Person (Person)
11 | import Data.Picture (Shape(..), Picture, getCenter, origin)
12 | import Effect (Effect)
13 | import Test.Unit (TestSuite, suite, test)
14 | import Test.Unit.Assert as Assert
15 | import Test.Unit.Main (runTest)
16 |
17 | john :: Person
18 | john = { name: "John Smith", address: { street: "123 Test Lane", city: "Los Angeles" } }
19 |
20 | rose :: Person
21 | rose = { name: "Rose Jackson", address: { street: "464 Sample Terrace", city: "Los Angeles" } }
22 |
23 | amy :: Person
24 | amy = { name: "Amy Lopez", address: { street: "10 Purs Street", city: "Omaha" } }
25 |
26 | samplePicture :: Picture
27 | samplePicture =
28 | [ Circle origin 2.0
29 | , Circle { x: 2.0, y: 2.0 } 3.0
30 | , Rectangle { x: 5.0, y: 5.0 } 4.0 4.0
31 | ]
32 |
33 | main :: Effect Unit
34 | main =
35 | runTest do
36 | runChapterExamples
37 | {- Move this block comment starting point to enable more tests
38 | This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. -}
39 | suite "Exercise Group - Simple Pattern Matching" do
40 | test "Exercise - factorial" do
41 | Assert.equal 1
42 | $ factorial 0
43 | Assert.equal 1
44 | $ factorial 1
45 | Assert.equal 24
46 | $ factorial 4
47 | Assert.equal 3628800
48 | $ factorial 10
49 | test "Exercise - binomial" do
50 | Assert.equal 1
51 | $ binomial 10 0
52 | Assert.equal 0
53 | $ binomial 0 3
54 | Assert.equal 0
55 | $ binomial 2 5
56 | Assert.equal 252
57 | $ binomial 10 5
58 | Assert.equal 1
59 | $ binomial 5 5
60 | test "Exercise - pascal" do
61 | Assert.equal 1
62 | $ pascal 10 0
63 | Assert.equal 0
64 | $ pascal 0 3
65 | Assert.equal 0
66 | $ pascal 2 5
67 | Assert.equal 252
68 | $ pascal 10 5
69 | Assert.equal 1
70 | $ pascal 5 5
71 | suite "Exercise Group - Array and Record Patterns" do
72 | test "Exercise - sameCity" do
73 | Assert.equal true
74 | $ sameCity john rose
75 | Assert.equal false
76 | $ sameCity amy rose
77 | test "Exercise - fromSingleton" do
78 | Assert.equal "default"
79 | $ fromSingleton "default" []
80 | Assert.equal "B"
81 | $ fromSingleton "default" ["B"]
82 | Assert.equal "default"
83 | $ fromSingleton "default" ["B", "C", "D"]
84 | suite "Exercise Group - Algebraic Data Types" do
85 | test "Exercise - circleAtOrigin" do
86 | Assert.equal origin
87 | $ getCenter circleAtOrigin
88 | test "Exercise - doubleScaleAndCenter" do
89 | Assert.equal (Circle origin 10.0)
90 | $ doubleScaleAndCenter $ Circle origin 5.0
91 | Assert.equal (Circle origin 10.0)
92 | $ doubleScaleAndCenter $ Circle { x: 2.0, y: 2.0 } 5.0
93 | Assert.equal (Rectangle origin 10.0 10.0)
94 | $ doubleScaleAndCenter $ Rectangle { x: 0.0, y: 0.0 } 5.0 5.0
95 | Assert.equal (Rectangle origin 40.0 40.0)
96 | $ doubleScaleAndCenter $ Rectangle { x: 30.0, y: 30.0 } 20.0 20.0
97 | Assert.equal (Line { x: -4.0, y: -4.0 } { x: 4.0, y: 4.0 })
98 | $ doubleScaleAndCenter $ Line { x: -2.0, y: -2.0 } { x: 2.0, y: 2.0 }
99 | Assert.equal (Line { x: -4.0, y: -4.0 } { x: 4.0, y: 4.0 })
100 | $ doubleScaleAndCenter $ Line { x: 0.0, y: 4.0 } { x: 4.0, y: 8.0 }
101 | Assert.equal (Text { x: 0.0, y: 0.0 } "Hello .purs!" )
102 | $ doubleScaleAndCenter $ Text { x: 4.0, y: 6.0 } "Hello .purs!"
103 | test "Exercise - shapeText" do
104 | Assert.equal (Just "Hello .purs!")
105 | $ shapeText $ Text origin "Hello .purs!"
106 | Assert.equal Nothing
107 | $ shapeText $ Circle origin 1.0
108 | Assert.equal Nothing
109 | $ shapeText $ Rectangle origin 1.0 1.0
110 | Assert.equal Nothing
111 | $ shapeText $ Line origin { x: 1.0, y: 1.0 }
112 | suite "Exercise Group - Newtype" do
113 | test "Exercise - calculateWattage" do
114 | Assert.equal 60.0
115 | $ let (Watt w) = calculateWattage (Amp 0.5) (Volt 120.0)
116 | in w
117 | suite "Exercise Group - Vector Graphics" do
118 | test "Exercise - area" do
119 | Assert.equal 50
120 | $ round $ area $ Circle origin 4.0
121 | Assert.equal 40
122 | $ round $ area $ Rectangle origin 4.0 10.0
123 | Assert.equal 0
124 | $ round $ area $ Line origin { x: 2.0, y: 2.0 }
125 | Assert.equal 0
126 | $ round $ area $ Text origin "Text has no area!"
127 | test "Exercise - Clipped shapeBounds" do
128 | Assert.equal { top: -2.0, left: -2.0, right: 2.0, bottom: 2.0 }
129 | -- Note to users: You'll need to manually import shapeBounds
130 | -- from Data.Picture. Don't import from Test.NoPeeking.Solutions.
131 | $ shapeBounds (Clipped samplePicture { x: 0.0, y: 0.0 } 4.0 4.0)
132 | Assert.equal { top: 3.0, left: 3.0, right: 7.0, bottom: 7.0 }
133 | $ shapeBounds (Clipped samplePicture { x: 5.0, y: 5.0 } 4.0 4.0)
134 | Assert.equal { top: 2.0, left: 2.0, right: 7.0, bottom: 7.0 }
135 | $ shapeBounds (Clipped samplePicture { x: 5.0, y: 5.0 } 6.0 6.0)
136 |
137 | {- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
138 | -}
139 | runChapterExamples :: TestSuite
140 | runChapterExamples =
141 | suite "Chapter Examples" do
142 | test "gcd" do
143 | Assert.equal 20
144 | $ gcd 60 100
145 | test "fromString" do
146 | Assert.equal true
147 | $ fromString "true"
148 | test "toString" do
149 | Assert.equal "false"
150 | $ toString false
151 | test "gcdV2" do
152 | Assert.equal 20
153 | $ gcdV2 60 100
154 | test "isEmpty" do
155 | Assert.equal false
156 | $ isEmpty [2, 3]
157 | test "takeFive" do
158 | Assert.equal 6
159 | $ takeFive [0, 1, 2, 3, 4]
160 | test "showPerson" do
161 | Assert.equal "Lovelace, Ada"
162 | $ showPerson {first: "Ada", last: "Lovelace"}
163 | test "showPersonV2" do
164 | Assert.equal "Lovelace, Ada"
165 | $ showPersonV2 {first: "Ada", last: "Lovelace"}
166 | test "unknownPerson" do
167 | Assert.equal {first: "Jane", last: "Doe"} unknownPerson
168 | test "livesInLA" do
169 | Assert.equal true
170 | $ livesInLA {name: "Suraj", address: {street: "123 Main St", city: "Los Angeles"}}
171 | test "sortPair" do
172 | Assert.equal [1, 2]
173 | $ sortPair [2, 1]
174 | test "lzs" do
175 | Assert.equal [-1, -2, 3]
176 | $ lzs [1, -1, -2, 3]
177 | test "partialFunction" do
178 | Assert.equal true
179 | $ partialFunction true
180 | test "current" do
181 | Assert.equal (Amp 0.003) current
182 |
--------------------------------------------------------------------------------
/exercises/chapter11/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude (Unit, discard, negate, ($), (*>), (<>), (==))
4 | import Test.MySolutions
5 | import Game
6 | import Test.NoPeeking.Solutions -- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
7 |
8 | import Control.Monad.Except (runExceptT)
9 | import Control.Monad.RWS (RWSResult(..), runRWS)
10 | import Control.Monad.State (runStateT)
11 | import Control.Monad.Writer (runWriterT, execWriter)
12 | import Data.Either (Either(..))
13 | import Data.GameEnvironment (GameEnvironment(..))
14 | import Data.GameItem (GameItem(..))
15 | import Data.GameState (GameState(..), initialGameState)
16 | import Data.List (List, (:))
17 | import Data.List as L
18 | import Data.Map as M
19 | import Data.Monoid.Additive (Additive(..))
20 | import Data.Newtype (unwrap)
21 | import Data.Set as S
22 | import Data.Tuple (Tuple(..))
23 | import Effect (Effect)
24 | import Test.Unit (TestSuite, success, suite, test)
25 | import Test.Unit.Assert as Assert
26 | import Test.Unit.Main (runTest)
27 |
28 | main :: Effect Unit
29 | main =
30 | runTest do
31 | test "" success
32 | {- Move this block comment starting point to enable more tests
33 | This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions. -}
34 | suite "Exercises Group - The State Monad" do
35 | suite "testParens" do
36 | let
37 | runTestParens :: Boolean -> String -> TestSuite
38 | runTestParens expected str =
39 | test testName do
40 | Assert.equal expected $ testParens str
41 | where testName = "str = \"" <> str <> "\""
42 | runTestParens true ""
43 | runTestParens true "(()(())())"
44 | runTestParens true "(hello)"
45 | runTestParens false ")"
46 | runTestParens false "(()()"
47 | runTestParens false ")("
48 | suite "Exercises Group - The Reader Monad" do
49 | suite "indents" do
50 | let
51 | expectedText =
52 | "Here is some indented text:\n\
53 | \ I am indented\n\
54 | \ So am I\n\
55 | \ I am even more indented"
56 | test "should render with indentations" do
57 | Assert.equal expectedText
58 | $ render $ cat
59 | [ line "Here is some indented text:"
60 | , indent $ cat
61 | [ line "I am indented"
62 | , line "So am I"
63 | , indent $ line "I am even more indented"
64 | ]
65 | ]
66 | suite "Exercises Group - The Writer Monad" do
67 | suite "sumArrayWriter" do
68 | test "should sum arrays" do
69 | Assert.equal (Additive 21)
70 | $ execWriter $ do
71 | sumArrayWriter [1, 2, 3]
72 | sumArrayWriter [4, 5]
73 | sumArrayWriter [6]
74 | suite "collatz" do
75 | let
76 | expected_11 =
77 | Tuple 14 [11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1]
78 | expected_15 =
79 | Tuple 17 [15, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1]
80 | test "c = 11" do
81 | Assert.equal expected_11
82 | $ collatz 11
83 | test "c = 15" do
84 | Assert.equal expected_15
85 | $ collatz 15
86 | suite "Exercises Group - Monad Transformers" do
87 | suite "safeDivide" do
88 | test "should fail when dividing by zero" do
89 | Assert.equal (Left "Divide by zero!")
90 | $ unwrap $ runExceptT $ safeDivide 5 0
91 | test "should successfully divide for any other input" do
92 | Assert.equal (Right 2) $ unwrap $ runExceptT $ safeDivide 6 3
93 | suite "parser" do
94 | let
95 | runParser p s = unwrap $ runExceptT $ runWriterT $ runStateT p s
96 | test "should parse a string" do
97 | Assert.equal (Right (Tuple (Tuple "abc" "def") ["The state is abcdef"]))
98 | $ runParser (string "abc") "abcdef"
99 | test "should fail if string could not be parsed" do
100 | Assert.equal (Left ["Could not parse"])
101 | $ runParser (string "abc") "foobar"
102 | suite "indents with ReaderT and WriterT" do
103 | let
104 | expectedText =
105 | "Here is some indented text:\n\
106 | \ I am indented\n\
107 | \ So am I\n\
108 | \ I am even more indented"
109 | test "should render with indentations" do
110 | Assert.equal expectedText
111 | $ render' $ do
112 | line' "Here is some indented text:"
113 | indent' $ do
114 | line' "I am indented"
115 | line' "So am I"
116 | indent' $ do
117 | line' "I am even more indented"
118 |
119 | suite "Exercises Group - Monad Comprehensions/backtracking" do
120 | suite "parser" do
121 | let
122 | runParser p s = unwrap $ runExceptT $ runWriterT $ runStateT p s
123 | test "should parse as followed by bs" do
124 | Assert.equal (Right (Tuple (Tuple "aaabb" "cde") [
125 | "The state is aaabbcde",
126 | "The state is aabbcde",
127 | "The state is abbcde",
128 | "The state is bbcde",
129 | "The state is bcde"]))
130 | $ runParser asFollowedByBs "aaabbcde"
131 | test "should fail if first is not a" do
132 | Assert.equal (Left ["Could not parse"])
133 | $ runParser asFollowedByBs "bfoobar"
134 | test "should parse as and bs" do
135 | Assert.equal (Right (Tuple (Tuple "babbaa" "cde") [
136 | "The state is babbaacde",
137 | "The state is abbaacde",
138 | "The state is bbaacde",
139 | "The state is baacde",
140 | "The state is aacde",
141 | "The state is acde"]))
142 | $ runParser asOrBs "babbaacde"
143 | test "should fail if first is not a or b" do
144 | Assert.equal (Left ["Could not parse","Could not parse"])
145 | $ runParser asOrBs "foobar"
146 |
147 | suite "Exercises Group - The RWS Monad" do
148 | let
149 | runGame :: Game Unit -> RWSResult GameState Unit (List String)
150 | runGame testGame = runRWS testGame env initialGameState
151 | env = GameEnvironment { debugMode: false, playerName: "Phil" }
152 |
153 | playerHasAllItems (GameState {inventory}) = inventory == S.fromFoldable [Candle, Matches]
154 | mapIsEmpty (GameState {items}) = M.isEmpty items
155 | expectedLogs = ("You now have the Candle" : "You now have the Matches" : L.Nil)
156 |
157 | suite "adds all items to your inventory when cheating" do
158 | let
159 | runCheatTest label testGame =
160 | test label do
161 | let (RWSResult actualState _ log) = runGame testGame
162 | Assert.assert "Expected player to have both Candle and Matches" $ playerHasAllItems actualState
163 | Assert.assert "Expected map to no longer have any items" $ mapIsEmpty actualState
164 | Assert.equal expectedLogs $ L.sort log
165 |
166 | runCheatTest "only cheat" cheat
167 | runCheatTest "move and cheat" $ move 0 (-1) *> move 0 1 *> cheat
168 | runCheatTest "pickup matches and cheat" $ pickUp Matches *> cheat
169 | runCheatTest "pickup all, move, and cheat" $ pickUp Matches *> move 0 1 *> pickUp Candle *> cheat
170 |
171 | {- This line should have been automatically deleted by resetSolutions.sh. See Chapter 2 for instructions.
172 | -}
--------------------------------------------------------------------------------
/exercises/chapter10/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Data.AddressBook (PhoneNumber, Person, examplePerson)
6 | import Data.AddressBook.Validation (Errors, validatePerson')
7 | import Data.Argonaut (Json, decodeJson, encodeJson, jsonParser, printJsonDecodeError, stringify)
8 | import Data.Array (length, mapWithIndex, updateAt)
9 | import Data.Bifunctor (lmap)
10 | import Data.Either (Either(..))
11 | import Data.Maybe (Maybe(..), fromMaybe)
12 | import Data.Tuple (Tuple(..))
13 | import Effect (Effect)
14 | import Effect.Alert (alert)
15 | import Effect.Console (log)
16 | import Effect.Exception (throw)
17 | import Effect.Storage (getItem, setItem)
18 | import React.Basic.DOM as D
19 | import React.Basic.DOM.Events (targetValue)
20 | import React.Basic.Events (handler, handler_)
21 | import React.Basic.Hooks (ReactComponent, element, reactComponent, useState)
22 | import React.Basic.Hooks as R
23 | import Web.DOM.NonElementParentNode (getElementById)
24 | import Web.HTML (window)
25 | import Web.HTML.HTMLDocument (toNonElementParentNode)
26 | import Web.HTML.Window (document)
27 |
28 | -- Note that there's a Purty formatting bug that
29 | -- adds an unwanted blank line
30 | -- https://gitlab.com/joneshf/purty/issues/77
31 | renderValidationErrors :: Errors -> Array R.JSX
32 | renderValidationErrors [] = []
33 |
34 | renderValidationErrors xs =
35 | let
36 | renderError :: String -> R.JSX
37 | renderError err = D.li_ [ D.text err ]
38 | in
39 | [ D.div
40 | { className: "alert alert-danger row"
41 | , children: [ D.ul_ (map renderError xs) ]
42 | }
43 | ]
44 |
45 | -- Helper function to render a single form field with an
46 | -- event handler to update
47 | formField :: String -> String -> String -> (String -> Effect Unit) -> R.JSX
48 | formField name placeholder value setValue =
49 | D.div
50 | { className: "form-group row"
51 | , children:
52 | [ D.label
53 | { className: "col-sm col-form-label"
54 | , htmlFor: name
55 | , children: [ D.text name ]
56 | }
57 | , D.div
58 | { className: "col-sm"
59 | , children:
60 | [ D.input
61 | { className: "form-control"
62 | , id: name
63 | , placeholder
64 | , value
65 | , onChange:
66 | let
67 | handleValue :: Maybe String -> Effect Unit
68 | handleValue (Just v) = setValue v
69 | handleValue Nothing = pure unit
70 | in
71 | handler targetValue handleValue
72 | }
73 | ]
74 | }
75 | ]
76 | }
77 |
78 | mkAddressBookApp :: Effect (ReactComponent { initialPerson :: Person })
79 | mkAddressBookApp =
80 | reactComponent "AddressBookApp" \props -> R.do
81 | -- `useState` takes a default initial value and returns the
82 | -- current value and a way to update the value.
83 | -- Consult react-hooks docs for a more detailed explanation of `useState`.
84 | Tuple person setPerson <- useState props.initialPerson
85 | let
86 | errors = case validatePerson' person of
87 | Left e -> e
88 | Right _ -> []
89 |
90 | -- helper-function to return array unchanged instead of Nothing if index is out of bounds
91 | updateAt' :: forall a. Int -> a -> Array a -> Array a
92 | updateAt' i x xs = fromMaybe xs (updateAt i x xs)
93 |
94 | -- helper-function to render a single phone number at a given index
95 | renderPhoneNumber :: Int -> PhoneNumber -> R.JSX
96 | renderPhoneNumber index phone =
97 | formField
98 | (show phone."type")
99 | "XXX-XXX-XXXX"
100 | phone.number
101 | (\s -> setPerson _ { phones = updateAt' index phone { number = s } person.phones })
102 |
103 | -- helper-function to render all phone numbers
104 | renderPhoneNumbers :: Array R.JSX
105 | renderPhoneNumbers = mapWithIndex renderPhoneNumber person.phones
106 |
107 | validateAndSave :: Effect Unit
108 | validateAndSave = do
109 | log "Running validators"
110 | case validatePerson' person of
111 | Left errs -> alert $ "There are " <> show (length errs) <> " validation errors."
112 | Right validPerson -> do
113 | setItem "person" $ stringify $ encodeJson validPerson
114 | log "Saved"
115 |
116 | -- helper-function to render saveButton
117 | saveButton :: R.JSX
118 | saveButton =
119 | D.label
120 | { className: "form-group row col-form-label"
121 | , children:
122 | [ D.button
123 | { className: "btn-primary btn"
124 | , onClick: handler_ validateAndSave
125 | , children: [ D.text "Save" ]
126 | }
127 | ]
128 | }
129 | pure
130 | $ D.div
131 | { className: "container"
132 | , children:
133 | renderValidationErrors errors
134 | <> [ D.div
135 | { className: "row"
136 | , children:
137 | [ D.form_
138 | $ [ D.h3_ [ D.text "Basic Information" ]
139 | , formField "First Name" "First Name" person.firstName \s ->
140 | setPerson _ { firstName = s }
141 | , formField "Last Name" "Last Name" person.lastName \s ->
142 | setPerson _ { lastName = s }
143 | , D.h3_ [ D.text "Address" ]
144 | , formField "Street" "Street" person.homeAddress.street \s ->
145 | setPerson _ { homeAddress { street = s } }
146 | , formField "City" "City" person.homeAddress.city \s ->
147 | setPerson _ { homeAddress { city = s } }
148 | , formField "State" "State" person.homeAddress.state \s ->
149 | setPerson _ { homeAddress { state = s } }
150 | , D.h3_ [ D.text "Contact Information" ]
151 | ]
152 | <> renderPhoneNumbers
153 | ]
154 | }
155 | ]
156 | <> [ saveButton ]
157 | }
158 |
159 | processItem :: Json -> Either String Person
160 | processItem item = do
161 | jsonString <- lmap (\e -> "No string in local storage: " <> printJsonDecodeError e) $ decodeJson item
162 | j <- lmap ( "Cannot parse JSON string: " <> _) $ jsonParser jsonString
163 | lmap (\e -> "Cannot decode Person: " <> printJsonDecodeError e) $ decodeJson j
164 |
165 | main :: Effect Unit
166 | main = do
167 | log "Rendering address book component"
168 | -- Get window object
169 | w <- window
170 | -- Get window's HTML document
171 | doc <- document w
172 | -- Get "container" element in HTML
173 | ctr <- getElementById "container" $ toNonElementParentNode doc
174 | case ctr of
175 | Nothing -> throw "Container element not found."
176 | Just c -> do
177 | -- Create AddressBook react component
178 | addressBookApp <- mkAddressBookApp
179 | -- Retrieve person from local storage
180 | item <- getItem "person"
181 | initialPerson <- case processItem item of
182 | Left err -> do
183 | alert $ "Error: " <> err <> ". Loading examplePerson"
184 | pure examplePerson
185 | Right p -> pure p
186 | let
187 | -- Create JSX node from react component.
188 | app = element addressBookApp { initialPerson }
189 | -- Render AddressBook JSX node in DOM "container" element
190 | D.render app c
191 |
--------------------------------------------------------------------------------