├── .github ├── FUNDING.yml └── workflows │ └── test.yml ├── bounded-queues.hs ├── branching.hs ├── cabal.project ├── common-types.hs ├── crypto-hashing.hs ├── docs ├── _config.yml ├── assets │ └── css │ │ └── style.scss ├── build-tools.md ├── contributing.md ├── license.txt ├── logo.png ├── readme.md └── thanks.md ├── dynamic.hs ├── enum-ranges.hs ├── file-handles.hs ├── folding-lists.hs ├── for-loops.hs ├── functions.hs ├── guard.hs ├── hashing.hs ├── hello-world.hs ├── hie.yaml ├── if-else.hs ├── invert.hs ├── logging.hs ├── moments-in-time.hs ├── monitoring.hs ├── mutable-references.hs ├── partial-application.hs ├── phrasebook.cabal ├── records-with-optics.hs ├── shell.nix ├── tests ├── PhrasebookTesting.hs ├── test-bounded-queues.hs ├── test-branching.hs ├── test-common-types.hs ├── test-crypto-hashing.hs ├── test-dynamic.hs ├── test-enum-ranges.hs ├── test-file-handles.hs ├── test-folding-lists.hs ├── test-for-loops.hs ├── test-functions.hs ├── test-guard.hs ├── test-hashing.hs ├── test-hello-world.hs ├── test-if-else.hs ├── test-invert.hs ├── test-logging.hs ├── test-moments-in-time.hs ├── test-monitoring.hs ├── test-mutable-references.hs ├── test-partial-application.hs ├── test-records-with-optics.hs ├── test-threads.hs ├── test-timeouts.hs ├── test-transactions.hs └── test-variables.hs ├── threads.hs ├── timeouts.hs ├── tools ├── default.nix ├── haskell.nix ├── push-to-cache.hs ├── readme.md ├── update-versions ├── versions.json └── versions.nix ├── transactions.hs └── variables.hs /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | liberapay: typeclasses 2 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Tests for the Haskell Phrasebook 2 | 3 | on: [ push, pull_request ] 4 | 5 | jobs: 6 | test: 7 | name: Test the examples 8 | runs-on: ubuntu-latest 9 | continue-on-error: ${{ matrix.channel == 'nixos-unstable' }} 10 | 11 | strategy: 12 | matrix: 13 | channel: 14 | - nixos-unstable 15 | - nixos-21.11 16 | 17 | steps: 18 | - uses: actions/checkout@v2.4.0 19 | 20 | - uses: cachix/install-nix-action@v16 21 | with: 22 | nix_path: nixpkgs=channel:${{ matrix.channel }} 23 | 24 | - uses: cachix/cachix-action@v10 25 | with: 26 | name: typeclasses 27 | skipPush: true 28 | 29 | - run: nix-shell --pure --run 'cabal build all' 30 | 31 | - run: nix-shell --pure --run 'cabal test all' 32 | -------------------------------------------------------------------------------- /bounded-queues.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NumericUnderscores #-} 2 | 3 | import Control.Concurrent 4 | import Control.Concurrent.Async 5 | import Control.Concurrent.STM 6 | import Control.Exception.Safe 7 | import System.IO 8 | 9 | import qualified System.Random.MWC as R 10 | 11 | vendorApiCall :: R.GenIO -> Int -> IO Int 12 | vendorApiCall rng n = 13 | do 14 | t <- R.uniformR (500_000, 1_500_000) rng 15 | threadDelay t 16 | return (n * n) 17 | 18 | main :: IO () 19 | main = 20 | do 21 | hSetBuffering stdout LineBuffering 22 | 23 | rng <- R.createSystemRandom 24 | 25 | bq <- atomically (newTBQueue 5) 26 | let 27 | acquire = atomically (writeTBQueue bq ()) 28 | release = atomically (readTBQueue bq) 29 | 30 | forConcurrently_ [1 .. 10] $ \x -> 31 | bracket_ acquire release $ 32 | do 33 | putStrLn ("start: " ++ show x) 34 | result <- vendorApiCall rng x 35 | putStrLn ("finish: " ++ show x ++ ", result: " ++ show result) 36 | -------------------------------------------------------------------------------- /branching.hs: -------------------------------------------------------------------------------- 1 | import Data.Time 2 | 3 | timeNow now = 4 | case todHour (localTimeOfDay (zonedTimeToLocalTime now)) < 12 of 5 | True -> putStrLn "It's before noon" 6 | False -> putStrLn "It's after noon" 7 | 8 | data ServicePlan = Free | Monthly | Annual 9 | 10 | billAmount plan = 11 | case plan of 12 | Free -> 0 13 | Monthly -> 5 14 | Annual -> billAmount Monthly * 12 15 | 16 | writeNumber i = 17 | case i of 18 | 1 -> "one" 19 | 2 -> "two" 20 | 3 -> "three" 21 | _ -> "unknown number." 22 | 23 | main = 24 | do 25 | now <- getZonedTime 26 | timeNow now 27 | 28 | let plan = Free 29 | putStrLn ("Customer owes " ++ show (billAmount plan) 30 | ++ " dollars.") 31 | 32 | let i = 2 33 | putStrLn ("Write " ++ show i ++ " as " ++ (writeNumber i)) 34 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: ./phrasebook.cabal 2 | 3 | constraints: 4 | hashable >= 1.3.5 5 | , optics >= 0.4 6 | , relude >= 1 7 | -------------------------------------------------------------------------------- /common-types.hs: -------------------------------------------------------------------------------- 1 | main = 2 | do 3 | putStrLn ("hask" ++ "ell") 4 | 5 | putStrLn ("1+1 = " ++ show (1 + 1)) 6 | 7 | putStrLn ("7.0/3.0 = " ++ show (7.0 / 3.0)) 8 | 9 | putStrLn (show (True && False)) 10 | putStrLn (show (True || False)) 11 | putStrLn (show (not True)) 12 | -------------------------------------------------------------------------------- /crypto-hashing.hs: -------------------------------------------------------------------------------- 1 | import Crypto.Hash 2 | import Data.ByteString (ByteString) 3 | import qualified Data.ByteString.UTF8 as UTF8 4 | import Data.ByteArray.Encoding 5 | 6 | sha256 :: String -> String 7 | sha256 input = result 8 | where 9 | bytes = UTF8.fromString input :: ByteString 10 | digest = hashWith SHA256 bytes :: Digest SHA256 11 | hex = convertToBase Base16 digest :: ByteString 12 | result = UTF8.toString hex :: String 13 | 14 | main = 15 | do 16 | putStrLn ("sha256(abc) = " ++ sha256 "abc") 17 | putStrLn ("sha256(hello) = " ++ sha256 "hello") 18 | -------------------------------------------------------------------------------- /docs/_config.yml: -------------------------------------------------------------------------------- 1 | remote_theme: pages-themes/cayman@v0.2.0 2 | plugins: 3 | - jekyll-remote-theme 4 | -------------------------------------------------------------------------------- /docs/assets/css/style.scss: -------------------------------------------------------------------------------- 1 | --- 2 | --- 3 | 4 | @import "{{ site.theme }}"; 5 | 6 | body { background-color: #fcf9f4; } 7 | 8 | a { &, &:active, &:hover, &:link, &:visited { font-weight: normal; } } 9 | 10 | h1 a { &, &:active, &:hover, &:link, &:visited { font-weight: bold; } } 11 | 12 | p a { text-decoration: underline; } 13 | -------------------------------------------------------------------------------- /docs/build-tools.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: How to build and run the Phrasebook examples 3 | --- 4 | 5 | ## Tools to use while editing 6 | 7 | ### Haskell language server 8 | 9 | If you are using Visual Studio Code, we recommend installing the [Haskell](https://marketplace.visualstudio.com/items?itemName=haskell.haskell) extension. Error messages and other helpful annotations will then appear in the editor. 10 | 11 | ### ghcid 12 | 13 | If you are not using an editor with integrated language support, [ghcid](https://typeclasses.com/ghci/ghcid) is a good alternative. 14 | 15 | ```sh 16 | $ ghcid --command 'cabal repl hello-world' 17 | ``` 18 | 19 | ## Experimentation and testing 20 | 21 | ### Running a program 22 | 23 | There are two ways to run one of the example programs: 24 | 25 | 1. Run it directly using `runhaskell`. For example, `runhaskell hello-world.hs`. The program's dependencies must already be installed. See information about Nix below to make that easier. 26 | 2. Run using cabal. For example, `cabal run hello-world`. 27 | 28 | ### The REPL 29 | 30 | To open a REPL, use the "cabal repl" command, giving as an argument the name of the program you want to load. 31 | 32 | ```sh 33 | $ cabal repl hello-world 34 | 35 | λ> main 36 | hello world 37 | ``` 38 | 39 | ### The test suites 40 | 41 | To run the tests: 42 | 43 | ```sh 44 | $ cabal test all 45 | ``` 46 | 47 | The tests are also run automatically by [GitHub actions](https://github.com/typeclasses/haskell-phrasebook/actions). 48 | 49 | ## Nix 50 | 51 | You do not have to use Nix to run these Haskell programs, but you may find it convenient. Within the Nix shell, you have all of the dependencies required by the examples in the Phrasebook. For example, you can run commands like `runhaskell` and `ghcid`. 52 | 53 | ```sh 54 | $ nix-shell 55 | 56 | [nix-shell]$ ghc --version 57 | The Glorious Glasgow Haskell Compilation System, version 9.0.1 58 | ``` 59 | 60 | ### Getting started with Nix 61 | 62 | [Install Nix](https://nixos.org/nix/manual/#chap-installation). 63 | 64 | Optionally, install [Cachix](https://cachix.org/) and add the `typeclasses` cache. This step is optional, but will greatly reduce build time. 65 | 66 | ```sh 67 | $ nix-env -iA 'cachix' -f 'https://cachix.org/api/v1/install' 68 | $ cachix use 'typeclasses' 69 | ``` 70 | 71 | ### Nix dependency versions 72 | 73 | All of the Nix tools are configured to use a specific version of [the Nix package set](https://github.com/nixos/nixpkgs/) to ensure that the code works the same in all environments. This version is specified in `tools/versions.json`. 74 | 75 | You can run `./tools/update-versions` to update the dependency hashes in `tools/versions.json` to their latest commits. The JSON data is then used by `tools/versions.nix`. This system is described in Vaibhav Sagar's blog post, [*Quick and Easy Nixpkgs Pinning*](https://vaibhavsagar.com/blog/2018/05/27/quick-easy-nixpkgs-pinning/). 76 | -------------------------------------------------------------------------------- /docs/contributing.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: Contributing to the Haskell Phrasebook 3 | --- 4 | 5 | # Contributing 6 | 7 | We're delighted by contributions of all sizes: 8 | 9 | - A request for a topic you'd like to see covered; 10 | - A complete code example showing off a language feature, library, or technique you use; 11 | - Anything in betweeen. 12 | 13 | **You do not need to be a Haskell expert to contribute.** Give us your thoughts, your hopes, your confusions, your code, and its imperfections; we'll help polish it up. 14 | 15 | If you've been frustrated with Haskell but are willing to show up with a constructive attitude, we would like to hear what problems you've had and talk about how this guide could help. If you've done something you're proud of that fits the Phrasebook, you're welcome to come show it off. 16 | 17 | If you'd like to contribute and need inspiration, try these sources for topic ideas: 18 | 19 | * Our [GitHub issue list](https://github.com/typeclasses/haskell-phrasebook/issues) 20 | * [Go by Example](https://gobyexample.com/) 21 | * [Rust by Example](https://doc.rust-lang.org/rust-by-example/index.html) 22 | 23 | ## How to contribute code with GitHub 24 | 25 | If you are a seasoned GitHub user, you may not need to read this section. If you are unfamiliar with pull requests, read on: 26 | 27 | On [the project's main page](https://github.com/typeclasses/haskell-phrasebook), click the "Create new file" button. If you don't have any code, just enter a file name for the example you'd like to see (then once the pull request is open, we can talk about what should go there). Click the "Propose new file" button, then on the next screen the "Create pull request" button. 28 | 29 | A pull request includes a discussion thread where we can talk about the code. If necessary you can continue making revisions to the file after you open the pull request. What you submit can be a work in progress. 30 | 31 | ## Content guidelines 32 | 33 | Aim for small examples that are just long enough to illustrate one idea. 34 | 35 | Each page of the Phrasebook demonstrates a particular thing that someone who doesn't know Haskell might be wondering how to do. For example: 36 | 37 | - "Introduction to optics" would not be appropriate as a Phrasebook topic (because a potential reader is unlikely to know what they would *want* to learn about optics); 38 | - "Working with JSON data" would be a good topic (and the example program might incidentally showcase optics). 39 | 40 | The [Phrasebook](https://typeclasses.com/phrasebook) itself includes explanations next to the code examples. We'll appreciate some explanation of code you contribute, but don't worry too much about this part; we'll write the Phrasebook's text to maintain a consistent style. 41 | 42 | We believe that Haskell is not so different from any other language that learning it would require unlearning everything else that one may already know about programming. Our goal in this project is not to focus on what makes Haskell unique, but to build bridges to familiar concepts. 43 | 44 | ## Social values 45 | 46 | The Phrasebook is run by [Type Classes](https://typeclasses.com/company), which consists of [Julie Moronuki](https://github.com/argumatronic/) and [Chris Martin](https://github.com/chris-martin/). This project serves as our primary introduction for Haskell newcomers, and we want contributors to care about helping all people who may read the Phrasebook. 47 | 48 | The nature of the Phrasebook invites comparisons between Haskell and other languages; we will not tolerate needless disparagement of any programming ecosystems. We love learning about the differences between languages, and we obviously have our own preferences among them, but undue emphasis on value judgements tends to incidentally insult entire degrees and careers. 49 | 50 | For more on what we're about, please see our Type Classes statement of [values](https://typeclasses.com/values). 51 | 52 | ## License 53 | 54 | All of the code in this repository is offered under the Creative Commons [CC BY-NC 4.0](https://creativecommons.org/licenses/by-nc/4.0/) license, which allows free non-commercial use with attribution. We will only accept contributions that are licensed under these same terms. Please let us know what name and URL you'd like to have listed on the [contributors](https://typeclasses.github.io/haskell-phrasebook/thanks) page. 55 | 56 | ## Style guide 57 | 58 | Each Phrasebook example should define a `main` action which prints something that demonstrates the program's behavior. 59 | 60 | Try to minimize the prerequisite knowledge for each example program. 61 | 62 | Introduce new library dependencies as necessary, but try to stick to [the libraries we have chosen](https://typeclasses.com/phrasebook#libraries). 63 | 64 | Use language extensions as necessary, but not to excess. 65 | 66 | - [`LambdaCase`](https://typeclasses.com/phrasebook/invert) is always acceptable. 67 | - When [a deriving extension](https://typeclasses.com/phrasebook/hash) is required, also enable `DerivingStrategies` and use an explicit strategy on each `deriving` clause. 68 | - Use `NumericUnderscores` when writing large numeric literals such as a [number of microseconds](https://typeclasses.com/phrasebook/timeouts). 69 | 70 | Don't include quite as many type signatures as you might in typical code. 71 | 72 | The `($)` operator tends to be an obstacle for unpracticed Haskell readers, so prefer parentheses. Do use `($)` to avoid parenthesizing [multi-line arguments](https://typeclasses.com/phrasebook/for-loops). We do not want to use the `BlockOperators` extension yet. 73 | 74 | The maximum line length is 68 characters. (This constraint is imposed by the format of the website.) 75 | -------------------------------------------------------------------------------- /docs/license.txt: -------------------------------------------------------------------------------- 1 | Creative Commons Attribution-NonCommercial 4.0 International Public 2 | License 3 | 4 | By exercising the Licensed Rights (defined below), You accept and agree 5 | to be bound by the terms and conditions of this Creative Commons 6 | Attribution-NonCommercial 4.0 International Public License ("Public 7 | License"). To the extent this Public License may be interpreted as a 8 | contract, You are granted the Licensed Rights in consideration of Your 9 | acceptance of these terms and conditions, and the Licensor grants You 10 | such rights in consideration of benefits the Licensor receives from 11 | making the Licensed Material available under these terms and 12 | conditions. 13 | 14 | 15 | Section 1 -- Definitions. 16 | 17 | a. Adapted Material means material subject to Copyright and Similar 18 | Rights that is derived from or based upon the Licensed Material 19 | and in which the Licensed Material is translated, altered, 20 | arranged, transformed, or otherwise modified in a manner requiring 21 | permission under the Copyright and Similar Rights held by the 22 | Licensor. For purposes of this Public License, where the Licensed 23 | Material is a musical work, performance, or sound recording, 24 | Adapted Material is always produced where the Licensed Material is 25 | synched in timed relation with a moving image. 26 | 27 | b. Adapter's License means the license You apply to Your Copyright 28 | and Similar Rights in Your contributions to Adapted Material in 29 | accordance with the terms and conditions of this Public License. 30 | 31 | c. Copyright and Similar Rights means copyright and/or similar rights 32 | closely related to copyright including, without limitation, 33 | performance, broadcast, sound recording, and Sui Generis Database 34 | Rights, without regard to how the rights are labeled or 35 | categorized. For purposes of this Public License, the rights 36 | specified in Section 2(b)(1)-(2) are not Copyright and Similar 37 | Rights. 38 | d. Effective Technological Measures means those measures that, in the 39 | absence of proper authority, may not be circumvented under laws 40 | fulfilling obligations under Article 11 of the WIPO Copyright 41 | Treaty adopted on December 20, 1996, and/or similar international 42 | agreements. 43 | 44 | e. Exceptions and Limitations means fair use, fair dealing, and/or 45 | any other exception or limitation to Copyright and Similar Rights 46 | that applies to Your use of the Licensed Material. 47 | 48 | f. Licensed Material means the artistic or literary work, database, 49 | or other material to which the Licensor applied this Public 50 | License. 51 | 52 | g. Licensed Rights means the rights granted to You subject to the 53 | terms and conditions of this Public License, which are limited to 54 | all Copyright and Similar Rights that apply to Your use of the 55 | Licensed Material and that the Licensor has authority to license. 56 | 57 | h. Licensor means the individual(s) or entity(ies) granting rights 58 | under this Public License. 59 | 60 | i. NonCommercial means not primarily intended for or directed towards 61 | commercial advantage or monetary compensation. For purposes of 62 | this Public License, the exchange of the Licensed Material for 63 | other material subject to Copyright and Similar Rights by digital 64 | file-sharing or similar means is NonCommercial provided there is 65 | no payment of monetary compensation in connection with the 66 | exchange. 67 | 68 | j. Share means to provide material to the public by any means or 69 | process that requires permission under the Licensed Rights, such 70 | as reproduction, public display, public performance, distribution, 71 | dissemination, communication, or importation, and to make material 72 | available to the public including in ways that members of the 73 | public may access the material from a place and at a time 74 | individually chosen by them. 75 | 76 | k. Sui Generis Database Rights means rights other than copyright 77 | resulting from Directive 96/9/EC of the European Parliament and of 78 | the Council of 11 March 1996 on the legal protection of databases, 79 | as amended and/or succeeded, as well as other essentially 80 | equivalent rights anywhere in the world. 81 | 82 | l. You means the individual or entity exercising the Licensed Rights 83 | under this Public License. Your has a corresponding meaning. 84 | 85 | 86 | Section 2 -- Scope. 87 | 88 | a. License grant. 89 | 90 | 1. Subject to the terms and conditions of this Public License, 91 | the Licensor hereby grants You a worldwide, royalty-free, 92 | non-sublicensable, non-exclusive, irrevocable license to 93 | exercise the Licensed Rights in the Licensed Material to: 94 | 95 | a. reproduce and Share the Licensed Material, in whole or 96 | in part, for NonCommercial purposes only; and 97 | 98 | b. produce, reproduce, and Share Adapted Material for 99 | NonCommercial purposes only. 100 | 101 | 2. Exceptions and Limitations. For the avoidance of doubt, where 102 | Exceptions and Limitations apply to Your use, this Public 103 | License does not apply, and You do not need to comply with 104 | its terms and conditions. 105 | 106 | 3. Term. The term of this Public License is specified in Section 107 | 6(a). 108 | 109 | 4. Media and formats; technical modifications allowed. The 110 | Licensor authorizes You to exercise the Licensed Rights in 111 | all media and formats whether now known or hereafter created, 112 | and to make technical modifications necessary to do so. The 113 | Licensor waives and/or agrees not to assert any right or 114 | authority to forbid You from making technical modifications 115 | necessary to exercise the Licensed Rights, including 116 | technical modifications necessary to circumvent Effective 117 | Technological Measures. For purposes of this Public License, 118 | simply making modifications authorized by this Section 2(a) 119 | (4) never produces Adapted Material. 120 | 121 | 5. Downstream recipients. 122 | 123 | a. Offer from the Licensor -- Licensed Material. Every 124 | recipient of the Licensed Material automatically 125 | receives an offer from the Licensor to exercise the 126 | Licensed Rights under the terms and conditions of this 127 | Public License. 128 | 129 | b. No downstream restrictions. You may not offer or impose 130 | any additional or different terms or conditions on, or 131 | apply any Effective Technological Measures to, the 132 | Licensed Material if doing so restricts exercise of the 133 | Licensed Rights by any recipient of the Licensed 134 | Material. 135 | 136 | 6. No endorsement. Nothing in this Public License constitutes or 137 | may be construed as permission to assert or imply that You 138 | are, or that Your use of the Licensed Material is, connected 139 | with, or sponsored, endorsed, or granted official status by, 140 | the Licensor or others designated to receive attribution as 141 | provided in Section 3(a)(1)(A)(i). 142 | 143 | b. Other rights. 144 | 145 | 1. Moral rights, such as the right of integrity, are not 146 | licensed under this Public License, nor are publicity, 147 | privacy, and/or other similar personality rights; however, to 148 | the extent possible, the Licensor waives and/or agrees not to 149 | assert any such rights held by the Licensor to the limited 150 | extent necessary to allow You to exercise the Licensed 151 | Rights, but not otherwise. 152 | 153 | 2. Patent and trademark rights are not licensed under this 154 | Public License. 155 | 156 | 3. To the extent possible, the Licensor waives any right to 157 | collect royalties from You for the exercise of the Licensed 158 | Rights, whether directly or through a collecting society 159 | under any voluntary or waivable statutory or compulsory 160 | licensing scheme. In all other cases the Licensor expressly 161 | reserves any right to collect such royalties, including when 162 | the Licensed Material is used other than for NonCommercial 163 | purposes. 164 | 165 | 166 | Section 3 -- License Conditions. 167 | 168 | Your exercise of the Licensed Rights is expressly made subject to the 169 | following conditions. 170 | 171 | a. Attribution. 172 | 173 | 1. If You Share the Licensed Material (including in modified 174 | form), You must: 175 | 176 | a. retain the following if it is supplied by the Licensor 177 | with the Licensed Material: 178 | 179 | i. identification of the creator(s) of the Licensed 180 | Material and any others designated to receive 181 | attribution, in any reasonable manner requested by 182 | the Licensor (including by pseudonym if 183 | designated); 184 | 185 | ii. a copyright notice; 186 | 187 | iii. a notice that refers to this Public License; 188 | 189 | iv. a notice that refers to the disclaimer of 190 | warranties; 191 | 192 | v. a URI or hyperlink to the Licensed Material to the 193 | extent reasonably practicable; 194 | 195 | b. indicate if You modified the Licensed Material and 196 | retain an indication of any previous modifications; and 197 | 198 | c. indicate the Licensed Material is licensed under this 199 | Public License, and include the text of, or the URI or 200 | hyperlink to, this Public License. 201 | 202 | 2. You may satisfy the conditions in Section 3(a)(1) in any 203 | reasonable manner based on the medium, means, and context in 204 | which You Share the Licensed Material. For example, it may be 205 | reasonable to satisfy the conditions by providing a URI or 206 | hyperlink to a resource that includes the required 207 | information. 208 | 209 | 3. If requested by the Licensor, You must remove any of the 210 | information required by Section 3(a)(1)(A) to the extent 211 | reasonably practicable. 212 | 213 | 4. If You Share Adapted Material You produce, the Adapter's 214 | License You apply must not prevent recipients of the Adapted 215 | Material from complying with this Public License. 216 | 217 | 218 | Section 4 -- Sui Generis Database Rights. 219 | 220 | Where the Licensed Rights include Sui Generis Database Rights that 221 | apply to Your use of the Licensed Material: 222 | 223 | a. for the avoidance of doubt, Section 2(a)(1) grants You the right 224 | to extract, reuse, reproduce, and Share all or a substantial 225 | portion of the contents of the database for NonCommercial purposes 226 | only; 227 | 228 | b. if You include all or a substantial portion of the database 229 | contents in a database in which You have Sui Generis Database 230 | Rights, then the database in which You have Sui Generis Database 231 | Rights (but not its individual contents) is Adapted Material; and 232 | 233 | c. You must comply with the conditions in Section 3(a) if You Share 234 | all or a substantial portion of the contents of the database. 235 | 236 | For the avoidance of doubt, this Section 4 supplements and does not 237 | replace Your obligations under this Public License where the Licensed 238 | Rights include other Copyright and Similar Rights. 239 | 240 | 241 | Section 5 -- Disclaimer of Warranties and Limitation of Liability. 242 | 243 | a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE 244 | EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS 245 | AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF 246 | ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS, 247 | IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION, 248 | WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR 249 | PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS, 250 | ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT 251 | KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT 252 | ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU. 253 | 254 | b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE 255 | TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, 256 | NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT, 257 | INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES, 258 | COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR 259 | USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN 260 | ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR 261 | DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR 262 | IN PART, THIS LIMITATION MAY NOT APPLY TO YOU. 263 | 264 | c. The disclaimer of warranties and limitation of liability provided 265 | above shall be interpreted in a manner that, to the extent 266 | possible, most closely approximates an absolute disclaimer and 267 | waiver of all liability. 268 | 269 | 270 | Section 6 -- Term and Termination. 271 | 272 | a. This Public License applies for the term of the Copyright and 273 | Similar Rights licensed here. However, if You fail to comply with 274 | this Public License, then Your rights under this Public License 275 | terminate automatically. 276 | 277 | b. Where Your right to use the Licensed Material has terminated under 278 | Section 6(a), it reinstates: 279 | 280 | 1. automatically as of the date the violation is cured, provided 281 | it is cured within 30 days of Your discovery of the 282 | violation; or 283 | 284 | 2. upon express reinstatement by the Licensor. 285 | 286 | For the avoidance of doubt, this Section 6(b) does not affect any 287 | right the Licensor may have to seek remedies for Your violations 288 | of this Public License. 289 | 290 | c. For the avoidance of doubt, the Licensor may also offer the 291 | Licensed Material under separate terms or conditions or stop 292 | distributing the Licensed Material at any time; however, doing so 293 | will not terminate this Public License. 294 | 295 | d. Sections 1, 5, 6, 7, and 8 survive termination of this Public 296 | License. 297 | 298 | 299 | Section 7 -- Other Terms and Conditions. 300 | 301 | a. The Licensor shall not be bound by any additional or different 302 | terms or conditions communicated by You unless expressly agreed. 303 | 304 | b. Any arrangements, understandings, or agreements regarding the 305 | Licensed Material not stated herein are separate from and 306 | independent of the terms and conditions of this Public License. 307 | 308 | 309 | Section 8 -- Interpretation. 310 | 311 | a. For the avoidance of doubt, this Public License does not, and 312 | shall not be interpreted to, reduce, limit, restrict, or impose 313 | conditions on any use of the Licensed Material that could lawfully 314 | be made without permission under this Public License. 315 | 316 | b. To the extent possible, if any provision of this Public License is 317 | deemed unenforceable, it shall be automatically reformed to the 318 | minimum extent necessary to make it enforceable. If the provision 319 | cannot be reformed, it shall be severed from this Public License 320 | without affecting the enforceability of the remaining terms and 321 | conditions. 322 | 323 | c. No term or condition of this Public License will be waived and no 324 | failure to comply consented to unless expressly agreed to by the 325 | Licensor. 326 | 327 | d. Nothing in this Public License constitutes or may be interpreted 328 | as a limitation upon, or waiver of, any privileges and immunities 329 | that apply to the Licensor or You, including from the legal 330 | processes of any jurisdiction or authority. 331 | -------------------------------------------------------------------------------- /docs/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typeclasses/haskell-phrasebook/2b0aa44ef6f6e9745c51ed47b4e59ff704346c87/docs/logo.png -------------------------------------------------------------------------------- /docs/readme.md: -------------------------------------------------------------------------------- 1 | ![Haskell Phrasebook logo](logo.png) 2 | 3 | *The Haskell Phrasebook* is a free quick-start Haskell guide comprised of a sequence of small annotated programs. It provides a cursory overview of selected Haskell features, jumping-off points for further reading, and recommendations to help get you writing programs as soon as possible. 4 | 5 | This repository contains only the code files; you may find them useful if you want to follow along while reading the *Phrasebook*, which can be found at [typeclasses.com/phrasebook](https://typeclasses.com/phrasebook). 6 | 7 | **Contributing** -- We love to hear any requests or ideas for how to expand or improve the Phrasebook! Please see the [contributor guide](https://typeclasses.github.io/haskell-phrasebook/contributing). 8 | 9 | **Build tools** -- See the [build tools](https://typeclasses.github.io/haskell-phrasebook/build-tools) page for information on how to build and run the Phrasebook examples. 10 | 11 | **License** -- The code in this repository is offered under the Creative Commons [CC BY-NC 4.0](https://creativecommons.org/licenses/by-nc/4.0/) license, which allows free non-commercial use with [attribution](https://typeclasses.github.io/haskell-phrasebook/thanks). You can read the full text in the [license.txt](license.txt) file. 12 | 13 | **Support** -- You can help support this community resource with funding via [Liberapay](https://liberapay.com/typeclasses) or by becoming a member of [Type Classes](https://typeclasses.com) (which gives you access to much more of our writing). 14 | -------------------------------------------------------------------------------- /docs/thanks.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: 🖤 Thanks 3 | --- 4 | 5 | Thanks to the following people who have [contributed](https://typeclasses.github.io/haskell-phrasebook/contributing) to the Phrasebook: 6 | 7 | - [ammatsui](https://github.com/ammatsui) -- [Defining functions](https://github.com/typeclasses/haskell-phrasebook/pull/16), [enum ranges](https://github.com/typeclasses/haskell-phrasebook/pull/17) 8 | - [Dima Kurilo](https://twitter.com/DimaKurilo) -- [Bounded queues](https://github.com/typeclasses/haskell-phrasebook/pull/18) 9 | - [Taylor Fausak](https://taylor.fausak.me) -- [Moments in time](https://github.com/typeclasses/haskell-phrasebook/pull/19) 10 | - [Julian Birch](https://colourcoding.net/) -- [Maybe](https://github.com/typeclasses/haskell-phrasebook/commit/518a0cb1cfd8ab7b583cfb699749259c018b47a9) 11 | - [Florian Beeres](https://fbrs.io/) -- [Records with optics](https://github.com/typeclasses/haskell-phrasebook/pull/34) 12 | - [Yuras Shumovich](https://twitter.com/shumovichy) -- assistance with exception handling in `monitoring.hs` ([1](https://twitter.com/shumovichy/status/1207093768182288386), [2](https://twitter.com/shumovichy/status/1207637508412059648)) 13 | - [gutierrezje](https://github.com/gutierrezje) -- [Folding lists](https://github.com/typeclasses/haskell-phrasebook/pull/20) 14 | - [Daniel Brice](https://github.com/friedbrice) -- [Logging](https://github.com/typeclasses/haskell-phrasebook/pull/39) 15 | -------------------------------------------------------------------------------- /dynamic.hs: -------------------------------------------------------------------------------- 1 | import Data.Dynamic 2 | import Data.Foldable 3 | 4 | mixedList = 5 | [ toDyn True 6 | , toDyn (5 :: Integer) 7 | , toDyn "hey" 8 | ] 9 | 10 | main = 11 | for_ mixedList $ \d -> 12 | putStrLn (message d) 13 | 14 | recognizeType d = 15 | asum 16 | [ (fromDynamic d :: Maybe Integer) >>= \x -> 17 | Just (show x ++ " is an integer") 18 | , (fromDynamic d :: Maybe Bool) >>= \x -> 19 | Just ("The answer is " ++ (if x then "yes" else "no")) 20 | ] 21 | 22 | message d = 23 | case (recognizeType d) of 24 | Just x -> x 25 | Nothing -> "Unrecognized type: " ++ show (dynTypeRep d) 26 | -------------------------------------------------------------------------------- /enum-ranges.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | import Data.Int (Int8) 4 | 5 | data Rank = 6 | Rank2 7 | | Rank3 8 | | Rank4 9 | | Rank5 10 | | Rank6 11 | | Rank7 12 | | Rank8 13 | | Rank9 14 | | Rank10 15 | | Jack 16 | | Queen 17 | | King 18 | | Ace 19 | deriving (Bounded, Enum, Show) 20 | 21 | main = 22 | do 23 | putStrLn (show [3 .. 8]) 24 | putStrLn (show ['a' .. 'z']) 25 | 26 | putStrLn (show [Rank2 .. Rank10]) 27 | putStrLn (show [Jack ..]) 28 | 29 | putStrLn (show (minBound @Rank)) 30 | putStrLn (show (maxBound @Rank)) 31 | 32 | putStrLn (show (minBound @Int8)) 33 | putStrLn (show (maxBound @Int8)) 34 | 35 | putStrLn (show [minBound @Rank .. maxBound @Rank]) 36 | -------------------------------------------------------------------------------- /file-handles.hs: -------------------------------------------------------------------------------- 1 | import System.IO 2 | import System.Directory 3 | 4 | main = 5 | do 6 | h <- openFile "hello.txt" WriteMode 7 | 8 | hPutStrLn h "hello" 9 | hPutStrLn h "world" 10 | 11 | hClose h 12 | 13 | h <- openFile "hello.txt" ReadMode 14 | 15 | line <- hGetLine h 16 | putStrLn line 17 | 18 | atEnd <- hIsEOF h 19 | putStrLn (show atEnd) 20 | 21 | line <- hGetLine h 22 | putStrLn line 23 | 24 | atEnd <- hIsEOF h 25 | putStrLn (show atEnd) 26 | 27 | hClose h 28 | 29 | removeFile "hello.txt" 30 | -------------------------------------------------------------------------------- /folding-lists.hs: -------------------------------------------------------------------------------- 1 | import Data.Foldable (foldr, foldMap, fold) 2 | import Prelude hiding (sum) 3 | 4 | sum :: [Integer] -> Integer 5 | sum xs = foldr (+) 0 xs 6 | 7 | commaList :: [String] -> String 8 | commaList xs = foldr commaSep "" xs 9 | where 10 | commaSep x "" = x 11 | commaSep x phrase = x ++ ", " ++ phrase 12 | 13 | bulletList :: [String] -> String 14 | bulletList xs = foldMap bulletItem xs 15 | where 16 | bulletItem x = " - " ++ x ++ "\n" 17 | 18 | smashTogether :: [String] -> String 19 | smashTogether xs = fold xs 20 | 21 | main = 22 | do 23 | let numbers = enumFromTo 1 5 24 | putStrLn (show numbers) 25 | putStrLn (show (sum numbers)) 26 | 27 | let words = ["One", "Two", "Three", "Four", "Five"] 28 | putStrLn (commaList words) 29 | putStr (bulletList words) 30 | putStrLn (smashTogether words) 31 | -------------------------------------------------------------------------------- /for-loops.hs: -------------------------------------------------------------------------------- 1 | import Data.Foldable (for_) 2 | import Data.Traversable (for) 3 | 4 | import Control.Monad (when) 5 | 6 | main = 7 | do 8 | putStr "Numbers:" 9 | for_ [1..5] $ \i -> 10 | do 11 | putStr " " 12 | putStr (show i) 13 | putStr "\n" 14 | 15 | putStr "Odds:" 16 | for_ [1..5] $ \i -> 17 | when (odd i) $ 18 | do 19 | putStr " " 20 | putStr (show i) 21 | putStr "\n" 22 | 23 | putStr "Odds:" 24 | for_ (filter odd [1..5]) $ \i -> 25 | do 26 | putStr " " 27 | putStr (show i) 28 | putStr "\n" 29 | 30 | tens <- 31 | for [1..3] $ \i -> 32 | do 33 | putStr (show i ++ " ") 34 | return (i * 10) 35 | putStr ("(sum: " ++ show (sum tens) ++ ")\n") 36 | -------------------------------------------------------------------------------- /functions.hs: -------------------------------------------------------------------------------- 1 | next x = x + 1 2 | 3 | hypotenuse x y = sqrt (x^2 + y^2) 4 | 5 | greet name = "hello" ++ " " ++ name 6 | 7 | greet2 :: String -> String 8 | greet2 name = "hello" ++ " " ++ name 9 | 10 | greetNext x = (next x, greet (show (next x))) 11 | 12 | hello :: String -> String 13 | hello "Olafur" = "hello, Olafur!" 14 | hello "Rocamadour" = "hey!" 15 | hello x = greet x 16 | 17 | main = 18 | do 19 | putStrLn (show (next 4)) 20 | putStrLn (show (next (next 4))) 21 | 22 | putStrLn (show (hypotenuse 3 4)) 23 | 24 | putStrLn (greet "world") 25 | putStrLn (greet2 "world") 26 | 27 | putStrLn (show (greetNext 7)) 28 | 29 | let (x, y) = greetNext 7 30 | putStrLn (show x) 31 | putStrLn y 32 | 33 | putStrLn (hello "Olafur") 34 | putStrLn (hello "Rocamadour") 35 | putStrLn (hello "Jane") 36 | -------------------------------------------------------------------------------- /guard.hs: -------------------------------------------------------------------------------- 1 | -- C# style languages have the a ? b : c construct. 2 | -- This can be replicated in Haskell as if a then b else c 3 | -- However, there's another way and it involves a bunch of functions 4 | -- that don't really look that promising at first. 5 | 6 | -- One is guard 7 | -- guard :: Alternative f => Bool -> f () 8 | 9 | import Control.Monad(guard) 10 | 11 | -- If we assume "Alternative" means "Maybe", this function returns Just () when bool is true and Nothing when bool is false. Doesn't look that useful. 12 | 13 | -- There's also this weird function that's attached to functor in the Prelude 14 | -- (<$) :: Functor f => a -> f b -> f a 15 | 16 | import Prelude((<$), Int, String, Maybe, IO, putStrLn, (<$>), (.), show, rem, (==)) -- You don't need this line 17 | -- which is like <$> only with a constant instead of a function. Again, that doesn't sound -- that useful, but what if you didn't care about the original values because the original -- value was () to begin with? Then we could write something like this: 18 | 19 | -- Alternative also has this useful function: 20 | -- (<|>) :: Alternative f => f a -> f a -> f a 21 | 22 | import Control.Applicative((<|>)) 23 | 24 | -- Again, if we just consider "Maybe" this means "if the first thing is Nothing, return the second thing, otherwise return the first". 25 | 26 | -- Finally, let's grab a useful function from Data.Maybe 27 | -- fromMaybe :: a -> Maybe a -> a 28 | 29 | import Data.Maybe(fromMaybe) 30 | 31 | -- This returns the second thing if it's "Just" or the first thing if the second thing is "Nothing". 32 | 33 | -- Finally, we need something that runs a function on a list and throws away the result. 34 | 35 | import Data.Foldable(for_) 36 | 37 | fizz :: Int -> Maybe String 38 | fizz n = "Fizz" <$ guard (n `rem` 3 == 0) 39 | 40 | -- Remember that there's lazy semantics going on here. If "Fizz" is expensive to 41 | -- evaluate, it doesn't matter because the guard expression will be evaluated first. 42 | -- In fact, when this is compiled, it will end up as pretty much the same code 43 | -- as a raw if statement. 44 | 45 | -- We could write the other components of FizzBuzz easily enough 46 | 47 | buzz :: Int -> Maybe String 48 | buzz n = "Buzz" <$ guard (n `rem` 5 == 0) 49 | 50 | fizzbuzz :: Int -> Maybe String 51 | fizzbuzz n = "FizzBuzz" <$ guard (n `rem` 15 == 0) 52 | 53 | -- You might be wondering if you can get the repetition in this code down. 54 | -- The answer is yes, but that requires the reader monad trick that we won't 55 | -- employ here. 56 | 57 | -- <|> can be used to combine Maybes so we can now write fizzbuzz n <|> buzz n <|> fizz n 58 | -- *But* this is still "Maybe String" not "String", which is what FizzBuzz actually wants 59 | 60 | -- To get a String back out of Maybe, we use `fromMaybe`. We just need to provide the "otherwise" clause 61 | 62 | toString :: Int -> String 63 | toString n = fromMaybe (show n) (fizzbuzz n <|> buzz n <|> fizz n) 64 | 65 | -- Again, without lazy evaluation this would be horribly inefficient, but GHC will 66 | -- turn this into pretty efficient code. 67 | 68 | -- All we need to do now is print the numbers. 69 | 70 | main :: IO () 71 | main = for_ [1..100] (putStrLn . toString) -------------------------------------------------------------------------------- /hashing.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | 5 | import Data.Hashable (Hashable (hash)) 6 | import Data.Word (Word8) 7 | import GHC.Generics (Generic) 8 | 9 | data Color = 10 | Color 11 | { red :: Word8 12 | , green :: Word8 13 | , blue :: Word8 14 | } 15 | deriving stock (Show, Generic) 16 | deriving anyclass (Hashable) 17 | 18 | main = 19 | do 20 | putStrLn (show (hash (Color 255 0 0))) 21 | putStrLn (show (hash (Color 0 255 0))) 22 | -------------------------------------------------------------------------------- /hello-world.hs: -------------------------------------------------------------------------------- 1 | main = putStrLn "hello world" 2 | -------------------------------------------------------------------------------- /hie.yaml: -------------------------------------------------------------------------------- 1 | cradle: 2 | cabal: 3 | - path: "./tests/PhrasebookTesting.hs" 4 | component: "lib:phrasebook-testing" 5 | 6 | - path: "./bounded-queues.hs" 7 | component: "exe:bounded-queues" 8 | - path: "./tests/test-bounded-queues.hs" 9 | component: "test:test-bounded-queues" 10 | 11 | - path: "./branching.hs" 12 | component: "exe:branching" 13 | - path: "./tests/test-branching.hs" 14 | component: "test:test-branching" 15 | 16 | - path: "./common-types.hs" 17 | component: "exe:common-types" 18 | - path: "./tests/test-common-types.hs" 19 | component: "test:test-common-types" 20 | 21 | - path: "./crypto-hashing.hs" 22 | component: "exe:crypto-hashing" 23 | - path: "./tests/test-crypto-hashing.hs" 24 | component: "test:test-crypto-hashing" 25 | 26 | - path: "./dynamic.hs" 27 | component: "exe:dynamic" 28 | - path: "./tests/test-dynamic.hs" 29 | component: "test:test-dynamic" 30 | 31 | - path: "./enum-ranges.hs" 32 | component: "exe:enum-ranges" 33 | - path: "./tests/test-enum-ranges.hs" 34 | component: "test:test-enum-ranges" 35 | 36 | - path: "./file-handles.hs" 37 | component: "exe:file-handles" 38 | - path: "./tests/test-file-handles.hs" 39 | component: "test:test-file-handles" 40 | 41 | - path: "./folding-lists.hs" 42 | component: "exe:folding-lists" 43 | - path: "./tests/test-folding-lists.hs" 44 | component: "test:test-folding-lists" 45 | 46 | - path: "./for-loops.hs" 47 | component: "exe:for-loops" 48 | - path: "./tests/test-for-loops.hs" 49 | component: "test:test-for-loops" 50 | 51 | - path: "./functions.hs" 52 | component: "exe:functions" 53 | - path: "./tests/test-functions.hs" 54 | component: "test:test-functions" 55 | 56 | - path: "./guard.hs" 57 | component: "exe:guard" 58 | - path: "./tests/test-guard.hs" 59 | component: "test:test-guard" 60 | 61 | - path: "./hashing.hs" 62 | component: "exe:hashing" 63 | - path: "./tests/test-hashing.hs" 64 | component: "test:test-hashing" 65 | 66 | - path: "./hello-world.hs" 67 | component: "exe:hello-world" 68 | - path: "./tests/test-hello-world.hs" 69 | component: "test:test-hello-world" 70 | 71 | - path: "./if-else.hs" 72 | component: "exe:if-else" 73 | - path: "./tests/test-if-else.hs" 74 | component: "test:test-if-else" 75 | 76 | - path: "./invert.hs" 77 | component: "exe:invert" 78 | - path: "./tests/test-invert.hs" 79 | component: "test:test-invert" 80 | 81 | - path: "./logging.hs" 82 | component: "exe:logging" 83 | - path: "./tests/test-logging.hs" 84 | component: "test:test-logging" 85 | 86 | - path: "./moments-in-time.hs" 87 | component: "exe:moments-in-time" 88 | - path: "./tests/test-moments-in-time.hs" 89 | component: "test:test-moments-in-time" 90 | 91 | - path: "./monitoring.hs" 92 | component: "exe:monitoring" 93 | - path: "./tests/test-monitoring.hs" 94 | component: "test:test-monitoring" 95 | 96 | - path: "./mutable-references.hs" 97 | component: "exe:mutable-references" 98 | - path: "./tests/test-mutable-references.hs" 99 | component: "test:test-mutable-references" 100 | 101 | - path: "./partial-application.hs" 102 | component: "exe:partial-application" 103 | - path: "./tests/test-partial-application.hs" 104 | component: "test:test-partial-application" 105 | 106 | - path: "./records-with-optics.hs" 107 | component: "exe:records-with-optics" 108 | - path: "./tests/test-records-with-optics.hs" 109 | component: "test:test-records-with-optics" 110 | 111 | - path: "./threads.hs" 112 | component: "exe:threads" 113 | - path: "./tests/test-threads.hs" 114 | component: "test:test-threads" 115 | 116 | - path: "./timeouts.hs" 117 | component: "exe:timeouts" 118 | - path: "./tests/test-timeouts.hs" 119 | component: "test:test-timeouts" 120 | 121 | - path: "./transactions.hs" 122 | component: "exe:transactions" 123 | - path: "./tests/test-transactions.hs" 124 | component: "test:test-transactions" 125 | 126 | - path: "./variables.hs" 127 | component: "exe:variables" 128 | - path: "./tests/test-variables.hs" 129 | component: "test:test-variables" 130 | -------------------------------------------------------------------------------- /if-else.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad (when) 2 | 3 | main = 4 | do 5 | if (even 7) 6 | then putStrLn "7 is even" 7 | else putStrLn "7 is odd" 8 | 9 | when (8 `mod` 4 == 0) $ 10 | putStrLn "8 is divisible by 4" 11 | 12 | let num = 9 in 13 | if num < 0 14 | then putStrLn (show num ++ " is negative") 15 | else 16 | if num < 10 17 | then putStrLn (show num ++ " has 1 digit") 18 | else putStrLn (show num ++ " has multiple digits") 19 | 20 | case 19 of 21 | num 22 | | num < 0 -> putStrLn (show num ++ " is negative") 23 | | num < 10 -> putStrLn (show num ++ " has 1 digit") 24 | | otherwise -> putStrLn (show num ++ " has multiple digits") 25 | -------------------------------------------------------------------------------- /invert.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DeriveAnyClass #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | 6 | import GHC.Generics (Generic) 7 | import Generics.Deriving.Enum (GEnum (genum)) 8 | import qualified Data.Map.Strict as Map 9 | 10 | data Product = Basic | Standard | Pro 11 | deriving stock (Generic, Show) 12 | deriving anyclass GEnum 13 | 14 | data Frequency = Monthly | Annual 15 | deriving stock (Generic, Show) 16 | deriving anyclass GEnum 17 | 18 | data Bill = Bill Product Frequency 19 | deriving stock (Generic, Show) 20 | deriving anyclass GEnum 21 | 22 | encodeProduct :: Product -> String 23 | encodeProduct = \case 24 | Basic -> "p1" 25 | Standard -> "p2" 26 | Pro -> "p3" 27 | 28 | encodeBill :: Bill -> Integer 29 | encodeBill = \case 30 | Bill Basic Monthly -> 10 31 | Bill Basic Annual -> 11 32 | Bill Standard Monthly -> 20 33 | Bill Standard Annual -> 21 34 | Bill Pro Monthly -> 30 35 | Bill Pro Annual -> 31 36 | 37 | invert :: (GEnum a, Ord b) => (a -> b) -> b -> Maybe a 38 | invert f = 39 | let 40 | reverseMap = foldMap (\a -> Map.singleton (f a) a) genum 41 | in 42 | \b -> Map.lookup b reverseMap 43 | 44 | decodeProduct :: String -> Maybe Product 45 | decodeProduct = invert encodeProduct 46 | 47 | decodeBill :: Integer -> Maybe Bill 48 | decodeBill = invert encodeBill 49 | 50 | main = 51 | do 52 | putStrLn (encodeProduct Basic) 53 | putStrLn (encodeProduct Standard) 54 | 55 | putStrLn (show (decodeProduct "p1")) 56 | putStrLn (show (decodeProduct "xyz")) 57 | 58 | putStrLn (show (encodeBill (Bill Basic Annual))) 59 | putStrLn (show (encodeBill (Bill Pro Monthly))) 60 | 61 | putStrLn (show (decodeBill 31)) 62 | putStrLn (show (decodeBill 50)) 63 | -------------------------------------------------------------------------------- /logging.hs: -------------------------------------------------------------------------------- 1 | import Control.Exception.Safe (displayException, tryAny) 2 | import Data.Foldable (fold) 3 | import System.Directory (getPermissions, writable) 4 | import System.Environment (getEnv) 5 | import System.IO (hPutStr, stdout, stderr) 6 | 7 | data Level = Info | Error 8 | 9 | data Event = Event Level String 10 | 11 | data Log = Log { record :: Event -> IO () } 12 | 13 | consoleLog = Log $ \(Event level message) -> 14 | hPutStr (standardStream level) (message <> "\n") 15 | 16 | standardStream Info = stdout 17 | standardStream Error = stderr 18 | 19 | fileLog path = Log $ \(Event level message) -> 20 | appendFile (path level) (message <> "\n") 21 | 22 | formattedLog topic log = Log $ \event -> 23 | record log (formatEvent topic event) 24 | 25 | formatEvent topic (Event level msg) = Event level msg' 26 | where 27 | msg' = paren (topic ! levelString level) ! msg 28 | 29 | paren x = "(" <> x <> ")" 30 | 31 | x ! y = x <> " " <> y 32 | 33 | levelString Info = "info" 34 | levelString Error = "error" 35 | 36 | nullLog = Log (\_ -> return ()) 37 | 38 | multiLog log1 log2 = Log $ \event -> 39 | do 40 | record log1 event 41 | record log2 event 42 | 43 | instance Semigroup Log where (<>) = multiLog 44 | instance Monoid Log where mempty = nullLog 45 | 46 | recoverFromException log action = 47 | do 48 | result <- tryAny action 49 | 50 | case result of 51 | Left e -> 52 | do 53 | record log (Event Error (displayException e)) 54 | return Nothing 55 | Right x -> 56 | return (Just x) 57 | 58 | main = 59 | do 60 | let bootLog = formattedLog "Boot" consoleLog 61 | record bootLog (Event Info "Starting") 62 | fileLog <- recoverFromException bootLog initFileLog 63 | 64 | let appLog = formattedLog "App" consoleLog <> fold fileLog 65 | record appLog (Event Info "Application started") 66 | 67 | -- ... 68 | 69 | initFileLog = 70 | do 71 | infoPath <- envLogPath "INFO" 72 | errorPath <- envLogPath "ERROR" 73 | 74 | let 75 | path Info = infoPath 76 | path Error = errorPath 77 | 78 | return (fileLog path) 79 | 80 | envLogPath varName = 81 | do 82 | path <- getEnv varName 83 | assertWritable path 84 | return path 85 | 86 | assertWritable path = 87 | do 88 | permissions <- getPermissions path 89 | case writable permissions of 90 | True -> return () 91 | False -> fail ("Log path" ! path ! "is not writable") 92 | -------------------------------------------------------------------------------- /moments-in-time.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | import qualified Data.Time as T 4 | import qualified Data.Time.Clock.POSIX as T 5 | 6 | timeToString format time = 7 | T.formatTime T.defaultTimeLocale format time 8 | 9 | stringToTime format string = 10 | T.parseTimeM acceptExtraWhitespace 11 | T.defaultTimeLocale format string 12 | where 13 | acceptExtraWhitespace = False 14 | 15 | main = 16 | do 17 | (now_utc :: T.UTCTime) <- T.getCurrentTime 18 | putStrLn ("Now (UTC): " ++ show now_utc) 19 | 20 | (now_posix :: T.POSIXTime) <- T.getPOSIXTime 21 | putStrLn ("Now (POSIX): " ++ show now_posix) 22 | 23 | let t1_string = "2038-01-19 03:14:07" 24 | (t1_utc :: T.UTCTime) <- 25 | stringToTime "%Y-%m-%d %H:%M:%S" t1_string 26 | putStrLn (show t1_utc) 27 | 28 | putStrLn (timeToString "%Y-%m-%d" t1_utc) 29 | putStrLn (timeToString "%I:%M %p" t1_utc) 30 | 31 | let (t2_utc :: T.UTCTime) = T.addUTCTime 15 t1_utc 32 | putStrLn (show t2_utc) 33 | putStrLn (show (t1_utc < t2_utc)) 34 | 35 | let (diff :: T.NominalDiffTime) = T.diffUTCTime t2_utc t1_utc 36 | putStrLn (show diff) 37 | 38 | let (t1_posix :: T.POSIXTime) = T.utcTimeToPOSIXSeconds t1_utc 39 | putStrLn (show t1_posix) 40 | putStrLn (show (T.posixSecondsToUTCTime t1_posix)) 41 | -------------------------------------------------------------------------------- /monitoring.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NumericUnderscores, TypeApplications #-} 2 | 3 | import qualified Network.Socket as S 4 | import Network.Socket.ByteString (recv, sendAll) 5 | 6 | import Control.Exception.Safe 7 | 8 | import qualified Data.ByteString as BS 9 | import qualified Data.ByteString.Char8 10 | 11 | import System.Environment 12 | import System.Exit 13 | import System.IO 14 | import System.Signal 15 | 16 | import Control.Concurrent 17 | import Control.Concurrent.Async 18 | import Control.Concurrent.STM 19 | 20 | import qualified Data.Sequence as Seq 21 | import Data.Ratio ((%)) 22 | 23 | import Control.Monad (forever, when) 24 | import Data.Foldable (asum, for_, find) 25 | import Data.Maybe (mapMaybe) 26 | 27 | -- An event report represents the result of a single action. 28 | data EventReport = Success | Failure 29 | deriving Eq 30 | 31 | -- The system status is an overview of whether, in general, actions tend to be succeeding or failing. 32 | data SystemStatus = Okay | Alarm 33 | deriving Eq 34 | 35 | main = 36 | do 37 | hSetBuffering stdout LineBuffering 38 | 39 | args <- getArgs 40 | 41 | case args of 42 | ["aggregate-reports"] -> aggregateReportsMain 43 | ["send-demo-reports"] -> sendDemoReportsMain 44 | _ -> die "Invalid args" 45 | 46 | aggregateReportsMain = 47 | withServerSocket $ \serverSocket -> 48 | do 49 | putStrLn "The monitoring server has started." 50 | 51 | reportQueue <- atomically newTQueue 52 | alarmQueue <- atomically newTQueue 53 | 54 | foldr1 race_ 55 | [ receiveReports serverSocket reportQueue 56 | , analyzeReports reportQueue alarmQueue 57 | , sendAlarms alarmQueue 58 | , waitForTerminationSignal 59 | ] 60 | 61 | putStrLn "The monitoring server is stopping." 62 | 63 | waitForTerminationSignal = 64 | do 65 | terminate <- atomically (newTVar False) 66 | installHandler sigTERM $ \_signal -> 67 | atomically (writeTVar terminate True) 68 | atomically (readTVar terminate >>= check) 69 | 70 | 71 | --- Message format --- 72 | 73 | encodeReport r = 74 | case r of 75 | Failure -> '0' 76 | Success -> '1' 77 | 78 | decodeReport c = 79 | find (\r -> encodeReport r == c) [Failure, Success] 80 | 81 | 82 | --- Receiving event reports --- 83 | 84 | serverAddress = S.SockAddrUnix "\0haskell-phrasebook/monitoring" 85 | 86 | openSocket = S.socket S.AF_UNIX S.Stream S.defaultProtocol 87 | 88 | withServerSocket action = 89 | bracket openSocket S.close $ \serverSocket -> 90 | do 91 | S.bind serverSocket serverAddress 92 | S.listen serverSocket S.maxListenQueue 93 | action serverSocket 94 | 95 | receiveReports serverSocket reportQueue = 96 | forever $ 97 | mask $ \unmask -> 98 | do 99 | (clientSocket, _clientAddr) <- S.accept serverSocket 100 | 101 | forkFinally 102 | (unmask (receiveReports' clientSocket reportQueue)) 103 | (\_ -> S.close clientSocket) 104 | 105 | receiveReports' clientSocket reportQueue = continue 106 | where 107 | continue = 108 | do 109 | receivedBytes <- recv clientSocket 1024 110 | 111 | case BS.length receivedBytes of 112 | 0 -> return () 113 | _ -> 114 | do 115 | receiveReports'' receivedBytes reportQueue 116 | continue 117 | 118 | receiveReports'' receivedBytes reportQueue = 119 | for_ @[] (Data.ByteString.Char8.unpack receivedBytes) $ \c -> 120 | for_ @Maybe (decodeReport c) $ \r -> do 121 | putStrLn (case r of Success -> "1 (success)" 122 | Failure -> "0 (failure)") 123 | atomically (writeTQueue reportQueue r) 124 | 125 | 126 | --- Analysis of system status changes using event reports --- 127 | 128 | reportWindowSize = 10 129 | okayThreshold = 80 % 100 130 | alarmThreshold = 50 % 100 131 | 132 | analysis reports 133 | | Seq.length reports < reportWindowSize = Nothing 134 | | successRate <= alarmThreshold = Just Alarm 135 | | successRate >= okayThreshold = Just Okay 136 | | otherwise = Nothing 137 | where 138 | successes = Seq.filter (== Success) reports 139 | successRate = Seq.length successes % Seq.length reports 140 | 141 | analyzeReports reportQueue alarmQueue = continue Nothing Seq.empty 142 | where 143 | continue status reports = 144 | do 145 | newReport <- atomically (readTQueue reportQueue) 146 | 147 | let reports' = Seq.take reportWindowSize 148 | (newReport Seq.<| reports) 149 | 150 | let status' = asum [analysis reports', status] 151 | 152 | for_ @Maybe status' $ \s -> 153 | when (status /= status') $ 154 | atomically (writeTQueue alarmQueue s) 155 | 156 | continue status' reports' 157 | 158 | 159 | --- Sending alerts about system status changes --- 160 | 161 | sendAlarms alarmQueue = 162 | forever $ 163 | do 164 | a <- atomically (readTQueue alarmQueue) 165 | case a of 166 | Alarm -> putStrLn "Alarm! System is in a degraded state." 167 | Okay -> putStrLn "System status is normal." 168 | 169 | 170 | --- Client that sends event reports to an aggregation service --- 171 | 172 | sendDemoReportsMain = 173 | do 174 | reportQueue <- atomically newTQueue 175 | 176 | foldr1 race_ 177 | [ generateReports reportQueue 178 | , sendReports reportQueue 179 | ] 180 | 181 | 182 | --- A fixed schedule of event reports for demonstration purposes --- 183 | 184 | demoReports = mapMaybe decodeReport 185 | "1111111111111010011000001000000100011101111110111111" 186 | -- successes -- -- failures -- -- successes -- 187 | 188 | generateReports reportQueue = 189 | for_ demoReports $ \r -> 190 | do 191 | atomically (writeTQueue reportQueue r) 192 | threadDelay 100_000 193 | 194 | 195 | --- Sending reports to the server --- 196 | 197 | withClientSocket action = 198 | bracket openSocket S.close $ \clientSocket -> 199 | do 200 | S.connect clientSocket serverAddress 201 | action clientSocket 202 | 203 | sendReports reportQueue = 204 | withClientSocket $ \clientSocket -> 205 | forever $ 206 | do 207 | r <- atomically (readTQueue reportQueue) 208 | sendAll clientSocket 209 | (Data.ByteString.Char8.pack [encodeReport r]) 210 | -------------------------------------------------------------------------------- /mutable-references.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad.STM 2 | import Control.Concurrent.STM.TVar 3 | 4 | import Data.Foldable (for_) 5 | 6 | main = 7 | do 8 | a <- atomically (newTVar 3) 9 | b <- atomically (newTVar 5) 10 | 11 | let 12 | printVars label = 13 | do 14 | x1 <- atomically (readTVar a) 15 | x2 <- atomically (readTVar b) 16 | putStrLn ("a = " ++ show x1 ++ ", b = " ++ show x2 17 | ++ " (" ++ label ++ ")") 18 | 19 | printVars "initial values" 20 | 21 | atomically (writeTVar a 7) 22 | printVars "changed a to 7" 23 | 24 | atomically (modifyTVar' b (* 2)) 25 | printVars "doubled b" 26 | 27 | let 28 | increment ref = atomically (modifyTVar' ref (+ 1)) 29 | 30 | swap ref1 ref2 = 31 | atomically $ 32 | do 33 | x1 <- readTVar ref1 34 | x2 <- readTVar ref2 35 | writeTVar ref1 x2 36 | writeTVar ref2 x1 37 | 38 | increment a 39 | for_ [1..5] $ \_ -> 40 | increment b 41 | printVars "incremented" 42 | 43 | swap a b 44 | printVars "swapped" 45 | -------------------------------------------------------------------------------- /partial-application.hs: -------------------------------------------------------------------------------- 1 | main = undefined 2 | 3 | -- map next [1..5] 4 | -- map (\x -> x + 1) [1..5] 5 | 6 | -- CURRYING: 7 | -- f :: X -> Y -> Z -> A 8 | -- is the same as 9 | -- f :: X -> (Y -> (Z -> A)) 10 | -- one may consider f as a function of type X that returns a function of type Y->Z->A 11 | -- and so on 12 | -- thus one can rewrite any function of multiple arguments into a sequence of functions with single argument 13 | 14 | -- currying explained with lambdas: 15 | 16 | -- \x y z -> x + y + z 17 | 18 | -- the same as 19 | 20 | -- \x -> (\y z -> x + y + z) 21 | 22 | -- the same as 23 | 24 | -- \x -> (\y -> (\z -> x + y + z)) 25 | 26 | -- because all functions can be seen as functions with single argument, partial application is possible 27 | 28 | -- add x y = x+y 29 | -- add x y = (add x) y 30 | -- add3 = add 3 -- = \y -> 3 + y 31 | -- add3 4 -- = (add 3) 4 = add 3 4 = 7 32 | 33 | -- this is also the reason why it is possible to write things like this: 34 | -- map (+1) [1..5] 35 | -------------------------------------------------------------------------------- /phrasebook.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | 3 | name: phrasebook 4 | version: 0 5 | 6 | common base 7 | default-language: Haskell2010 8 | 9 | -- Enable all warnings. This is good practice for any 10 | -- project, because GHC does not by default enable all 11 | -- warnings that are likely indicators of serious problems. 12 | ghc-options: -Wall 13 | 14 | common example 15 | import: base 16 | hs-source-dirs: . 17 | 18 | -- For the examples, we disable some specific warnings. 19 | -- In a typical project we would leave all of these enabled, 20 | -- but we allow the Phrasebook code to be a bit more lax so 21 | -- that we can shorten the code and simplify its presentation. 22 | ghc-options: 23 | -fno-warn-missing-signatures 24 | -fno-warn-name-shadowing 25 | -fno-warn-type-defaults 26 | -fno-warn-unused-do-bind 27 | -fno-warn-unused-imports 28 | 29 | common testing 30 | import: base 31 | hs-source-dirs: ./tests 32 | ghc-options: -fno-warn-missing-signatures 33 | build-depends: base, containers, megaparsec, 34 | phrasebook-testing 35 | default-extensions: 36 | BlockArguments NumericUnderscores OverloadedLists 37 | OverloadedStrings ScopedTypeVariables TypeApplications 38 | mixins: 39 | base hiding (Prelude) 40 | , phrasebook-testing (PhrasebookTesting as Prelude) 41 | 42 | library phrasebook-testing 43 | import: base 44 | hs-source-dirs: ./tests 45 | exposed-modules: PhrasebookTesting 46 | default-extensions: 47 | BlockArguments NumericUnderscores OverloadedLists 48 | OverloadedStrings ScopedTypeVariables TypeApplications 49 | build-depends: base, bytestring, containers, 50 | hedgehog, directory, megaparsec, mtl, 51 | process, relude, temporary, text 52 | mixins: 53 | base hiding (Prelude) 54 | , relude (Relude as Prelude) 55 | 56 | executable bounded-queues 57 | import: example 58 | main-is: bounded-queues.hs 59 | build-depends: async, base, 60 | mwc-random, safe-exceptions, stm 61 | 62 | test-suite test-bounded-queues 63 | import: testing 64 | type: exitcode-stdio-1.0 65 | main-is: test-bounded-queues.hs 66 | 67 | executable branching 68 | import: example 69 | main-is: branching.hs 70 | build-depends: base, time 71 | 72 | test-suite test-branching 73 | import: testing 74 | type: exitcode-stdio-1.0 75 | main-is: test-branching.hs 76 | 77 | executable common-types 78 | import: example 79 | main-is: common-types.hs 80 | build-depends: base 81 | 82 | test-suite test-common-types 83 | import: testing 84 | type: exitcode-stdio-1.0 85 | main-is: test-common-types.hs 86 | 87 | executable crypto-hashing 88 | import: example 89 | main-is: crypto-hashing.hs 90 | build-depends: base, bytestring, 91 | cryptonite, memory, utf8-string 92 | 93 | test-suite test-crypto-hashing 94 | import: testing 95 | type: exitcode-stdio-1.0 96 | main-is: test-bounded-queues.hs 97 | 98 | executable dynamic 99 | import: example 100 | main-is: dynamic.hs 101 | build-depends: base 102 | 103 | test-suite test-dynamic 104 | import: testing 105 | type: exitcode-stdio-1.0 106 | main-is: test-dynamic.hs 107 | 108 | executable enum-ranges 109 | import: example 110 | main-is: enum-ranges.hs 111 | build-depends: base 112 | 113 | test-suite test-enum-ranges 114 | import: testing 115 | type: exitcode-stdio-1.0 116 | main-is: test-enum-ranges.hs 117 | 118 | executable file-handles 119 | import: example 120 | main-is: file-handles.hs 121 | build-depends: base, directory 122 | 123 | test-suite test-file-handles 124 | import: testing 125 | type: exitcode-stdio-1.0 126 | main-is: test-file-handles.hs 127 | 128 | executable folding-lists 129 | import: example 130 | main-is: folding-lists.hs 131 | build-depends: base 132 | 133 | test-suite test-folding-lists 134 | import: testing 135 | type: exitcode-stdio-1.0 136 | main-is: test-folding-lists.hs 137 | 138 | executable for-loops 139 | import: example 140 | main-is: for-loops.hs 141 | build-depends: base 142 | 143 | test-suite test-for-loops 144 | import: testing 145 | type: exitcode-stdio-1.0 146 | main-is: test-for-loops.hs 147 | 148 | executable functions 149 | import: example 150 | main-is: functions.hs 151 | build-depends: base 152 | 153 | test-suite test-functions 154 | import: testing 155 | type: exitcode-stdio-1.0 156 | main-is: test-functions.hs 157 | 158 | executable guard 159 | import: example 160 | main-is: guard.hs 161 | build-depends: base 162 | 163 | test-suite test-guard 164 | import: testing 165 | type: exitcode-stdio-1.0 166 | main-is: test-guard.hs 167 | 168 | executable hashing 169 | import: example 170 | main-is: hashing.hs 171 | build-depends: base, hashable 172 | 173 | test-suite test-hashing 174 | import: testing 175 | type: exitcode-stdio-1.0 176 | main-is: test-hashing.hs 177 | 178 | executable hello-world 179 | import: example 180 | main-is: hello-world.hs 181 | build-depends: base 182 | 183 | test-suite test-hello-world 184 | import: testing 185 | type: exitcode-stdio-1.0 186 | main-is: test-hello-world.hs 187 | 188 | executable if-else 189 | import: example 190 | main-is: if-else.hs 191 | build-depends: base 192 | 193 | test-suite test-if-else 194 | import: testing 195 | type: exitcode-stdio-1.0 196 | main-is: test-if-else.hs 197 | 198 | executable invert 199 | import: example 200 | main-is: invert.hs 201 | build-depends: base, containers, generic-deriving 202 | 203 | test-suite test-invert 204 | import: testing 205 | type: exitcode-stdio-1.0 206 | main-is: test-invert.hs 207 | 208 | executable logging 209 | import: example 210 | main-is: logging.hs 211 | build-depends: base, directory, safe-exceptions 212 | 213 | test-suite test-logging 214 | import: testing 215 | type: exitcode-stdio-1.0 216 | main-is: test-logging.hs 217 | 218 | executable moments-in-time 219 | import: example 220 | main-is: moments-in-time.hs 221 | build-depends: base, time 222 | 223 | test-suite test-moments-in-time 224 | import: testing 225 | type: exitcode-stdio-1.0 226 | main-is: test-moments-in-time.hs 227 | 228 | executable monitoring 229 | import: example 230 | main-is: monitoring.hs 231 | build-depends: async, base, bytestring, containers, 232 | network, process, safe-exceptions, signal, stm 233 | 234 | test-suite test-monitoring 235 | import: testing 236 | type: exitcode-stdio-1.0 237 | main-is: test-monitoring.hs 238 | 239 | executable mutable-references 240 | import: example 241 | main-is: mutable-references.hs 242 | build-depends: base, stm 243 | 244 | test-suite test-mutable-references 245 | import: testing 246 | type: exitcode-stdio-1.0 247 | main-is: test-mutable-references.hs 248 | 249 | executable partial-application 250 | import: example 251 | main-is: partial-application.hs 252 | build-depends: base 253 | 254 | test-suite test-partial-application 255 | import: testing 256 | type: exitcode-stdio-1.0 257 | main-is: test-partial-application.hs 258 | 259 | executable records-with-optics 260 | import: example 261 | main-is: records-with-optics.hs 262 | build-depends: base, optics 263 | 264 | test-suite test-records-with-optics 265 | import: testing 266 | type: exitcode-stdio-1.0 267 | main-is: test-records-with-optics.hs 268 | 269 | executable threads 270 | import: example 271 | main-is: threads.hs 272 | build-depends: base, stm 273 | 274 | test-suite test-threads 275 | import: testing 276 | type: exitcode-stdio-1.0 277 | main-is: test-threads.hs 278 | 279 | executable timeouts 280 | import: example 281 | main-is: timeouts.hs 282 | build-depends: base, stm 283 | 284 | test-suite test-timeouts 285 | import: testing 286 | type: exitcode-stdio-1.0 287 | main-is: test-timeouts.hs 288 | 289 | executable transactions 290 | import: example 291 | main-is: transactions.hs 292 | build-depends: base, containers, mwc-random, stm 293 | 294 | test-suite test-transactions 295 | import: testing 296 | type: exitcode-stdio-1.0 297 | main-is: test-transactions.hs 298 | 299 | executable variables 300 | import: example 301 | main-is: variables.hs 302 | build-depends: base 303 | 304 | test-suite test-variables 305 | import: testing 306 | type: exitcode-stdio-1.0 307 | main-is: test-variables.hs 308 | -------------------------------------------------------------------------------- /records-with-optics.hs: -------------------------------------------------------------------------------- 1 | {-# options_ghc -fno-warn-unused-top-binds #-} 2 | {-# language TemplateHaskell #-} 3 | 4 | import Optics 5 | 6 | data Address = 7 | Address 8 | { _city :: String 9 | , _country :: String 10 | } 11 | deriving (Show) 12 | 13 | makeLenses ''Address 14 | 15 | data Person = 16 | Person 17 | { _name :: String 18 | , _age :: Int 19 | , _address :: Address 20 | } 21 | deriving (Show) 22 | 23 | makeLenses ''Person 24 | 25 | main = 26 | do 27 | let alice = 28 | Person 29 | { _name = "Alice" 30 | , _age = 30 31 | , _address = Address "Faketown" "Fakeland" 32 | } 33 | 34 | print alice 35 | print (set age 40 alice) 36 | print (over age (+ 1) alice) 37 | print (view age alice) 38 | print (view (address % city) alice) 39 | print (set (address % city) "Fakeville" alice) 40 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | let 2 | inherit (import ./tools/default.nix) pkgs haskell ghcid; 3 | inherit (pkgs) cacert cachix nix rsync cabal-install; 4 | in 5 | pkgs.mkShell { 6 | buildInputs = [ haskell ghcid cacert nix rsync cachix cabal-install ]; 7 | shellHook = '' 8 | export NIX_GHC="${haskell}/bin/ghc" 9 | export NIX_GHCPKG="${haskell}/bin/ghc-pkg" 10 | export NIX_GHC_DOCDIR="${haskell}/share/doc/ghc/html" 11 | export NIX_GHC_LIBDIR=$( $NIX_GHC --print-libdir ) 12 | ''; 13 | } 14 | -------------------------------------------------------------------------------- /tests/PhrasebookTesting.hs: -------------------------------------------------------------------------------- 1 | module PhrasebookTesting 2 | ( 3 | propertyMain 4 | 5 | -- * Running example programs 6 | , phrasebook, Exe (..), exeStdout, build, runCreateProcess 7 | 8 | -- * Working with lines of text 9 | , strLines, strLineSet, P, replace, match 10 | 11 | -- * Reexports 12 | , module Prelude 13 | , module Hedgehog 14 | , module Control.Monad.Cont 15 | , module System.Process 16 | , ExitCode (..), for, hClose, withSystemTempFile, hGetLine, hGetContents 17 | ) where 18 | 19 | import System.Process 20 | import System.Process () 21 | import Hedgehog 22 | import qualified Data.Set as Set 23 | import Control.Monad.Cont 24 | import System.IO 25 | import System.Exit (ExitCode (..)) 26 | import System.Environment 27 | import Data.Traversable 28 | import System.IO.Temp 29 | import qualified Data.Map.Strict as Map 30 | import qualified Data.List as List 31 | import qualified Text.Megaparsec as P 32 | 33 | propertyMain :: Property -> IO () 34 | propertyMain prop = do 35 | ok <- check prop 36 | when (not ok) exitFailure 37 | 38 | data Exe = Exe{ exeName :: String, exeEnv :: Map String String, exeArgs :: [String] } 39 | 40 | phrasebook :: String -> Exe 41 | phrasebook x = Exe{ exeName = x, exeEnv = mempty, exeArgs = mempty } 42 | 43 | setCreateProcessEnv :: MonadIO m => Map String String -> CreateProcess -> m CreateProcess 44 | setCreateProcessEnv extra cp = do 45 | current <- Map.fromList <$> liftIO getEnvironment 46 | pure cp{ env = Just $ Map.toList $ extra <> current } 47 | 48 | runCreateProcess :: MonadIO m => CreateProcess -> m () 49 | runCreateProcess p = liftIO $ withCreateProcess p mempty 50 | 51 | build :: MonadIO m => String -> m FilePath 52 | build x = liftIO do 53 | callProcess "cabal" 54 | [ "build", "--ghc-options", "-Werror", x ] 55 | fmap (toString . List.head . lines . toText) $ 56 | readProcess "cabal" ["list-bin", x] "" 57 | 58 | -- | Run a phrasebook example and return what it prints to stdout. 59 | exeStdout :: MonadIO m => Exe -> m String 60 | exeStdout exe = do 61 | e <- build $ exeName exe 62 | cp <- setCreateProcessEnv (exeEnv exe) $ proc e (exeArgs exe) 63 | liftIO $ readCreateProcess cp "" 64 | 65 | strLines :: String -> [Text] 66 | strLines = lines . toText 67 | 68 | strLineSet :: String -> Set Text 69 | strLineSet = Set.fromList . strLines 70 | 71 | type P a = P.Parsec Void Text a 72 | 73 | match :: P a -> P Text 74 | match = fmap fst . P.match 75 | 76 | replace :: P Text -> Text -> Text 77 | replace p t = x 78 | where 79 | Right x = P.runParser p' "" t 80 | p' = P.try (p <* P.eof) <|> P.takeRest 81 | -------------------------------------------------------------------------------- /tests/test-bounded-queues.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "bounded-queues" 3 | strLineSet x === 4 | [ "start: 1", "start: 2", "start: 3", "start: 4", "start: 5" 5 | , "start: 6", "start: 7", "start: 8", "start: 9", "start: 10" 6 | , "finish: 1, result: 1", "finish: 2, result: 4" 7 | , "finish: 3, result: 9", "finish: 4, result: 16" 8 | , "finish: 5, result: 25", "finish: 6, result: 36" 9 | , "finish: 7, result: 49", "finish: 8, result: 64" 10 | , "finish: 9, result: 81", "finish: 10, result: 100" ] 11 | -------------------------------------------------------------------------------- /tests/test-branching.hs: -------------------------------------------------------------------------------- 1 | import qualified Text.Megaparsec as P 2 | import qualified Text.Megaparsec.Char as P 3 | 4 | main = propertyMain $ withTests 1 $ property do 5 | let 6 | redact = replace $ fold @[] 7 | [ P.string "It's " 8 | , P.skipMany (P.satisfy (/= ' ')) $> "..." 9 | , P.string " noon" 10 | ] 11 | x <- exeStdout $ phrasebook "branching" 12 | fmap redact (strLines x) === 13 | [ "It's ... noon", "Customer owes 0 dollars.", "Write 2 as two" ] 14 | -------------------------------------------------------------------------------- /tests/test-common-types.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "common-types" 3 | strLines x === 4 | [ "haskell", "1+1 = 2", "7.0/3.0 = 2.3333333333333335" 5 | , "False", "True", "False" ] 6 | -------------------------------------------------------------------------------- /tests/test-crypto-hashing.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "crypto-hashing" 3 | strLines x === 4 | [ "sha256(abc) = ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" 5 | , "sha256(hello) = 2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824" ] 6 | -------------------------------------------------------------------------------- /tests/test-dynamic.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "dynamic" 3 | strLines x === 4 | [ "The answer is yes", "5 is an integer", "Unrecognized type: [Char]" ] 5 | -------------------------------------------------------------------------------- /tests/test-enum-ranges.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "enum-ranges" 3 | strLines x === 4 | [ "[3,4,5,6,7,8]", "\"abcdefghijklmnopqrstuvwxyz\"" 5 | , "[Rank2,Rank3,Rank4,Rank5,Rank6,Rank7,Rank8,Rank9,Rank10]" 6 | , "[Jack,Queen,King,Ace]", "Rank2", "Ace", "-128", "127" 7 | , "[Rank2,Rank3,Rank4,Rank5,Rank6,Rank7,Rank8,Rank9,Rank10,Jack,Queen,King,Ace]" ] 8 | -------------------------------------------------------------------------------- /tests/test-file-handles.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "file-handles" 3 | strLines x === [ "hello", "False", "world", "True" ] 4 | -------------------------------------------------------------------------------- /tests/test-folding-lists.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "folding-lists" 3 | strLines x === 4 | [ "[1,2,3,4,5]", "15", "One, Two, Three, Four, Five" 5 | , " - One", " - Two", " - Three", " - Four", " - Five" 6 | , "OneTwoThreeFourFive" ] 7 | -------------------------------------------------------------------------------- /tests/test-for-loops.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "for-loops" 3 | strLines x === 4 | [ "Numbers: 1 2 3 4 5", "Odds: 1 3 5", "Odds: 1 3 5", "1 2 3 (sum: 60)" ] 5 | -------------------------------------------------------------------------------- /tests/test-functions.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "functions" 3 | strLines x === 4 | [ "5", "6", "5.0", "hello world", "hello world", "(8,\"hello 8\")" 5 | , "8", "hello 8", "hello, Olafur!", "hey!", "hello Jane" ] 6 | -------------------------------------------------------------------------------- /tests/test-guard.hs: -------------------------------------------------------------------------------- 1 | main = pure () -- todo 2 | -------------------------------------------------------------------------------- /tests/test-hashing.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "hashing" 3 | strLines x === [ "-2971258545394699232", "-2788793491217597546" ] 4 | -------------------------------------------------------------------------------- /tests/test-hello-world.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "hello-world" 3 | strLines x === [ "hello world" ] 4 | -------------------------------------------------------------------------------- /tests/test-if-else.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "if-else" 3 | strLines x === 4 | [ "7 is odd" 5 | , "8 is divisible by 4" 6 | , "9 has 1 digit" 7 | , "19 has multiple digits" 8 | ] 9 | -------------------------------------------------------------------------------- /tests/test-invert.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "invert" 3 | strLines x === 4 | [ "p1", "p2", "Just Basic", "Nothing", "11", "30" 5 | , "Just (Bill Pro Annual)", "Nothing" ] 6 | -------------------------------------------------------------------------------- /tests/test-logging.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Map.Strict as Map 2 | 3 | main = propertyMain $ withTests 1 $ property do 4 | let levels = ["INFO", "ERROR"] 5 | (output, fileOutputs) <- liftIO $ flip runContT pure do 6 | files <- Map.fromList <$> for levels \l -> do 7 | f <- ContT \c -> withSystemTempFile (l <> ".txt") \fp h -> hClose h *> c fp 8 | pure (l, f) 9 | output <- exeStdout (phrasebook "logging"){ exeEnv = files } 10 | fileOutputs <- for files readFileText 11 | pure (output, fileOutputs) 12 | 13 | strLines output === [ "(Boot info) Starting", "(App info) Application started" ] 14 | fmap lines fileOutputs === [("INFO", [ "Application started" ]), ("ERROR", [])] 15 | -------------------------------------------------------------------------------- /tests/test-moments-in-time.hs: -------------------------------------------------------------------------------- 1 | import qualified Text.Megaparsec as P 2 | import qualified Text.Megaparsec.Char as P 3 | 4 | main = propertyMain $ withTests 1 $ property do 5 | let 6 | redact = replace $ fold @[] 7 | [ match $ P.string "Now " *> P.skipManyTill P.anySingle (P.string ": ") 8 | , P.takeRest $> "..." 9 | ] 10 | output <- exeStdout $ phrasebook "moments-in-time" 11 | fmap redact (strLines output) === 12 | [ "Now (UTC): ...", "Now (POSIX): ..." 13 | , "2038-01-19 03:14:07 UTC", "2038-01-19", "03:14 AM", "2038-01-19 03:14:22 UTC" 14 | , "True", "15s", "2147483647s", "2038-01-19 03:14:07 UTC" ] 15 | -------------------------------------------------------------------------------- /tests/test-monitoring.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | exe <- build "monitoring" 3 | 4 | (_, Just serverOut, _, server) <- liftIO $ 5 | createProcess (proc exe ["aggregate-reports"]){ std_out = CreatePipe } 6 | 7 | liftIO (hGetLine serverOut) >>= (=== "The monitoring server has started.") 8 | 9 | sender <- liftIO $ spawnProcess exe ["send-demo-reports"] 10 | liftIO (waitForProcess sender) >>= (=== ExitSuccess) 11 | liftIO $ terminateProcess server 12 | liftIO (waitForProcess server) >>= (=== ExitSuccess) 13 | 14 | x <- liftIO $ hGetContents serverOut 15 | strLines x === 16 | [ "1 (success)", "1 (success)", "1 (success)", "1 (success)" 17 | , "1 (success)", "1 (success)", "1 (success)", "1 (success)" 18 | , "1 (success)", "1 (success)" 19 | , "System status is normal." 20 | , "1 (success)", "1 (success)", "1 (success)", "0 (failure)" 21 | , "1 (success)", "0 (failure)", "0 (failure)", "1 (success)" 22 | , "1 (success)", "0 (failure)", "0 (failure)" 23 | , "Alarm! System is in a degraded state." 24 | , "0 (failure)", "0 (failure)", "0 (failure)", "1 (success)" 25 | , "0 (failure)", "0 (failure)", "0 (failure)", "0 (failure)" 26 | , "0 (failure)", "0 (failure)", "1 (success)", "0 (failure)" 27 | , "0 (failure)", "0 (failure)", "1 (success)", "1 (success)" 28 | , "1 (success)", "0 (failure)", "1 (success)", "1 (success)" 29 | , "1 (success)", "1 (success)", "1 (success)" 30 | , "System status is normal." 31 | , "1 (success)", "0 (failure)", "1 (success)", "1 (success)" 32 | , "1 (success)", "1 (success)", "1 (success)", "1 (success)" 33 | , "The monitoring server is stopping." ] 34 | -------------------------------------------------------------------------------- /tests/test-mutable-references.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "mutable-references" 3 | strLines x === 4 | [ "a = 3, b = 5 (initial values)" 5 | , "a = 7, b = 5 (changed a to 7)" 6 | , "a = 7, b = 10 (doubled b)" 7 | , "a = 8, b = 15 (incremented)" 8 | , "a = 15, b = 8 (swapped)" ] 9 | -------------------------------------------------------------------------------- /tests/test-partial-application.hs: -------------------------------------------------------------------------------- 1 | main = pure () -- todo 2 | -------------------------------------------------------------------------------- /tests/test-records-with-optics.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "records-with-optics" 3 | strLines x === 4 | [ "Person {_name = \"Alice\", _age = 30, _address = Address {_city = \"Faketown\", _country = \"Fakeland\"}}" 5 | , "Person {_name = \"Alice\", _age = 40, _address = Address {_city = \"Faketown\", _country = \"Fakeland\"}}" 6 | , "Person {_name = \"Alice\", _age = 31, _address = Address {_city = \"Faketown\", _country = \"Fakeland\"}}" 7 | , "30" 8 | , "\"Faketown\"" 9 | , "Person {_name = \"Alice\", _age = 30, _address = Address {_city = \"Fakeville\", _country = \"Fakeland\"}}" ] 10 | -------------------------------------------------------------------------------- /tests/test-threads.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Set as Set 2 | 3 | main = propertyMain $ withTests 1 $ property do 4 | x <- exeStdout $ phrasebook "threads" 5 | xs <- pure $ strLines x 6 | 7 | take 3 xs === [ "main: 1", "main: 2", "main: 3" ] 8 | Set.fromList ((take 6 . drop 3) xs) === 9 | [ "forkA: 1", "forkA: 2", "forkA: 3" 10 | , "forkB: 1", "forkB: 2", "forkB: 3" ] 11 | drop 9 xs === ["done"] 12 | -------------------------------------------------------------------------------- /tests/test-timeouts.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "timeouts" 3 | strLines x === 4 | [ "Task A: Gave up after one second" 5 | , "Task B: Completed in half a second" ] 6 | -------------------------------------------------------------------------------- /tests/test-transactions.hs: -------------------------------------------------------------------------------- 1 | import qualified Data.Char as Char 2 | import qualified Text.Megaparsec as P 3 | import qualified Text.Megaparsec.Char as P 4 | 5 | main = propertyMain $ withTests 1 $ property do 6 | let 7 | redact = replace $ fold @[] 8 | [ P.string "[" 9 | , P.skipMany (P.satisfy (\x -> Char.isDigit x || x == ',')) $> "..." 10 | , P.string "]" 11 | ] 12 | x <- exeStdout $ phrasebook "transactions" 13 | fmap redact (strLines x) === 14 | [ "[...]", "Total: 1000" 15 | , "[...]", "Total: 1000" 16 | , "[...]", "Total: 1000" 17 | , "[...]", "Total: 1000" ] 18 | -------------------------------------------------------------------------------- /tests/test-variables.hs: -------------------------------------------------------------------------------- 1 | main = propertyMain $ withTests 1 $ property do 2 | x <- exeStdout $ phrasebook "variables" 3 | strLines x === [ "4", "one", "two", "True", "[1,2,3]" ] 4 | -------------------------------------------------------------------------------- /threads.hs: -------------------------------------------------------------------------------- 1 | import Control.Concurrent (forkIO) 2 | import Control.Concurrent.STM.TVar 3 | import Control.Monad.STM 4 | import Data.Foldable (for_) 5 | import System.IO 6 | 7 | main = 8 | do 9 | hSetBuffering stdout LineBuffering 10 | 11 | tasksCompleted <- atomically (newTVar 0) 12 | 13 | let 14 | task x = 15 | do 16 | for_ [1..3] $ \i -> 17 | putStrLn (x ++ ": " ++ show i) 18 | atomically $ 19 | modifyTVar' tasksCompleted (+ 1) 20 | 21 | task "main" 22 | forkIO (task "forkA") 23 | forkIO (task "forkB") 24 | 25 | atomically $ 26 | do 27 | x <- readTVar tasksCompleted 28 | check (x == 3) 29 | 30 | putStrLn "done" 31 | -------------------------------------------------------------------------------- /timeouts.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase, NumericUnderscores #-} 2 | 3 | import Data.Foldable (asum) 4 | 5 | import Control.Concurrent (forkIO, threadDelay) 6 | import Control.Concurrent.STM (atomically, retry) 7 | import Control.Concurrent.STM.TVar 8 | 9 | main = 10 | do 11 | result <- atomically (newTVar Nothing) 12 | forkIO $ 13 | do 14 | threadDelay 2_000_000 15 | atomically (writeTVar result (Just 16 | "Task A: Completed in two seconds")) 17 | 18 | timeout <- atomically (newTVar False) 19 | forkIO $ 20 | do 21 | threadDelay 1_000_000 22 | atomically (writeTVar timeout True) 23 | 24 | message <- atomically $ 25 | asum 26 | [ readTVar result >>= 27 | \case 28 | Nothing -> retry 29 | Just x -> return x 30 | , readTVar timeout >>= 31 | \case 32 | False -> retry 33 | True -> return "Task A: Gave up after one second" 34 | ] 35 | putStrLn message 36 | 37 | ---- 38 | 39 | result <- atomically (newTVar Nothing) 40 | forkIO $ 41 | do 42 | threadDelay (500_000) 43 | atomically (writeTVar result (Just 44 | "Task B: Completed in half a second")) 45 | 46 | timeout <- atomically (newTVar False) 47 | forkIO $ 48 | do 49 | threadDelay 1_000_000 50 | atomically (writeTVar timeout True) 51 | 52 | message <- atomically $ 53 | asum 54 | [ readTVar result >>= 55 | \case 56 | Nothing -> retry 57 | Just x -> return x 58 | , readTVar timeout >>= 59 | \case 60 | False -> retry 61 | True -> return "Task B: Gave up after one second" 62 | ] 63 | putStrLn message 64 | -------------------------------------------------------------------------------- /tools/default.nix: -------------------------------------------------------------------------------- 1 | rec { 2 | 3 | versions = import ./versions.nix; 4 | 5 | pkgs = import versions.nixpkgs {}; 6 | 7 | unstable = import versions.unstable {}; 8 | 9 | haskell = unstable.callPackage ./haskell.nix {}; 10 | 11 | inherit (pkgs.haskellPackages) ghcid; 12 | 13 | outputs = pkgs.callPackage ./outputs.nix { inherit haskell; }; 14 | 15 | } 16 | -------------------------------------------------------------------------------- /tools/haskell.nix: -------------------------------------------------------------------------------- 1 | { haskell }: 2 | 3 | let 4 | 5 | overrides = self: super: 6 | { 7 | hashable = self.callHackage "hashable" "1.3.5.0" {}; 8 | optics = self.callHackage "optics" "0.4" {}; 9 | optics-core = self.callHackage "optics-core" "0.4" {}; 10 | optics-extra = self.callHackage "optics-extra" "0.4" {}; 11 | optics-th = self.callHackage "optics-th" "0.4" {}; 12 | relude = self.callHackage "relude" "1.0.0.1" {}; 13 | }; 14 | 15 | in 16 | 17 | (haskell.packages.ghc902.override { inherit overrides; }).ghcWithPackages (p: [ 18 | p.async 19 | p.bytestring 20 | p.containers 21 | p.cryptonite 22 | p.directory 23 | p.filepath 24 | p.generic-deriving 25 | p.hashable 26 | p.hedgehog 27 | p.megaparsec 28 | p.memory 29 | p.mwc-random 30 | p.neat-interpolation 31 | p.network 32 | p.optics 33 | p.process 34 | p.relude 35 | p.safe-exceptions 36 | p.signal 37 | p.stm 38 | p.temporary 39 | p.time 40 | p.utf8-string 41 | ]) 42 | -------------------------------------------------------------------------------- /tools/push-to-cache.hs: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell --pure ../shell.nix 3 | #! nix-shell --keep NIX_PATH 4 | #! nix-shell -i runhaskell 5 | 6 | -- We use this script to upload the Nix shell environment to Cachix. 7 | 8 | import Control.Monad 9 | import Data.Foldable 10 | import System.Process 11 | 12 | main = build >>= push 13 | 14 | build = fmap (head . lines) $ readProcess "nix-build" ["shell.nix", "--attr", "buildInputs", "--no-out-link"] "" 15 | 16 | push path = callProcess "cachix" ["push", "typeclasses", path] 17 | -------------------------------------------------------------------------------- /tools/readme.md: -------------------------------------------------------------------------------- 1 | All of the scripts in this directory are intended to be run from the root directory of the git repository. 2 | -------------------------------------------------------------------------------- /tools/update-versions: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell --pure 3 | #! nix-shell --keep NIX_PATH 4 | #! nix-shell -i bash 5 | #! nix-shell -p curl jq nix cacert 6 | 7 | set -eufo pipefail 8 | 9 | function update { 10 | FILE=$1 11 | PROJECT=$2 12 | BRANCH=${3:-master} 13 | 14 | OWNER=$(jq -r '.[$project].owner' --arg project "$PROJECT" < "$FILE") 15 | REPO=$(jq -r '.[$project].repo' --arg project "$PROJECT" < "$FILE") 16 | 17 | REV=$(curl "https://api.github.com/repos/$OWNER/$REPO/branches/$BRANCH" | jq -r '.commit.sha') 18 | SHA256=$(nix-prefetch-url --unpack "https://github.com/$OWNER/$REPO/archive/$REV.tar.gz") 19 | TJQ=$(jq '.[$project] = {owner: $owner, repo: $repo, rev: $rev, sha256: $sha256}' \ 20 | --arg project "$PROJECT" \ 21 | --arg owner "$OWNER" \ 22 | --arg repo "$REPO" \ 23 | --arg rev "$REV" \ 24 | --arg sha256 "$SHA256" \ 25 | < "$FILE") 26 | [[ $? == 0 ]] && echo "${TJQ}" >| "$FILE" 27 | } 28 | 29 | update tools/versions.json nixpkgs nixos-21.11 30 | update tools/versions.json unstable nixos-unstable 31 | -------------------------------------------------------------------------------- /tools/versions.json: -------------------------------------------------------------------------------- 1 | { 2 | "nixpkgs": { 3 | "owner": "NixOS", 4 | "repo": "nixpkgs", 5 | "rev": "4275a321beab5a71872fb7a5fe5da511bb2bec73", 6 | "sha256": "1p3pn7767ifbg08nmgjd93iqk0z87z4lv29ypalj9idwd3chsm69" 7 | }, 8 | "unstable": { 9 | "owner": "NixOS", 10 | "repo": "nixpkgs", 11 | "rev": "7f9b6e2babf232412682c09e57ed666d8f84ac2d", 12 | "sha256": "03nb8sbzgc3c0qdr1jbsn852zi3qp74z4qcy7vrabvvly8rbixp2" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /tools/versions.nix: -------------------------------------------------------------------------------- 1 | let 2 | inherit ((import { }).lib) mapAttrs; 3 | inherit (builtins) fetchTarball fromJSON readFile; 4 | 5 | fetchFromGitHub = { owner, repo, rev, sha256 }: 6 | builtins.fetchTarball { 7 | inherit sha256; 8 | url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; 9 | }; 10 | in 11 | mapAttrs (_: fetchFromGitHub) (fromJSON (readFile ./versions.json)) 12 | -------------------------------------------------------------------------------- /transactions.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad.STM 2 | import Control.Concurrent.STM.TVar 3 | 4 | import Control.Concurrent (forkIO, threadDelay) 5 | 6 | import System.Random.MWC (createSystemRandom, uniformR) 7 | 8 | import qualified Data.Sequence as Seq 9 | 10 | import Control.Monad (forever) 11 | import Data.Foldable (asum, for_) 12 | import Data.Traversable (for) 13 | 14 | main = 15 | do 16 | accountList <- 17 | for [1..10] $ \_ -> 18 | atomically (newTVar (100 :: Integer)) 19 | 20 | let 21 | accountSeq = Seq.fromList accountList 22 | 23 | randomAccount rng = 24 | do 25 | i <- uniformR (1, Seq.length accountSeq) rng 26 | return (Seq.index accountSeq (i - 1)) 27 | 28 | for_ [1..500] $ \_ -> 29 | forkIO $ 30 | do 31 | rng <- createSystemRandom 32 | forever $ 33 | do 34 | d <- uniformR (10, 50) rng 35 | threadDelay d 36 | 37 | sender <- randomAccount rng 38 | recipient <- randomAccount rng 39 | 40 | amount <- 41 | do 42 | x <- uniformR (1, 10) rng 43 | return (toInteger (x :: Int)) 44 | 45 | atomically $ 46 | asum 47 | [ do 48 | modifyTVar' sender (\x -> x - amount) 49 | readTVar sender >>= \x -> check (x >= 0) 50 | 51 | modifyTVar' recipient (\x -> x + amount) 52 | 53 | , return () 54 | ] 55 | 56 | for_ [1..4] $ \_ -> 57 | do 58 | threadDelay 500000 59 | balances <- atomically (for accountList readTVar) 60 | putStrLn (show balances) 61 | putStrLn ("Total: " ++ show (sum balances)) 62 | -------------------------------------------------------------------------------- /variables.hs: -------------------------------------------------------------------------------- 1 | main = 2 | do 3 | let x = 2 4 | putStrLn (show (x + x)) 5 | 6 | let (b, c) = ("one", "two") 7 | putStrLn b 8 | putStrLn c 9 | 10 | let 11 | d = True 12 | e = [1,2,3] 13 | putStrLn (show d) 14 | putStrLn (show e) 15 | --------------------------------------------------------------------------------