├── .gitignore ├── elixir ├── .gitignore ├── README.md ├── kv │ ├── .formatter.exs │ ├── .gitignore │ ├── README.md │ ├── lib │ │ ├── kv.ex │ │ └── kv │ │ │ ├── bucket.ex │ │ │ └── registry.ex │ ├── mix.exs │ └── test │ │ ├── kv │ │ ├── bucket_test.exs │ │ └── registry_test.exs │ │ ├── kv_test.exs │ │ └── test_helper.exs ├── math.ex ├── modules-and-functions.exs └── simple.exs ├── fp-in-scala ├── .gitattributes ├── Functional data structures (Chapter 3).ipynb ├── Getting started (Chapter 2).ipynb ├── README.md └── Strictness and laziness (Chapter 5).ipynb ├── fp-ts ├── .gitignore ├── .prettierrc.yaml ├── README.md ├── custom-typeclasses-2.test.ts ├── custom-typeclasses.test.ts ├── either-validation.ts ├── eq.test.ts ├── index.ts ├── io.test.ts ├── jest.config.js ├── package.json ├── property-based-testing.test.ts ├── semigroup.test.ts ├── taskeither.test.ts ├── tsconfig.json └── yarn.lock ├── learn-you-a-haskell ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── Main.hs ├── learn-you-a-haskell.cabal ├── learning-fp.md ├── package.yaml ├── resources │ └── girlfriend.txt ├── src │ ├── FunctionallySolvingProblems.hs │ ├── Functors.hs │ ├── Geometry │ │ ├── Cube.hs │ │ ├── Cuboid.hs │ │ └── Sphere.hs │ ├── GeometryModule.hs │ ├── HigherOrderFunctions.hs │ ├── InputAndOutput.hs │ ├── LensTutorial.hs │ ├── Lib.hs │ ├── MakingOurOwnTypesAndTypeclasses.hs │ ├── Modules.hs │ ├── Recursion.hs │ ├── StartingOut.hs │ ├── SyntaxInFunctions.hs │ ├── TreeADT.hs │ └── TypesAndTypeClasses.hs ├── stack.yaml ├── stack.yaml.lock ├── test │ ├── OptimalPath.hs │ ├── RPN.hs │ └── Spec.hs └── todo-app │ └── Main.hs ├── monocle-ts ├── .gitignore ├── README.md ├── artists.test.ts ├── index.test.ts ├── jest.config.js ├── optics-part-1.md ├── package.json ├── stripe-simple.yaml ├── tsconfig.json └── yarn.lock ├── project-euler ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── Main.hs ├── package.yaml ├── src │ └── Problem1.hs ├── stack.yaml ├── stack.yaml.lock └── test │ └── Spec.hs └── purescript ├── README.md ├── getting-started ├── .gitignore ├── README.md ├── bower.json ├── package.json ├── src │ ├── Euler.purs │ └── Main.purs ├── test │ └── Main.purs └── yarn.lock ├── hello-cowboy ├── .gitignore ├── README.md ├── bower.json ├── package.json ├── src │ └── Main.purs ├── test │ └── Main.purs └── yarn.lock └── spago-project ├── .gitignore ├── README.md ├── package.json ├── packages.dhall ├── spago.dhall ├── src └── Main.purs ├── test └── Main.purs └── yarn.lock /.gitignore: -------------------------------------------------------------------------------- 1 | .ipynb_checkpoints 2 | *~ 3 | .vscode/ 4 | -------------------------------------------------------------------------------- /elixir/.gitignore: -------------------------------------------------------------------------------- 1 | *.beam 2 | -------------------------------------------------------------------------------- /elixir/README.md: -------------------------------------------------------------------------------- 1 | # Getting started with [Elixir](https://elixir-lang.org/getting-started/introduction.html) 2 | 3 | ## Instructions 4 | 5 | Run script: 6 | 7 | ```bash 8 | $ elixir simple.exs 9 | ``` 10 | 11 | Compile module: 12 | 13 | ```bash 14 | $ elixirc math.ex 15 | ``` 16 | 17 | ## `mix` 18 | 19 | Key-value storage example was created with 20 | 21 | ```bash 22 | $ mix new kv --module KV 23 | ``` 24 | -------------------------------------------------------------------------------- /elixir/kv/.formatter.exs: -------------------------------------------------------------------------------- 1 | # Used by "mix format" 2 | [ 3 | inputs: ["{mix,.formatter}.exs", "{config,lib,test}/**/*.{ex,exs}"] 4 | ] 5 | -------------------------------------------------------------------------------- /elixir/kv/.gitignore: -------------------------------------------------------------------------------- 1 | # The directory Mix will write compiled artifacts to. 2 | /_build/ 3 | 4 | # If you run "mix test --cover", coverage assets end up here. 5 | /cover/ 6 | 7 | # The directory Mix downloads your dependencies sources to. 8 | /deps/ 9 | 10 | # Where third-party dependencies like ExDoc output generated docs. 11 | /doc/ 12 | 13 | # Ignore .fetch files in case you like to edit your project deps locally. 14 | /.fetch 15 | 16 | # If the VM crashes, it generates a dump, let's ignore it too. 17 | erl_crash.dump 18 | 19 | # Also ignore archive artifacts (built via "mix archive.build"). 20 | *.ez 21 | 22 | # Ignore package tarball (built via "mix hex.build"). 23 | kv-*.tar 24 | 25 | .vscode/ 26 | -------------------------------------------------------------------------------- /elixir/kv/README.md: -------------------------------------------------------------------------------- 1 | # KV 2 | 3 | **TODO: Add description** 4 | 5 | ## Installation 6 | 7 | If [available in Hex](https://hex.pm/docs/publish), the package can be installed 8 | by adding `kv` to your list of dependencies in `mix.exs`: 9 | 10 | ```elixir 11 | def deps do 12 | [ 13 | {:kv, "~> 0.1.0"} 14 | ] 15 | end 16 | ``` 17 | 18 | Documentation can be generated with [ExDoc](https://github.com/elixir-lang/ex_doc) 19 | and published on [HexDocs](https://hexdocs.pm). Once published, the docs can 20 | be found at [https://hexdocs.pm/kv](https://hexdocs.pm/kv). 21 | 22 | ## Instructions 23 | 24 | Compile: 25 | 26 | ```bash 27 | $ mix compile 28 | ``` 29 | 30 | All compilation artifacts are placed inside the `\_build` directory using the options defined in the mix.exs file. 31 | 32 | Test: 33 | 34 | ```bash 35 | $ mix test 36 | ``` 37 | 38 | Start an `iex` session: 39 | 40 | ```bash 41 | $ iex -S mix 42 | ``` 43 | 44 | Recompile with `recompile()` inside the session. 45 | -------------------------------------------------------------------------------- /elixir/kv/lib/kv.ex: -------------------------------------------------------------------------------- 1 | defmodule KV do 2 | @moduledoc """ 3 | Documentation for `KV`. 4 | """ 5 | 6 | @doc """ 7 | Hello world. 8 | 9 | ## Examples 10 | 11 | iex> KV.hello() 12 | :world 13 | 14 | """ 15 | def hello do 16 | :world 17 | end 18 | end 19 | -------------------------------------------------------------------------------- /elixir/kv/lib/kv/bucket.ex: -------------------------------------------------------------------------------- 1 | defmodule KV.Bucket do 2 | use Agent 3 | 4 | @doc """ 5 | Starts a new bucket agent. 6 | """ 7 | def start_link(_opts) do 8 | Agent.start_link(fn -> %{} end) 9 | end 10 | 11 | @doc """ 12 | Gets a value from bucket agent with key. 13 | """ 14 | def get(bucket, key) do 15 | Agent.get(bucket, &Map.get(&1, key)) 16 | end 17 | 18 | @doc " 19 | Put a value to bucket with key and value. 20 | " 21 | def put(bucket, key, value) do 22 | Agent.update(bucket, &Map.put(&1, key, value)) 23 | end 24 | 25 | def delete(bucket, key) do 26 | Agent.get_and_update(bucket, &Map.pop(&1, key)) 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /elixir/kv/lib/kv/registry.ex: -------------------------------------------------------------------------------- 1 | defmodule KV.Registry do 2 | use GenServer 3 | 4 | # Client API will be here 5 | 6 | def start_link(opts) do 7 | # Callbacks defined in current __MODULE__ 8 | GenServer.start_link(__MODULE__, :ok, opts) 9 | end 10 | 11 | def lookup(server, name) do 12 | GenServer.call(server, {:lookup, name}) 13 | end 14 | 15 | def create(server, name) do 16 | GenServer.cast(server, {:create, name}) 17 | end 18 | 19 | # Callbacks 20 | 21 | @impl true 22 | def init(:ok) do 23 | names = %{} 24 | refs = %{} 25 | {:ok, {names, refs}} 26 | end 27 | 28 | # The "@impl true" informs the compiler that our intention for the subsequent function definition is to define a callback. 29 | # Calls are synchronous and the server must send back a response 30 | @impl true 31 | def handle_call({:lookup, name}, _from, state) do 32 | {names, _} = state 33 | {:reply, Map.fetch(names, name), state} 34 | end 35 | 36 | # Casts are asynchronous, the server won't send a response back 37 | @impl true 38 | def handle_cast({:create, name}, {names, refs}) do 39 | if Map.has_key?(names, name) do 40 | {:noreply, {names, refs}} 41 | else 42 | {:ok, bucket} = KV.Bucket.start_link([]) 43 | ref = Process.monitor(bucket) 44 | refs = Map.put(refs, ref, name) 45 | names = Map.put(names, name, bucket) 46 | {:noreply, {names, refs}} 47 | end 48 | end 49 | 50 | @impl true 51 | def handle_info({:DOWN, ref, :process, _pid, _reason}, {names, refs}) do 52 | {name, refs} = Map.pop(refs, ref) 53 | names = Map.delete(names, name) 54 | {:noreply, {names, refs}} 55 | end 56 | 57 | @impl true 58 | def handle_info(_msg, state) do 59 | {:noreply, state} 60 | end 61 | end 62 | -------------------------------------------------------------------------------- /elixir/kv/mix.exs: -------------------------------------------------------------------------------- 1 | defmodule KV.MixProject do 2 | use Mix.Project 3 | 4 | def project do 5 | [ 6 | app: :kv, 7 | version: "0.1.0", 8 | elixir: "~> 1.10", 9 | start_permanent: Mix.env() == :prod, 10 | deps: deps() 11 | ] 12 | end 13 | 14 | # Run "mix help compile.app" to learn about applications. 15 | def application do 16 | [ 17 | extra_applications: [:logger] 18 | ] 19 | end 20 | 21 | # Run "mix help deps" to learn about dependencies. 22 | defp deps do 23 | [ 24 | # {:dep_from_hexpm, "~> 0.3.0"}, 25 | # {:dep_from_git, git: "https://github.com/elixir-lang/my_dep.git", tag: "0.1.0"} 26 | ] 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /elixir/kv/test/kv/bucket_test.exs: -------------------------------------------------------------------------------- 1 | defmodule KV.BucketTest do 2 | use ExUnit.Case, async: true 3 | 4 | # setup macro run before every test in the same process as the test 5 | setup do 6 | {:ok, bucket} = KV.Bucket.start_link([]) 7 | %{bucket: bucket} 8 | end 9 | 10 | # Pattern match to "bucket" from test context 11 | test "stores values by key", %{bucket: bucket} do 12 | assert KV.Bucket.get(bucket, "milk") == nil 13 | 14 | KV.Bucket.put(bucket, "milk", 3) 15 | assert KV.Bucket.get(bucket, "milk") == 3 16 | end 17 | 18 | test "deletes values by key", %{bucket: bucket} do 19 | KV.Bucket.put(bucket, "milk", 3) 20 | assert KV.Bucket.get(bucket, "milk") == 3 21 | KV.Bucket.delete(bucket, "milk") 22 | assert KV.Bucket.get(bucket, "milk") == nil 23 | end 24 | 25 | test "shows distinction between client and server", %{bucket: bucket} do 26 | # Puts client to sleep 27 | Process.sleep(100) 28 | key = "milk" 29 | 30 | val = 31 | Agent.get_and_update(bucket, fn dict -> 32 | # Puts server to sleep 33 | Process.sleep(100) 34 | Map.pop(dict, key) 35 | end) 36 | 37 | assert val == nil 38 | end 39 | end 40 | -------------------------------------------------------------------------------- /elixir/kv/test/kv/registry_test.exs: -------------------------------------------------------------------------------- 1 | defmodule KV.RegistryTest do 2 | use ExUnit.Case, async: true 3 | 4 | setup do 5 | # The start_supervised! function is injected by use ExUnit.Case. It does the job of starting the KV.Registry process, by calling its start_link/1 function. The advantage of using start_supervised! is that ExUnit will guarantee that the registry process will be shutdown before the next test starts. 6 | registry = start_supervised!(KV.Registry) 7 | %{registry: registry} 8 | end 9 | 10 | test "spawns buckets", %{registry: registry} do 11 | assert KV.Registry.lookup(registry, "shopping") == :error 12 | 13 | KV.Registry.create(registry, "shopping") 14 | assert {:ok, bucket} = KV.Registry.lookup(registry, "shopping") 15 | 16 | KV.Bucket.put(bucket, "milk", 1) 17 | assert KV.Bucket.get(bucket, "milk") == 1 18 | end 19 | 20 | test "removes buckets on exit", %{registry: registry} do 21 | KV.Registry.create(registry, "shopping") 22 | {:ok, bucket} = KV.Registry.lookup(registry, "shopping") 23 | Agent.stop(bucket) 24 | assert KV.Registry.lookup(registry, "shopping") == :error 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /elixir/kv/test/kv_test.exs: -------------------------------------------------------------------------------- 1 | defmodule KVTest do 2 | use ExUnit.Case 3 | doctest KV 4 | 5 | test "greets the world" do 6 | assert KV.hello() == :world 7 | end 8 | end 9 | -------------------------------------------------------------------------------- /elixir/kv/test/test_helper.exs: -------------------------------------------------------------------------------- 1 | ExUnit.start() 2 | -------------------------------------------------------------------------------- /elixir/math.ex: -------------------------------------------------------------------------------- 1 | defmodule Math do 2 | def sum(a, b) do 3 | a + b 4 | end 5 | 6 | def zero?(0), do: true 7 | def zero?(x) when is_integer(x) do 8 | false 9 | end 10 | end 11 | -------------------------------------------------------------------------------- /elixir/modules-and-functions.exs: -------------------------------------------------------------------------------- 1 | 2 | # Capture function from Math.module 3 | # Question mark denotes a function returning boolean 4 | fun = &Math.zero?/1 5 | 6 | IO.puts is_function(fun) 7 | 8 | # Anonymous function `fun` must be invoked with a dot before parentheses 9 | IO.puts fun.(0) 10 | # IO.puts Math.zero?(0) 11 | 12 | # Shorthand for creating functions: 13 | fun2 = &(&1 + 1) 14 | # same as 15 | fun3 = fn x -> x + 1 end 16 | 17 | # Default arguments 18 | 19 | defmodule Concat do 20 | def join(a, b \\ nil, sep \\ " ") 21 | 22 | def join(a, b, _sep) when is_nil(b) do 23 | a 24 | end 25 | 26 | def join(a, b, sep) do 27 | a <> sep <> b 28 | end 29 | 30 | 31 | end 32 | 33 | IO.puts Concat.join("Hello", "World") 34 | IO.puts Concat.join("Hello", "World", "--") 35 | -------------------------------------------------------------------------------- /elixir/simple.exs: -------------------------------------------------------------------------------- 1 | defmodule Math do 2 | def sum(a, b) do 3 | do_sum(a, b) 4 | end 5 | 6 | def zero?(0), do: true 7 | def zero?(x) when is_integer(x) do 8 | false 9 | end 10 | 11 | defp do_sum(a, b) do 12 | a + b 13 | end 14 | end 15 | 16 | defmodule Recursion do 17 | def print_multiple_times(msg, n) when n <= 1 do 18 | IO.puts msg 19 | end 20 | 21 | def print_multiple_times(msg, n) do 22 | IO.puts msg 23 | print_multiple_times(msg, n - 1) 24 | end 25 | end 26 | 27 | IO.puts Math.sum(1, 2) #=> 3 28 | # IO.puts Math.do_sum(1, 2) #=> ** (UndefinedFunctionError) 29 | 30 | IO.puts Enum.reduce([1, 2, 3], 0, fn(x, acc) -> x + acc end) 31 | 32 | stream = Stream.cycle([1, 2, 3]) 33 | Enum.take(stream, 10) |> Enum.each(&IO.write/1) 34 | Enum.take(stream, 10) |> Enum.each(fn a -> IO.puts a end) 35 | # IO.puts vals |> IO.puts 36 | -------------------------------------------------------------------------------- /fp-in-scala/.gitattributes: -------------------------------------------------------------------------------- 1 | *.ipynb filter= 2 | -------------------------------------------------------------------------------- /fp-in-scala/Getting started (Chapter 2).ipynb: -------------------------------------------------------------------------------- 1 | { 2 | "cells": [ 3 | { 4 | "cell_type": "markdown", 5 | "metadata": {}, 6 | "source": [ 7 | "### Recursive functions\n", 8 | "A recursive call is said to be in tail position if the caller only returns the value of the recursive call but does not do anything else with it. As an example, consider a simple function computing factorial." 9 | ] 10 | }, 11 | { 12 | "cell_type": "code", 13 | "execution_count": 1, 14 | "metadata": {}, 15 | "outputs": [ 16 | { 17 | "name": "stdout", 18 | "output_type": "stream", 19 | "text": [ 20 | "Factorial of 5 is: 120" 21 | ] 22 | }, 23 | { 24 | "data": { 25 | "text/plain": [ 26 | "defined \u001b[32mfunction\u001b[39m \u001b[36mfactorial\u001b[39m\n", 27 | "\u001b[36mtestValue\u001b[39m: \u001b[32mInt\u001b[39m = \u001b[32m5\u001b[39m" 28 | ] 29 | }, 30 | "execution_count": 1, 31 | "metadata": {}, 32 | "output_type": "execute_result" 33 | } 34 | ], 35 | "source": [ 36 | "def factorial(n: Int): Int = {\n", 37 | " n match {\n", 38 | " case 0 => 1\n", 39 | " case _ => n*factorial(n - 1) // This call is not in tail position\n", 40 | " }\n", 41 | "}\n", 42 | "\n", 43 | "val testValue = 5\n", 44 | "print(s\"Factorial of ${testValue} is: ${factorial(testValue)}\")" 45 | ] 46 | }, 47 | { 48 | "cell_type": "markdown", 49 | "metadata": {}, 50 | "source": [ 51 | "A better implementation is one where the recursive call is in tail position:" 52 | ] 53 | }, 54 | { 55 | "cell_type": "code", 56 | "execution_count": 2, 57 | "metadata": {}, 58 | "outputs": [ 59 | { 60 | "name": "stdout", 61 | "output_type": "stream", 62 | "text": [ 63 | "Factorial of 5 is: 120" 64 | ] 65 | }, 66 | { 67 | "data": { 68 | "text/plain": [ 69 | "defined \u001b[32mfunction\u001b[39m \u001b[36mfactorial2\u001b[39m" 70 | ] 71 | }, 72 | "execution_count": 2, 73 | "metadata": {}, 74 | "output_type": "execute_result" 75 | } 76 | ], 77 | "source": [ 78 | "def factorial2(n: Int): Int = {\n", 79 | " // `@annotation.tailrec` forces Scala to compile code that eliminates the current function call from stack \n", 80 | " // when the recursive call is made (tail call optimization).\n", 81 | " // Optimization is made automatically, but annotation ensures that compiler throws error for \n", 82 | " // a head recursive function.\n", 83 | " @annotation.tailrec \n", 84 | " def go(n: Int, acc: Int): Int =\n", 85 | " if (n<=0) acc\n", 86 | " else go(n-1, n*acc) // This is in tail position!\n", 87 | " go(n, 1)\n", 88 | "}\n", 89 | "\n", 90 | "print(s\"Factorial of ${testValue} is: ${factorial2(testValue)}\")" 91 | ] 92 | }, 93 | { 94 | "cell_type": "markdown", 95 | "metadata": {}, 96 | "source": [ 97 | "### Exercise 2.1\n", 98 | "Write tail recursive implementation to compute `n`th Fibonacci number." 99 | ] 100 | }, 101 | { 102 | "cell_type": "code", 103 | "execution_count": 3, 104 | "metadata": {}, 105 | "outputs": [ 106 | { 107 | "name": "stdout", 108 | "output_type": "stream", 109 | "text": [ 110 | "First ten Fibonacci numbers are: 0, 1, 1, 2, 3, 5, 8, 13, 21, 34" 111 | ] 112 | }, 113 | { 114 | "data": { 115 | "text/plain": [ 116 | "defined \u001b[32mfunction\u001b[39m \u001b[36mfib\u001b[39m\n", 117 | "\u001b[36mfirstTen\u001b[39m: \u001b[32mcollection\u001b[39m.\u001b[32mimmutable\u001b[39m.\u001b[32mIndexedSeq\u001b[39m[\u001b[32mInt\u001b[39m] = \u001b[33mVector\u001b[39m(\u001b[32m0\u001b[39m, \u001b[32m1\u001b[39m, \u001b[32m1\u001b[39m, \u001b[32m2\u001b[39m, \u001b[32m3\u001b[39m, \u001b[32m5\u001b[39m, \u001b[32m8\u001b[39m, \u001b[32m13\u001b[39m, \u001b[32m21\u001b[39m, \u001b[32m34\u001b[39m)" 118 | ] 119 | }, 120 | "execution_count": 3, 121 | "metadata": {}, 122 | "output_type": "execute_result" 123 | } 124 | ], 125 | "source": [ 126 | "// First write a naive implementation\n", 127 | "def fib(n: Int): Int = {\n", 128 | " n match {\n", 129 | " case 0 => 0\n", 130 | " case 1 => 1\n", 131 | " case _ => fib(n-1) + fib(n-2) // Not in tail position!\n", 132 | " }\n", 133 | "}\n", 134 | "\n", 135 | "val firstTen = (0 until 10).map(fib)\n", 136 | "\n", 137 | "print(s\"First ten Fibonacci numbers are: ${firstTen mkString \", \"}\")\n" 138 | ] 139 | }, 140 | { 141 | "cell_type": "code", 142 | "execution_count": 4, 143 | "metadata": {}, 144 | "outputs": [ 145 | { 146 | "name": "stdout", 147 | "output_type": "stream", 148 | "text": [ 149 | "First ten Fibonacci numbers are: 0, 1, 1, 2, 3, 5, 8, 13, 21, 34" 150 | ] 151 | }, 152 | { 153 | "data": { 154 | "text/plain": [ 155 | "defined \u001b[32mfunction\u001b[39m \u001b[36mfib2\u001b[39m" 156 | ] 157 | }, 158 | "execution_count": 4, 159 | "metadata": {}, 160 | "output_type": "execute_result" 161 | } 162 | ], 163 | "source": [ 164 | "// Tail-recursive implementation that traverses the Fibonacci sequence starting from beginning\n", 165 | "def fib2(n: Int): Int = {\n", 166 | " @annotation.tailrec\n", 167 | " def proceedInFib(iter: Int, previousValue: Int, currentValue: Int): Int = {\n", 168 | " if (iter <= 0) currentValue\n", 169 | " else proceedInFib(iter-1, previousValue = currentValue, currentValue = previousValue + currentValue)\n", 170 | " }\n", 171 | " proceedInFib(iter = n, previousValue = 0, currentValue = 1)\n", 172 | "}\n", 173 | "\n", 174 | "print(s\"First ten Fibonacci numbers are: ${firstTen mkString \", \"}\")\n" 175 | ] 176 | }, 177 | { 178 | "cell_type": "markdown", 179 | "metadata": {}, 180 | "source": [ 181 | "### Higher-order functions\n", 182 | "Example of a function that accepts a function as argument. The function is polymorphic in type as it is not restricted to a given type." 183 | ] 184 | }, 185 | { 186 | "cell_type": "code", 187 | "execution_count": 5, 188 | "metadata": {}, 189 | "outputs": [ 190 | { 191 | "data": { 192 | "text/plain": [ 193 | "defined \u001b[32mfunction\u001b[39m \u001b[36mfindFirst\u001b[39m\n", 194 | "\u001b[36mres4_1\u001b[39m: \u001b[32mInt\u001b[39m = \u001b[32m3\u001b[39m" 195 | ] 196 | }, 197 | "execution_count": 5, 198 | "metadata": {}, 199 | "output_type": "execute_result" 200 | } 201 | ], 202 | "source": [ 203 | "def findFirst[A](as: Array[A], p: A => Boolean): Int = {\n", 204 | " @annotation.tailrec\n", 205 | " def loop(n: Int): Int = {\n", 206 | " if (n >= as.length) -1\n", 207 | " else if (p(as(n))) n \n", 208 | " else loop(n+1)\n", 209 | " }\n", 210 | " loop(0)\n", 211 | "}\n", 212 | "findFirst(Array(2, 3, 3, 1, 1), (x: Int) => x == 1)" 213 | ] 214 | }, 215 | { 216 | "cell_type": "markdown", 217 | "metadata": {}, 218 | "source": [ 219 | "### Exercise 2.2\n", 220 | "Implement `isSorted` checking if an array is sorted according to given comparison function." 221 | ] 222 | }, 223 | { 224 | "cell_type": "code", 225 | "execution_count": 6, 226 | "metadata": {}, 227 | "outputs": [ 228 | { 229 | "name": "stdout", 230 | "output_type": "stream", 231 | "text": [ 232 | "Array 2,3,4,8,0 is not sorted\n", 233 | "Array 2,3,4,8 is sorted\n" 234 | ] 235 | }, 236 | { 237 | "data": { 238 | "text/plain": [ 239 | "defined \u001b[32mfunction\u001b[39m \u001b[36misSorted\u001b[39m\n", 240 | "\u001b[36mas\u001b[39m: \u001b[32mArray\u001b[39m[\u001b[32mInt\u001b[39m] = \u001b[33mArray\u001b[39m(\u001b[32m2\u001b[39m, \u001b[32m3\u001b[39m, \u001b[32m4\u001b[39m, \u001b[32m8\u001b[39m, \u001b[32m0\u001b[39m)\n", 241 | "\u001b[36mo\u001b[39m: (\u001b[32mInt\u001b[39m, \u001b[32mInt\u001b[39m) => \u001b[32mBoolean\u001b[39m = \n", 242 | "\u001b[36mas2\u001b[39m: \u001b[32mArray\u001b[39m[\u001b[32mInt\u001b[39m] = \u001b[33mArray\u001b[39m(\u001b[32m2\u001b[39m, \u001b[32m3\u001b[39m, \u001b[32m4\u001b[39m, \u001b[32m8\u001b[39m)" 243 | ] 244 | }, 245 | "execution_count": 6, 246 | "metadata": {}, 247 | "output_type": "execute_result" 248 | } 249 | ], 250 | "source": [ 251 | "def isSorted[A](as: Array[A], o: (A, A) => Boolean): Boolean = {\n", 252 | " @annotation.tailrec\n", 253 | " def loop(n: Int): Boolean = {\n", 254 | " if (n >= as.length - 1) true // Reached last value, all ok\n", 255 | " else o(as(n), as(n+1)) && loop(n + 1)\n", 256 | " }\n", 257 | " loop(0)\n", 258 | "}\n", 259 | "\n", 260 | "val as = Array(2, 3, 4, 8, 0)\n", 261 | "val o = (x: Int, y: Int) => x < y\n", 262 | "val as2 = as.slice(0, 4)\n", 263 | "println(s\"Array ${as mkString \",\"} is ${if (isSorted(as, o)) \"sorted\" else \"not sorted\"}\")\n", 264 | "println(s\"Array ${as2 mkString \",\"} is ${if (isSorted(as2, o)) \"sorted\" else \"not sorted\"}\")\n" 265 | ] 266 | }, 267 | { 268 | "cell_type": "markdown", 269 | "metadata": {}, 270 | "source": [ 271 | "### Exercise 2.3 \n", 272 | "Implement `currying` function with signature\n", 273 | "```scala\n", 274 | "def curry[A,B,C](f: (A, B) => C): A => (B => C)\n", 275 | "```" 276 | ] 277 | }, 278 | { 279 | "cell_type": "code", 280 | "execution_count": 7, 281 | "metadata": {}, 282 | "outputs": [ 283 | { 284 | "name": "stdout", 285 | "output_type": "stream", 286 | "text": [ 287 | "Now Mark introduces as: My name is Mark and age 15\n", 288 | "Next year Mark introduces as: My name is Mark and age 16\n" 289 | ] 290 | }, 291 | { 292 | "data": { 293 | "text/plain": [ 294 | "defined \u001b[32mfunction\u001b[39m \u001b[36mcurry\u001b[39m\n", 295 | "defined \u001b[32mfunction\u001b[39m \u001b[36mintroduce\u001b[39m\n", 296 | "\u001b[36mcurried\u001b[39m: \u001b[32mString\u001b[39m => \u001b[32mInt\u001b[39m => \u001b[32mString\u001b[39m = \n", 297 | "\u001b[36mintroduceMarkAtAge\u001b[39m: \u001b[32mInt\u001b[39m => \u001b[32mString\u001b[39m = " 298 | ] 299 | }, 300 | "execution_count": 7, 301 | "metadata": {}, 302 | "output_type": "execute_result" 303 | } 304 | ], 305 | "source": [ 306 | "def curry[A,B,C](f: (A, B) => C): A => (B => C) = {\n", 307 | " (a: A) => (b: B) => f(a, b)\n", 308 | "}\n", 309 | "\n", 310 | "def introduce(name: String, age: Int): String = s\"My name is ${name} and age ${age}\"\n", 311 | "val curried = curry(introduce)\n", 312 | "val introduceMarkAtAge = curried(\"Mark\")\n", 313 | "\n", 314 | "println(s\"Now Mark introduces as: ${introduceMarkAtAge(15)}\")\n", 315 | "println(s\"Next year Mark introduces as: ${introduceMarkAtAge(16)}\")" 316 | ] 317 | }, 318 | { 319 | "cell_type": "markdown", 320 | "metadata": {}, 321 | "source": [ 322 | "### Exercise 2.4\n", 323 | "Implement `uncurry` with signature\n", 324 | "```scala\n", 325 | " def uncurry[A,B,C](f: A => B => C): (A, B) => C\n", 326 | "```" 327 | ] 328 | }, 329 | { 330 | "cell_type": "code", 331 | "execution_count": 8, 332 | "metadata": {}, 333 | "outputs": [ 334 | { 335 | "name": "stdout", 336 | "output_type": "stream", 337 | "text": [ 338 | "Mark introduces as: My name is Mark and age 15\n" 339 | ] 340 | }, 341 | { 342 | "data": { 343 | "text/plain": [ 344 | "defined \u001b[32mfunction\u001b[39m \u001b[36muncurry\u001b[39m\n", 345 | "defined \u001b[32mfunction\u001b[39m \u001b[36muncurried\u001b[39m" 346 | ] 347 | }, 348 | "execution_count": 8, 349 | "metadata": {}, 350 | "output_type": "execute_result" 351 | } 352 | ], 353 | "source": [ 354 | "def uncurry[A,B,C](f: A => B => C): (A, B) => C = {\n", 355 | " (a: A, b: B) => f(a)(b)\n", 356 | "}\n", 357 | "\n", 358 | "def uncurried = uncurry(curried) // `curried` defined above\n", 359 | "println(s\"Mark introduces as: ${uncurried(\"Mark\", 15)}\")" 360 | ] 361 | }, 362 | { 363 | "cell_type": "markdown", 364 | "metadata": {}, 365 | "source": [ 366 | "### Exercise 2.5\n", 367 | "Implement `compose`:\n", 368 | "```scala\n", 369 | " def compose[A,B,C](f: B => C, g: A => B): A => C\n", 370 | "```" 371 | ] 372 | }, 373 | { 374 | "cell_type": "code", 375 | "execution_count": 9, 376 | "metadata": {}, 377 | "outputs": [ 378 | { 379 | "data": { 380 | "text/plain": [ 381 | "defined \u001b[32mfunction\u001b[39m \u001b[36mcompose\u001b[39m" 382 | ] 383 | }, 384 | "execution_count": 9, 385 | "metadata": {}, 386 | "output_type": "execute_result" 387 | } 388 | ], 389 | "source": [ 390 | "def compose[A,B,C](f: B => C, g: A => B): A => C = {\n", 391 | " (a: A) => f(g(a))\n", 392 | "}" 393 | ] 394 | } 395 | ], 396 | "metadata": { 397 | "kernelspec": { 398 | "display_name": "Scala", 399 | "language": "scala", 400 | "name": "scala" 401 | }, 402 | "language_info": { 403 | "codemirror_mode": "text/x-scala", 404 | "file_extension": ".scala", 405 | "mimetype": "text/x-scala", 406 | "name": "scala211", 407 | "nbconvert_exporter": "script", 408 | "pygments_lexer": "scala", 409 | "version": "2.11.8" 410 | } 411 | }, 412 | "nbformat": 4, 413 | "nbformat_minor": 2 414 | } 415 | -------------------------------------------------------------------------------- /fp-in-scala/README.md: -------------------------------------------------------------------------------- 1 | # Functional programming in Scala 2 | [Jupyter-scala](https://github.com/jupyter-scala/jupyter-scala) notebooks based on [Functional programming in Scala](https://www.manning.com/books/functional-programming-in-scala) by P. Chiusano and R. Bjarnason (Manning, 2014). -------------------------------------------------------------------------------- /fp-ts/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ 2 | -------------------------------------------------------------------------------- /fp-ts/.prettierrc.yaml: -------------------------------------------------------------------------------- 1 | printWidth: 80 2 | tabWidth: 2 3 | useTabs: false 4 | semi: true 5 | singleQuote: false 6 | jsxSingleQuote: false 7 | trailingComma: "es5" 8 | bracketSpacing: true 9 | arrowParens: "avoid" 10 | endOfLine: "auto" 11 | -------------------------------------------------------------------------------- /fp-ts/README.md: -------------------------------------------------------------------------------- 1 | # Examples of using [fp-ts](https://gcanti.github.io/fp-ts/) 2 | -------------------------------------------------------------------------------- /fp-ts/custom-typeclasses-2.test.ts: -------------------------------------------------------------------------------- 1 | // For higher-order type constructors, there are `URItoKind2`, `URIS2`, and `Kind2`: 2 | 3 | // export declare type URIS2 = keyof URItoKind2; 4 | // export declare type Kind2 = URI extends URIS2 ? URItoKind2[URI] : any; 5 | 6 | import { Functor2 } from "fp-ts/lib/Functor"; 7 | 8 | export const URI = "Either"; 9 | export type URI = typeof URI; 10 | 11 | declare module "fp-ts/lib/HKT" { 12 | interface URItoKind2 { 13 | Either: Either; 14 | } 15 | } 16 | 17 | export interface Left { 18 | readonly _tag: "Left"; 19 | readonly left: E; 20 | } 21 | 22 | export interface Right { 23 | readonly _tag: "Right"; 24 | readonly right: A; 25 | } 26 | 27 | export type Either = Left | Right; 28 | 29 | const right = (a: A): Right => ({ 30 | _tag: "Right", 31 | right: a, 32 | }); 33 | 34 | const left = (e: E): Left => ({ 35 | _tag: "Left", 36 | left: e, 37 | }); 38 | 39 | export const eitherF: Functor2 = { 40 | URI, 41 | map: (ma, f) => (ma._tag === "Left" ? ma : right(f(ma.right))), 42 | }; 43 | 44 | describe("Functor2 for Either", () => { 45 | it("should work for right", () => { 46 | const val: Either = right(1); 47 | const val2 = eitherF.map(val, (val: number) => val + 1); 48 | expect(val2).toEqual(right(2)); 49 | }); 50 | it("should work for left", () => { 51 | const val: Either = left(Error("text")); 52 | const val2 = eitherF.map(val, (val: number) => val + 1); 53 | expect(val2).toEqual(val); 54 | }); 55 | }); 56 | -------------------------------------------------------------------------------- /fp-ts/custom-typeclasses.test.ts: -------------------------------------------------------------------------------- 1 | // Creating custom typeclass 2 | // https://gcanti.github.io/fp-ts/recipes/HKT.html 3 | 4 | export type Identity = A; 5 | 6 | import { Functor1 } from "fp-ts/lib/Functor"; 7 | export const URI = "Identity"; 8 | 9 | export type URI = typeof URI; 10 | 11 | // URItoKind is type-level map, it maps a URI to a concrete data type, and is populated using the module augmentation feature 12 | declare module "fp-ts/lib/HKT" { 13 | interface URItoKind { 14 | Identity: Identity; 15 | } 16 | } 17 | 18 | // URIS in the definition of Functor1 is used as a constraint (keyof URItoKind) in the Functor1 interface: 19 | /** 20 | export declare type URIS = keyof URItoKind; 21 | export interface Functor1 { 22 | readonly URI: F; 23 | readonly map: (fa: Kind, f: (a: A) => B) => Kind; 24 | } 25 | */ 26 | 27 | // `Kind` is defined as follows: 28 | // export declare type Kind = URI extends URIS ? URItoKind[URI] : any; 29 | // It is able to project an abstract data type to a concrete data type. 30 | // If URI = 'Identity', then `Kind` is `Identity`. 31 | 32 | // Here's how a Functor1 instance is then defined for `Identity`: 33 | export const identityF: Functor1 = { 34 | URI, 35 | map: (ma, f) => f(ma), 36 | }; 37 | 38 | describe("Functor instance for identity", () => { 39 | it("should map with function", () => { 40 | const a: Identity = 1; 41 | expect(identityF.map(a, val => val + 1)).toEqual(2); 42 | }); 43 | }); 44 | 45 | // For higher-order kinds, see `custom-typeclasses-2.test.ts`. 46 | -------------------------------------------------------------------------------- /fp-ts/either-validation.ts: -------------------------------------------------------------------------------- 1 | // Handling validation with multiple errors, copied from 2 | // https://dev.to/gcanti/getting-started-with-fp-ts-either-vs-validation-5eja 3 | // Comments added by me. 4 | import { sequenceT } from "fp-ts/lib/Apply"; 5 | import { 6 | Either, 7 | getValidation, 8 | left, 9 | map, 10 | mapLeft, 11 | right, 12 | } from "fp-ts/lib/Either"; 13 | import { getSemigroup, NonEmptyArray } from "fp-ts/lib/NonEmptyArray"; 14 | import { pipe } from "fp-ts/lib/pipeable"; 15 | import expect from "expect"; 16 | 17 | // A "check" function checking length 18 | const minLength = (s: string): Either => 19 | s.length >= 6 ? right(s) : left("at least 6 characters"); 20 | 21 | const oneCapital = (s: string): Either => 22 | /[A-Z]/g.test(s) ? right(s) : left("at least one capital letter"); 23 | 24 | const oneNumber = (s: string): Either => 25 | /[0-9]/g.test(s) ? right(s) : left("at least one number"); 26 | 27 | /** 28 | * Lift a check function returning an either to a check function returning an either of an array 29 | * @param check Check function returning an `Either` from a value 30 | */ 31 | function lift( 32 | check: (a: A) => Either 33 | ): (a: A) => Either, A> { 34 | return a => 35 | pipe( 36 | check(a), 37 | mapLeft(a => [a]) 38 | ); 39 | } 40 | 41 | /** 42 | * A semigroup for concatenating arrays of strings with the `.concat` property 43 | */ 44 | const StringSemiGroup = getSemigroup(); 45 | 46 | expect(StringSemiGroup.concat(["a"], ["b"])).toEqual(["a", "b"]); 47 | 48 | const ApplicativeValidation = getValidation(StringSemiGroup); 49 | 50 | // Validation has `map` to map the `right` value 51 | const exampleOfMap: Either< 52 | NonEmptyArray, 53 | { verified: boolean } 54 | > = ApplicativeValidation.map(lift(minLength)("asdfasdf"), _ => ({ 55 | verified: true, 56 | })); 57 | 58 | console.log("Result of mapping:", exampleOfMap); 59 | 60 | const exampleOfChaining: Either< 61 | NonEmptyArray, 62 | string 63 | > = ApplicativeValidation.chain(lift(minLength)("st"), lift(oneCapital)); 64 | 65 | console.log("Result of chaining checks:", exampleOfChaining); 66 | 67 | const fullCheck = ( 68 | s: string 69 | ): Either, [string, string, string]> => 70 | sequenceT(ApplicativeValidation)( 71 | lift(minLength)(s), 72 | lift(oneCapital)(s), 73 | lift(oneNumber)(s) 74 | ); 75 | 76 | console.log("Result of full check:", fullCheck("st")); 77 | console.log("Result of full check for valid string:", fullCheck("ASDFasdf2")); 78 | 79 | function validatePassword(s: string): Either, string> { 80 | return pipe( 81 | sequenceT(ApplicativeValidation)( 82 | lift(minLength)(s), 83 | lift(oneCapital)(s), 84 | lift(oneNumber)(s) 85 | ), 86 | map(() => s) 87 | ); 88 | } 89 | 90 | console.log(validatePassword("ab")); 91 | -------------------------------------------------------------------------------- /fp-ts/eq.test.ts: -------------------------------------------------------------------------------- 1 | import { contramap, Eq, getStructEq } from "fp-ts/lib/Eq"; 2 | 3 | // https://dev.to/gcanti/getting-started-with-fp-ts-setoid-39f3 4 | // # Type classes in fp-ts 5 | // In fp-ts, type classes are encoded as TypeScript interfaces 6 | 7 | // Type class `Eq` is defined as follows: 8 | interface Eq1 { 9 | // Name as Eq1 to avoid collisions with `fp-ts/lib/Eq` 10 | readonly equals: (x: A, y: A) => boolean; 11 | } 12 | 13 | // Read as: "a type A belongs to type class Eq if there is a function named `equal` of the appropriate type defined on it". 14 | 15 | // Instances of a type class Eq for type A can be made by declaring an instance that defines implementations 16 | // of all of Eq's members for A. 17 | 18 | // Example: 19 | const eqNumber: Eq1 = { 20 | equals: (x, y) => x === y, 21 | }; 22 | 23 | /** 24 | * For typeclass Eq, we expect instances to satisfy 25 | * 1. Reflexivity 26 | * 2. Symmetry 27 | * 3. Transitivity 28 | */ 29 | 30 | // A function of `elem` could then be defined for members of typeclass Eq as follows: 31 | const elem = (E: Eq1): ((a: A, as: Array) => boolean) => { 32 | return (a, as) => as.some(item => E.equals(item, a)); 33 | }; 34 | 35 | // For structs, one can derive an instance of `Eq` using `getStructEq` from `fp-ts/lib/Eq`: 36 | type Point = { 37 | x: number; 38 | y: number; 39 | }; 40 | 41 | const eqPoint: Eq = getStructEq({ 42 | x: eqNumber, 43 | y: eqNumber, 44 | }); 45 | 46 | // Going further: 47 | 48 | type Vector = { 49 | from: Point; 50 | to: Point; 51 | }; 52 | 53 | const eqVector: Eq = getStructEq({ 54 | from: eqPoint, 55 | to: eqPoint, 56 | }); 57 | 58 | // Finally, one can use `contramap` to derive an instance of `Eq` for `B` given 59 | // an instance of `Eq` for `A` and a function from `B` to `A`: 60 | 61 | type User = { 62 | userId: number; 63 | name: string; 64 | }; 65 | 66 | // Two users are equal if their `userId` fields are equal 67 | const eqUser: Eq = contramap((user: User) => user.userId)(eqNumber); 68 | 69 | it("should recognize two users as equal", () => { 70 | const user1 = { userId: 23, name: "K" }; 71 | const user2 = { userId: 23, name: "M" }; 72 | expect(eqUser.equals(user1, user2)).toBe(true); 73 | }); 74 | -------------------------------------------------------------------------------- /fp-ts/index.ts: -------------------------------------------------------------------------------- 1 | import "./either-validation"; 2 | -------------------------------------------------------------------------------- /fp-ts/io.test.ts: -------------------------------------------------------------------------------- 1 | import { IO, io, map } from "fp-ts/lib/IO"; 2 | import { array } from "fp-ts/lib/Array"; 3 | // import { sequence_ } from "fp-ts/lib/Foldable"; 4 | import { log } from "fp-ts/lib/Console"; 5 | import { pipe } from "fp-ts/lib/pipeable"; 6 | 7 | import { sequenceS } from "fp-ts/lib/Apply"; 8 | 9 | interface Result { 10 | name: string; 11 | age: number; 12 | } 13 | 14 | // returns { name: 'Aristotle', age: 60 } 15 | 16 | it("Works with IO", () => { 17 | const logGiraffe: IO = log("giraffe"); 18 | const logZebra: IO = log("zebra"); 19 | 20 | const logGiraffeThenZebra: IO = array.sequence(io)([ 21 | logGiraffe, 22 | logZebra, 23 | ]); 24 | 25 | const ioAction = pipe( 26 | logGiraffeThenZebra, 27 | map(() => "Finished") 28 | ); 29 | 30 | const returnResult = ioAction(); 31 | 32 | expect(returnResult).toBe("Finished"); 33 | }); 34 | 35 | it("works with sequenceS", () => { 36 | const computations: { [K in keyof Result]: IO } = { 37 | name: io.of("Aristotle"), 38 | age: io.of(60), 39 | }; 40 | 41 | const computation: IO = sequenceS(io)(computations); 42 | 43 | console.log(computation()); 44 | }); 45 | -------------------------------------------------------------------------------- /fp-ts/jest.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | preset: 'ts-jest', 3 | testEnvironment: 'node', 4 | }; -------------------------------------------------------------------------------- /fp-ts/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "fp-ts", 3 | "version": "1.0.0", 4 | "description": "Examples of using fp-ts", 5 | "main": "index.js", 6 | "author": "Kimmo Sääskilahti", 7 | "license": "MIT", 8 | "private": false, 9 | "scripts": { 10 | "start": "ts-node index.ts", 11 | "test": "jest" 12 | }, 13 | "dependencies": { 14 | "@types/jest": "^24.0.17", 15 | "axios": "^0.19.0", 16 | "chalk": "^2.4.2", 17 | "fast-check": "^1.17.0", 18 | "fp-ts": "^2.0.3", 19 | "jest": "^24.8.0", 20 | "ts-jest": "^24.0.2", 21 | "ts-node": "^8.3.0", 22 | "typescript": "^3.5.3" 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /fp-ts/property-based-testing.test.ts: -------------------------------------------------------------------------------- 1 | // https://dev.to/gcanti/introduction-to-property-based-testing-17nk 2 | import * as fc from "fast-check"; 3 | import { Semigroup } from "fp-ts/lib/Semigroup"; 4 | 5 | // Semigroup that's not a monoid because of missing "empty" 6 | const S: Semigroup = { 7 | concat: (x, y) => x + " " + y, 8 | }; 9 | 10 | // Expected law 11 | const associativity = (x: string, y: string, z: string) => 12 | S.concat(S.concat(x, y), z) === S.concat(x, S.concat(y, z)); 13 | 14 | // An Arbitrary generates random values of type A: 15 | const stringArb: fc.Arbitrary = fc.string(); 16 | 17 | describe("Semigroup instance", () => { 18 | it("should satisfy associativity", () => { 19 | fc.assert(fc.property(stringArb, stringArb, stringArb, associativity)); 20 | }); 21 | }); 22 | -------------------------------------------------------------------------------- /fp-ts/semigroup.test.ts: -------------------------------------------------------------------------------- 1 | // https://dev.to/gcanti/getting-started-with-fp-ts-semigroup-2mf7 2 | import { semigroupSum, Semigroup } from "fp-ts/lib/Semigroup"; 3 | import { getApplySemigroup, Option, some, none } from "fp-ts/lib/Option"; 4 | 5 | // # Semigroups 6 | 7 | // A semigroup is a pair (A, *) in which A is a non-empty set and * is a binary 8 | // associative operation on A: 9 | // *: (x: A, y: A) => A 10 | // with associativity law 11 | // (x * y) * z = x * (y * z) 12 | 13 | // Type class for Semigroup is defined as follows: 14 | interface Semigroup1 { 15 | concat: (x: A, y: A) => A; 16 | } 17 | 18 | // `concat` operation can mean concatenation, merging, fusion, selection, addition, substitution, etc. 19 | 20 | // Example instance for type `number` with `product` operation: 21 | const semigroupProduct: Semigroup1 = { 22 | concat: (x, y) => x * y, 23 | }; 24 | 25 | // The same with addition: 26 | const semigroupAddition: Semigroup1 = { 27 | concat: (x, y) => x + y, 28 | }; 29 | 30 | // And strings 31 | const semigroupString: Semigroup1 = { 32 | concat: (x, y) => x + y, 33 | }; 34 | 35 | // These trivial semigroups always exist for any type: 36 | const getFirstSemigroup = (): Semigroup1 => { 37 | return { concat: (x, y) => x }; 38 | }; 39 | 40 | const getLastSemigroup = (): Semigroup1 => { 41 | return { concat: (x, y) => y }; 42 | }; 43 | 44 | // The free semigroup for A is a semigroup instance for (NonEmpty) Array under array concatenation: 45 | const getArraySemigroup = (): Semigroup1> => { 46 | return { concat: (x, y) => x.concat(y) }; 47 | }; 48 | 49 | // Semigroups for type constructors 50 | // To merge some(a) with some(b), we need something to merge a and b. That's what semigroups do! 51 | 52 | const S: Semigroup> = getApplySemigroup(semigroupSum); 53 | 54 | it("concatenates options", () => { 55 | expect(S.concat(some(1), some(2))).toEqual(some(3)); 56 | expect(S.concat(some(1), none)).toEqual(none); 57 | }); 58 | -------------------------------------------------------------------------------- /fp-ts/taskeither.test.ts: -------------------------------------------------------------------------------- 1 | import { 2 | TaskEither, 3 | tryCatch, 4 | chain, 5 | map, 6 | fromEither, 7 | } from "fp-ts/lib/TaskEither"; 8 | import { 9 | either, 10 | Either, 11 | fold, 12 | isLeft, 13 | isRight, 14 | getOrElse, 15 | tryCatch as eitherTryCatch, 16 | } from "fp-ts/lib/either"; 17 | import { pipe } from "fp-ts/lib/pipeable"; 18 | import { Lazy } from "fp-ts/lib/function"; 19 | import axios from "axios"; 20 | import chalk from "chalk"; 21 | 22 | const ICNDB_HOST = "http://api.icndb.com"; 23 | 24 | const colorJoke = chalk.bold.magentaBright; 25 | const url = `${ICNDB_HOST}/jokes/random`; 26 | 27 | /** 28 | * Fetch response body from URL. 29 | * @param url Target URL 30 | */ 31 | const fetch = async (url: string) => { 32 | return (await axios(url)).data; 33 | }; 34 | 35 | const parseResponseBody = (responseBody: any): string => 36 | responseBody.value.joke; 37 | 38 | const chuckClient = async (): Promise => { 39 | const response = await fetch(url); 40 | const joke = parseResponseBody(response); 41 | return joke; 42 | }; 43 | 44 | type ResponseBody = any; 45 | 46 | const fetchJokeTask = (url: string): TaskEither => 47 | tryCatch( 48 | () => fetch(url), 49 | (e: unknown) => new Error(`Failed fetching from ${url}`) 50 | ); 51 | 52 | const asTaskEither = ( 53 | f: Lazy, 54 | failureMessage?: string 55 | ): TaskEither => fromEither(asEither(f, failureMessage)); 56 | 57 | const asEither = (f: Lazy, failureMessage?: string) => 58 | eitherTryCatch(f, (e: unknown) => 59 | Error(failureMessage || `Operation failed: ${JSON.stringify(e)}`) 60 | ); 61 | 62 | const parseResponseBodyAsTaskEither = ( 63 | responseBody: any 64 | ): TaskEither => 65 | asTaskEither( 66 | () => parseResponseBody(responseBody), 67 | `Failed parsing joke from response: ${JSON.stringify(responseBody)}` 68 | ); 69 | 70 | const chainWithEither: ( 71 | f: (fa: A) => Either 72 | ) => (te: TaskEither) => TaskEither = ( 73 | f: (fa: A) => Either 74 | ) => { 75 | return (te: TaskEither) => chain((a: A) => fromEither(f(a)))(te); 76 | }; 77 | 78 | // Problem: chaining a `TaskEither` with `string => Either` 79 | // (without casting everything with `asTaskEither`) is possible how? 80 | const fpChuckClient = (url: string): TaskEither => 81 | pipe( 82 | url, 83 | fetchJokeTask, 84 | chainWithEither(responseBody => 85 | asEither(() => parseResponseBody(responseBody)) 86 | ) 87 | ); 88 | 89 | /** 90 | * Get the right value or throw. 91 | * @param ma Instance of either 92 | */ 93 | const get = (ma: Either): B => { 94 | return fold( 95 | e => { 96 | throw e; 97 | }, 98 | (val: B) => val 99 | )(ma); 100 | }; 101 | 102 | describe("Getting a random joke", () => { 103 | it("works imperatively", async () => { 104 | const joke = await chuckClient(); 105 | console.log(`Your daily Chuck joke: ${colorJoke(joke)}`); 106 | expect(joke.length).toBeGreaterThan(0); 107 | }); 108 | it("works with FP", async () => { 109 | const jokeTask: TaskEither = fpChuckClient(url); 110 | const resolvedJoke: Either = await jokeTask(); 111 | const joke = get(resolvedJoke); 112 | console.log(`Your daily Chuck joke: ${colorJoke(joke)}`); 113 | expect(joke.length).toBeGreaterThan(0); 114 | }); 115 | }); 116 | -------------------------------------------------------------------------------- /fp-ts/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | /* Basic Options */ 4 | // "incremental": true, /* Enable incremental compilation */ 5 | "target": "esnext" /* Specify ECMAScript target version: 'ES3' (default), 'ES5', 'ES2015', 'ES2016', 'ES2017', 'ES2018', 'ES2019' or 'ESNEXT'. */, 6 | "module": "commonjs" /* Specify module code generation: 'none', 'commonjs', 'amd', 'system', 'umd', 'es2015', or 'ESNext'. */, 7 | // "lib": [], /* Specify library files to be included in the compilation. */ 8 | // "allowJs": true, /* Allow javascript files to be compiled. */ 9 | // "checkJs": true, /* Report errors in .js files. */ 10 | // "jsx": "preserve", /* Specify JSX code generation: 'preserve', 'react-native', or 'react'. */ 11 | // "declaration": true, /* Generates corresponding '.d.ts' file. */ 12 | // "declarationMap": true, /* Generates a sourcemap for each corresponding '.d.ts' file. */ 13 | // "sourceMap": true, /* Generates corresponding '.map' file. */ 14 | // "outFile": "./", /* Concatenate and emit output to single file. */ 15 | // "outDir": "./", /* Redirect output structure to the directory. */ 16 | // "rootDir": "./", /* Specify the root directory of input files. Use to control the output directory structure with --outDir. */ 17 | // "composite": true, /* Enable project compilation */ 18 | // "tsBuildInfoFile": "./", /* Specify file to store incremental compilation information */ 19 | // "removeComments": true, /* Do not emit comments to output. */ 20 | // "noEmit": true, /* Do not emit outputs. */ 21 | // "importHelpers": true, /* Import emit helpers from 'tslib'. */ 22 | // "downlevelIteration": true, /* Provide full support for iterables in 'for-of', spread, and destructuring when targeting 'ES5' or 'ES3'. */ 23 | // "isolatedModules": true, /* Transpile each file as a separate module (similar to 'ts.transpileModule'). */ 24 | 25 | /* Strict Type-Checking Options */ 26 | "strict": true /* Enable all strict type-checking options. */, 27 | // "noImplicitAny": true, /* Raise error on expressions and declarations with an implied 'any' type. */ 28 | // "strictNullChecks": true, /* Enable strict null checks. */ 29 | // "strictFunctionTypes": true, /* Enable strict checking of function types. */ 30 | // "strictBindCallApply": true, /* Enable strict 'bind', 'call', and 'apply' methods on functions. */ 31 | // "strictPropertyInitialization": true, /* Enable strict checking of property initialization in classes. */ 32 | // "noImplicitThis": true, /* Raise error on 'this' expressions with an implied 'any' type. */ 33 | // "alwaysStrict": true, /* Parse in strict mode and emit "use strict" for each source file. */ 34 | 35 | /* Additional Checks */ 36 | // "noUnusedLocals": true, /* Report errors on unused locals. */ 37 | // "noUnusedParameters": true, /* Report errors on unused parameters. */ 38 | // "noImplicitReturns": true, /* Report error when not all code paths in function return a value. */ 39 | // "noFallthroughCasesInSwitch": true, /* Report errors for fallthrough cases in switch statement. */ 40 | 41 | /* Module Resolution Options */ 42 | "moduleResolution": "node" /* Specify module resolution strategy: 'node' (Node.js) or 'classic' (TypeScript pre-1.6). */, 43 | // "baseUrl": "./", /* Base directory to resolve non-absolute module names. */ 44 | // "paths": {}, /* A series of entries which re-map imports to lookup locations relative to the 'baseUrl'. */ 45 | // "rootDirs": [], /* List of root folders whose combined content represents the structure of the project at runtime. */ 46 | // "typeRoots": [], /* List of folders to include type definitions from. */ 47 | // "types": [], /* Type declaration files to be included in compilation. */ 48 | // "allowSyntheticDefaultImports": true, /* Allow default imports from modules with no default export. This does not affect code emit, just typechecking. */ 49 | "esModuleInterop": true /* Enables emit interoperability between CommonJS and ES Modules via creation of namespace objects for all imports. Implies 'allowSyntheticDefaultImports'. */ 50 | // "preserveSymlinks": true, /* Do not resolve the real path of symlinks. */ 51 | // "allowUmdGlobalAccess": true, /* Allow accessing UMD globals from modules. */ 52 | 53 | /* Source Map Options */ 54 | // "sourceRoot": "", /* Specify the location where debugger should locate TypeScript files instead of source locations. */ 55 | // "mapRoot": "", /* Specify the location where debugger should locate map files instead of generated locations. */ 56 | // "inlineSourceMap": true, /* Emit a single file with source maps instead of having a separate file. */ 57 | // "inlineSources": true, /* Emit the source alongside the sourcemaps within a single file; requires '--inlineSourceMap' or '--sourceMap' to be set. */ 58 | 59 | /* Experimental Options */ 60 | // "experimentalDecorators": true, /* Enables experimental support for ES7 decorators. */ 61 | // "emitDecoratorMetadata": true, /* Enables experimental support for emitting type metadata for decorators. */ 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /learn-you-a-haskell/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | hello-haskell.cabal 3 | *~ -------------------------------------------------------------------------------- /learn-you-a-haskell/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for hello-haskell 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /learn-you-a-haskell/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2019 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /learn-you-a-haskell/README.md: -------------------------------------------------------------------------------- 1 | # Hello Haskell 2 | 3 | Code examples from the awesome [Learn You a Haskell](http://learnyouahaskell.com) book. 4 | 5 | - [Chapter 2: Starting out](src/StartingOut.hs) 6 | - [Chapter 3: Types and Typeclasses](./src/TypesAndTypeClasses.hs) 7 | - [Chapter 4: Syntax in Functions](./src/SyntaxInFunctions.hs) 8 | - [Chapter 5: Recursion](./src/Recursion.hs) 9 | - [Chapter 6: Higher order functions](./src/HigherOrderFunctions.hs) 10 | - [Chapter 7: Modules](./src/Modules.hs) 11 | - [Chapter 8: Making our own types and typeclasses](./src/MakingOurOwnTypesAndTypeclasses.hs) 12 | - [Chapter 9: Input and Output](./src/InputAndOutput.hs) 13 | - [Chapter 10: Functionally Solving Problems](./src/FunctionallySolvingProblems.hs) 14 | - [Chapter 11: Functors, Applicative Functors, and Monoids](./src/Functors.hs) 15 | 16 | ## Project setup 17 | 18 | Project was created using [stack](https://docs.haskellstack.org/en/stable/README/): 19 | 20 | ```bash 21 | stack new hello-haskell new-template 22 | ``` 23 | 24 | ### Build 25 | 26 | ```bash 27 | stack build 28 | ``` 29 | 30 | ### Executables 31 | 32 | #### Main app 33 | 34 | Run [app/Main.hs](./app/Main.hs): 35 | 36 | ```bash 37 | stack run 38 | ``` 39 | 40 | or 41 | 42 | ```bash 43 | runhaskell app/Main.hs 44 | ``` 45 | 46 | #### TODO app 47 | 48 | Run the [Todo app](./todo-app/Main.hs) from [Chapter 9](http://learnyouahaskell.com/input-and-output): 49 | 50 | ```bash 51 | stack run todo [command] [filename] 52 | ``` 53 | 54 | For example, this writes to file `todo.txt`: 55 | 56 | ```bash 57 | stack run todo add todo.txt "Do the laundry." 58 | ``` 59 | 60 | Alternatively, use `runhaskell`: 61 | 62 | ```bash 63 | runhaskell todo-app/Main.hs add todo.txt "Do the laundry." 64 | ``` 65 | 66 | ### Interactive mode 67 | 68 | ```bash 69 | stack ghci 70 | ``` 71 | 72 | Load a module in `ghci`: 73 | 74 | ``` 75 | Prelude> :l StartingOut 76 | ``` 77 | 78 | Reload module: 79 | 80 | ``` 81 | StartingOut> :r 82 | ``` 83 | 84 | ### Execute 85 | 86 | ```bash 87 | stack exec hello-haskell-exe 88 | ``` 89 | 90 | ### Run tests 91 | 92 | ```bash 93 | stack test 94 | ``` 95 | -------------------------------------------------------------------------------- /learn-you-a-haskell/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /learn-you-a-haskell/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Char 4 | import Control.Monad 5 | 6 | main :: IO () 7 | 8 | main = do 9 | sayHello 10 | reverser 11 | 12 | sayHello = do 13 | putStrLn "What's your first name?" 14 | firstName <- getLine 15 | putStrLn "What's your last name?" 16 | lastName <- getLine 17 | let bigFirstName = map toUpper firstName 18 | bigLastName = map toUpper lastName 19 | putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?" 20 | 21 | reverser = do 22 | putStrLn "Write words to reverse, empty to move on." 23 | line <- getLine 24 | if null line 25 | then return () 26 | else do 27 | putStrLn $ reverseWords line 28 | reverser 29 | 30 | reverseWords :: String -> String 31 | reverseWords = unwords . map reverse . words 32 | 33 | useMapM = do 34 | as <- mapM print [1, 2, 3] 35 | mapM_ print [4, 5, 6] 36 | -------------------------------------------------------------------------------- /learn-you-a-haskell/learn-you-a-haskell.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.31.2. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | -- 7 | -- hash: 2fd499b13ed43337759ff3946eeec1f48c304b9faf2155652a0359765fc5abf7 8 | 9 | name: learn-you-a-haskell 10 | version: 0.1.0.0 11 | description: Please see the README on GitHub at 12 | homepage: https://github.com/ksaaskil/functional-programming-examples#readme 13 | bug-reports: https://github.com/ksaaskil/functional-programming-examples/issues 14 | author: ksaaskil 15 | maintainer: ksaaskil 16 | license: BSD3 17 | license-file: LICENSE 18 | build-type: Simple 19 | extra-source-files: 20 | README.md 21 | ChangeLog.md 22 | 23 | source-repository head 24 | type: git 25 | location: https://github.com/ksaaskil/functional-programming-examples 26 | 27 | library 28 | exposed-modules: 29 | FunctionallySolvingProblems 30 | Functors 31 | Geometry.Cube 32 | Geometry.Cuboid 33 | Geometry.Sphere 34 | GeometryModule 35 | HigherOrderFunctions 36 | InputAndOutput 37 | LensTutorial 38 | Lib 39 | MakingOurOwnTypesAndTypeclasses 40 | Modules 41 | Recursion 42 | StartingOut 43 | SyntaxInFunctions 44 | TreeADT 45 | TypesAndTypeClasses 46 | other-modules: 47 | Paths_learn_you_a_haskell 48 | hs-source-dirs: 49 | src 50 | build-depends: 51 | acme-missiles 52 | , base >=4.7 && <5 53 | , containers 54 | , filepath 55 | , lens 56 | , lens-tutorial 57 | , random 58 | , text 59 | default-language: Haskell2010 60 | 61 | executable main-exe 62 | main-is: Main.hs 63 | other-modules: 64 | Paths_learn_you_a_haskell 65 | hs-source-dirs: 66 | app 67 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 68 | build-depends: 69 | acme-missiles 70 | , base >=4.7 && <5 71 | , containers 72 | , filepath 73 | , learn-you-a-haskell 74 | , lens 75 | , lens-tutorial 76 | , random 77 | , text 78 | default-language: Haskell2010 79 | 80 | executable todo 81 | main-is: Main.hs 82 | other-modules: 83 | Paths_learn_you_a_haskell 84 | hs-source-dirs: 85 | todo-app 86 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 87 | build-depends: 88 | acme-missiles 89 | , base >=4.7 && <5 90 | , containers 91 | , directory 92 | , filepath 93 | , learn-you-a-haskell 94 | , lens 95 | , lens-tutorial 96 | , random 97 | , text 98 | default-language: Haskell2010 99 | 100 | test-suite learn-you-a-haskell-test 101 | type: exitcode-stdio-1.0 102 | main-is: Spec.hs 103 | other-modules: 104 | OptimalPath 105 | RPN 106 | Paths_learn_you_a_haskell 107 | hs-source-dirs: 108 | test 109 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 110 | build-depends: 111 | HUnit 112 | , acme-missiles 113 | , base >=4.7 && <5 114 | , containers 115 | , filepath 116 | , learn-you-a-haskell 117 | , lens 118 | , lens-tutorial 119 | , random 120 | , text 121 | default-language: Haskell2010 122 | -------------------------------------------------------------------------------- /learn-you-a-haskell/learning-fp.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Why I love learning functional programming 3 | published: false 4 | description: Yet another blog post on why learning functional programming is fun and useful 5 | tags: functional,programming,haskell 6 | series: Learning functional programming 7 | --- 8 | 9 | This is the first part of the series on learning functional programming (FP). Inspired by [100 days of FP](https://dev.to/gillchristian/day-12-lambda-calculus-29hg), I'm also writing this series as my personal notes of my progress in learning FP. I do not claim to be an expert in FP, so if you think anything I write is inaccurate or plain wrong, please let me know in the comments! 10 | 11 | In this first part, I'd like to share why I spend time on learning functional programming in the first place. Don't take me as a functional programming advocate or expert: at work, I mostly write imperative code and I'm a noob in writing real-world software in FP. However, I still spend time learning functional programming. This is why. 12 | 13 | ### It brings math to programming 14 | 15 | The first reason I like functional programming is that to me, it brings math back to programming. At the university, I minored in match. I'll probably never have practical use to my courses in topology, differential geometry, measure theory or group theory, but I don't think any of those courses were waste of time. They all taught something about the power of abstraction, how to find and see the big concepts underlying seemingly unrelated problems. 16 | 17 | In functional programming, you encounter abstractions like functors and monads all the time. Functional programming has roots deep in category theory, a branch of mathematics studying objects and their relationships. Category theory tells us, for example, that [monad is just a monoid in the category of endofunctors](https://stackoverflow.com/questions/3870088/a-monad-is-just-a-monoid-in-the-category-of-endofunctors-whats-the-problem). What the heck do those words even mean? I have no idea, but I need to find out! 18 | 19 | I've been learning category theory from the wonderful [Category Theory for Programmers](https://bartoszmilewski.com/2014/10/28/category-theory-for-programmers-the-preface/) blog posts. They're are an easy and accessible way to access category theory. Maybe some day I'll be able to pick up a serious textbook on category theory! 20 | 21 | 22 | 23 | ### It forces you to think differently 24 | 25 | Putting aside playing with [Basic](https://en.wikipedia.org/wiki/BASIC) in the 90s, I first learned programming at the university in Java and C. In those languages, programs are written using constructs such as if-clauses and for-loops. Data is typically modified in-place with functions or method calls that return nothing. 26 | 27 | If-clauses, for-loops and in-place mutations are easy to understand, because that's how we intuitively process data. If I'm given a list of `N` skills that I need to learn unless I already know the skill, here's what to do: 28 | 29 | 0. Set `i=1` 30 | 1. Take the `i`th skill from the list 31 | 2. Check if you know the skill. If you don't, learn the skill. 32 | 3. If `i=N`, exit. Otherwise, set `i = i+1` and go to `1`. 33 | 34 | This is an imperative program, with one command after another that modify the program state. This is intuitive to us, because that's how we process data in everyday life. To us, world is made of mutable objects. That's how computers also work, one statement after another modifying the program state. 35 | 36 | Now, imagine you're told you need to write code for a program without a single if-clause or for-loop. You are also forbidden to mutate objects. What you're allowed to do is create new objects and write _pure_, _referentially transparent_ functions. Referential transparency means that a function call can be replaced by its return value without any change in the program. So for example, this function is not referentially transparent: 37 | 38 | ```python 39 | def square(x): 40 | print(f"Computing the square of {x}") 41 | return x*x 42 | ``` 43 | 44 | because you can't replace `square(x)` with `x*x` and expect the program to remain unchanged. 45 | 46 | It goes without saying that such constraints force you to think differently about writing code. To me, that's a very good thing. Recently I've been writing code mostly in Python and JavaScript. While I love both languages for their flexibility and simple syntax, and there's always something new to learn in both of them, I don't think they offer that many chances for learning new _concepts_. I write the same if-clauses and for-loops day after another, possibly in some new framework, but at the end of the day, the programs look the same. 47 | 48 | With functional programming, programs will inevitably look different. Are they better? That's an ill-posed question, as there's no best code for a particular task. But I do think it's useful to learn different ways of writing code. The more tools you have at your disposal, the more likely it is that you can pick the best one for the job when new problems emerge. 49 | 50 | Now, a fact is that my employer most likely wouldn't appreciate me spending the whole morning figuring out how to [make a HTTP call](https://dev.to/ksaaskil/using-fp-ts-for-http-requests-and-validation-131c) or spending the morning explaing my colleagues how data type `Maybe` replaces `if`. That's why learning FP is mostly a hobby to me at the moment. However, if I had colleagues at work as enthusiastic about FP as me, situation would get different. Everyone could support each other in learning how to solve problems in a functional way, knowledge would spread through the whole team in the form of peer reviews and code, and the cost of learning new concepts would be lower as those new concepts might improve everybody's code base. 51 | 52 | Finally, I'd like to note that functional programming doesn't mean you're not programming imperatively. Here's one excerpt of Scala code from the [Functional Programming in Scala](https://www.manning.com/books/functional-programming-in-scala) book ("red book"): 53 | 54 | ```scala 55 | val factorialREPL: IO[Unit] = sequence_( 56 | IO { println(helpstring) }, 57 | doWhile { IO { readline } } { line => 58 | when (line != "q") { 59 | for { 60 | n <- factorial(line.toInt) 61 | _ <- IO { println("factorial: " + n) } 62 | } 63 | } yield () 64 | } 65 | ) 66 | ``` 67 | 68 | That's a purely functional program written in imperative fashion. The for-loop is Scala's [syntactic sugar](https://docs.scala-lang.org/tutorials/FAQ/yield.html) for the composition of operations such as `map`, `filter` and `flatMap`. 69 | 70 | ### FP is a logical conclusion to many ideas considered good programming style 71 | 72 | My first touch to functional programming came from attending lectures in [functional programming](https://csd.cmu.edu/course-profiles/15-150-Principles-of-Functional-Programming) at CMU when I was a visiting researcher there. I attended maybe six lectures, where the lecturer wrote formal proofs that given recursive functions would terminate and have the correct result. It all seemed very theoretical to me and I thought I would not meet FP again. 73 | 74 | However, I was introduced to FP soon in my working career as more experienced programmers [told me](https://dev.to/ksaaskil/how-i-accidentally-learned-functional-programming-1g1m) to avoid writing code with implicit side effects and mutable state where possible. Of course, I didn't really understand at the time that such ideas were built-in to FP. 75 | 76 | As an example of how FP can help write clean code by avoiding implicit side effects, let's say you have a function 77 | 78 | ```ts 79 | const containsFinnishLapphund: (jpegBase64: String) => boolean = ... 80 | ``` 81 | 82 | that checks if an image contains a [Finnish lapphund](https://www.youtube.com/watch?v=X0ejoDOmM6Q). The signature says the function takes a base64 encoded string and returns a boolean. Based on the signature, I _expect this function to not have implicit side effects_ like modifying the input or writing to a database. Therefore, I can safely call the function for 100 images in parallel without worrying about race conditions, deadlocks, or anything else. 83 | 84 | The key here is the word _implicit_. In the context of my TypeScript codebase, I do not mind if the function prints to console: my code would most likely be interspersed with such logging statements anyway. However, I would be very surprised if calling the function incremented a database counter or stored the image to Google storage. Such surprises could lead to hard-to-find bugs, let alone they would make testing a pain. 85 | 86 | In non-functional languages, it's the developer's responsibility to write code that is not surprising. In Haskell, however, a type signature such as 87 | 88 | ```hs 89 | containsFinnishLapphund :: String -> Bool 90 | ``` 91 | 92 | would make it _impossible_ for the implementation to have observable side effects such as storing the image somewhere. If the function insisted on making a network call or logging to console, it would need a type signature 93 | 94 | ```hs 95 | containsFinnishLapphund :: String -> IO Bool 96 | ``` 97 | 98 | The `IO` typeclass here makes it explicit that the function is doing _something_ with the external world. What does it do? For that, you'll need to read the code or trust the function docstring saying it doesn't do anything other than print to console. But at least, it's not a surprise anymore. 99 | 100 | Another example of an "FP idea" considered good programming style nowadays is declarative style. For example, most programmers would nowadays agree that to remove even elements from an array and square the rest, this 101 | 102 | ```js 103 | const double = (arr) => arr.filter(v => v % 2 === 0).map(v => v*v); 104 | ``` 105 | 106 | is preferred to this: 107 | 108 | ```js 109 | const double = (arr) => { 110 | const newArr = []; 111 | for (const i = 0; i++; i < arr.length) { 112 | if (arr[i] % 2 === 0) { 113 | newArr.push(arr[i] * arr[i]); 114 | } 115 | } 116 | return newArr; 117 | } 118 | ``` 119 | 120 | In functional languages, the former would be the default. Again, this doesn't mean declarative style is better than imperative, but shows that declarative programming has its pros. In FP, the declarative style can be pushed to the limits with function composition operator `.` and point-free style: 121 | 122 | ```hs 123 | square :: Int -> Int 124 | square num = num * num 125 | 126 | isEven :: Int -> Bool 127 | isEven n = n `mod` 2 == 0 128 | 129 | double :: [Int] -> [Int] 130 | double = map square . filter isEven 131 | ``` 132 | 133 | I find this to be elegant and beautiful. It's true that imperative code can be easier to read and it takes time to get used to function composition and the point-free style, but I find it worth the effort. 134 | 135 | ### Conclusion 136 | 137 | That concludes the first part of the series. I love learning functional programming because it gives me reason to read math again, is forces me to think differently, and it pushes the boundaries of good programming style. Thanks for reading, please leave a comment if you have any! 138 | 139 | --- 140 | title: Why I love learning functional programming 141 | published: false 142 | description: Yet another blog post on why I think learning FP is fun and useful 143 | tags: functional,programming,haskell 144 | series: Learning functional programming 145 | --- 146 | 147 | ## Why Haskell? 148 | 149 | ### 1. Haskell is lingua franca 150 | 151 | ### 2. Haskell is purely functional 152 | 153 | ### 3. Haskell has a powerful type system 154 | 155 | 156 | 157 | --- 158 | title: What are kinds in functional programming? 159 | published: false 160 | description: Understanding proper types, type constructors, and higher kinded types 161 | tags: functional,programming,haskell 162 | series: Learning functional programming 163 | --- 164 | 165 | This is the first part of the series on learning functional programming (FP). Inspired by [100 days of FP](https://dev.to/gillchristian/day-12-lambda-calculus-29hg), I'm also writing this series as my personal notes of my progress in learning FP. I do not claim to be an expert in FP, so if you think anything I write is inaccurate or plain wrong, please let me know in the comments! 166 | 167 | In this first part, I'd like to speak about types. I'll use [Haskell](https://www.haskell.org/) in the code snippets below. While I've never used Haskell in my working career in software development (and probably won't), I think Haskell is the best language to learn functional programming concepts. Being a pure functional language, Haskell won't let you "cheat" by reverting to imperative programming. There are also wonderful resources for learning Haskell such as the [Learn You a Haskell](http://learnyouahaskell.com/introduction) book available for free. 168 | 169 | I'll use the [GHCi](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html), the interactive environment of the [GHC](https://www.haskell.org/ghc/) Haskell compiler to explore types. If you'd like to follow along, you can install Haskell with [Stack](https://docs.haskellstack.org/en/stable/README/) and enter 170 | 171 | ```bash 172 | $ stack ghci 173 | ``` 174 | 175 | to enter the `ghci` REPL. 176 | 177 | ## Types of values 178 | 179 | In programming, we typically deal with two kinds of objects: values and types. In Haskell interpreter, we can use `:t` to print types of values as follows: 180 | 181 | ``` 182 | ghci> :t True 183 | True :: Bool 184 | ``` 185 | 186 | Haskell says that the inferred type of `True` is `Bool`, a boolean. `Bool` is defined in the [`Prelude`](https://hackage.haskell.org/package/base-4.6.0.1/docs/Prelude.html) module imported by default. 187 | 188 | Tuples are defined by parentheses: 189 | 190 | ``` 191 | ghci> :t (True, False) 192 | (True, False) :: (Bool, Bool) 193 | ``` 194 | 195 | Function `fst` can be used to extract the first component from a pair (a tuple of two elements). In Haskell, function is invoked by putting the arguments after the function name, without parentheses: 196 | 197 | ``` 198 | ghci> myPair = (True, False) 199 | ghci> fst myPair 200 | True 201 | ``` 202 | 203 | What is the type of function `fst`? 204 | 205 | ``` 206 | ghci> :t fst 207 | fst :: (a, b) -> a 208 | ``` 209 | 210 | Here, `a` and `b` are so-called _type variables_. They represent any type, a bit like _generics_ in languages such as Java. 211 | 212 | As another example of function, consider `&&`, the `AND` operator familiar from most programming languages. When you write the following in Haskell, 213 | 214 | ``` 215 | ghci> True && False 216 | False 217 | ``` 218 | 219 | you're actually evaluating the function `(&&)` with two arguments, `True` and `False`. In Haskell, functions consisting of only special characters are considered _infix_ functions by default, meaning that the function should be sandwiched between its arguments. The parentheses are required for examining the type or calling it as a prefix function: 220 | 221 | ``` 222 | 223 | ghci> (&&) True False 224 | False 225 | ``` 226 | 227 | Parentheses are also required if calling the functions as a prefix ("normal") function: 228 | 229 | ``` 230 | ghci> :t (&&) 231 | (&&) :: Bool -> Bool -> Bool 232 | ``` 233 | 234 | ## Typeclasses 235 | 236 | What is the type of `2`? Let's see: 237 | 238 | ``` 239 | ghci> :t 2 240 | 2 :: Num p => p 241 | ``` 242 | 243 | What does this mean? Haskell says that the inferred type of `2` is `p`, where `p` is a so-called _type variable_. A type variable represents any type satisfying the _class constraints_ on the left side of `=>`. In this case, the class constraint is `Num p`, meaning that the type `p` belongs to the _typeclass_ `Num`. 244 | 245 | Here's another example: 246 | 247 | ``` 248 | ghci> :t [1, 2, 3] 249 | [1, 2, 3] :: Num a => [a] 250 | ``` 251 | 252 | Now, Haskell says that the inferred type of `[1, 2, 3]` is a list of type variable `a`, where `a` again has the type constrain that it belongs to the `Num`. 253 | 254 | ## Kind 255 | 256 | I'll cite following on the Wikipedia article on [kinds](https://en.wikipedia.org/wiki/Kind_%28type_theory%29): 257 | 258 | > In the area of mathematical logic and computer science known as type theory, a kind is the type of a type constructor or, less commonly, the type of a higher-order type operator. 259 | 260 | ```ghci 261 | ghci> :k [] 262 | [] :: * -> * 263 | ``` 264 | 265 | ``` 266 | ghci> :k Maybe 267 | Maybe :: * -> * 268 | ``` 269 | 270 | ```ghci 271 | ghci> :k Functor 272 | Functor :: (* -> *) -> Constraint 273 | ``` 274 | 275 | 276 | ## Resources 277 | 278 | - [What is a higher kinded type in Scala?](https://stackoverflow.com/questions/6246719/what-is-a-higher-kinded-type-in-scala) 279 | - [Generics of a Higher Kind](https://adriaanm.github.io/files/higher.pdf) 280 | - [Kind (type theory)](https://en.wikipedia.org/wiki/Kind_%28type_theory%29) 281 | - [Type Constructor Polymorphism](https://adriaanm.github.io/research/2010/10/06/new-in-scala-2.8-type-constructor-inference/) 282 | - [Learn You a Haskell](http://learnyouahaskell.com/) 283 | - [What exactly is the kind in Haskell](https://stackoverflow.com/questions/27095011/what-exactly-is-the-kind-in-haskell) -------------------------------------------------------------------------------- /learn-you-a-haskell/package.yaml: -------------------------------------------------------------------------------- 1 | name: learn-you-a-haskell 2 | version: 0.1.0.0 3 | github: "ksaaskil/functional-programming-examples" 4 | license: BSD3 5 | author: "ksaaskil" 6 | 7 | extra-source-files: 8 | - README.md 9 | - ChangeLog.md 10 | 11 | # Metadata used when publishing your package 12 | # synopsis: Short description of your package 13 | # category: Web 14 | 15 | # To avoid duplicated efforts in documentation and dealing with the 16 | # complications of embedding Haddock markup inside cabal files, it is 17 | # common to point users to the README.md file. 18 | description: Please see the README on GitHub at 19 | 20 | dependencies: 21 | - base >= 4.7 && < 5 22 | - text 23 | - filepath 24 | - containers 25 | - acme-missiles # added 26 | - random 27 | - lens 28 | - lens-tutorial 29 | 30 | library: 31 | source-dirs: src 32 | 33 | executables: 34 | main-exe: 35 | main: Main.hs 36 | source-dirs: app 37 | ghc-options: 38 | - -threaded 39 | - -rtsopts 40 | - -with-rtsopts=-N 41 | dependencies: 42 | - learn-you-a-haskell 43 | 44 | todo: 45 | main: Main.hs 46 | source-dirs: todo-app 47 | ghc-options: 48 | - -threaded 49 | - -rtsopts 50 | - -with-rtsopts=-N 51 | dependencies: 52 | - learn-you-a-haskell 53 | - directory 54 | 55 | tests: 56 | learn-you-a-haskell-test: 57 | main: Spec.hs 58 | source-dirs: test 59 | ghc-options: 60 | - -threaded 61 | - -rtsopts 62 | - -with-rtsopts=-N 63 | dependencies: 64 | - learn-you-a-haskell 65 | - HUnit 66 | -------------------------------------------------------------------------------- /learn-you-a-haskell/resources/girlfriend.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ksaaskil/functional-programming-examples/cbeb90f200d42e4a464dfb02fa5d7424bc12dd00/learn-you-a-haskell/resources/girlfriend.txt -------------------------------------------------------------------------------- /learn-you-a-haskell/src/FunctionallySolvingProblems.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 10: http://learnyouahaskell.com/functionally-solving-problems 2 | module FunctionallySolvingProblems where 3 | 4 | import Data.List as L 5 | 6 | -- Reverse Polish notation calculator 7 | 8 | -- In reverse polish notation, 10 - (4 + 3) * 2 is written as 9 | -- 10 4 3 + 2 * - 10 | -- The idea is that you go from left to right, pushing numbers to the top 11 | -- of the stack. When you encounter an operator, you pop the top two elements 12 | -- from the stack and apply the operator 13 | 14 | -- The type for the calculator would be, a function from string to number 15 | solveRPN :: (Num a, Read a) => String -> a 16 | solveRPN = head . foldl foldingFunction [] . words 17 | where 18 | foldingFunction (x : y : ys) "*" = (x * y) : ys 19 | foldingFunction (x : y : ys) "+" = (x + y) : ys 20 | foldingFunction (x : y : ys) "-" = (x + y) : ys 21 | foldingFunction xs numberString = read numberString : xs 22 | 23 | solved = solveRPN "10 4 +" 24 | 25 | 26 | -- Heathrow to London 27 | 28 | -- The job is to make a program that takes input that represents a road system and prints out what the shortest path across it is. 29 | 30 | -- Example input looks like this: 31 | {- 50 32 | 10 33 | 30 34 | 5 35 | 90 36 | 20 37 | 40 38 | 2 39 | 25 40 | 10 41 | 8 42 | 0 -} 43 | 44 | -- This can be read in threes, where each section (group of threes) comprises of length of road A, length of road B, and the length of the crossing road. 45 | 46 | -- To get the bast path from Heathrow to London, we do this: first we see what the best path to the next crossroads on main road A is. The two options are going directly forward or starting at the opposite road, going forward and then crossing over. We remember the cost and the path. We use the same method to see what the best path to the next crossroads on main road B is and remember that. Then, we see if the path to the next crossroads on A is cheaper if we go from the previous A crossroads or if we go from the previous B crossroads and then cross over. We remember the cheaper path and then we do the same for the crossroads opposite of it. We do this for every section until we reach the end. Once we've reached the end, the cheapest of the two paths that we have is our optimal path! 47 | 48 | -- Data type for Section has length of road A, length of road B, and the length of the crossing C. 49 | data Section = Section { getA :: Int, getB :: Int, getC :: Int } deriving (Show) 50 | type RoadSystem = [Section] 51 | 52 | -- The input data is now this: 53 | heathrowToLondon :: RoadSystem 54 | heathrowToLondon = 55 | [Section 50 10 30, Section 5 90 20, Section 40 2 25, Section 10 8 0] 56 | 57 | -- Other type declarations we'll need are a label for a road and a possible path 58 | data Label = A | B | C deriving (Eq, Show) 59 | type Path = [(Label, Int)] 60 | 61 | -- Solution should have the type: 62 | optimalPath :: RoadSystem -> Path -- Implemented below 63 | 64 | -- Our solution will use a function called roadStep. It takes the optimal paths to current section's A and B and the current section and produces the optimal paths to the next A and B. Like this: 65 | roadStep :: (Path, Path) -> Section -> (Path, Path) 66 | roadStep (pathA, pathB) (Section a b c) = 67 | let pricesToA = map snd pathA 68 | priceA = sum pricesToA 69 | priceB = sum $ map snd pathB 70 | forwardPriceToA = priceA + a 71 | crossPriceToA = priceB + b + c 72 | forwardPriceToB = priceB + b 73 | crossPriceToB = priceA + a + c 74 | newPathToA = if forwardPriceToA <= crossPriceToA 75 | then (A, a) : pathA -- Prepending is much cheaper than adding to the end, so reverse at the end 76 | else (C, c) : (B, b) : pathB 77 | newPathToB = if forwardPriceToB <= crossPriceToB 78 | then (B, b) : pathB 79 | else (C, c) : (A, a) : pathA 80 | in (newPathToA, newPathToB) 81 | 82 | -- Finding the optimal path is now a simple left fold on the whole roadsystem: 83 | optimalPath roadSystem = 84 | let (bestAPath, bestBPath) = foldl roadStep ([], []) roadSystem 85 | in if sum (map snd bestAPath) <= sum (map snd bestBPath) 86 | then reverse bestAPath 87 | else reverse bestBPath 88 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Functors.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 11: http://learnyouahaskell.com/functors-applicative-functors-and-monoids 2 | module Functors where 3 | 4 | -- Nothing here yet! 5 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Geometry/Cube.hs: -------------------------------------------------------------------------------- 1 | module Geometry.Cube 2 | ( volume 3 | , area 4 | ) 5 | where 6 | 7 | import qualified Geometry.Cuboid as Cuboid 8 | 9 | volume :: Float -> Float 10 | volume side = Cuboid.volume side side side 11 | 12 | area :: Float -> Float 13 | area side = Cuboid.area side side side 14 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Geometry/Cuboid.hs: -------------------------------------------------------------------------------- 1 | module Geometry.Cuboid 2 | ( volume 3 | , area 4 | ) 5 | where 6 | 7 | volume :: Float -> Float -> Float -> Float 8 | volume a b c = rectangleArea a b * c 9 | 10 | area :: Float -> Float -> Float -> Float 11 | area a b c = 12 | rectangleArea a b * 2 + rectangleArea a c * 2 + rectangleArea c b * 2 13 | 14 | rectangleArea :: Float -> Float -> Float 15 | rectangleArea a b = a * b 16 | 17 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Geometry/Sphere.hs: -------------------------------------------------------------------------------- 1 | module Geometry.Sphere 2 | ( volume 3 | , area 4 | ) 5 | where 6 | 7 | volume :: Float -> Float 8 | volume radius = (4.0 / 3.0) * pi * (radius ^ 3) 9 | 10 | area :: Float -> Float 11 | area radius = 4 * pi * (radius ^ 2) 12 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/GeometryModule.hs: -------------------------------------------------------------------------------- 1 | -- Example module 2 | module GeometryModule 3 | ( sphereVolume 4 | , sphereArea 5 | , cubeVolume 6 | , cubeArea 7 | , cuboidArea 8 | , cuboidVolume 9 | ) 10 | where 11 | 12 | sphereVolume :: Float -> Float 13 | sphereVolume radius = (4.0 / 3.0) * pi * (radius ^ 3) 14 | 15 | sphereArea :: Float -> Float 16 | sphereArea radius = 2 * pi * (radius ^ 2) 17 | 18 | cubeVolume :: Float -> Float 19 | cubeVolume side = cuboidVolume side side side 20 | 21 | cubeArea :: Float -> Float 22 | cubeArea side = cuboidArea side side side 23 | 24 | cuboidVolume :: Float -> Float -> Float -> Float 25 | cuboidVolume a b c = rectangleArea a b * c 26 | 27 | cuboidArea :: Float -> Float -> Float -> Float 28 | cuboidArea a b c = 29 | rectangleArea a b * 2 + rectangleArea a c * 2 + rectangleArea c b * 2 30 | 31 | -- Not exported 32 | rectangleArea :: Float -> Float -> Float 33 | rectangleArea a b = a * b 34 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/HigherOrderFunctions.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 6: http://learnyouahaskell.com/higher-order-functions 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module HigherOrderFunctions 5 | () 6 | where 7 | 8 | -- Haskell functions can take functions as parameters and return functions as return values. A function that does either of those is called a higher order function. 9 | 10 | -- All functions in Haskell are curried, i.e., they take one parameter at a time. For example, 11 | a = max 4 5 12 | -- can be read as 13 | a' = (max 4) 5 14 | -- where (max 4) is a function applied to 5. Similarly, the type of max can be written as 15 | -- max :: (Ord a) => a -> (a -> a). 16 | 17 | -- In Haskell, putting a space between things is function application. It is like an operator with the highest precedence. 18 | 19 | -- A function called with "too few" parameters (like max 4) is a partially applied function. 20 | -- For example, to create function that compares a number to 10 we can do 21 | compareWithTen :: (Num a, Ord a) => a -> Ordering 22 | compareWithTen = compare 10 23 | -- where "compareWithTen x = compare 10 x" is equivalent! 24 | 25 | -- Also infix functions can be partially applied by using sections. To section an infix function, surround it with parentheses and only supply a parameter on one side. 26 | divideByTen :: (Floating a) => a -> a 27 | divideByTen = (/ 10) 28 | 29 | -- Similarly, a function that checks if a character belongs to uppercase letters: 30 | isUpperAlphaNum :: Char -> Bool 31 | isUpperAlphaNum = (`elem` ['A' .. 'Z']) 32 | 33 | -- Functions can take functions as parameters: 34 | applyTwice :: (a -> a) -> a -> a 35 | applyTwice f x = f (f x) 36 | -- Note that parentheses are needed in the type because `->` is right-associative. 37 | -- `applyTwice` is essentially a function of two arguments, a function and a value, 38 | -- and it returns a value. 39 | sixteen = applyTwice (+ 3) 10 40 | sentence = applyTwice (++ " HAHA") "HEY" -- HEY HAHA HAHA 41 | sentence2 = applyTwice ("HAHA " ++) "HEY" -- HAHA HAHA HEY 42 | 43 | -- A bit more useful example, zipWith: 44 | zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c] 45 | zipWith' _ [] _ = [] 46 | zipWith' _ _ [] = [] 47 | zipWith' f (x : xs) (y : ys) = f x y : zipWith' f xs ys 48 | 49 | -- "As you can see, a single higher order function can be used in very versatile ways. Imperative programming usually uses stuff like for loops, while loops, setting something to a variable, checking its state, etc. to achieve some behavior and then wrap it around an interface, like a function. Functional programming uses higher order functions to abstract away common patterns, like examining two lists in pairs and doing something with those pairs or getting a set of solutions and eliminating the ones you don't need." 50 | 51 | flip' :: (a -> b -> c) -> (b -> a -> c) 52 | flip' f = g where g x y = f y x 53 | -- Or even simpler: 54 | -- flip' f x y = g y x 55 | -- Note that one can here take advantage of currying when making higher-order functinos by thinking ahead and writing what their end result would be if they were fully applied and flip' was considered as type "flip' :: (a -> b -> c) -> b -> a -> c" 56 | 57 | -- Example: 58 | flipped = flip' zip [1, 2, 3, 4, 5] "hello" 59 | -- [('h',1),('e',2),('l',3),('l',4),('o',5)] 60 | flipped2 = zipWith' (flip' div) [2, 2 ..] [10, 8, 6, 4, 2] 61 | -- [5,4,3,2,1] 62 | 63 | -- Maps and filters 64 | map' :: (a -> b) -> [a] -> [b] 65 | map' _ [] = [] 66 | map' f (x : xs) = f x : map' f xs 67 | 68 | addedThree = map' (+ 3) [1, 4, 3, 2] 69 | 70 | replicated = map (replicate 3) [3 .. 6] 71 | 72 | allSquared = map (map (^ 2)) [[1, 2], [3, 5]] 73 | 74 | filter' :: (a -> Bool) -> [a] -> [a] 75 | filter' _ [] = [] 76 | filter' f (x : xs) = if f x then x : filter f xs else filter f xs 77 | -- Or with guards 78 | -- filter f (x:xs) | f x = x : filter f xs | otherwise = filter f xs 79 | 80 | filtered = filter' (> 3) [1, 5, 10, 2] 81 | 82 | notNulls = 83 | let notNull x = not (null x) 84 | in filter notNull [[1, 2, 3], [], [3, 4, 5], [2, 2], [], [], []] 85 | 86 | -- quicksort with filter 87 | quicksort :: (Ord a) => [a] -> [a] 88 | quicksort [] = [] 89 | quicksort (x : xs) = 90 | let smallerThan = filter (<= x) xs 91 | greaterThan = filter (> x) xs 92 | in quicksort smallerThan ++ [x] ++ quicksort greaterThan 93 | 94 | largestDivisible :: (Integral a) => a 95 | largestDivisible = maximum 96 | (let divisible x = x `mod` 3829 == 0 in filter' divisible [0 .. 100000]) 97 | -- or, better, use Haskell's laziness: 98 | -- largestDivisible = head (filter p [100000, 99999 ..]) where p x = x `mod` 3829 == 0 99 | 100 | -- Find the sum of all odd squares that are smaller than 10000 101 | -- Without takeWhile, one does not know which range to start with (cannot be infinite) 102 | sumOfAllSquares' = sum (filter (< 10000) (filter odd (map (^ 2) [1 .. 10000]))) 103 | -- With takeWhile, one can use an infinite range: 104 | sumOfAllSquares = sum (takeWhile (< 10000) (filter odd (map (^ 2) [1 ..]))) 105 | 106 | -- Collatz sequence: Take a natural number. If that number is even, divide it by two. If it's odd, multiply it by 3 and then add 1 to that. We take the resulting number and apply the same thing to it, which produces a new number and so on. 107 | chain :: (Integral a) => a -> [a] 108 | chain 1 = [1] 109 | chain n | even n = n : chain (n `div` 2) 110 | | otherwise = n : chain (3 * n + 1) 111 | 112 | -- For all starting numbers between 1 and 100, how many chains have a length greater than 15? 113 | chainsLongerThan15 :: Int 114 | chainsLongerThan15 = length (filter isLong (map chain [1 .. 100])) 115 | where isLong xs = length xs > 15 116 | 117 | -- Note that one can also map with functions taking more than one argument to produce a list of functions: 118 | multipliers = map (*) [0 ..] 119 | ten = (multipliers !! 2) 5 -- second element of the list is (2*) 120 | 121 | -- Lambdas are anonymous functions used only once, normally with the sole purpose of passing it to a higher-order function. To make a lambda, write a "\" followed by the parameters, separated by spaces. After that comes a -> and the function body. 122 | 123 | -- Rewrite chainsLongerThan15 with a lambda: 124 | chainsLongerThan15' :: Int 125 | chainsLongerThan15' = 126 | length (filter (\xs -> length xs > 15) (map chain [1 .. 100])) 127 | 128 | -- Lambdas are expressions so one can pass them around like that. 129 | 130 | -- Lambdas can take any number of arguments: 131 | zipped = zipWith (\a b -> (a * 30 + 3) / b) [5, 4, 3, 2, 1] [1, 2, 3, 4, 5] 132 | 133 | -- One can also pattern match a (single) pattern with lambdas: 134 | mapped = map (\(a, b) -> a + b) [(1, 2), (3, 4)] 135 | 136 | -- One can use lambdas in function expressions when it's more readable: 137 | flip'' :: (a -> b -> c) -> b -> a -> c 138 | flip'' f = \x y -> f y x 139 | 140 | -- A fold takes a binary function, a starting value (accumulator) and a "foldable" like a list. 141 | sum' :: (Num a) => [a] -> a 142 | sum' xs = foldl (\acc x -> acc + x) 0 xs 143 | -- More succinctly: sum' = foldl (+) 0 144 | 145 | elem' :: (Eq a) => a -> [a] -> Bool 146 | elem' y ys = foldl (\acc x -> if x == y then True else acc) False ys 147 | 148 | map'' :: (a -> b) -> [a] -> [b] 149 | -- map'' f xs = foldl (\acc x -> acc ++ [f x]) [] xs 150 | map'' f xs = foldr (\x acc -> f x : acc) [] xs 151 | 152 | -- "One big difference [between left and right folds] is that right folds work on infinite lists, whereas left ones don't! To put it plainly, if you take an infinite list at some point and you fold it up from the right, you'll eventually reach the beginning of the list. However, if you take an infinite list at a point and you try to fold it up from the left, you'll never reach an end!" 153 | 154 | -- "Folds can be used to implement any function where you traverse a list once, element by element, and then return something based on that. Whenever you want to traverse a list to return something, chances are you want a fold. That's why folds are, along with maps and filters, one of the most useful types of functions in functional programming." 155 | 156 | -- scanl and scanr are like foldl and foldr, only they report all the intermediate accumulator states in the form of a list. 157 | -- Use scanl to answer the question "How many elements does it take for the sum of the roots of all natural numbers to exceed 1000? 158 | 159 | sumsOfRoots = length (takeWhile (< 1000) (scanl1 (+) (map sqrt [1 ..]))) + 1 160 | 161 | -- Note that "scanl1" (not scanl) starts the fold by using the first value as the accumulator, like foldl1, so there's no zero as the head element here. 162 | 163 | -- Function application with $ has type: 164 | -- ($) :: (a -> b) -> a -> b 165 | -- f $ x = f x 166 | 167 | -- Whereas normal function application (space) has high precedence, the $ function has the lowest precedence. 168 | -- For example: f g x is the same as (f g) x -- Left-associative! 169 | -- But f $ g x = f (g x) -- Right-associative! 170 | 171 | -- You can imagine a $ to be sort of the equivalent of writing an opening parentheses and then writing a closing one one the far right of the expression. 172 | 173 | -- These are equal: 174 | sum1 = sum (filter (> 10) (map (* 2) [2 .. 10])) 175 | sum2 = sum $ filter (> 10) $ map (* 2) [2 .. 10] 176 | 177 | -- One can also use function application to "lift" values to functions 178 | mapped2 = map ($ 3) [(4 +), (10 *), (^ 2), sqrt] 179 | -- [7.0,30.0,9.0,1.7320508075688772] 180 | 181 | -- Function composition produces a new function like 182 | -- (f \circ g)(x) == f(g(x)) 183 | -- In Haskell, one can do function composition with the "." function, of type: 184 | -- (.) :: (b -> c) -> (a -> b) -> a -> c 185 | -- f . g = \x -> f (g x) 186 | 187 | -- For example, these are equal: 188 | negate1 = map (\x -> negate (abs x)) [5, -3, -6, 7, -3, 2, -19, 24] 189 | negate2 = map (negate . abs) [5, -3, -6, 7, -3, 2, -19, 24] 190 | 191 | -- "If you want to rewrite an expression with a lot of parentheses by using function composition, you can start by putting the last parameter of the innermost function after a $ and then just composing all the other function calls, writing them without their last parameter and putting dots between them." 192 | 193 | ugly = replicate 194 | 100 195 | (product (map (* 3) (zipWith max [1, 2, 3, 4, 5] [4, 5, 6, 7, 8]))) 196 | 197 | pretty = 198 | replicate 100 -- This is applied last 199 | . product -- This is applied third 200 | . map (* 3) -- This is applied second 201 | . zipWith max [1, 2, 3, 4, 5] -- This is applied first 202 | $ [4, 5, 6, 7, 8] -- This is the "input" list 203 | 204 | -- One can also use composition to write point-free function definitions: 205 | fn = ceiling . negate . tan . cos . max 50 206 | 207 | -- "Making long chains of function composition is discouraged, although I plead guilty of sometimes being too composition-happy. The prefered style is to use let bindings to give labels to intermediary results or split the problem into sub-problems and then put it together so that the function makes sense to someone reading it instead of just making a huge composition chain." 208 | 209 | -- Four ways to write the oddSquareSum 210 | oddSquareSum :: Integer 211 | oddSquareSum = sum (takeWhile (< 10000) (filter odd (map (^ 2) [1 ..]))) 212 | oddSquareSum' = sum $ takeWhile (< 10000) $ filter odd $ map (^ 2) [1 ..] 213 | oddSquareSum'' = sum . takeWhile (< 10000) . filter odd . map (^ 2) $ [1 ..] 214 | oddSquareSum''' = 215 | let oddSquares = filter odd $ map (^ 2) [1 ..] 216 | belowLimit = takeWhile (< 10000) oddSquares 217 | in sum belowLimit 218 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/InputAndOutput.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 9: http://learnyouahaskell.com/input-and-output 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module InputAndOutput 5 | () 6 | where 7 | 8 | import Control.Monad 9 | import Data.Char 10 | import System.IO 11 | import System.Random 12 | import Control.Monad ( when ) 13 | -- Pure functions cannot change state of things in the world. To achieve effects, 14 | -- Haskell uses the IO type. 15 | 16 | -- For example, the type of `putStrLn`: 17 | -- ghci> :t putStrLn 18 | -- putStrLn :: String -> IO () 19 | -- So the function takes a string and returns an I/O action. 20 | 21 | -- Here's how you compose I/O actions in the main program with `do`: 22 | 23 | -- main = do 24 | -- putStrLn "Hello, what's your name?" 25 | -- name <- getLine 26 | -- putStrLn ("Hey " ++ name ++ ", you rock!") 27 | 28 | -- What's the type of getLine? 29 | -- ghci> :t getLine 30 | -- getLine :: IO String 31 | 32 | -- getLine is an I/O action that contains a result of type String. Once the result is available, the only way to open the I/O box and get the data inside it is to use the <- construct. Taking data out of an I/O action can only be done when inside another I/O action. This is how Haskell separates the pure and impure parts of the code. 33 | 34 | -- Let bindings can be used in `do` blocks without the `in` part to bind pure expressions to names: 35 | 36 | -- main = do 37 | -- putStrLn "What's your first name?" 38 | -- firstName <- getLine 39 | -- putStrLn "What's your last name?" 40 | -- lastName <- getLine 41 | -- let bigFirstName = map toUpper firstName 42 | -- bigLastName = map toUpper lastName 43 | -- putStrLn $ "hey " ++ bigFirstName ++ " " ++ bigLastName ++ ", how are you?" 44 | 45 | -- In Haskell (in I/O actions specifically), "return" makes an I/O action out of a pure value. If you think about the box analogy from before, it takes a value and wraps it up in a box. The resulting I/O action doesn't actually do anything, it just has that value encapsulated as its result. 46 | 47 | useReturn = do 48 | a <- return "hell" 49 | b <- return "yeah!" 50 | putStrLn $ a ++ " " ++ b 51 | 52 | -- When dealing with I/O do blocks, we mostly use return either because we need to create an I/O action that doesn't do anything or because we don't want the I/O action that's made up from a do block to have the result value of its last action, but we want it to have a different result value, so we use return to make an I/O action that always has our desired result contained and we put it at the end. 53 | 54 | -- "when" takes a boolean value and an I/O action if that boolean value is True, it returns the same I/O action that we supplied to it. However, if it's False, it returns the return (), action, so an I/O action that doesn't do anything. It's useful for encapsulating the if something then do some I/O action else return () pattern. 55 | useWhen = do 56 | putStrLn "Hello, give a char" 57 | c <- getChar 58 | when (c /= ' ') $ do 59 | putChar c 60 | useWhen 61 | 62 | -- sequence takes a list of I/O actions and returns an I/O actions that will perform those actions one after the other. 63 | useSequence = do 64 | rs <- sequence [getLine, getLine, getLine] 65 | print rs 66 | 67 | -- Because mapping a function that returns an I/O action over a list and then sequencing it is so common, the utility functions mapM and mapM_ were introduced. mapM takes a function and a list, maps the function over the list and then sequences it. mapM_ does the same, only it throws away the result later. We usually use mapM_ when we don't care what result our sequenced I/O actions have. 68 | useMapM = do 69 | as <- mapM print [1, 2, 3] 70 | mapM_ print [4, 5, 6] 71 | 72 | -- forever takes an I/O action and returns an I/O action that just repeats the I/O action it got forever. 73 | main = forever $ do 74 | putStr "Give me some input: " 75 | l <- getLine 76 | putStrLn $ map toUpper l 77 | 78 | -- forM (located in Control.Monad) is like mapM, only that it has its parameters switched around. The first parameter is the list and the second one is the function to map over that list, which is then sequenced. Why is that useful? Well, with some creative use of lambdas and do notation, we can do stuff like this: 79 | useForM = do 80 | colors <- forM 81 | [1, 2, 3, 4] 82 | (\a -> do 83 | putStrLn 84 | $ "Which color do you associate with the number " 85 | ++ show a 86 | ++ "?" 87 | color <- getLine 88 | return color 89 | ) 90 | putStrLn "The colors that you associate with 1, 2, 3 and 4 are: " 91 | mapM putStrLn colors 92 | -- You can think of forM as meaning: make an I/O action for every element in this list. 93 | 94 | -- Files and streams 95 | 96 | -- getContents is an I/O actions that reads everything from the standard input until it encounters EOF. But it does it lazily! It does not read the contents with `foo <- getContents` but when it's actually accessed. 97 | 98 | contentReader = do 99 | contents <- getContents 100 | putStr (map toUpper contents) 101 | 102 | shortLineAcceptor = do 103 | contents <- getContents 104 | putStr $ shortLinesOnly contents 105 | 106 | shortLinesOnly :: String -> String 107 | shortLinesOnly input = 108 | let allLines = lines input 109 | shortLines = filter (\line -> length line < 10) allLines 110 | result = unlines shortLines 111 | in result 112 | 113 | -- `interact` is made for the pattern of getting some string from the input, transforming it and then outputting it. It takes a function `String -> String` and returns an I/O action that takes inputs, runs the function on it, and prints the result. Observe: 114 | 115 | shortLinesAcceptorWithInteract = interact shortLinesOnly 116 | 117 | -- Another example: 118 | respondPalidromes = 119 | unlines 120 | . map 121 | (\xs -> 122 | if isPalindrome xs then "palindrome" else "not a palindrome" 123 | ) 124 | . lines 125 | where isPalindrome xs = xs == reverse xs 126 | 127 | respondPalidromesMain = interact respondPalidromes 128 | 129 | -- So far we've been reading from standard input and writing to standard output. Writing files is very similar. Here's a program that reads a file: 130 | 131 | fileReader = do 132 | handle <- openFile "girlfriend.txt" ReadMode 133 | contents <- hGetContents handle 134 | putStr contents 135 | hClose handle 136 | 137 | -- Note the difference between the handle used to identify a file and the contents of the file, bound in our program to handle and contents. The handle is just something by which we know what our file is. If you imagine your whole file system to be a really big book and each file is a chapter in the book, the handle is a bookmark that shows where you're currently reading (or writing) a chapter, whereas the contents are the actual chapter. 138 | 139 | -- Here's the same with `withFile`: 140 | withFileExample = withFile 141 | "girlfriend.txt" 142 | ReadMode 143 | (\handle -> do 144 | contents <- hGetContents handle 145 | putStr contents 146 | ) 147 | 148 | -- withFile essentially does this: 149 | withFile' :: FilePath -> IOMode -> (Handle -> IO a) -> IO a 150 | withFile' path mode f = do 151 | handle <- openFile path mode 152 | result <- f handle 153 | hClose handle 154 | return result 155 | 156 | -- Just like we have hGetContents that works like getContents but for a specific file, there's also hGetLine, hPutStr, hPutStrLn, hGetChar, etc. They work just like their counterparts without the h, only they take a handle as a parameter and operate on that specific file instead of operating on standard input or standard output. 157 | 158 | -- readFile has a type signature of readFile :: FilePath -> IO String. Remember, FilePath is just a fancy name for String. readFile takes a path to a file and returns an I/O action that will read that file (lazily, of course) and bind its contents to something as a string. 159 | 160 | readFileExample = do 161 | contents <- readFile "girlfriend.txt" 162 | putStr contents 163 | 164 | -- writeFile has a type of writeFile :: FilePath -> String -> IO (). It takes a path to a file and a string to write to that file and returns an I/O action that will do the writing. 165 | 166 | writeFileExample = do 167 | contents <- readFile "girlfriend.txt" 168 | let transformedText = map toUpper contents 169 | writeFile "girlfriendcaps.txt" transformedText 170 | 171 | -- appendFile has a type signature that's just like writeFile, only appendFile doesn't truncate the file to zero length if it already exists but it appends stuff to it. 172 | 173 | appendExample = do 174 | todoItem <- getLine 175 | appendFile "todo.txt" (todoItem ++ "\n") 176 | 177 | -- Just like you can think of lists as streams, you can also think of files as streams. This will read one line at a time and print it out to the terminal as it goes along. So you may be asking, how wide is this pipe then? How often will the disk be accessed? Well, for text files, the default buffering is line-buffering usually. That means that the smallest part of the file to be read at once is one line. That's why in this case it actually reads a line, prints it to the output, reads the next line, prints it, etc. For binary files, the default buffering is usually block-buffering. That means that it will read the file chunk by chunk. The chunk size is some size that your operating system thinks is cool. 178 | 179 | -- You can control how exactly buffering is done by using the hSetBuffering function. 180 | manualBufferingExample = withFile 181 | "something.txt" 182 | ReadMode 183 | (\handle -> do 184 | hSetBuffering handle $ BlockBuffering (Just 2048) 185 | contents <- hGetContents handle 186 | putStr contents 187 | ) 188 | 189 | 190 | -- Command-line arguments: See ./todo-app/Main.hs. 191 | 192 | -- Randomness 193 | 194 | -- In Haskell functions are pure, including functions for generating random numbers. 195 | -- Therefore, functions generating random values take in a generator (created with e.g. `mkStdGen`) and return both a value and the new generator. For example: 196 | numberBetweenOneAndSix :: Int 197 | numberBetweenOneAndSix = 198 | fst (randomR (1, 6) (mkStdGen 359353) :: (Int, StdGen)) 199 | 200 | -- Here's an I/O action for generating random strings 201 | 202 | genRandomString :: IO () 203 | genRandomString = do 204 | gen <- getStdGen -- Ask the system for a good random number generator. 205 | putStr $ take 20 (randomRs ('a', 'z') gen) 206 | 207 | guessNumber :: IO () 208 | guessNumber = do 209 | gen <- getStdGen 210 | askForNumber gen 211 | 212 | askForNumber :: StdGen -> IO () 213 | askForNumber gen = do 214 | let (randNumber, newGen) = randomR (1, 10) gen :: (Int, StdGen) 215 | putStr "Which number in the range from 1 to 10 am I thinking of?" 216 | numberString <- getLine 217 | when (not $ null numberString) $ do 218 | let number = read numberString 219 | if randNumber == number 220 | then putStrLn "You're correct!" 221 | else putStrLn $ "Sorry, it was " ++ show randNumber 222 | askForNumber newGen 223 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/LensTutorial.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE DeriveFoldable #-} -- For deriving foldables and stuff for common data types 3 | {-# LANGUAGE DeriveFunctor #-} 4 | {-# LANGUAGE DeriveTraversable #-} 5 | -- http://hackage.haskell.org/package/lens-tutorial-1.0.4/docs/Control-Lens-Tutorial.html#targetText=makeLenses%20creates%20one%20lens%20per,the%20field%20without%20the%20underscore.&targetText=This%20means%20that%20you%20can,provided%20by%20the%20Haskell%20Prelude. 6 | -- Enter interactive mode with `stack ghci` 7 | module LensTutorial 8 | () 9 | where 10 | 11 | 12 | 13 | import Control.Lens 14 | 15 | data Point = Point { _x :: Double, _y :: Double } deriving (Show) 16 | data Atom = Atom { _element :: String, _point :: Point } deriving (Show) 17 | 18 | -- Brute-forcing change of field 19 | shiftAtomX' :: Atom -> Atom 20 | shiftAtomX' (Atom e (Point x y)) = Atom e (Point (x + 1) y) 21 | 22 | -- Autogenerate lenses with Template Haskell (see the top for the pragma): 23 | $(makeLenses ''Atom) 24 | $(makeLenses ''Point) 25 | -- This creates four lenses of types 26 | -- element :: Lens' Atom String 27 | -- point :: Lens' Atom Point 28 | -- x :: Lens' Point Double 29 | -- y :: Lens' Point Double 30 | 31 | 32 | shiftAtomX :: Atom -> Atom 33 | shiftAtomX = over (point . x) (+ 1) 34 | 35 | atom = Atom { _element = "C", _point = Point { _x = 1.0, _y = 2.0 } } 36 | 37 | -- Add molecule 38 | newtype Molecule = Molecule { _atoms :: [Atom] } deriving (Show) 39 | 40 | -- Define "atoms" 41 | $(makeLenses ''Molecule) 42 | 43 | shiftMoleculeX :: Molecule -> Molecule 44 | shiftMoleculeX = over (atoms . traverse . point . x) (+ 1) 45 | 46 | -- Helpers 47 | 48 | atom1 = Atom { _element = "C", _point = Point { _x = 1.0, _y = 2.0 } } 49 | atom2 = Atom { _element = "O", _point = Point { _x = 3.0, _y = 4.0 } } 50 | molecule = Molecule { _atoms = [atom1, atom2] } 51 | 52 | shiftedMolecule = shiftMoleculeX molecule 53 | 54 | -- What is a lens? A lens is a first class getter and setter. `view` is a "get": 55 | viewAtom = view (point . x) atom 56 | 57 | -- You could pretend they're defined as follows: 58 | -- data Lens a b = Lens { view :: a -> b, over :: (b -> b) -> (a -> a)} 59 | 60 | -- Actual definition is like this: 61 | -- type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a) 62 | -- The trick here is that we get to pick what Functor we specialize f to and depending on which Functor we pick we get different features. 63 | 64 | -- Instead of using Template Haskell, one can use `lens` to build lenses: 65 | -- lens :: (a -> b) -> (a -> b -> a) -> Lens' a b 66 | -- The first argument is the "getter". The second argument is the "setter". Define our own lens: 67 | 68 | point' :: Lens' Atom Point 69 | point' = lens _point (\atom newPoint -> atom { _point = newPoint }) 70 | 71 | -- Without lens: 72 | -- point'' :: Lens' Atom Point 73 | point'' :: Functor f => (Point -> f Point) -> Atom -> f Atom 74 | point'' k atom = 75 | fmap (\newPoint -> atom { _point = newPoint }) (k (_point atom)) 76 | 77 | -- Lenses can be combined using function composition. 78 | -- (.) :: Lens' a b -> Lens' b c -> Lens' a c 79 | atomToX :: Lens' Atom Double 80 | atomToX = point . x 81 | 82 | -- Getter 83 | viewX :: Atom -> Double 84 | viewX = view atomToX 85 | 86 | -- Setter 87 | overX :: (Double -> Double) -> (Atom -> Atom) 88 | overX = over atomToX 89 | 90 | increaseXByOne :: Atom -> Atom 91 | increaseXByOne = overX (+ 1) 92 | 93 | -- How to consume lenses? 94 | -- view :: Lens' a b -> a -> b 95 | -- over :: Lens' a b -> (b -> b) -> (a -> a) 96 | -- set :: Lens ' a b -> b -> (a -> a) -- Special case of `over` 97 | 98 | -- view and over distribute over lens composition: 99 | -- view (lens1 . lens2) = (view lens1) . (view lens2) 100 | -- over (lens1 . lens2) = (over lens1) . (over lens2) 101 | 102 | -- Traversals 103 | -- Traversal is a first class getter and setter for an arbitrary number of values. It lets you get all the values it points to as a list and to update the values it points to. Think of it like this: 104 | -- data Traversal' a b = Traversal' { toListOf :: a -> [b], over :: (b -> b) -> (a -> a)} 105 | 106 | -- We saw a traverse here: 107 | -- shiftMoleculeX = over (atoms . traverse . point . x) (+ 1) 108 | 109 | -- Let's bite this into pieces: 110 | atomX :: Lens' Atom Double 111 | atomX = point . x 112 | 113 | moleculeX :: Traversal' Molecule Double -- Defines essentially "over" and "toListOf" 114 | moleculeX = atoms . traverse . atomX 115 | 116 | -- Compose with a single shift function: 117 | shift lens = over lens (+ 1) 118 | shiftAtomX'' = shift atomX 119 | shiftMoleculeX'' = shift moleculeX 120 | 121 | -- As moleculeX is a Traversal', it has `toListOf` instead of `view` 122 | allX :: Molecule -> [Double] 123 | allX = toListOf moleculeX 124 | 125 | -- We're using a special case of Traversal where the Traversable is of type [] (an array). 126 | 127 | -- One can derive Functor, Foldable, and Traversable for many data types using `DeriveFoldable` etc. 128 | data Pair a = Pair a a deriving (Show, Functor, Foldable, Traversable) -- Relies on extensions 129 | 130 | pair :: Pair Integer 131 | pair = Pair 3 4 132 | 133 | -- Traversing by mapping to a list 134 | traverseToArray :: [Pair Integer] 135 | traverseToArray = traverse (\x -> [x]) (Pair 3 4) 136 | 137 | -- Traversing by mapping to a Just 138 | traverseToMaybe :: Maybe (Pair Integer) 139 | traverseToMaybe = traverse (\x -> Just x) (Pair 3 4) 140 | 141 | traverseToChildren :: Traversal' (Pair a) a 142 | traverseToChildren = traverse 143 | 144 | -- updatePair :: (Integer -> Identity Integer) -> (Pair Integer -> Pair Integer) 145 | -- updatePair pair = over traverse 146 | updatedPair = over traverse (+ 1) (Pair 3 4) 147 | 148 | -- Traversals can be composed as lenses can 149 | 150 | -- atoms :: Traversal' Molecule [Atom] --- Lens' is a Traversal' 151 | traverseAtoms :: Traversal' Molecule Atom 152 | traverseAtoms = atoms . traverse 153 | 154 | traversePoints :: Traversal' Molecule Point 155 | traversePoints = traverseAtoms . point 156 | 157 | traverseX :: Traversal' Molecule Double 158 | traverseX = traversePoints . x 159 | 160 | -- Set all x coordinates 161 | incrementX :: Molecule -> Molecule 162 | incrementX = over traverseX (+ 3) 163 | 164 | -- Get all x coordinates 165 | viewXs :: Molecule -> [Double] 166 | viewXs = toListOf traverseX 167 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Lib.hs: -------------------------------------------------------------------------------- 1 | module Lib 2 | ( someFunc 3 | ) 4 | where 5 | 6 | someFunc :: IO () 7 | someFunc = putStrLn "Hello from Haskell!" 8 | a = 5 + 4 9 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/MakingOurOwnTypesAndTypeclasses.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 8: http://learnyouahaskell.com/making-our-own-types-and-typeclasses 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module MakingOurOwnTypesAndTypeclasses 5 | ( Shape'(Rectangle', Circle') 6 | ) 7 | where 8 | 9 | import qualified Data.Map as Map 10 | 11 | -- Use the data keyword to define a type. 12 | -- The parts after the = are value constructors. They specify the different values that this type can have. 13 | data Bool' = False' | True' 14 | 15 | -- Here, the Circle value constructor has three fields, which take floats. So when we write a value constructor, we can optionally add some types after it and those types define the values it will contain. Here, the first two fields are the coordinates of its center, the third one its radius. The Rectangle value constructor has four fields which accept floats. The first two are the coordinates to its upper left corner and the second two are coordinates to its lower right one. 16 | data Shape = Circle Float Float Float | Rectangle Float Float Float Float deriving (Show) 17 | 18 | -- Value constructors are actually functions that ultimately return a value of a data type. 19 | -- The type of Circle is: "Circle :: Float -> Float -> Float -> Shape" 20 | 21 | surface :: Shape -> Float 22 | surface (Circle _ _ r ) = pi * r ^ 2 23 | surface (Rectangle x1 y1 x2 y2) = abs (x2 - x1) * abs (y2 - y1) 24 | 25 | -- Note that Circle is not a type, Shape is. Circle is a value constructor and it can be pattern matched. 26 | 27 | -- Using surface: 28 | surfaceArea = surface $ Circle 10 20 10 29 | 30 | -- Value constructors are functions so we can map and curry them. For example: 31 | 32 | circles = map (Circle 10 20) [4, 5, 6, 6] 33 | 34 | -- Intermediate data types: 35 | data Point = Point Float Float deriving (Show) 36 | data Shape' = Circle' Point Float | Rectangle' Point Point deriving (Show) 37 | 38 | surface' :: Shape' -> Float 39 | surface' (Circle' _ r) = pi * r ^ 2 40 | surface' (Rectangle' (Point x1 y1) (Point x2 y2)) = 41 | abs (x2 - x1) * abs (y2 - y1) 42 | 43 | surfaceArea' = surface' (Rectangle' (Point 0 0) (Point 100 100)) 44 | 45 | nudge :: Shape' -> Float -> Float -> Shape' 46 | nudge (Circle' (Point x y) r) a b = Circle' (Point (x + a) (y + b)) r 47 | nudge (Rectangle' (Point x1 y1) (Point x2 y2)) a b = 48 | Rectangle' (Point (x1 + a) (y1 + b)) (Point (x2 + a) (y2 + b)) 49 | 50 | 51 | -- Example person using the record syntax 52 | 53 | data Person = Person { firstName :: String 54 | , lastName:: String 55 | , age:: Int 56 | , height:: Float 57 | , phoneNumber :: String 58 | , flavor:: String } deriving (Show, Eq, Read) 59 | 60 | guy = Person { firstName = "Buddy" 61 | , lastName = "Finklestein" 62 | , age = 43 63 | , height = 184.2 64 | , phoneNumber = "526-2928" 65 | , flavor = "Chocolate" 66 | } 67 | 68 | -- Type constructors can take types as parameters to produce new types. 69 | data Maybe' a = Nothing' | Just' a 70 | 71 | -- The a here is the type parameter. Because Maybe takes a type parameter, it's called a type constructor. It may end up producing a Maybe Int, Maybe Car, etc. 72 | 73 | -- It's a very strong convention in Haskell to never add typeclass constraints in data declarations like this: 74 | -- data (Ord k) => Map k v = ... 75 | -- This would require functions like "toList :: Map k a -> [(k, a)]" to have the typeclass constraint 76 | -- "toList :: (Ord k) => Map k a -> [(k, a)]" even though they don't care k is an Ord. 77 | 78 | data Vector a = Vector a a a deriving (Show) 79 | 80 | vplus :: (Num t) => Vector t -> Vector t -> Vector t 81 | (Vector i j k) `vplus` (Vector l m n) = Vector (i + l) (j + m) (k + n) 82 | 83 | -- It's very important to distinguish between the type constructor and the value constructor. When declaring a data type, the part before the = is the type constructor and the constructors after it (possibly separated by |'s) are value constructors. The vector type constructor takes one parameter whereas the value constructor takes three. 84 | 85 | vectorSum = Vector 3 5 8 `vplus` Vector 9 2 5 86 | 87 | -- Typeclass is a sort of an interface that defines some behavior. **A type can be made an instance of a typeclass if it supports that behavior**. Example: the Int type is an instance of the Eq typeclass because the Eq typeclass defines behavior for stuff that can be equated. 88 | 89 | -- Unlike from classes in languages like Java, one does not make data from typeclasses. Instead, one makes the data type and then thinks about how it can act. An `Int` can be equatded, so it should be an instance of the `Eq` typelass. 90 | 91 | -- We can read a person from string by deriving from Read typeclass 92 | readPerson = 93 | read "Person {firstName =\"Michael\", lastName =\"Diamond\", age = 43}" :: Person 94 | 95 | -- One can use algebraic data types to make enumerations having Enum and Bounded typeclasses: 96 | -- Note that all value constructors here are "nullary", i.e., take no parameters. 97 | data Day = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday 98 | deriving (Eq, Ord, Show, Read, Bounded, Enum) 99 | 100 | comparison = Monday `compare` Wednesday -- LT 101 | 102 | firstDay = minBound :: Day 103 | 104 | days = [Thursday .. Sunday] 105 | allDays = [minBound .. maxBound] :: [Day] 106 | 107 | -- Type synomyms give types different names like this 108 | type String' = [Char] 109 | 110 | -- Add some phone book helpers 111 | type PhoneNumber = String 112 | type Name = String 113 | type PhoneBook = [(Name, PhoneNumber)] 114 | 115 | phoneBook :: PhoneBook 116 | phoneBook = 117 | [ ("betty" , "555-2938") 118 | , ("bonnie" , "452-2928") 119 | , ("patsy" , "493-2928") 120 | , ("lucille", "205-2928") 121 | , ("wendy" , "939-8282") 122 | , ("penny" , "853-2492") 123 | ] 124 | 125 | inPhoneBook :: Name -> PhoneNumber -> PhoneBook -> Bool 126 | inPhoneBook name pnumber pbook = (name, pnumber) `elem` pbook 127 | 128 | -- Parameterized type synonym (a type constructor) 129 | type AssocList k v = [(k, v)] 130 | 131 | -- Remember: values can only have types that are concrete types! 132 | 133 | -- Definition of Either 134 | data Either' a b = Left' a | Right' b deriving (Eq, Ord, Read, Show) 135 | 136 | -- Locker example 137 | data LockerState = Taken | Free deriving (Show, Eq) 138 | 139 | type Code = String 140 | 141 | type LockerMap = Map.Map Int (LockerState, Code) 142 | 143 | lockerLookup :: Int -> LockerMap -> Either String Code 144 | lockerLookup lockerNumber map = case Map.lookup lockerNumber map of 145 | Nothing -> 146 | Left $ "Locker number " ++ show lockerNumber ++ " doesn't exist!" 147 | Just (state, code) -> if state /= Taken 148 | then Right code 149 | else Left $ "Locker " ++ show lockerNumber ++ " is already taken!" 150 | 151 | lockers :: LockerMap 152 | lockers = Map.fromList 153 | [ (100, (Taken, "ZD39I")) 154 | , (101, (Free, "JAH3I")) 155 | , (103, (Free, "IQSA9")) 156 | , (105, (Free, "QOTSA")) 157 | , (109, (Taken, "893JJ")) 158 | , (110, (Taken, "99292")) 159 | ] 160 | 161 | lookedUp = lockerLookup 101 lockers -- Right "JAH31" 162 | 163 | -- Recursive data structures are data structures whose definition refers to themselves. For example: 164 | 165 | -- data List a = Empty | Cons a (List a) deriving (Show, Read, Eq, Ord) 166 | -- list = 5 `Cons` (4 `Cons` Empty) 167 | 168 | -- Using fixity declaration: 169 | infixr 5 :-: -- Right-associative with "bind" 5, infix because has only special chars 170 | data List a = Empty | a :-: (List a) deriving (Show, Read, Eq, Ord) 171 | 172 | list = 3 :-: 4 :-: Empty 173 | 174 | -- Custom concatenation 175 | infixr 5 .++ 176 | (.++) :: List a -> List a -> List a 177 | Empty .++ ys = ys 178 | (x :-: xs) .++ ys = x :-: (xs .++ ys) 179 | 180 | -- Notice the pattern match on :-:. This works because :-: is a constructor for the list type, just like : is a constructor the standard list type and can be pattern matched. 181 | 182 | a = 3 :-: 4 :-: 5 :-: Empty 183 | b = 6 :-: 7 :-: Empty 184 | c = a .++ b 185 | 186 | -- Binary search tree 187 | -- A tree is either an empty tree or it's an element that contains some value and two trees. 188 | data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq) 189 | 190 | singleton :: a -> Tree a 191 | singleton x = Node x EmptyTree EmptyTree 192 | 193 | treeInsert :: (Ord a) => a -> Tree a -> Tree a 194 | treeInsert x EmptyTree = singleton x 195 | treeInsert x (Node a left right) | x == a = Node x left right 196 | | x < a = Node a (treeInsert x left) right 197 | | x > a = Node a left (treeInsert x right) 198 | 199 | treeElem :: (Ord a) => a -> Tree a -> Bool 200 | treeElem _ EmptyTree = False 201 | treeElem x (Node a left right) | x == a = True 202 | | x < a = treeElem x left 203 | | otherwise = treeElem x right 204 | 205 | nums = [8, 2, 4, 5, 7, 10] 206 | numsTree = foldr treeInsert EmptyTree nums 207 | 208 | -- Typeclasses 102 209 | 210 | -- This is how the Eq (type)class is defined in Prelude: 211 | class Eq' a where 212 | (.==) :: a -> a -> Bool 213 | (./=) :: a -> a -> Bool 214 | x .== y = not (x ./= y) -- Mutual recursion 215 | x ./= y = not (x .== y) 216 | 217 | -- Here a is the type variable. How to define instances of the class? Here's an example: 218 | 219 | data TrafficLight = Red | Yellow | Green 220 | 221 | instance Eq' TrafficLight where 222 | Red .== Red = True -- Overwrite only (==): the minimal complete definition 223 | Green .== Green = True 224 | Yellow .== Yellow = True 225 | _ .== _ = False 226 | 227 | -- Class is for defining new typeclasses and instance is for making types instances of typeclasses. 228 | -- Also define instance of Show TrafficLight: 229 | instance Show TrafficLight where 230 | show Red = "Red light" 231 | show Yellow = "Yellow light" 232 | show Green = "Green light" 233 | 234 | -- One can also subclass, for example subclassing Num from Eq is essentially a **class constraint on a class declaration**. 235 | class (Eq' a) => Num' a where 236 | someNumBehaviour :: a -> a 237 | 238 | -- To define instances on type constructors, one needs to use a concrete type like (Maybe m): 239 | {- instance (Eq' m) => Eq' (Maybe m) where 240 | Just x == Just y = x == y -- Needs class constraint on m 241 | Nothing == Nothing = True 242 | _ == _ = False -} 243 | 244 | -- Most of the times, class constraints in class declarations are used for making a typeclass a subclass of another typeclass and class constraints in instance declarations are used to express requirements about the contents of some type. For instance, here we required the contents of the Maybe to also be part of the Eq typeclass. 245 | 246 | -- Use `:info Eq'` to see what the instances of a typeclass are. 247 | 248 | -- Custom YesNo typeclass representing "truthy" values. 249 | class YesNo a where 250 | yesno :: a -> Bool 251 | 252 | -- Typeclass instance on concrete Int type 253 | instance YesNo Int where 254 | yesno 0 = False 255 | yesno _ = True 256 | 257 | instance YesNo [a] where 258 | yesno [] = False 259 | yesno _ = True 260 | 261 | instance YesNo Bool where 262 | yesno = id -- From standard library, identity 263 | 264 | instance YesNo (Maybe a) where 265 | yesno (Just _) = True 266 | yesno Nothing = False 267 | 268 | instance YesNo (Tree a) where 269 | yesno EmptyTree = False 270 | yesno _ = True 271 | 272 | instance YesNo TrafficLight where 273 | yesno Red = False 274 | yesno _ = True 275 | 276 | emptyListTruthy = yesno $ length [] -- False 277 | stringTruthy = yesno "haha" 278 | justTruthy = yesno (Just 0) 279 | trueTruthy = yesno True 280 | 281 | -- Function that works on yesno instances 282 | yesnoIf :: (YesNo y) => y -> a -> a -> a 283 | yesnoIf yesnoVal yesResult noResult = 284 | if yesno yesnoVal then yesResult else noResult 285 | 286 | -- Functor typeclass gives the fmap function on all its instances: 287 | class Functor' f where 288 | fmap' :: (a -> b) -> f a -> f b 289 | 290 | -- Note that f is NOT a concrete type but a type constructor. fmap takes a function from one type to another and a functor applied with one type and returns a functor applied with another type. 291 | 292 | -- Functor instance on list can just use the list map: 293 | 294 | instance Functor' [] where -- Here [] is a type constructor (list), not concrete type 295 | fmap' = map 296 | 297 | fmapped = fmap' (+ 3) [1, 2, 3] 298 | 299 | -- Functor instance on Maybe: 300 | instance Functor' Maybe where 301 | fmap' f (Just x) = Just (f x) 302 | fmap' _ Nothing = Nothing 303 | 304 | fmappedMaybe = fmap' (* 2) (Just 3) 305 | 306 | -- Functor instance for our binary tree 307 | instance Functor Tree where 308 | fmap _ EmptyTree = EmptyTree 309 | fmap f (Node x left right) = Node (f x) (fmap f left) (fmap f right) 310 | 311 | fmappedTree = fmap (* 4) numsTree 312 | 313 | -- What about Either, it takes two type parameters and Functor only wants one? 314 | -- Simple, feed in one of the type parameters. That's because if the functor is for Either a 315 | -- the type signature becomes "(b -> c) -> (Either a) b -> (Either a) c" which makes a lot of sense: 316 | -- we only want to map over Right. 317 | instance Functor' (Either a) where 318 | fmap' f (Right x) = Right (f x) 319 | fmap' f (Left x) = Left x 320 | 321 | fmappedEither = fmap' (+ 2) (Right 10 :: Either String Int) 322 | 323 | -- Kinds are "labels" on types, kind of like type of type. Kinds can be inspected with `:k` in ghci: 324 | -- ghci> :k Int 325 | -- Int :: * 326 | -- ghci> :k Maybe 327 | -- Maybe :: * -> * -- Type constructor takes one concrete type and returns a concrete type. 328 | 329 | -- Types are the labels of values and kinds are the labels of types. 330 | 331 | -- What goes on here? 332 | class Tofu t where 333 | tofu :: j a -> t a j 334 | 335 | -- ja is used as the type of a value so "j a" must have kind *. 336 | -- Therefore, j must have kind * -> *. t takes two types and must produce a concrete value 337 | -- so it must have kind * -> (* -> *) -> *. So it takes a concrete type, a type constructor that takes one concrete type, and produces a concrete type. 338 | 339 | -- Example of a type with that kind: 340 | data Frank a b = Frank { frankField :: b a } deriving (Show) 341 | 342 | frank = Frank { frankField = Just "HAHA" } 343 | -- ghci> frank :: Frank [Char] Maybe 344 | 345 | instance Tofu Frank where 346 | tofu x = Frank x 347 | 348 | tofued = tofu (Just 'a') :: Frank Char Maybe 349 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Modules.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 7: http://learnyouahaskell.com/modules 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module Modules 5 | () 6 | where 7 | 8 | -- Import given functions 9 | -- import Data.List ( nub ) 10 | -- Hide a specific function 11 | -- import Data.List hiding ( sort ) 12 | -- "Named" import, use as "Map.filter" 13 | import qualified Data.Map as Map 14 | import qualified Data.Set as Set 15 | import qualified Data.List as L 16 | import qualified Data.Function as F 17 | 18 | -- All the functions, types and typeclasses that we've dealt with so far were part of the Prelude module, which is imported by default. The syntax for importing modules in a Haskell script is "import ". 19 | 20 | numUniques :: (Eq a) => [a] -> Int 21 | numUniques = length . L.nub 22 | 23 | -- Functions of modules can be put into the global namescape like this: 24 | -- ghci> :m + Data.List 25 | 26 | -- Examples from Data.List: 27 | interspersed = L.intersperse '.' "Monkey" 28 | intercalated = L.intercalate " " ["hey", "there", "guys"] 29 | transposed = L.transpose [[1, 2, 3], [4, 5, 6]] 30 | 31 | -- Summing elements of list 32 | transposeExample = 33 | map sum $ L.transpose [[0, 3, 5, 9], [10, 0, 0, 9], [8, 6, 1, -1]] 34 | 35 | -- L.foldl' and L.foldl1' are stricter versions of their respective lazy incarnations. 36 | -- The strict folds aren't lazy buggers and actually compute the intermediate values as they go along instead of filling up your stack with thunks like foldl does 37 | 38 | concatted = concat ["foo", "bar", "car"] 39 | 40 | concatMapped = concatMap (replicate 4) [1 .. 3] 41 | 42 | allTrue = and . map (> 4) $ [5, 6, 7, 8] 43 | anyTrue = or $ map (== 4) [2, 3, 4, 5] 44 | 45 | anyTrue' = any (== 4) [2, 3, 4, 5] 46 | allTrue' = all (> 4) [6, 49] 47 | 48 | -- iterate takes a function and a starting value. It applies the function to the starting value, then it applies that function to the result, then it applies the function to that result again, etc. It returns all the results in the form of an infinite list. 49 | 50 | iterated = take 10 $ iterate (* 2) 1 51 | 52 | -- Example of dropWhile: 53 | stock = 54 | [ (994.4 , 2008, 9, 1) 55 | , (995.2 , 2008, 9, 2) 56 | , (999.2 , 2008, 9, 3) 57 | , (1001.4, 2008, 9, 4) 58 | , (998.3 , 2008, 9, 5) 59 | ] 60 | 61 | firstAboveThousand = head $ dropWhile (\(val, y, m, d) -> val < 1000) stock 62 | 63 | -- inits and tails are like init and tail, only they recursively apply that to a list until there's nothing left. 64 | -- tails "woof" => ["woof", "oof", "of", "f", ""] 65 | search :: (Eq a) => [a] -> [a] -> Bool 66 | search needle haystack = 67 | let nlen = length needle 68 | in foldl (\acc x -> (take nlen x == needle) || acc) 69 | False 70 | (L.tails haystack) 71 | 72 | -- partition takes a list and a predicate and returns a pair of lists. 73 | -- Note that span and break are done once they encounter the first element that doesn't and does satisfy the predicate, partition goes through the whole list and splits it up according to the predicate. 74 | partitioned = L.partition (`elem` ['A' .. 'Z']) "BOBsidneyMORGANeddy" 75 | 76 | -- find is a safe find function that returns a Maybe 77 | firstOverThousand = L.find (\(val, y, m, d) -> val > 1000) stock 78 | 79 | -- Zipping more than two arguments can be done with zipWithX 80 | zippedWith3 = zipWith3 (\x y z -> x + y + z) [1, 2, 3] [4, 5, 2, 2] [2, 2, 3] 81 | 82 | -- \\ is the list difference function. 83 | listDiff = [1 .. 10] L.\\ [2, 5, 9] 84 | 85 | -- Example of groupBy with `on`: 86 | values = 87 | [-4.3, -2.4, -1.2, 0.4, 2.3, 5.9, 10.5, 29.1, 5.3, -2.4, -14.5, 2.9, 2.3] 88 | groupedBySign = L.groupBy ((==) `F.on` (> 0)) values 89 | -- Here `(==) `F.on` (>0)` is the function \x y -> (==) (>0 x) (>0 y), 90 | -- so it says whether the two values are equal in the sense that they are both larger than zero. 91 | 92 | -- Another example with sortBy 93 | xs = [[5, 4, 5, 4, 4], [1, 2, 3], [3, 5, 4, 3], [], [2], [2, 2]] 94 | listsSortedByLength = L.sortBy (compare `F.on` length) xs 95 | -- compare `F.on` length is the same as \x y -> length x `compare` length y 96 | 97 | -- Examples of Data.Char 98 | -- http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Char.html 99 | 100 | -- Data.Map 101 | -- http://hackage.haskell.org/package/containers-0.6.2.1/docs/Data-Map.html 102 | 103 | -- Data.Set 104 | -- http://hackage.haskell.org/package/containers-0.6.2.1/docs/Data-Set.html 105 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/Recursion.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 5: http://learnyouahaskell.com/recursion 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module Recursion 5 | () 6 | where 7 | 8 | -- Recursion is important to Haskell because unlike imperative languages, you do computations in Haskell by declaring what something is instead of declaring how you get it. That's why there are no while loops or for loops in Haskell and instead we many times have to use recursion to declare what something is. 9 | 10 | -- To set up the maximum function recursively, we first set up an edge condition and say that the maximum of a singleton list is equal to the only element in it. Then we can say that the maximum of a longer list is the head if the head is bigger than the maximum of the tail. If the maximum of the tail is bigger, well, then it's the maximum of the tail. 11 | 12 | maximum' :: (Ord a) => [a] -> a 13 | maximum' [] = error "maximum of empty list" 14 | maximum' [x] = x 15 | maximum' (x:xs) 16 | | x > maxTail = x 17 | | otherwise = maxTail 18 | where maxTail = maximum' xs 19 | -- maximum' (x:xs) = max x (maximum' xs) -- Shorter version with max 20 | 21 | -- Let's see some more examples to see pattern matching and guards in action! 22 | 23 | replicate' :: (Num i, Ord i) => i -> a -> [a] 24 | replicate' n x 25 | | n <= 0 = [] 26 | | otherwise = x:replicate' (n-1) x 27 | 28 | take' :: (Num i, Ord i) => i -> [a] -> [a] 29 | take' n _ -- Define edge condition for n with guards as needs boolean condition 30 | | n<= 0 = [] -- No "otherwise" to allow flowing to next pattern 31 | take' _ [] = [] -- Pattern matching for the list matching part 32 | take' n (x:xs) = x : take' (n-1) xs 33 | 34 | reverse' :: [a] -> [a] 35 | reverse' [] = [] 36 | reverse' (x:xs) = reverse' xs ++ [x] 37 | 38 | -- Recursion without an edge condition 39 | repeat' :: a -> [a] 40 | repeat' x = x : repeat' x 41 | -- Use with something like `take 4 (repeat' 3)` 42 | 43 | zip' :: [a] -> [b] -> [(a, b)] 44 | zip' _ [] = [] 45 | zip' [] _ = [] 46 | zip' (x:xs) (y:ys) = (x, y) : zip' xs ys 47 | 48 | elem' :: (Eq a) => a -> [a] -> Bool 49 | elem' _ [] = False 50 | elem' a (x:xs) = a == x || a `elem'` xs 51 | 52 | -- QuickSort is the poster child of Haskell, it's so elegant! 53 | -- In quicksort, a sorted list is a list that has all the values smaller than (or equal to) the head of the list in front (and those values are sorted), then comes the head of the list in the middle and then come all the values that are bigger than the head (they're also sorted). 54 | -- Notice that the definition uses the verb "is" to define the algorithm instead of saying "do this, do that, then do that..." That's functional programming! 55 | quicksort:: (Ord a) => [a] -> [a] 56 | quicksort [] = [] 57 | quicksort (x:xs) = 58 | let smallerSorted = quicksort [a | a <- xs, a <= x] 59 | biggerSorted = quicksort [a | a <- xs, a > x] 60 | in smallerSorted ++ [x] ++ biggerSorted 61 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/StartingOut.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 2: http://learnyouahaskell.com/starting-out 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module StartingOut 5 | () 6 | where 7 | 8 | -- Function with no arguments is called a definition or name 9 | -- Apply with: printHello (no parentheses!) 10 | printHello = putStrLn "Hello from Haskell!" 11 | 12 | -- Function taking one argument 13 | -- Apply with: doubleMe 2 14 | doubleMe x = x + x 15 | 16 | -- Function taking two arguments 17 | -- Application with prefix: doubleUs 1 2 18 | -- Application as infix: 1 `doubleUs` 2 19 | doubleUs x y = doubleMe x + doubleMe y 20 | 21 | -- In Haskell, if statement is an expression and must return something 22 | doubleSmallNumber x = if x > 100 then x else x * 2 23 | 24 | -- Use the expression as part of a larger expression 25 | doubleSmallNumber' x = (if x > 100 then x else x * 2) + 1 26 | 27 | -- In Haskell, lists are homogenous: they can only store elements of the same type. 28 | lostNumbers = [4, 8, 15, 16, 23, 42] 29 | 30 | -- Concatenation with ++ 31 | concatenatedLists = lostNumbers ++ [9, 10, 11, 12] 32 | 33 | -- Strings are just lists of chars 34 | concatenatedString = "hello" ++ " " ++ "world" 35 | 36 | -- Cons operator is very fast compared to concatenation 37 | aSmallCat = 'A' : " SMALL CAT" 38 | 39 | -- These are equal 40 | areEqualLists = 1 : 2 : 3 : [] == [1, 2, 3] -- true 41 | 42 | -- Accessing elements by index 43 | secondLetter = "Steve Buscemi" !! 1 44 | 45 | -- Lists have the usual basic functions 46 | headOfAList = head lostNumbers 47 | lengthOfAList = length lostNumbers 48 | listIsNull = null lostNumbers 49 | firstThreeNumbers = take 3 lostNumbers 50 | has42 = 42 `elem` lostNumbers 51 | 52 | -- Ranges are a way of making lists that are arithmetic sequences of elements that can be enumerated. 53 | listOfNumbers = [1 .. 20] 54 | listOfChars = ['a' .. 'z'] 55 | listOfNumbersWithStep = [2, 4 .. 20] 56 | listGoingBackwards = [20, 19 .. 1] 57 | listTakenFromInfiniteList = take 24 [13, 26 ..] 58 | listTakenFromCycle = take 7 (cycle [1, 2, 3]) 59 | listWithReplicate = replicate 10 5 -- Equivalent to take 10 (repeat 5) 60 | 61 | -- List comprehensions 62 | listComprehension = [ 2 * x | x <- [1 .. 10] ] 63 | 64 | -- Filtering a list comprehension using a predicate 65 | listComprehensionWithFilter = [ 2 * x | x <- [1 .. 10], x > 5 ] 66 | 67 | -- Custom function applying to a list 68 | boomBangs xs = [ if x < 10 then "BOOM" else "BANG!" | x <- xs, odd x ] 69 | 70 | -- Compute all products from two lists 71 | listComprehensionWithTwoLists = [ x * y | x <- [1, 2, 3], y <- [4, 5, 6] ] 72 | 73 | -- Simple implementation of length using a list comprehension 74 | length' xs = sum [ 1 | _ <- xs ] 75 | 76 | -- Strings are lists of chars so just process them with list comprehensions 77 | removeNonUppercase st = [ c | c <- st, c `elem` ['A' .. 'Z'] ] 78 | 79 | -- Lists can also be zipped 80 | zippedList = [1, 2, 3, 4, 5] `zip` [1, 2, 3, 4, 5] 81 | 82 | -- Because Haskell is lazy and the longer list simply gets cut off, 83 | -- you can zip an infinite list with a finite list 84 | zippedListWithTwoElements = zip [1 ..] ["apple", "orange"] 85 | 86 | -- There are also tuples, which are a bit like lists with definite length 87 | -- and allowed to contain several types 88 | tuple = ('a', 1) 89 | 90 | firstItemOfTuple = fst tuple 91 | secondItemOfTuple = snd tuple 92 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/SyntaxInFunctions.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 4: http://learnyouahaskell.com/syntax-in-functions 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module SyntaxInFunctions 5 | () 6 | where 7 | 8 | -- Pattern matching 9 | 10 | -- When defining functions, define separate bodies for different patterns 11 | lucky :: (Integral a) => a -> String 12 | lucky 7 = "LUCKY NUMBER SEVEN!" 13 | lucky x = "Sorry you're out of luck!" 14 | 15 | sayMe :: (Integral a) => a -> String 16 | sayMe 1 = "One!" 17 | sayMe 2 = "Two!" 18 | sayMe x = "Not one or two!" 19 | 20 | -- Recursion becomes beautiful with pattern matching 21 | factorial :: (Integral a) => a -> a 22 | factorial 0 = 1 23 | factorial n = n * factorial (n - 1) 24 | 25 | -- Extract variables with pattern matching 26 | addVectors :: (Num a) => (a, a) -> (a, a) -> (a, a) 27 | addVectors (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) 28 | 29 | -- Custom `head` 30 | head' :: [a] -> a 31 | head' [] = error "Can't call head on an empty list!" 32 | head' (x : _) = x 33 | -- head' [x] = x -- This would also work for matching a list 34 | 35 | -- Custom length function: 36 | length' :: (Num b) => [a] -> b 37 | length' [] = 0 38 | length' (_ : xs) = 1 + length' xs 39 | 40 | -- "as patterns" allow keeping reference to the full input 41 | capital :: String -> String 42 | capital "" = "Empty string!" 43 | capital all@(x : xs) = "The first letter of " ++ all ++ " is " ++ [x] 44 | 45 | -- Guards are indicated by pipes that follow a function's name and its parameters. 46 | bmiTell :: (RealFloat a) => a -> String 47 | bmiTell bmi | bmi < 18.5 = "You're underweight, you emo, you!" 48 | | bmi < 25.0 = "You're supposedly normal, pfft!" 49 | | bmi < 30.0 = "You're fat you fatty!" 50 | | otherwise = "You're a whale, congrats!" 51 | 52 | max' :: (Ord a) => a -> a -> a 53 | max' a b | a < b = a 54 | | otherwise = b 55 | 56 | -- Custom compare with infix definition using backticks 57 | compare' :: (Ord a) => a -> a -> Ordering 58 | a `compare'` b | a > b = GT 59 | | a < b = LT 60 | | a == b = EQ 61 | 62 | -- One can define values to avoid repeating oneself using the "where" binding. 63 | -- Where bindings are a syntactic construct that let you bind to variables 64 | -- at the end of a function and the whole function can see them, including all the guards. 65 | bmiTell' :: (RealFloat a) => a -> a -> String 66 | bmiTell' weight height 67 | | bmi <= skinny = "You're underweight, you emo, you!" 68 | | bmi <= normal = "You're supposedly normal. Pffft, I bet you're ugly!" 69 | | bmi <= fat = "You're fat! Lose some weight, fatty!" 70 | | otherwise = "You're a whale, congratulations!" 71 | where 72 | bmi = weight / height ^ 2 73 | (skinny, normal, fat) = (18.5, 25.0, 30.0) -- Pattern matching 74 | 75 | 76 | -- One can also define functions inside "where" 77 | calcBmis :: (RealFloat a) => [(a, a)] -> [a] 78 | calcBmis xs = [ bmi w h | (w, h) <- xs ] -- Pattern matching in a list comprehension! 79 | where bmi weight height = weight / height ^ 2 -- Function defined in a binding! 80 | 81 | -- Let bindings let one bind to variables anywhere and are expressions themselves. 82 | -- They are very local, so they don't span across guards. 83 | -- The form is "let in ": 84 | cylinder :: (RealFloat a) => a -> a -> a 85 | cylinder r h = 86 | let sideArea = 2 * pi * r * h 87 | topArea = pi * r ^ 2 88 | in sideArea + 2 * topArea 89 | 90 | -- let bindings are expressions that one can cram basically anywhere 91 | -- just like if-else: 92 | expressionWithLet = 4 * (let a = 9 in a + 1) + 2 93 | 94 | -- One can also introduce functions in local scope: 95 | squares = [let square x = x * x in (square 5, square 3, square 2)] 96 | 97 | -- Several variables are separated with semicolons: 98 | tupleWithLets = 99 | ( let a = 100 100 | b = 200 101 | c = 300 102 | in a * b * c 103 | , let foo = "Hey " 104 | bar = "there!" 105 | in foo ++ bar 106 | ) 107 | 108 | -- Remember you can pattern match bindings: 109 | foo = (let (a, b, c) = (1, 2, 3) in a + b + c) * 100 110 | 111 | -- let bindings can also be used inside list comprehensions: 112 | calcBmis' :: (RealFloat a) => [(a, a)] -> [a] 113 | calcBmis' xs = [ bmi | (w, h) <- xs, let bmi = w / h ^ 2 ] 114 | 115 | -- Case expressions can be used for pattern matching pretty much anywhere: 116 | describeList :: [a] -> String 117 | describeList xs = "The list is " ++ case xs of 118 | [] -> "empty." 119 | [x] -> "a singleton list." 120 | xs -> "a longer list." 121 | 122 | 123 | -- This is equivalent to this 124 | describeList' :: [a] -> String 125 | describeList' xs = "The list is " ++ what xs 126 | where 127 | what [] = "empty." 128 | what [x] = "a singleton list." 129 | what xs = "a longer list." 130 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/TreeADT.hs: -------------------------------------------------------------------------------- 1 | -- Example abstract data type 2 | -- https://www.haskell.org/tutorial/modules.html 3 | module TreeADT 4 | ( Tree 5 | , leaf 6 | , branch 7 | , cell 8 | , left 9 | , right 10 | , isLeaf 11 | ) 12 | where 13 | 14 | data Tree a = Leaf a | Branch (Tree a) (Tree a) 15 | 16 | leaf = Leaf 17 | branch = Branch 18 | cell (Leaf a) = a 19 | left (Branch l r) = l 20 | right (Branch l r) = r 21 | isLeaf (Leaf _) = True 22 | isLeaf _ = False 23 | -------------------------------------------------------------------------------- /learn-you-a-haskell/src/TypesAndTypeClasses.hs: -------------------------------------------------------------------------------- 1 | -- Chapter 3: http://learnyouahaskell.com/types-and-typeclasses 2 | -- Enter interactive mode with `stack ghci` 3 | -- and load the module with `:l StartingOut` 4 | module TypesAndTypeClasses 5 | () 6 | where 7 | 8 | -- Haskell has a static type system. 9 | -- Use `:t` in `ghci` to tell a type of a variable. 10 | 11 | -- Read this as "a has type of Char" 12 | -- ghci> :t 'a' 13 | -- 'a' :: Char 14 | 15 | -- Double quotes mark a "String" 16 | -- ghci> :t "a" 17 | -- "a" :: [Char] 18 | 19 | -- Functions can be given explicit type declarations as follows 20 | removeNonUpperCase :: String -> String 21 | removeNonUpperCase st = [ c | c <- st, c `elem` ['A' .. 'Z'] ] 22 | 23 | -- Curried function can be defined as follows 24 | addThree :: Int -> Int -> Int -> Int 25 | addThree x y z = x + y + z 26 | 27 | -- Type variables are a bit like generics in other languages. See them in action: 28 | -- ghci> :t head 29 | -- head :: [a] -> a 30 | -- The above says that `head` is a polymorphic function that can be used on a list of any type 31 | -- and returns an element of that type. 32 | 33 | -- A typeclass is a kind of interface that defines behaviour. Consider the "==" functions: 34 | -- ghci> :t (==) 35 | -- (==) :: Eq a => a -> a -> Bool 36 | 37 | -- Note that "==" contains only special characters so it's considered infix by default. 38 | -- Its type can be inspected by wrapping it in parentheses. 39 | 40 | -- Above, everything before `<==` is called a class constraint. The type is read as follows: 41 | -- "(==) takes any two values that are of the same type and returns a Bool. The type of those two values must be a member of the Eq class" 42 | -- Here the `Eq` typeclass provides an interface for testing equality. 43 | 44 | -- Another example with `elem`: 45 | -- ghci> :t elem 46 | -- elem :: (Foldable t, Eq a) => a -> t a -> Bool 47 | -- Here `t a` is a foldable (like list) containing values of type `a`. 48 | 49 | -- Basic type classes: 50 | 51 | -- `Eq` is used for types that support testing for equality. Its members implement the functions `==` and `/=` 52 | 53 | -- `Ord` if for types that have ordering 54 | -- ghci> :t (>) 55 | -- (>) :: Ord a => a -> a -> Bool 56 | -- ghci> :t compare 57 | -- compare :: Ord a => a -> a -> Ordering 58 | 59 | -- Members of `Show` can be presented as strings with the `show` function: 60 | -- ghci> :t show 61 | -- show :: Show a => a -> String 62 | 63 | -- Members of `Read` can be constructed from a String with the `read` function 64 | -- ghci> :t read 65 | -- read :: Read a => String -> a 66 | -- When reading an ambiguous type like `read "4"`, you can use explicit type annotations to help Haskell infer the type: 67 | -- ghci> read "4" :: Int 68 | 69 | -- Members of `Bounded` have an upper and lower bound that one can access with, e.g., `minBound` 70 | -- ghci> :t minBound 71 | -- minBound :: Bounded a => a 72 | 73 | -- Note that `minBound` does not take input arguments, "Bounded a" is the class constraint. 74 | -- `minBound` is a kind of polymorphic constant. 75 | 76 | -- ghci> minBound :: Int 77 | -- -9223372036854775808 78 | 79 | -- `Num` is a numeric typeclass for beings able to act like numbers. 80 | -- ghci> :t 20 81 | -- 20 :: (Num p) => p 82 | 83 | -- Numbers are also "polymorphic constants" able to act like any type that's a member of the `Num` type class: 84 | 85 | a = 20 :: Int 86 | b = 20 :: Double 87 | 88 | -- One can use functions like `fromIntegral` to map an Integral (Int or Integer) to a `Num`: 89 | -- ghci> :t fromIntegral 90 | -- fromIntegral :: (Integral a, Num b) => a -> b 91 | 92 | c = fromIntegral (length [1, 2, 3, 4]) + 3.2 93 | -------------------------------------------------------------------------------- /learn-you-a-haskell/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-13.30 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | extra-deps: 43 | - acme-missiles-0.3 # not in the LTS 44 | - HUnit-1.6.0.0 45 | - lens-tutorial-1.0.4@sha256:325b59b7658f035d11386589c57d603ee27573f191ed8380dc2a890102bfe143,1199 46 | # Override default flag values for local packages and extra-deps 47 | # flags: {} 48 | 49 | # Extra package databases containing global packages 50 | # extra-package-dbs: [] 51 | 52 | # Control whether we use the GHC we find on the path 53 | # system-ghc: true 54 | # 55 | # Require a specific version of stack, using version ranges 56 | # require-stack-version: -any # Default 57 | # require-stack-version: ">=2.1" 58 | # 59 | # Override the architecture used by stack, especially useful on Windows 60 | # arch: i386 61 | # arch: x86_64 62 | # 63 | # Extra directories used by stack for building 64 | # extra-include-dirs: [/path/to/dir] 65 | # extra-lib-dirs: [/path/to/dir] 66 | # 67 | # Allow a newer minor version of GHC than the snapshot specifies 68 | # compiler-check: newer-minor 69 | -------------------------------------------------------------------------------- /learn-you-a-haskell/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: acme-missiles-0.3@sha256:2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1,613 9 | pantry-tree: 10 | size: 226 11 | sha256: 614bc0cca76937507ea0a5ccc17a504c997ce458d7f2f9e43b15a10c8eaeb033 12 | original: 13 | hackage: acme-missiles-0.3 14 | - completed: 15 | hackage: HUnit-1.6.0.0@sha256:8014b27c884becd8041214a1ab263fa92244ca62700a911aff604a1047869298,1570 16 | pantry-tree: 17 | size: 878 18 | sha256: 270a6f8d6ef23eba3a9a1697aa244576abb168d10cb8e4736cf4add2b09eb650 19 | original: 20 | hackage: HUnit-1.6.0.0 21 | - completed: 22 | hackage: lens-tutorial-1.0.4@sha256:325b59b7658f035d11386589c57d603ee27573f191ed8380dc2a890102bfe143,1199 23 | pantry-tree: 24 | size: 279 25 | sha256: c04add7d791a173f23f32b25f6fe14151f23e2f8651c0e1a0bcfc6293df9a80c 26 | original: 27 | hackage: lens-tutorial-1.0.4@sha256:325b59b7658f035d11386589c57d603ee27573f191ed8380dc2a890102bfe143,1199 28 | snapshots: 29 | - completed: 30 | size: 500539 31 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml 32 | sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b 33 | original: lts-13.30 34 | -------------------------------------------------------------------------------- /learn-you-a-haskell/test/OptimalPath.hs: -------------------------------------------------------------------------------- 1 | module OptimalPath where 2 | 3 | import FunctionallySolvingProblems as F 4 | import Test.HUnit 5 | 6 | expectedPath :: F.Path 7 | expectedPath = 8 | [(F.B, 10), (F.C, 30), (F.A, 5), (F.C, 20), (F.B, 2), (F.B, 8), (F.C, 0)] 9 | 10 | -- Optimal path solutions 11 | testSolution = 12 | TestCase 13 | $ assertEqual "Optimal path should be as expected" expectedPath 14 | $ F.optimalPath F.heathrowToLondon 15 | 16 | testRoadStep = 17 | TestCase 18 | $ assertEqual "Road step should work as expected for the first step" 19 | ([(F.C, 30), (F.B, 10)], [(B, 10)]) 20 | $ roadStep ([], []) (head F.heathrowToLondon) 21 | 22 | testOptimalPath = TestList [testRoadStep, testSolution] 23 | -------------------------------------------------------------------------------- /learn-you-a-haskell/test/RPN.hs: -------------------------------------------------------------------------------- 1 | module RPN where 2 | 3 | import FunctionallySolvingProblems 4 | import Test.HUnit 5 | 6 | exampleTest = TestCase $ assertEqual "Should sum 1+1 to 2" 2 (1 + 1) 7 | 8 | -- RPN tests 9 | testRPN1 = 10 | TestCase $ assertEqual "RPN should sum '1 1 +' to 2" 2 $ solveRPN "1 1 +" 11 | 12 | testRPN2 = 13 | "testRPN2" ~: assertEqual "RPN should sum '1 2 +' to 3" 3 $ solveRPN "1 2 +" 14 | 15 | testRPN = TestList [testRPN1, testRPN2] 16 | -------------------------------------------------------------------------------- /learn-you-a-haskell/test/Spec.hs: -------------------------------------------------------------------------------- 1 | import FunctionallySolvingProblems ( solveRPN ) 2 | import Test.HUnit as HUnit 3 | import RPN ( testRPN ) 4 | import OptimalPath ( testOptimalPath ) 5 | 6 | exampleTest = TestCase $ assertEqual "Should sum 1+1 to 2" 2 (1 + 1) 7 | 8 | {- tests = TestList 9 | [TestLabel "Example test 1" test1, TestLabel "Solve RPN 1" testRPN1] -} 10 | 11 | main :: IO HUnit.Counts 12 | main = HUnit.runTestTT $ TestList [exampleTest, testRPN, testOptimalPath] 13 | -------------------------------------------------------------------------------- /learn-you-a-haskell/todo-app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Data.Char 4 | import Control.Monad 5 | import System.Environment 6 | import System.Directory 7 | import System.IO 8 | import Data.List 9 | 10 | add :: [String] -> IO () 11 | add [fileName, todoItem] = appendFile fileName (todoItem ++ "\n") 12 | 13 | view :: [String] -> IO () 14 | view [fileName] = do 15 | contents <- readFile fileName 16 | let todoTasks = lines contents 17 | numberedTasks = 18 | zipWith (\n line -> show n ++ " - " ++ line) [0 ..] todoTasks 19 | putStr $ unlines numberedTasks 20 | 21 | remove :: [String] -> IO () 22 | remove [fileName, numberString] = do 23 | handle <- openFile fileName ReadMode 24 | (tempName, tempHandle) <- openTempFile "." "temp" 25 | contents <- hGetContents handle 26 | let number = read numberString 27 | todoTasks = lines contents 28 | newTodoItems = delete (todoTasks !! number) todoTasks 29 | hPutStr tempHandle $ unlines newTodoItems 30 | hClose handle 31 | hClose tempHandle 32 | removeFile fileName 33 | renameFile tempName fileName 34 | 35 | dispatch :: [(String, [String] -> IO ())] 36 | dispatch = [("add", add), ("view", view), ("remove", remove)] 37 | 38 | main :: IO () 39 | main = do 40 | (command : args) <- getArgs 41 | let (Just action) = lookup command dispatch 42 | action args 43 | -------------------------------------------------------------------------------- /monocle-ts/.gitignore: -------------------------------------------------------------------------------- 1 | node_modules/ -------------------------------------------------------------------------------- /monocle-ts/README.md: -------------------------------------------------------------------------------- 1 | # Introduction to `monocle-ts` 2 | 3 | See [optics-part-1.md](./optics-part-1.md) for an introduction to `monocle-ts` and [artists.test.ts](./artists.test.ts) for code. 4 | 5 | ## Instructions 6 | 7 | Install dependencies: 8 | 9 | ```bash 10 | $ yarn 11 | ``` 12 | 13 | Run tests: 14 | 15 | ```bash 16 | $ yarn test 17 | ``` 18 | -------------------------------------------------------------------------------- /monocle-ts/artists.test.ts: -------------------------------------------------------------------------------- 1 | import { 2 | Iso, 3 | Lens, 4 | Optional, 5 | Prism, 6 | Traversal, 7 | fromTraversable, 8 | } from "monocle-ts"; 9 | import { array } from "fp-ts/lib/array"; 10 | import { fromNullable, some, none, Option } from "fp-ts/lib/Option"; 11 | import { Either, fold, isLeft, isRight } from "fp-ts/lib/Either"; 12 | import { findIndex, isEqual, maxBy } from "lodash"; 13 | import * as t from "io-ts"; 14 | import { PathReporter } from "io-ts/lib/PathReporter"; 15 | 16 | /* 17 | interface Hobby { 18 | name: string; 19 | } 20 | */ 21 | const HobbyT = t.interface({ name: t.string }); 22 | type Hobby = t.TypeOf; // Static type 23 | 24 | /* interface Person { 25 | firstName: string; 26 | age: number; 27 | hobbies: Hobby[]; 28 | } */ 29 | const PersonT = t.interface({ 30 | firstName: t.string, 31 | age: t.number, 32 | hobbies: t.array(HobbyT), 33 | }); 34 | type Person = t.TypeOf; 35 | 36 | /* type Band = { 37 | name: string; 38 | members: Person[]; 39 | }; */ 40 | const BandT = t.interface({ name: t.string, members: t.array(PersonT) }); 41 | type Band = t.TypeOf; 42 | 43 | // type Artist = Person | Band; 44 | const ArtistT = t.union([PersonT, BandT]); 45 | type Artist = t.TypeOf; 46 | 47 | const elvis: Artist = { 48 | firstName: "Elvis", 49 | age: 85, 50 | hobbies: [ 51 | { 52 | name: "singing", 53 | }, 54 | ], 55 | }; 56 | 57 | /** 58 | * Small helper function that gets the value from Either if it's right, 59 | * throws otherwise 60 | * @param either 61 | */ 62 | const getOrThrow = (either: Either): A => { 63 | return fold( 64 | () => { 65 | throw Error( 66 | `Failed decoding, errors: ${PathReporter.report(either).join(", ")}` 67 | ); 68 | }, 69 | (val: A) => val 70 | )(either); 71 | }; 72 | 73 | const metallica: Band = { 74 | name: "Metallica", 75 | members: [ 76 | { 77 | firstName: "James", 78 | hobbies: [], 79 | age: 56, 80 | }, 81 | { 82 | firstName: "Lars", 83 | hobbies: [], 84 | age: 55, 85 | }, 86 | { 87 | firstName: "Kirk", 88 | hobbies: [], 89 | age: 57, 90 | }, 91 | { 92 | firstName: "Robert", 93 | hobbies: [], 94 | age: 55, 95 | }, 96 | ], 97 | }; 98 | 99 | const artists: Artist[] = [elvis, metallica]; 100 | 101 | describe("io-ts", () => { 102 | it("HobbyT.is accepts an valid hobby object as HobbyT", () => { 103 | const isHobby = HobbyT.is({ name: "Photographing corgis" }); 104 | expect(isHobby).toBe(true); 105 | }); 106 | it("HobbyT.is does not accept an invalid hobby object as HobbyT", () => { 107 | const isHobby = HobbyT.is({ name: 66 }); 108 | expect(isHobby).toBe(false); 109 | }); 110 | it("HobbyT.decode can decode a hobby from valid input", () => { 111 | const maybeHobby = HobbyT.decode({ name: "Petting corgis" }); 112 | expect(isRight(maybeHobby)).toBe(true); 113 | }); 114 | it("HobbyT.decode does not decode a hobby from invalid input", () => { 115 | const maybeHobby = HobbyT.decode({ name: 67 }); 116 | expect(isLeft(maybeHobby)).toBe(true); 117 | }); 118 | it("ArtistT.decode can decode an artist from elvis", () => { 119 | const maybeArtist = ArtistT.decode(elvis); 120 | expect(isRight(maybeArtist)).toBe(true); 121 | }); 122 | it("BandT.is validates metallica object as proper Band", () => { 123 | expect(BandT.is(metallica)).toBe(true); 124 | }); 125 | it("ArtistT.decode does not decode an artist from invalid data", () => { 126 | const foo = { lastName: "corgi" }; 127 | const notArtist = ArtistT.decode(foo); 128 | expect(isLeft(notArtist)).toBe(true); 129 | }); 130 | }); 131 | 132 | describe("monocle-ts", () => { 133 | describe("lenses", () => { 134 | const personToName: Lens = Lens.fromProp()( 135 | "firstName" 136 | ); 137 | it("should be getter", () => { 138 | const getName: (p: Person) => string = (p: Person) => personToName.get(p); 139 | expect(getName(elvis)).toEqual("Elvis"); 140 | }); 141 | it("should be a setter", () => { 142 | const setName: (newName: string) => (p: Person) => Person = 143 | personToName.set; 144 | const setJillAsName: (p: Person) => Person = setName("Jill"); 145 | const modified: Person = setJillAsName(elvis); 146 | expect(modified).toHaveProperty("firstName", "Jill"); 147 | expect(elvis).toHaveProperty("firstName", "Elvis"); // Unchanged 148 | }); 149 | it("should be a setter", () => { 150 | const upperCase = (s: string): string => s.toUpperCase(); 151 | const upperCasePersonName: (p: Person) => Person = personToName.modify( 152 | upperCase 153 | ); 154 | const elvisUpperCased = upperCasePersonName(elvis); 155 | expect(elvisUpperCased).toHaveProperty("firstName", "ELVIS"); 156 | }); 157 | it("allows to avoid some boilerplate with 'fromPath'", () => { 158 | const personToAge: Lens = Lens.fromPath()([ 159 | "age", 160 | ]); 161 | expect(personToAge.get(elvis)).toBe(85); 162 | }); 163 | }); 164 | 165 | describe("optional", () => { 166 | /** 167 | * Laws for Optional: 168 | * getOption(s).fold(() => s, a => set(a)(s)) = s 169 | * getOption(set(a)(s)) = getOption(s).map(_ => a) 170 | * set(a)(set(a)(s)) = set(a)(s) 171 | */ 172 | const membersLens = Lens.fromProp()("members"); 173 | 174 | describe("head", () => { 175 | const getOption: (ps: Person[]) => Option = ( 176 | personArray: Person[] 177 | ) => (personArray.length === 0 ? none : some(personArray[0])); 178 | 179 | const set: (p: Person) => (ps: Person[]) => Person[] = (p: Person) => ( 180 | ps: Person[] 181 | ) => (ps.length === 0 ? [] : [p, ...ps.slice(1)]); 182 | 183 | const head = new Optional, Person>(getOption, set); 184 | 185 | const bandToFirstMember: Optional< 186 | Band, 187 | Person 188 | > = membersLens.composeOptional(head); 189 | 190 | it("allows getting the first member of the band", () => { 191 | expect(bandToFirstMember.getOption(metallica)).toEqual( 192 | some( 193 | expect.objectContaining({ 194 | firstName: "James", 195 | }) 196 | ) 197 | ); 198 | }); 199 | 200 | it("is safe with empty band", () => { 201 | const bandWithNoMembers: Band = { 202 | name: "Unknown", 203 | members: [], 204 | }; 205 | expect(bandToFirstMember.getOption(bandWithNoMembers)).toEqual(none); 206 | }); 207 | 208 | it("allows composition with other lenses", () => { 209 | const nameLens = Lens.fromProp()("firstName"); 210 | const nameOptional: Optional< 211 | Band, 212 | string 213 | > = bandToFirstMember.composeLens(nameLens); 214 | 215 | const upperCase = (s: string): string => s.toUpperCase(); 216 | 217 | const upperCaseFirstBandMemberName = nameOptional.modify(upperCase); 218 | 219 | expect(upperCaseFirstBandMemberName(metallica).members).toContainEqual( 220 | expect.objectContaining({ 221 | firstName: "JAMES", 222 | }) 223 | ); 224 | }); 225 | }); 226 | 227 | describe("oldest member", () => { 228 | const getOption: (ps: Person[]) => Option = ( 229 | personArray: Person[] 230 | ) => fromNullable(maxBy(personArray, "age")); 231 | 232 | const set: (p: Person) => (ps: Person[]) => Person[] = (p: Person) => ( 233 | ps: Person[] 234 | ) => { 235 | const oldest = maxBy(ps, "age"); 236 | if (!oldest) { 237 | return []; 238 | } 239 | 240 | const indexOfOldest = findIndex(ps, (other: Person) => 241 | isEqual(oldest, other) 242 | ); 243 | 244 | return [ 245 | ...ps.slice(0, indexOfOldest), 246 | p, 247 | ...ps.slice(indexOfOldest + 1), 248 | ]; 249 | }; 250 | 251 | const oldestOptional = new Optional, Person>( 252 | getOption, 253 | set 254 | ); 255 | const oldestMemberInBand = membersLens.composeOptional(oldestOptional); 256 | 257 | it("allows working with lists using optionals", () => { 258 | expect(oldestMemberInBand.getOption(metallica)).toEqual( 259 | some( 260 | expect.objectContaining({ 261 | firstName: "Kirk", 262 | }) 263 | ) 264 | ); 265 | 266 | const nameLens = Lens.fromProp()("firstName"); 267 | 268 | const upperCase = (s: string): string => s.toUpperCase(); 269 | 270 | const upperCaseOldestBandMember = oldestMemberInBand 271 | .composeLens(nameLens) 272 | .modify(upperCase); 273 | 274 | expect(upperCaseOldestBandMember(metallica).members).toContainEqual( 275 | expect.objectContaining({ 276 | firstName: "KIRK", 277 | }) 278 | ); 279 | }); 280 | it("is safe with empty objects", () => { 281 | const bandWithNoMembers = { 282 | name: "Unknown", 283 | members: [], 284 | }; 285 | expect(oldestMemberInBand.getOption(bandWithNoMembers)).toEqual(none); 286 | }); 287 | }); 288 | }); 289 | 290 | describe.skip("traversal", () => { 291 | it("allows modifying lists", () => { 292 | // A Traversal is the generalisation of an Optional to several targets. 293 | // In other words, a Traversal allows to focus from a type S into 0 to n values of type A. 294 | const listOfNumbers = [1, 2, 3]; 295 | const traversal: Traversal = fromTraversable(array)< 296 | number 297 | >(); 298 | expect(traversal.modify(value => value + 1)(listOfNumbers)).toEqual([ 299 | 2, 300 | 3, 301 | 4, 302 | ]); 303 | }); 304 | 305 | it("allows getting all values via asFold", () => { 306 | const listOfNumbers = [1, 2, 3]; 307 | const traversal: Traversal = fromTraversable(array)< 308 | number 309 | >(); 310 | // Get all values with `asFold`: 311 | const asFold = traversal.asFold(); 312 | expect(asFold.getAll(listOfNumbers)).toEqual(listOfNumbers); 313 | }); 314 | 315 | it("allows composing with lenses", () => { 316 | const person: Person = { 317 | firstName: "Eve", 318 | age: 67, 319 | hobbies: [{ name: "swimming" }], 320 | }; 321 | 322 | // Zoom in on hobbies array 323 | const hobby: Lens = Lens.fromProp()("hobbies"); 324 | 325 | // Traversal for hobbies, for example, `person => [{ name: "swimming "}]` 326 | const hobbies: Traversal = hobby.composeTraversal( 327 | fromTraversable(array)() 328 | ); 329 | // Traversal for hobby names, for example: `person => ["swimming"]` 330 | const hobbyNames: Traversal = hobbies.composeLens( 331 | Lens.fromProp()("name") 332 | ); 333 | 334 | // Function that uppercases all hobby names 335 | const upperCaseHobbyNames: ( 336 | p: Person 337 | ) => Person = hobbyNames.modify((s: string) => s.toUpperCase()); 338 | 339 | const personWithUppercasedHobbyNames = upperCaseHobbyNames(person); 340 | 341 | expect(personWithUppercasedHobbyNames.hobbies[0].name).toEqual( 342 | "SWIMMING" 343 | ); 344 | }); 345 | }); 346 | describe.skip("prism", () => { 347 | it("allows zooming in on sum types", () => { 348 | // A Prism is an optic used to select part of a Sum type, such as types of `Band` in `(Person | Band)[]` 349 | 350 | const artistsT: Traversal = fromTraversable(array)< 351 | Artist 352 | >(); 353 | 354 | const isBand = (a: Artist): a is Band => { 355 | return Array.isArray((a as any).members); 356 | }; 357 | 358 | const bands: Traversal = artistsT.composePrism( 359 | Prism.fromPredicate(isBand) 360 | ); 361 | 362 | const bandNames: Traversal = bands.composeLens( 363 | Lens.fromProp()("name") 364 | ); 365 | 366 | const upperCaseBandNames: ( 367 | artists: Artist[] 368 | ) => Artist[] = bandNames.modify((name: string) => name.toUpperCase()); 369 | 370 | expect(upperCaseBandNames(artists)[1]).toHaveProperty( 371 | "name", 372 | "METALLICA" 373 | ); 374 | }); 375 | }); 376 | describe.skip("iso", () => { 377 | it("allows converting between elements without loss", () => { 378 | const exampleName: Record = { 379 | firstName: "elvis", 380 | secondName: "king", 381 | lastName: "presley", 382 | }; 383 | 384 | const objectToArray = (): Iso, Array<[string, T]>> => 385 | new Iso, Array<[string, T]>>( 386 | s => Object.entries(s), 387 | a => a.reduce((q, r) => ({ ...q, [r[0]]: r[1] }), {}) 388 | ); 389 | 390 | // Iso from records to an array of key-value pairs 391 | const recordsIso: Iso< 392 | Record, 393 | [string, string][] 394 | > = objectToArray(); 395 | 396 | // Traversal that traverses all key-value pairs as tuples 397 | const records: Traversal< 398 | Record, 399 | [string, string] 400 | > = recordsIso.composeTraversal( 401 | fromTraversable(array)<[string, string]>() 402 | ); 403 | 404 | const upperCaseValues = records.modify(([key, value]) => [ 405 | key, 406 | value.toUpperCase(), 407 | ]); 408 | 409 | expect(upperCaseValues(exampleName)).toHaveProperty("firstName", "ELVIS"); 410 | }); 411 | }); 412 | }); 413 | -------------------------------------------------------------------------------- /monocle-ts/index.test.ts: -------------------------------------------------------------------------------- 1 | import { 2 | Iso, 3 | Lens, 4 | Optional, 5 | Prism, 6 | Traversal, 7 | fromTraversable, 8 | } from "monocle-ts"; 9 | import { array } from "fp-ts/lib/array"; 10 | import { some, none } from "fp-ts/lib/Option"; 11 | 12 | interface Street { 13 | num: number; 14 | name: string; 15 | } 16 | interface Address { 17 | city: string; 18 | street: Street; 19 | } 20 | interface Company { 21 | name: string; 22 | address: Address; 23 | } 24 | interface Employee { 25 | name: string; 26 | company: Company; 27 | } 28 | 29 | /** 30 | * Lens from Employee to Company 31 | */ 32 | const company: Lens = Lens.fromProp()("company"); 33 | 34 | const address: Lens = Lens.fromProp()("address"); 35 | const street: Lens = Lens.fromProp
()("street"); 36 | const name: Lens = Lens.fromProp()("name"); 37 | 38 | /** 39 | * Compose lenses 40 | */ 41 | const employeeToStreetName: Lens = company 42 | .compose(address) 43 | .composeLens(street) // Alias for `compose` 44 | .composeLens(name); 45 | 46 | /** 47 | * Example values 48 | */ 49 | 50 | const employee: Employee = { 51 | name: "john", 52 | company: { 53 | name: "awesome inc", 54 | address: { 55 | city: "london", 56 | street: { 57 | num: 23, 58 | name: "high street", 59 | }, 60 | }, 61 | }, 62 | }; 63 | 64 | const capitalize = (s: string): string => 65 | s.substring(0, 1).toUpperCase() + s.substring(1); 66 | 67 | interface Hobby { 68 | name: string; 69 | } 70 | 71 | interface Person { 72 | firstName: string; 73 | hobbies: Hobby[]; 74 | } 75 | 76 | type Band = { 77 | name: string; 78 | members: Person[]; 79 | }; 80 | 81 | type Artist = Person | Band; 82 | 83 | interface Name { 84 | firstName: string; 85 | secondName: string; 86 | lastName: string; 87 | } 88 | 89 | describe("monocle-ts", () => { 90 | describe("lens", () => { 91 | it("allows to modify values inside nested object", () => { 92 | /** 93 | * Modify value with lens (think of `over` in Control.Lens) 94 | */ 95 | const employee2 = employeeToStreetName.modify(capitalize)(employee); 96 | 97 | expect(employee2.company.address.street.name).toMatch(/^High/); 98 | }); 99 | 100 | it("allows to avoid some boilerplate with 'fromPath'", () => { 101 | const employeeToStreetName = Lens.fromPath()([ 102 | "company", 103 | "address", 104 | "street", 105 | "name", 106 | ]); 107 | const employee2 = employeeToStreetName.modify(capitalize)(employee); 108 | expect(employeeToStreetName.get(employee2)).toMatch(/^High/); 109 | }); 110 | }); 111 | 112 | describe("optional", () => { 113 | it("allows composing with optionals for nullable values", () => { 114 | // Optional that allows zooming into the (optional) first letter 115 | const firstLetter = new Optional( 116 | s => (s.length > 0 ? some(s[0]) : none), // getOption 117 | a => s => a + s.substring(1) // set 118 | ); 119 | const toFirstLetter: Optional = company 120 | .compose(address) 121 | .compose(street) 122 | .compose(name) 123 | .asOptional() 124 | .compose(firstLetter); 125 | const upperCaseStreetName: ( 126 | e: Employee 127 | ) => Employee = toFirstLetter.modify(s => s.toUpperCase()); 128 | const employeeToStreetName = Lens.fromPath()([ 129 | "company", 130 | "address", 131 | "street", 132 | "name", 133 | ]); 134 | expect(employeeToStreetName.get(upperCaseStreetName(employee))).toMatch( 135 | /^High/ 136 | ); 137 | }); 138 | 139 | it("allows working with lists using optionals", () => { 140 | const firstNumber = new Optional, number>( 141 | s => (s.length > 0 ? some(s[0]) : none), // getOption 142 | a => s => [a, ...s.slice(1)] // Set value by replacing the first value in the array 143 | ); 144 | 145 | expect(firstNumber.getOption([1, 2, 3])).toEqual(some(1)); 146 | expect(firstNumber.getOption([])).toEqual(none); 147 | 148 | const addOneToFirstNumber = firstNumber.modify(value => value + 1); 149 | expect(addOneToFirstNumber([1, 2, 3])).toEqual([2, 2, 3]); 150 | expect(addOneToFirstNumber([])).toEqual([]); 151 | }); 152 | }); 153 | 154 | describe("traversal", () => { 155 | it("allows modifying lists", () => { 156 | // A Traversal is the generalisation of an Optional to several targets. 157 | // In other words, a Traversal allows to focus from a type S into 0 to n values of type A. 158 | const listOfNumbers = [1, 2, 3]; 159 | const traversal: Traversal = fromTraversable(array)< 160 | number 161 | >(); 162 | expect(traversal.modify(value => value + 1)(listOfNumbers)).toEqual([ 163 | 2, 164 | 3, 165 | 4, 166 | ]); 167 | }); 168 | 169 | it("allows getting all values via asFold", () => { 170 | const listOfNumbers = [1, 2, 3]; 171 | const traversal: Traversal = fromTraversable(array)< 172 | number 173 | >(); 174 | // Get all values with `asFold`: 175 | const asFold = traversal.asFold(); 176 | expect(asFold.getAll(listOfNumbers)).toEqual(listOfNumbers); 177 | }); 178 | 179 | it("allows composing with lenses", () => { 180 | const person: Person = { 181 | firstName: "Eve", 182 | hobbies: [{ name: "swimming" }], 183 | }; 184 | 185 | // Zoom in on hobbies array 186 | const hobby: Lens = Lens.fromProp()("hobbies"); 187 | 188 | // Traversal for hobbies, for example, `person => [{ name: "swimming "}]` 189 | const hobbies: Traversal = hobby.composeTraversal( 190 | fromTraversable(array)() 191 | ); 192 | // Traversal for hobby names, for example: `person => ["swimming"]` 193 | const hobbyNames: Traversal = hobbies.composeLens( 194 | Lens.fromProp()("name") 195 | ); 196 | 197 | // Function that uppercases all hobby names 198 | const upperCaseHobbyNames: ( 199 | p: Person 200 | ) => Person = hobbyNames.modify((s: string) => s.toUpperCase()); 201 | 202 | const personWithUppercasedHobbyNames = upperCaseHobbyNames(person); 203 | 204 | expect(personWithUppercasedHobbyNames.hobbies[0].name).toEqual( 205 | "SWIMMING" 206 | ); 207 | }); 208 | }); 209 | describe("prism", () => { 210 | it("allows zooming in on sum types", () => { 211 | // A Prism is an optic used to select part of a Sum type, such as types of `Band` in `(Person | Band)[]` 212 | const exampleArtists: Artist[] = [ 213 | { 214 | firstName: "Elvis Presley", 215 | hobbies: [], 216 | }, 217 | { 218 | name: "Metallica", 219 | members: [ 220 | { 221 | firstName: "James", 222 | hobbies: [], 223 | }, 224 | { 225 | firstName: "Lars", 226 | hobbies: [], 227 | }, 228 | { 229 | firstName: "Kirk", 230 | hobbies: [], 231 | }, 232 | { 233 | firstName: "Robert", 234 | hobbies: [], 235 | }, 236 | ], 237 | }, 238 | ]; 239 | 240 | const artists: Traversal = fromTraversable(array)< 241 | Artist 242 | >(); 243 | 244 | const isBand = (a: Artist): a is Band => { 245 | return Array.isArray((a as any).members); 246 | }; 247 | 248 | const bands: Traversal = artists.composePrism( 249 | Prism.fromPredicate(isBand) 250 | ); 251 | 252 | const bandNames: Traversal = bands.composeLens( 253 | Lens.fromProp()("name") 254 | ); 255 | 256 | const upperCaseBandNames: ( 257 | artists: Artist[] 258 | ) => Artist[] = bandNames.modify((name: string) => name.toUpperCase()); 259 | 260 | expect(upperCaseBandNames(exampleArtists)[1]).toHaveProperty( 261 | "name", 262 | "METALLICA" 263 | ); 264 | }); 265 | }); 266 | describe("iso", () => { 267 | it("allows converting between elements without loss", () => { 268 | const exampleName: Record = { 269 | firstName: "elvis", 270 | secondName: "king", 271 | lastName: "presley", 272 | }; 273 | 274 | const objectToArray = (): Iso, Array<[string, T]>> => 275 | new Iso, Array<[string, T]>>( 276 | s => Object.entries(s), 277 | a => a.reduce((q, r) => ({ ...q, [r[0]]: r[1] }), {}) 278 | ); 279 | 280 | // Iso from records to an array of key-value pairs 281 | const recordsIso: Iso< 282 | Record, 283 | [string, string][] 284 | > = objectToArray(); 285 | 286 | // Traversal that traverses all key-value pairs as tuples 287 | const records: Traversal< 288 | Record, 289 | [string, string] 290 | > = recordsIso.composeTraversal( 291 | fromTraversable(array)<[string, string]>() 292 | ); 293 | 294 | const upperCaseValues = records.modify(([key, value]) => [ 295 | key, 296 | value.toUpperCase(), 297 | ]); 298 | 299 | expect(upperCaseValues(exampleName)).toHaveProperty("firstName", "ELVIS"); 300 | }); 301 | }); 302 | }); 303 | -------------------------------------------------------------------------------- /monocle-ts/jest.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | preset: 'ts-jest', 3 | testEnvironment: 'node', 4 | }; -------------------------------------------------------------------------------- /monocle-ts/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "monocle-ts", 3 | "version": "1.0.0", 4 | "main": "index.js", 5 | "license": "MIT", 6 | "scripts": { 7 | "test": "jest" 8 | }, 9 | "dependencies": { 10 | "@types/jest": "^24.0.18", 11 | "@types/js-yaml": "^3.12.1", 12 | "@types/lodash": "^4.14.149", 13 | "@types/node": "^12.12.7", 14 | "fp-ts": "^2.0.5", 15 | "io-ts": "^2.1.0", 16 | "jest": "^24.9.0", 17 | "js-yaml": "^3.13.1", 18 | "lodash": "^4.17.19", 19 | "monocle-ts": "^2.0.0", 20 | "ts-jest": "^24.1.0", 21 | "typescript": "^3.6.3" 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /monocle-ts/stripe-simple.yaml: -------------------------------------------------------------------------------- 1 | openapi: 3.0.0 2 | info: 3 | contact: 4 | email: dev-platform@stripe.com 5 | description: 6 | The Stripe REST API. Please see https://stripe.com/docs/api for more 7 | details. 8 | title: Stripe API 9 | version: "2019-11-05" 10 | servers: 11 | - url: https://api.stripe.com/ 12 | paths: 13 | /v1/account: 14 | get: 15 | description: "

Retrieves the details of an account.

" 16 | operationId: GetAccount 17 | responses: 18 | "200": 19 | content: 20 | application/json: 21 | schema: 22 | "$ref": "#/components/schemas/account" 23 | description: Successful response. 24 | default: 25 | content: 26 | application/json: 27 | schema: 28 | "$ref": "#/components/schemas/error" 29 | description: Error response. 30 | components: 31 | schemas: 32 | account: 33 | properties: 34 | country: 35 | description: The account's country. 36 | maxLength: 5000 37 | type: string 38 | created: 39 | description: 40 | Time at which the object was created. Measured in seconds since 41 | the Unix epoch. 42 | format: unix-time 43 | type: integer 44 | email: 45 | description: The primary user's email address. 46 | maxLength: 5000 47 | nullable: true 48 | type: string 49 | required: 50 | - id 51 | - object 52 | title: Account 53 | type: object 54 | error: 55 | description: An error response from the Stripe API 56 | properties: 57 | error: 58 | "$ref": "#/components/schemas/api_errors" 59 | required: 60 | - error 61 | type: object 62 | api_errors: 63 | properties: 64 | type: 65 | description: 66 | The type of error returned. One of `api_connection_error`, 67 | `api_error`, `authentication_error`, `card_error`, `idempotency_error`, 68 | `invalid_request_error`, or `rate_limit_error` 69 | enum: 70 | - api_connection_error 71 | - api_error 72 | - authentication_error 73 | - card_error 74 | - idempotency_error 75 | - invalid_request_error 76 | - rate_limit_error 77 | type: string 78 | required: 79 | - type 80 | title: APIErrors 81 | type: object 82 | -------------------------------------------------------------------------------- /monocle-ts/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | /* Basic Options */ 4 | // "incremental": true, /* Enable incremental compilation */ 5 | "target": "es5", /* Specify ECMAScript target version: 'ES3' (default), 'ES5', 'ES2015', 'ES2016', 'ES2017', 'ES2018', 'ES2019' or 'ESNEXT'. */ 6 | "module": "commonjs", /* Specify module code generation: 'none', 'commonjs', 'amd', 'system', 'umd', 'es2015', or 'ESNext'. */ 7 | "lib": ["esnext"], /* Specify library files to be included in the compilation. */ 8 | // "allowJs": true, /* Allow javascript files to be compiled. */ 9 | // "checkJs": true, /* Report errors in .js files. */ 10 | // "jsx": "preserve", /* Specify JSX code generation: 'preserve', 'react-native', or 'react'. */ 11 | // "declaration": true, /* Generates corresponding '.d.ts' file. */ 12 | // "declarationMap": true, /* Generates a sourcemap for each corresponding '.d.ts' file. */ 13 | // "sourceMap": true, /* Generates corresponding '.map' file. */ 14 | // "outFile": "./", /* Concatenate and emit output to single file. */ 15 | // "outDir": "./", /* Redirect output structure to the directory. */ 16 | // "rootDir": "./", /* Specify the root directory of input files. Use to control the output directory structure with --outDir. */ 17 | // "composite": true, /* Enable project compilation */ 18 | // "tsBuildInfoFile": "./", /* Specify file to store incremental compilation information */ 19 | // "removeComments": true, /* Do not emit comments to output. */ 20 | // "noEmit": true, /* Do not emit outputs. */ 21 | // "importHelpers": true, /* Import emit helpers from 'tslib'. */ 22 | // "downlevelIteration": true, /* Provide full support for iterables in 'for-of', spread, and destructuring when targeting 'ES5' or 'ES3'. */ 23 | // "isolatedModules": true, /* Transpile each file as a separate module (similar to 'ts.transpileModule'). */ 24 | 25 | /* Strict Type-Checking Options */ 26 | "strict": true, /* Enable all strict type-checking options. */ 27 | // "noImplicitAny": true, /* Raise error on expressions and declarations with an implied 'any' type. */ 28 | // "strictNullChecks": true, /* Enable strict null checks. */ 29 | // "strictFunctionTypes": true, /* Enable strict checking of function types. */ 30 | // "strictBindCallApply": true, /* Enable strict 'bind', 'call', and 'apply' methods on functions. */ 31 | // "strictPropertyInitialization": true, /* Enable strict checking of property initialization in classes. */ 32 | // "noImplicitThis": true, /* Raise error on 'this' expressions with an implied 'any' type. */ 33 | // "alwaysStrict": true, /* Parse in strict mode and emit "use strict" for each source file. */ 34 | 35 | /* Additional Checks */ 36 | // "noUnusedLocals": true, /* Report errors on unused locals. */ 37 | // "noUnusedParameters": true, /* Report errors on unused parameters. */ 38 | // "noImplicitReturns": true, /* Report error when not all code paths in function return a value. */ 39 | // "noFallthroughCasesInSwitch": true, /* Report errors for fallthrough cases in switch statement. */ 40 | 41 | /* Module Resolution Options */ 42 | // "moduleResolution": "node", /* Specify module resolution strategy: 'node' (Node.js) or 'classic' (TypeScript pre-1.6). */ 43 | // "baseUrl": "./", /* Base directory to resolve non-absolute module names. */ 44 | // "paths": {}, /* A series of entries which re-map imports to lookup locations relative to the 'baseUrl'. */ 45 | // "rootDirs": [], /* List of root folders whose combined content represents the structure of the project at runtime. */ 46 | // "typeRoots": [], /* List of folders to include type definitions from. */ 47 | // "types": [], /* Type declaration files to be included in compilation. */ 48 | // "allowSyntheticDefaultImports": true, /* Allow default imports from modules with no default export. This does not affect code emit, just typechecking. */ 49 | "esModuleInterop": true /* Enables emit interoperability between CommonJS and ES Modules via creation of namespace objects for all imports. Implies 'allowSyntheticDefaultImports'. */ 50 | // "preserveSymlinks": true, /* Do not resolve the real path of symlinks. */ 51 | // "allowUmdGlobalAccess": true, /* Allow accessing UMD globals from modules. */ 52 | 53 | /* Source Map Options */ 54 | // "sourceRoot": "", /* Specify the location where debugger should locate TypeScript files instead of source locations. */ 55 | // "mapRoot": "", /* Specify the location where debugger should locate map files instead of generated locations. */ 56 | // "inlineSourceMap": true, /* Emit a single file with source maps instead of having a separate file. */ 57 | // "inlineSources": true, /* Emit the source alongside the sourcemaps within a single file; requires '--inlineSourceMap' or '--sourceMap' to be set. */ 58 | 59 | /* Experimental Options */ 60 | // "experimentalDecorators": true, /* Enables experimental support for ES7 decorators. */ 61 | // "emitDecoratorMetadata": true, /* Enables experimental support for emitting type metadata for decorators. */ 62 | } 63 | } 64 | -------------------------------------------------------------------------------- /project-euler/.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | project-euler.cabal 3 | *~ -------------------------------------------------------------------------------- /project-euler/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for project-euler 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /project-euler/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2019 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /project-euler/README.md: -------------------------------------------------------------------------------- 1 | # [Project Euler](https://projecteuler.net/about) 2 | 3 | Build project: 4 | 5 | ```bash 6 | stack build 7 | ``` 8 | 9 | Run tests: 10 | 11 | ```bash 12 | stack test 13 | ``` 14 | -------------------------------------------------------------------------------- /project-euler/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /project-euler/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Problem1 ( result ) 4 | 5 | main :: IO () 6 | main = putStrLn $ show result 7 | -------------------------------------------------------------------------------- /project-euler/package.yaml: -------------------------------------------------------------------------------- 1 | name: project-euler 2 | version: 0.1.0.0 3 | github: "githubuser/project-euler" 4 | license: BSD3 5 | author: "Author name here" 6 | maintainer: "example@example.com" 7 | copyright: "2019 Author name here" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | 25 | library: 26 | source-dirs: src 27 | 28 | executables: 29 | project-euler-exe: 30 | main: Main.hs 31 | source-dirs: app 32 | ghc-options: 33 | - -threaded 34 | - -rtsopts 35 | - -with-rtsopts=-N 36 | dependencies: 37 | - project-euler 38 | 39 | tests: 40 | project-euler-test: 41 | main: Spec.hs 42 | source-dirs: test 43 | ghc-options: 44 | - -threaded 45 | - -rtsopts 46 | - -with-rtsopts=-N 47 | dependencies: 48 | - project-euler 49 | - HUnit 50 | -------------------------------------------------------------------------------- /project-euler/src/Problem1.hs: -------------------------------------------------------------------------------- 1 | -- https://projecteuler.net/problem=1 2 | module Problem1 where 3 | 4 | resultForBelow :: (Int -> Int) 5 | resultForBelow maxValue = 6 | let array = takeWhile (< maxValue) [0 ..] 7 | filtered = filter (\n -> n `mod` 3 == 0 || n `mod` 5 == 0) array 8 | in sum filtered 9 | 10 | result :: Int 11 | result = resultForBelow 1000 12 | -------------------------------------------------------------------------------- /project-euler/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-14.3 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=2.1" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /project-euler/stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 523878 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/3.yaml 11 | sha256: 470c46c27746a48c7c50f829efc0cf00112787a7804ee4ac7a27754658f6d92c 12 | original: lts-14.3 13 | -------------------------------------------------------------------------------- /project-euler/test/Spec.hs: -------------------------------------------------------------------------------- 1 | import Test.HUnit 2 | import Problem1 ( result 3 | , resultForBelow 4 | ) 5 | 6 | testProblem1ResultForBelow = TestCase 7 | $ assertEqual "Should return 23 for under 10" 23 (resultForBelow 10) 8 | 9 | testProblem1Result = 10 | TestCase $ assertEqual "Should return 233168" 233168 result 11 | 12 | tests = TestList 13 | [ TestLabel "Problem 1" testProblem1Result 14 | , TestLabel "Problem 1 helper" testProblem1ResultForBelow 15 | ] 16 | 17 | main :: IO Counts 18 | main = runTestTT tests 19 | -------------------------------------------------------------------------------- /purescript/README.md: -------------------------------------------------------------------------------- 1 | # Adventures in [PureScript](http://www.purescript.org/) 2 | -------------------------------------------------------------------------------- /purescript/getting-started/.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 | -------------------------------------------------------------------------------- /purescript/getting-started/README.md: -------------------------------------------------------------------------------- 1 | # [Getting started](https://github.com/purescript/documentation/blob/master/guides/Getting-Started.md) 2 | 3 | ## Usage 4 | 5 | - Install dependencies: `yarn` 6 | - Compile: `yarn pulp build` 7 | - Run executable: `yarn pulp run` 8 | - Run tests: `yarn pulp test` 9 | - Move to REPL: `yarn pulp repl` 10 | -------------------------------------------------------------------------------- /purescript/getting-started/bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-playground", 3 | "ignore": [ 4 | "**/.*", 5 | "node_modules", 6 | "bower_components", 7 | "output" 8 | ], 9 | "dependencies": { 10 | "purescript-prelude": "^4.1.1", 11 | "purescript-console": "^4.2.0", 12 | "purescript-effect": "^2.0.1", 13 | "purescript-lists": "^5.4.1", 14 | "purescript-assert": "^4.1.0" 15 | }, 16 | "devDependencies": { 17 | "purescript-psci-support": "^4.0.0" 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /purescript/getting-started/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-playground", 3 | "version": "1.0.0", 4 | "main": "index.js", 5 | "license": "MIT", 6 | "dependencies": { 7 | "bower": "^1.8.8", 8 | "pulp": "^13.0.0", 9 | "purescript": "^0.13.2" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /purescript/getting-started/src/Euler.purs: -------------------------------------------------------------------------------- 1 | module Euler where 2 | 3 | import Prelude 4 | 5 | import Data.List (range, filter) 6 | import Data.Foldable (sum) 7 | 8 | ns = range 0 999 9 | multiples = filter (\n -> mod n 3 == 0 || mod n 5 == 0) ns 10 | answer :: Int 11 | answer = sum multiples 12 | -------------------------------------------------------------------------------- /purescript/getting-started/src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | import Euler (answer) 5 | import Effect (Effect) 6 | import Effect.Console (log) 7 | 8 | main :: Effect Unit 9 | main = do 10 | log ("The answer is " <> show answer) 11 | -------------------------------------------------------------------------------- /purescript/getting-started/test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Euler (answer) 5 | import Effect (Effect) 6 | import Effect.Console (log) 7 | import Test.Assert (assert) 8 | 9 | main :: Effect Unit 10 | main = do 11 | assert (answer == 233168) 12 | -------------------------------------------------------------------------------- /purescript/hello-cowboy/.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 | -------------------------------------------------------------------------------- /purescript/hello-cowboy/README.md: -------------------------------------------------------------------------------- 1 | # Simple hacks with PureScript 2 | 3 | Contains code from 4 | 5 | - [FP sparks joy](https://rachelcarmena.github.io/2019/08/05/functional-programming-sparks-joy.html) article 6 | - [PureScript tutorials](https://github.com/purescript/documentation/tree/master/language) 7 | 8 | ## Install dependencies 9 | 10 | Install node modules: 11 | 12 | ``` 13 | yarn 14 | ``` 15 | 16 | Install bower dependencies: 17 | 18 | ``` 19 | yarn bower install purescript-math --save 20 | ``` 21 | 22 | Build: 23 | 24 | ``` 25 | yarn pulp build 26 | ``` 27 | -------------------------------------------------------------------------------- /purescript/hello-cowboy/bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "hello-cowboy", 3 | "ignore": [ 4 | "**/.*", 5 | "node_modules", 6 | "bower_components", 7 | "output" 8 | ], 9 | "dependencies": { 10 | "purescript-prelude": "^4.1.1", 11 | "purescript-console": "^4.2.0", 12 | "purescript-effect": "^2.0.1", 13 | "purescript-lists": "^5.4.1", 14 | "purescript-assert": "^4.1.0", 15 | "purescript-math": "^2.1.1", 16 | "purescript-integers": "^4.0.0" 17 | }, 18 | "devDependencies": { 19 | "purescript-psci-support": "^4.0.0" 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /purescript/hello-cowboy/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "hello-cowboy", 3 | "version": "1.0.0", 4 | "main": "index.js", 5 | "license": "MIT", 6 | "dependencies": { 7 | "bower": "^1.8.8", 8 | "pulp": "^13.0.0" 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /purescript/hello-cowboy/src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Effect (Effect) 7 | import Effect.Console (log) 8 | import Math (pow) 9 | import Data.Int (toNumber) 10 | 11 | data SendingMethod 12 | = Email String 13 | | Address { street :: String, 14 | city :: String, 15 | country :: String } 16 | 17 | exampleSendingMethod :: SendingMethod 18 | exampleSendingMethod = Email "kimmo@meeshkan" 19 | 20 | maybeVal :: Maybe String 21 | maybeVal = Just "some string" 22 | 23 | otherMaybeVal :: Maybe String 24 | otherMaybeVal = maybeVal >>= (\s -> Just (s <> "some other string")) 25 | 26 | showTheValue :: Maybe Number -> String 27 | showTheValue value = 28 | case value of 29 | Nothing -> "There is no value" 30 | Just value' -> "The value is: " <> show value' 31 | 32 | showSendingMethod :: SendingMethod -> String 33 | showSendingMethod sendingMethod = 34 | case sendingMethod of 35 | Email email -> "Sent by mail to: " <> email 36 | Address address -> "Sent to an address" 37 | 38 | square :: Number -> Number 39 | square number = pow number $ toNumber 2 40 | 41 | numbers :: Array Number 42 | numbers = map toNumber [2, 5, 8] 43 | 44 | squared :: Array Number 45 | squared = map square numbers 46 | -- [4,25,64] 47 | 48 | -- Data types and pattern matching 49 | data Tuple a b = Tuple a b -- Tuple in LHS is a type constructor, in RHS a value constructor 50 | data Currency = Int -- Type alias, improves readability 51 | data Money = Money { currency :: Currency } -- Record type 52 | 53 | data Person = Person { name :: String, age :: Int } 54 | 55 | -- Pattern matching on the value 56 | showPerson :: Person -> String 57 | showPerson (Person o) = o.name <> ", aged " <> show o.age 58 | 59 | examplePerson :: Person 60 | examplePerson = Person { name: "Bonnie", age: 26 } 61 | 62 | examplePersonShown :: String 63 | examplePersonShown = showPerson examplePerson 64 | 65 | -- newtype declarations 66 | newtype Percentage = Percentage Number 67 | 68 | -- Typeclass instance of show for newtype 69 | instance showPercentage :: Show Percentage where 70 | show (Percentage n) = show n <> "%" 71 | 72 | -- Polymorphic types 73 | identity :: forall a. a -> a 74 | identity x = x 75 | 76 | -- Type aliases 77 | type Foo = { foo :: Number, bar :: Number } 78 | 79 | foo :: Foo 80 | foo = { foo: toNumber 1, bar: toNumber 2 } 81 | 82 | -- Create an alias for a polymorphic record with the same shape 83 | type Bar a = { foo :: a, bar :: a } -- Bar Number is the same as Foo 84 | 85 | main :: Effect Unit 86 | main = do 87 | log "Hello sailor!" 88 | -------------------------------------------------------------------------------- /purescript/hello-cowboy/test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Effect (Effect) 5 | import Effect.Console (log) 6 | 7 | main :: Effect Unit 8 | main = do 9 | log "You should add some tests." 10 | -------------------------------------------------------------------------------- /purescript/spago-project/.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 | -------------------------------------------------------------------------------- /purescript/spago-project/README.md: -------------------------------------------------------------------------------- 1 | # Example project using Spago in [2019](https://discourse.purescript.org/t/recommended-tooling-for-purescript-applications-in-2019/948) 2 | 3 | ### Project initialization 4 | 5 | Start project: 6 | 7 | ``` 8 | yarn init -y 9 | ``` 10 | 11 | Initialize PureScript project with Spago: 12 | 13 | ``` 14 | yarn spago init 15 | ``` 16 | 17 | This command creates, among others, `packages.dhall` and `spago.dhall`. 18 | 19 | This is how `packages.dhall` looks like for me at the time of writing (excluding comments): 20 | 21 | ```dhall 22 | let upstream = 23 | https://github.com/purescript/package-sets/releases/download/psc-0.13.3-20190831/packages.dhall sha256:852cd4b9e463258baf4e253e8524bcfe019124769472ca50b316fe93217c3a47 24 | 25 | let overrides = {=} 26 | 27 | let additions = {=} 28 | 29 | in upstream // overrides // additions 30 | ``` 31 | 32 | These are the contents of `spago.dhall`: 33 | 34 | ```dhall 35 | { name = 36 | "my-project" 37 | , dependencies = 38 | [ "effect", "console", "psci-support" ] 39 | , packages = 40 | ./packages.dhall 41 | , sources = 42 | [ "src/**/*.purs", "test/**/*.purs" ] 43 | } 44 | ``` 45 | 46 | Build project: 47 | 48 | ``` 49 | yarn spago build 50 | ``` 51 | 52 | The project is built in `output/` directory. 53 | 54 | Run `Main.purs`: 55 | 56 | ``` 57 | yarn spago run 58 | ``` 59 | 60 | ### Install dependencies 61 | 62 | Install Halogen: 63 | 64 | ``` 65 | yarn spago install halogen 66 | ``` 67 | 68 | `spago.dhall` now looks like this: 69 | 70 | ```dhall 71 | { 72 | name = 73 | "my-project" 74 | , dependencies = 75 | [ "console", "effect", "halogen", "psci-support" ] 76 | , packages = 77 | ./packages.dhall 78 | , sources = 79 | [ "src/**/*.purs", "test/**/*.purs" ] 80 | } 81 | ``` 82 | -------------------------------------------------------------------------------- /purescript/spago-project/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "spago-project", 3 | "version": "1.0.0", 4 | "main": "index.js", 5 | "license": "MIT", 6 | "devDependencies": { 7 | "parcel-bundler": "^1.12.3", 8 | "purescript": "^0.13.3", 9 | "spago": "^0.9.0" 10 | } 11 | } 12 | -------------------------------------------------------------------------------- /purescript/spago-project/packages.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to your new Dhall package-set! 3 | 4 | Below are instructions for how to edit this file for most use 5 | cases, so that you don't need to know Dhall to use it. 6 | 7 | ## Warning: Don't Move This Top-Level Comment! 8 | 9 | Due to how `dhall format` currently works, this comment's 10 | instructions cannot appear near corresponding sections below 11 | because `dhall format` will delete the comment. However, 12 | it will not delete a top-level comment like this one. 13 | 14 | ## Use Cases 15 | 16 | Most will want to do one or both of these options: 17 | 1. Override/Patch a package's dependency 18 | 2. Add a package not already in the default package set 19 | 20 | This file will continue to work whether you use one or both options. 21 | Instructions for each option are explained below. 22 | 23 | ### Overriding/Patching a package 24 | 25 | Purpose: 26 | - Change a package's dependency to a newer/older release than the 27 | default package set's release 28 | - Use your own modified version of some dependency that may 29 | include new API, changed API, removed API by 30 | using your custom git repo of the library rather than 31 | the package set's repo 32 | 33 | Syntax: 34 | Replace the overrides' "{=}" (an empty record) with the following idea 35 | The "//" or "⫽" means "merge these two records and 36 | when they have the same value, use the one on the right:" 37 | ------------------------------- 38 | let override = 39 | { packageName = 40 | upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" } 41 | , packageName = 42 | upstream.packageName // { version = "v4.0.0" } 43 | , packageName = 44 | upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" } 45 | } 46 | ------------------------------- 47 | 48 | Example: 49 | ------------------------------- 50 | let overrides = 51 | { halogen = 52 | upstream.halogen // { version = "master" } 53 | , halogen-vdom = 54 | upstream.halogen-vdom // { version = "v4.0.0" } 55 | } 56 | ------------------------------- 57 | 58 | ### Additions 59 | 60 | Purpose: 61 | - Add packages that aren't already included in the default package set 62 | 63 | Syntax: 64 | Replace the additions' "{=}" (an empty record) with the following idea: 65 | ------------------------------- 66 | let additions = 67 | { "package-name" = 68 | { dependencies = 69 | [ "dependency1" 70 | , "dependency2" 71 | ] 72 | , repo = 73 | "https://example.com/path/to/git/repo.git" 74 | , version = 75 | "tag ('v4.0.0') or branch ('master')" 76 | } 77 | , "package-name" = 78 | { dependencies = 79 | [ "dependency1" 80 | , "dependency2" 81 | ] 82 | , repo = 83 | "https://example.com/path/to/git/repo.git" 84 | , version = 85 | "tag ('v4.0.0') or branch ('master')" 86 | } 87 | , etc. 88 | } 89 | ------------------------------- 90 | 91 | Example: 92 | ------------------------------- 93 | let additions = 94 | { benchotron = 95 | { dependencies = 96 | [ "arrays" 97 | , "exists" 98 | , "profunctor" 99 | , "strings" 100 | , "quickcheck" 101 | , "lcg" 102 | , "transformers" 103 | , "foldable-traversable" 104 | , "exceptions" 105 | , "node-fs" 106 | , "node-buffer" 107 | , "node-readline" 108 | , "datetime" 109 | , "now" 110 | ], 111 | , repo = 112 | "https://github.com/hdgarrood/purescript-benchotron.git" 113 | , version = 114 | "v7.0.0" 115 | } 116 | } 117 | ------------------------------- 118 | -} 119 | 120 | 121 | let upstream = 122 | https://github.com/purescript/package-sets/releases/download/psc-0.13.3-20190831/packages.dhall sha256:852cd4b9e463258baf4e253e8524bcfe019124769472ca50b316fe93217c3a47 123 | 124 | let overrides = {=} 125 | 126 | let additions = {=} 127 | 128 | in upstream // overrides // additions 129 | -------------------------------------------------------------------------------- /purescript/spago-project/spago.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to a Spago project! 3 | You can edit this file as you like. 4 | -} 5 | { name = 6 | "my-project" 7 | , dependencies = 8 | [ "console", "effect", "halogen", "psci-support" ] 9 | , packages = 10 | ./packages.dhall 11 | , sources = 12 | [ "src/**/*.purs", "test/**/*.purs" ] 13 | } 14 | -------------------------------------------------------------------------------- /purescript/spago-project/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 | -------------------------------------------------------------------------------- /purescript/spago-project/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 | --------------------------------------------------------------------------------