├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── functional-doc ├── info.rkt └── scribblings │ ├── data │ └── functional.scrbl │ └── info.rkt ├── functional-lib ├── data │ ├── applicative.rkt │ ├── either.rkt │ ├── functor.rkt │ ├── maybe.rkt │ └── monad.rkt └── info.rkt ├── functional-test ├── info.rkt └── tests │ └── data │ ├── applicative.rkt │ ├── either.rkt │ ├── functor.rkt │ ├── maybe.rkt │ └── monad.rkt └── functional └── info.rkt /.gitignore: -------------------------------------------------------------------------------- 1 | compiled/ 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | 3 | env: 4 | global: 5 | - RACKET_DIR: '~/racket' 6 | matrix: 7 | - RACKET_VERSION: 6.3 8 | - RACKET_VERSION: 6.4 9 | - RACKET_VERSION: 6.5 10 | - RACKET_VERSION: 6.6 11 | - RACKET_VERSION: 6.7 12 | - RACKET_VERSION: 6.8 13 | - RACKET_VERSION: 6.9 14 | - RACKET_VERSION: HEAD 15 | 16 | before_install: 17 | - git clone https://github.com/greghendershott/travis-racket.git 18 | - cat travis-racket/install-racket.sh | bash 19 | - export PATH="${RACKET_DIR}/bin:${PATH}" 20 | 21 | install: 22 | - raco pkg install --installation --auto --link 23 | $TRAVIS_BUILD_DIR/functional-lib 24 | $TRAVIS_BUILD_DIR/functional-doc 25 | $TRAVIS_BUILD_DIR/functional-test 26 | - raco pkg install --installation --auto cover cover-coveralls 27 | 28 | script: 29 | - raco test -ep functional-lib functional-test 30 | - raco cover -bf coveralls -d $TRAVIS_BUILD_DIR/coverage -p functional-lib functional-test 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2021 Alexis King and contributors 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # functional [![Build Status](https://travis-ci.org/lexi-lambda/functional.svg?branch=master)](https://travis-ci.org/lexi-lambda/functional) [![Coverage Status](https://coveralls.io/repos/github/lexi-lambda/functional/badge.svg?branch=master)](https://coveralls.io/github/lexi-lambda/functional?branch=master) 2 | 3 | This library provides **functional programming utilities** for Racket, including interfaces, such as functors and monads, and common data types that implement those interfaces, such as maybe and either. 4 | 5 | Here’s an example of performing monadic computations using `functional`: 6 | 7 | ```racket 8 | #lang racket 9 | 10 | (require data/applicative 11 | data/monad 12 | data/maybe) 13 | 14 | (define try-bytes->string/utf8 15 | (curry exn->maybe exn:fail:contract? bytes->string/utf-8)) 16 | 17 | (define input-char-length 18 | (do [str <- (try-bytes->string/utf-8 (port->bytes))] 19 | (pure (length str)))) 20 | ``` 21 | 22 | [**For more information, see the documentation.**][functional-doc] 23 | 24 | [functional-doc]: http://docs.racket-lang.org/functional/index.html 25 | -------------------------------------------------------------------------------- /functional-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps 6 | '()) 7 | (define build-deps 8 | '("base" 9 | "collections-doc" 10 | "collections-lib" 11 | "functional-lib" 12 | "racket-doc" 13 | "scribble-lib")) 14 | -------------------------------------------------------------------------------- /functional-doc/scribblings/data/functional.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require racket/require 4 | scribble/eval 5 | (for-label data/collection 6 | (subtract-in (except-in racket/base #%app do) 7 | data/collection) 8 | (multi-in data [functor applicative monad maybe either]) 9 | (multi-in racket [contract format function match]))) 10 | 11 | @(module base-ids racket/base 12 | (require scribble/manual (for-label racket/base)) 13 | (provide map) 14 | (define map @racket[map])) 15 | 16 | @(require (prefix-in base-id: 'base-ids)) 17 | 18 | @(define (reftech . args) 19 | (apply tech #:doc '(lib "scribblings/reference/reference.scrbl") args)) 20 | 21 | @(define (make-functional-eval) 22 | (let ([eval ((make-eval-factory '()))]) 23 | (eval '(require data/functor data/applicative data/monad data/maybe data/either 24 | (submod data/applicative custom-app) 25 | data/collection racket/format racket/function racket/match)) 26 | eval)) 27 | 28 | @(define-syntax-rule (functional-interaction . body) 29 | (interaction 30 | #:eval (make-functional-eval) 31 | . body)) 32 | 33 | @title{Functional generic interfaces} 34 | @author[@author+email["Alexis King" "lexi.lambda@gmail.com"]] 35 | 36 | This package provides a set of interfaces and data structures that are designed to make it easier to 37 | write programs in a compositional, purely functional style. It uses @reftech{generic interfaces} via 38 | @racketmodname[racket/generic] to provide a set of helpers that can be used with a variety of concrete 39 | values. 40 | 41 | @table-of-contents[] 42 | 43 | @section[#:tag "interfaces"]{Interfaces} 44 | 45 | @subsection[#:tag "functors"]{Functors} 46 | 47 | @defmodule[data/functor] 48 | 49 | A @deftech{functor} can be thought of as a kind of “container”. This can be something like a list or 50 | hash map, which actually contains values, or something like a channel, which produces values over 51 | time. All functors work with @racket[map], which allows producing a new functor with the elements 52 | “contained” by the functor modified by the mapping function. 53 | 54 | For example, using @racket[map] on lists simply modifies each element of the list, just like 55 | @base-id:map from @racketmodname[racket/base]. 56 | 57 | @(functional-interaction 58 | (map add1 '(1 2 3))) 59 | 60 | However, unlike @base-id:map from @racketmodname[racket/base], this more generic @racket[map] can also 61 | map over things like @tech{optional values}. 62 | 63 | @(functional-interaction 64 | (map add1 (just 2)) 65 | (map add1 nothing)) 66 | 67 | Functors provide a way to manipulate data in a consistent way without needing to know the data’s 68 | underlying structure. To ensure consistency and predictability, all implementations of 69 | @racket[gen:functor] must conform to the @deftech{functor laws}, of which there are two: 70 | 71 | @nested[ 72 | #:style 'inset 73 | @itemlist[ 74 | #:style 'ordered 75 | @item{@racket[(map identity _x)] must be equivalent to @racket[_x].} 76 | @item{@racket[(map (compose _f _g) _x)] must be equivalent to @racket[(map _f (map _g _x))].}]] 77 | 78 | Most reasonable definitions of a functor will satisfy these laws already, but it is possible to write 79 | an implementation that does not, and there is no guarantee that functions in this library will work 80 | predictably on unlawful functors. 81 | 82 | @deftogether[(@defidform[#:kind "interface" gen:functor] 83 | @defproc[(functor? [v any/c]) boolean?] 84 | @defthing[functor/c contract?])]{ 85 | The @reftech{generic interface} that specifies @tech{functors}.} 86 | 87 | @defproc[(map [f procedure?] [x functor?]) functor?]{ 88 | Applies @racket[f] to the @tech{functor} @racket[x].} 89 | 90 | @subsubsection[#:tag "custom-functors"]{Implementing new functors} 91 | 92 | To define your own functors, simply implement the @racket[gen:functor] @reftech{generic interface} and 93 | implement the @racket[map] method. The only implementation requirements are that methods conform to 94 | their associated contracts and that they follow the @tech{functor laws}. 95 | 96 | Here is an example implementation of the most trivial possible functor, the identity functor: 97 | 98 | @(functional-interaction 99 | (struct id (val) 100 | #:transparent 101 | #:methods gen:functor 102 | [(define (map f x) 103 | (id (f (id-val x))))]) 104 | (map add1 (id 12))) 105 | 106 | @subsection[#:tag "applicatives"]{Applicatives} 107 | 108 | @defmodule[data/applicative] 109 | 110 | @deftech{Applicative functors} generalize function application to work with any kind of data 111 | structure, not just procedures. This is much like @racket[prop:procedure], but it is specified via a 112 | generic interface. Additionally, all implementations of @racket[gen:applicative] should also implement 113 | @racket[gen:functor]. 114 | 115 | @(functional-interaction 116 | ((just +) (just 1) (just 2)) 117 | ((just +) nothing (just 2)) 118 | (sequence->list 119 | ((list + *) (list 3 4) (list 10 20)))) 120 | 121 | In addition to the implementation of @racket[apply], the @racket[gen:applicative] interface must also 122 | implement a function called @racket[pure]. This function “lifts” an ordinary value into the functor. 123 | For example, the @racket[pure] function for lists is just @racket[list], but the @racket[pure] 124 | function for optional values is @racket[just]. 125 | 126 | Like functors, applicative functors have their own set of @deftech{applicative functor laws} which all 127 | implementations of @racket[gen:applicative] must conform to: 128 | 129 | @nested[ 130 | #:style 'inset 131 | @itemlist[ 132 | #:style 'ordered 133 | @item{@racket[((pure identity) _x)] must be equivalent to @racket[_x].} 134 | @item{@racket[(((pure compose) _f _g) _x)] must be equivalent to @racket[(_f (_g _x))].} 135 | @item{@racket[((pure _f) (pure _x))] must be equivalent to @racket[(pure (_f _x))].}]] 136 | 137 | Most reasonable definitions of an applicative functor will satisfy these laws already, but it is 138 | possible to write an implementation that does not, and there is no guarantee that functions in this 139 | library will work predictably on unlawful applicative functors. 140 | 141 | @deftogether[(@defidform[#:kind "interface" gen:applicative] 142 | @defproc[(applicative? [v any/c]) boolean?] 143 | @defthing[applicative/c contract?])]{ 144 | The @reftech{generic interface} that specifies @tech{applicative functors}.} 145 | 146 | @defproc[(pure [v any/c]) applicative?]{ 147 | Lifts a plain value into an @tech{applicative functor}. When initially called, this function simply 148 | places the value in a box because it cannot yet know what kind of functor it needs to produce. When 149 | used, the value will be coerced into a functor of the appropriate type using the relevant value’s 150 | @racket[pure] method.} 151 | 152 | @defproc[(pure? [v any/c]) boolean?]{ 153 | A predicate that determines if a value is a boxed value that is awaiting coercion into a concrete type 154 | of @tech{applicative functor}. Ideally, you should never need to use this function, but sometimes 155 | values cannot be immediately coerced, so this can be needed.} 156 | 157 | @defproc[(pure/c [val-ctc contract?]) contract?]{ 158 | A contract that accepts boxed values awaiting coercion into a concrete type of @tech{applicative 159 | functor}. Ideally, you should never need to use this function, but sometimes values cannot be 160 | immediately coerced, so this can be needed.} 161 | 162 | @subsubsection[#:tag "custom-applicatives"]{Implementing new applicative functors} 163 | 164 | Implementing your own applicative functors is somewhat more complicated than implementing plain 165 | functors. You must implement two methods, named @racket[pure] and @racket[apply]. The former, 166 | @emph{unlike} the @racket[pure] function exported by @racketmodname[data/applicative], should be a 167 | function of @emph{two} arguments, the first of which should be ignored. This is necessary in order to 168 | properly perform dynamic dispatch with @racketmodname[racket/generic], since some value must exist to 169 | be dispatched on. The first argument is therefore the value being used for dispatch, but there is no 170 | guarantee about what it is, so you should always ignore it completely. 171 | 172 | Implementing the @racket[apply] method is somewhat more straightforward. It should be a function of 173 | two arguments, this first corresponding to the functor in application position and second a list of 174 | functors provided as arguments in the application. It should produce an applicative functor result. 175 | 176 | Here is an example implementation of the most trivial possible applicative functor, the identity 177 | functor: 178 | 179 | @(functional-interaction 180 | (require (prefix-in base: racket/base)) 181 | (struct id (val) 182 | #:transparent 183 | #:methods gen:functor 184 | [(define (map f x) 185 | (id (f (id-val x))))] 186 | #:methods gen:applicative 187 | [(define (pure _ x) 188 | (id x)) 189 | (define (apply f xs) 190 | (id (base:apply (id-val f) (base:map id-val xs))))]) 191 | ((id +) (pure 2) (pure 3))) 192 | 193 | @subsection[#:tag "monads"]{Monads} 194 | 195 | @defmodule[data/monad] 196 | 197 | A @deftech{monad} is a mechanism for sequencing pure values in a context. Monads are an extremely 198 | general concept that are notoriously difficult to explain (despite being relatively simple once you 199 | understand them), and I will not attempt to explain them here (though perhaps I will try someday). 200 | 201 | All monads must also be @tech{applicative functors}, but they add one more method, called 202 | @racket[chain]. The @racket[chain] method, much like @racket[map], applies a function to a value in a 203 | context, but unlike @racket[map], the applied function must produce a new monad, not a pure value. 204 | Monads can be used to control sequencing of computation in a very flexible way. 205 | 206 | Using the @racket[chain] function directly can become tedious and hard to read beyond a couple of 207 | nested applications, so the @racket[do] form is provided to make sequencing monadic operations more 208 | pleasant to read and write. 209 | 210 | Like functors and applicative functors, monads have their own set of @deftech{monad laws} which all 211 | implementations of @racket[gen:monad] must conform to: 212 | 213 | @nested[ 214 | #:style 'inset 215 | @itemlist[ 216 | #:style 'ordered 217 | @item{@racket[(chain _f (pure _x))] must be equivalent to @racket[(_f _x)].} 218 | @item{@racket[(chain pure _x)] must be equivalent to @racket[_x].} 219 | @item{@racket[(chain (λ (y) (chain _g (_f y))) _x)] must be equivalent to 220 | @racket[(chain _g (chain _f _x))].}]] 221 | 222 | Most reasonable definitions of a monad will satisfy these laws already, but it is possible to write an 223 | implementation that does not, and there is no guarantee that functions in this library will work 224 | predictably on unlawful monads. 225 | 226 | @deftogether[(@defidform[#:kind "interface" gen:monad] 227 | @defproc[(monad? [v any/c]) boolean?] 228 | @defthing[monad/c contract?])]{ 229 | The @reftech{generic interface} that specifies @tech{monads}.} 230 | 231 | @defproc[(chain [f (any/c . -> . monad?)] [x monad?]) monad?]{ 232 | Applies @racket[f] to the value within the monadic context @racket[x] and produces a new monad as the 233 | result.} 234 | 235 | @defform[#:literals [<-] 236 | (do expr-or-clauses) 237 | #:grammar 238 | ([expr-or-clauses monad-expr 239 | (code:line do-clause expr-or-clauses)] 240 | [do-clause [match-pattern <- monad-expr] 241 | monad-expr 242 | internal-definition]) 243 | #:contracts 244 | ([monad-expr monad?])]{ 245 | Syntactic shorthand for successive, nested uses of @racket[chain]. The @racket[do] form allows 246 | writing arbitrary sequential monadic operations without an excessive proliferation of lambdas and a 247 | significant amount of rightward drift. 248 | 249 | In its simplest form, @racket[do] does nothing at all. Any @racket[do] block containing only a single 250 | expression is equivalent to the expression itself. 251 | 252 | @(functional-interaction 253 | (do 3) 254 | (do "hello, world") 255 | (do '(1 2 3 4))) 256 | 257 | This is obviously not particularly useful, but @racket[do] becomes helpful when using multiple 258 | sub-forms. Each @racket[do-clause] may bind the result of a @racket[chain] operation, which may be 259 | used in subsequent computations. 260 | 261 | @(functional-interaction 262 | (sequence->list 263 | (do [x <- '(1 2 3)] 264 | (pure (* x 2))))) 265 | 266 | Specifically, any block of the form @racket[(do [_x <- _m] _clause ...+)] is precisely equivalent to 267 | @racket[(chain (λ (_x) (do _clause ...+)) _m)]. More generally, the binding identifier can be replaced 268 | with a @racket[match] pattern, in which case the resulting code uses @racket[match-lambda] instead. 269 | 270 | Not every @racket[chain] operation has a useful result. In that case, the binding brackets may be 271 | omitted, simply leaving the @racket[monad-expr]. In this case, a @racket[chain] call will still be 272 | produced, but the result will not be bound anywhere. 273 | 274 | @(functional-interaction 275 | (sequence->list 276 | (do '(1 2 3) 277 | (pure 'hello)))) 278 | 279 | Finally, arbitrary internal definitions may be interspersed between each @racket[do-clause]. These 280 | definitions do not produce new @racket[chain] calls, they simply create new bindings. 281 | 282 | @margin-note{ 283 | If a macro used within a @racket[do] block produces a @racket[begin] form containing both internal 284 | definitions and expressions, the whole form is spliced into the surrounding internal definition 285 | context. All expressions will be simply evaluated for side-effects and will not result in any 286 | additional calls to @racket[chain].} 287 | 288 | @(functional-interaction 289 | (sequence->list 290 | (do [x <- '(1 2)] 291 | (define y (* x 2)) 292 | [z <- '(a b)] 293 | (define (prettify a b) (~a a ": " b)) 294 | (pure (prettify y z))))) 295 | 296 | Internal definitions defined within @racket[do] blocks may refer to all previous bindings, but not 297 | subsequent ones. However, multiple internal definitions directly next to one another may be mutually 298 | recursive, so long as they are not separated by a @racket[chain]. 299 | 300 | @(functional-interaction 301 | (do [x <- (just 7)] 302 | (define (calls-b) 303 | (add1 (b))) 304 | (define (b) 305 | (- x)) 306 | [y <- (just (calls-b))] 307 | (pure (* 2 y))))} 308 | 309 | @deftogether[(@defidform[<-] 310 | @defidform[←])]{ 311 | Recognized specially within forms like @racket[do]. Using either form as an expression is a syntax 312 | error.} 313 | 314 | @defproc[(join [x monad?]) monad?]{ 315 | Joins a nested monadic value (a monadic value embedded within another monadic value, both of the same 316 | type) into a single value. In other words, this @emph{flattens} a monadic value by a single layer. 317 | 318 | @(functional-interaction 319 | (sequence->list (join '((1 2) (3 4)))) 320 | (sequence->list (join '())) 321 | (join (just (just 'hello))) 322 | (join (just nothing)) 323 | (join nothing))} 324 | 325 | @defproc[(map/m [f (any/c . -> . monad?)] [xs sequence?]) monad?]{ 326 | Applies @racket[f] to each element of @racket[xs], then chains the resulting monadic values from left 327 | to right and returns the results as a single monadic value. 328 | 329 | @(functional-interaction 330 | (define (ascii->char x) 331 | (if (<= 0 x 127) 332 | (just (integer->char x)) 333 | nothing)) 334 | (map/m ascii->char '(76 33)) 335 | (map/m ascii->char '(76 -5 33)))} 336 | 337 | @subsubsection[#:tag "custom-monads"]{Implementing new monads} 338 | 339 | Implementing your own monads is no more complicated than implementing your own applicative functors, 340 | you just need to provide an implementation of @racket[chain] that satisfies the @tech{monad laws}. 341 | 342 | Here is an example implementation of the most trivial possible monad, the identity monad: 343 | 344 | @(functional-interaction 345 | (require (prefix-in base: racket/base)) 346 | (struct id (val) 347 | #:transparent 348 | #:methods gen:functor 349 | [(define (map f x) 350 | (id (f (id-val x))))] 351 | #:methods gen:applicative 352 | [(define (pure _ x) 353 | (id x)) 354 | (define (apply f xs) 355 | (id (base:apply (id-val f) (base:map id-val xs))))] 356 | #:methods gen:monad 357 | [(define (chain f x) 358 | (f (id-val x)))]) 359 | (do [x <- (id 1)] 360 | [y <- (id 2)] 361 | (pure (+ x y)))) 362 | 363 | @section[#:tag "data-types" #:style 'toc]{Data types} 364 | 365 | @local-table-of-contents[] 366 | 367 | @subsection[#:tag "maybe"]{Maybe} 368 | 369 | @defmodule[data/maybe] 370 | 371 | The @emph{maybe} pattern implements @deftech{optional values}, values that represent computations that 372 | can fail. Idiomatic Scheme uses @racket[#f] to represent a “lack of a value”, similar to how @tt{null} 373 | is used in other programming languages, but this exhibits a few problems: 374 | 375 | @itemlist[ 376 | #:style 'ordered 377 | @item{Sometimes @racket[#f] can be a valid value, at which point it is ambiguous whether or not a 378 | result is nonexistent or if it is simply the value @racket[#f].} 379 | @item{Composing operations that can fail can be tedious and can result in deeply nested 380 | conditionals, as each step of the computation must check if the value is @racket[#f] and 381 | short-circuit if necessary.}] 382 | 383 | @emph{Maybe} reifies the concept of a lack of a value as @racket[nothing] and the presence of a value 384 | as @racket[just]. It then provides a series of combinators to help work with operations that can fail 385 | without excessive error-checking. 386 | 387 | Optional values are @tech{functors}, @tech{applicative functors}, and @tech{monads}. This provides a 388 | reasonable framework for managing failable computations in a consistent and extensible way. For 389 | example, consider an operation that can fail. 390 | 391 | @(define maybe-eval (make-functional-eval)) 392 | 393 | @(interaction 394 | #:eval maybe-eval 395 | (define (safe-first lst) 396 | (if (empty? lst) 397 | nothing 398 | (just (first lst))))) 399 | 400 | Now, consider using that operation on a list of characters. 401 | 402 | @(interaction 403 | #:eval maybe-eval 404 | (safe-first '(#\a #\b #\c)) 405 | (safe-first '())) 406 | 407 | It is possible that you might want to, rather than retrieve the first character, get the first 408 | character’s unicode code point. If @racket[safe-first] returned @racket[#f] rather than 409 | @racket[nothing] upon failure, you would need to branch to check if the value was found before 410 | attempting to convert the character to an integer. 411 | 412 | @(racketblock 413 | (let ([c (safe-first list-of-chars)]) 414 | (if c 415 | (char->integer c) 416 | #f))) 417 | 418 | It would be possible to use @racket[and] to make things a little shorter, but the explicit 419 | error-checking would still be necessary. However, since optional values are just @tech{functors}, it 420 | is possible to just use @racket[map]. 421 | 422 | @(interaction 423 | #:eval maybe-eval 424 | (map char->integer (safe-first '(#\a #\b #\c))) 425 | (map char->integer (safe-first '()))) 426 | 427 | Consider another example: safely dividing a number without having division-by-zero errors. We can 428 | implement a @racket[safe-/] function like we did with @racket[safe-first]: 429 | 430 | @(interaction 431 | #:eval maybe-eval 432 | (define (safe-/ a b) 433 | (if (zero? b) 434 | nothing 435 | (just (/ a b))))) 436 | 437 | Now, obviously we could use it just like we used @racket[safe-first], but what if we want to use them 438 | both @emph{together}? That is, we want to call @racket[safe-/] on the result of @racket[safe-first]. 439 | We could try using @racket[map] again, which seems like it should work: 440 | 441 | @(interaction 442 | #:eval maybe-eval 443 | (map (λ (x) (safe-/ 2 x)) 444 | (safe-first '(10 20 30)))) 445 | 446 | Oops, now we have a @racket[just] wrapped inside another @racket[just]. This is because @racket[map] 447 | replaces whatever is @emph{inside} the functor, not the functor itself, and we returned 448 | @racket[(just 1/5)] from our mapping function. Instead, we want the inner @racket[just] to be subsumed 449 | by the outer one. For that, we can use @racket[chain]. 450 | 451 | The @racket[chain] function works just like @racket[map], but it joins the two wrappers together into 452 | a single wrapper after the operation is finished. 453 | 454 | @(interaction 455 | #:eval maybe-eval 456 | (chain (λ (x) (safe-/ 2 x)) 457 | (safe-first '(10 20 30)))) 458 | 459 | @(maybe-eval 460 | '(define (safe-rest lst) 461 | (if (empty? lst) 462 | nothing 463 | (just (rest lst))))) 464 | 465 | We can use multiple calls to @racket[chain] to sequence many failable operations at once. For example, 466 | we could write a function that divides the first two numbers of a list that won’t ever throw 467 | exceptions: 468 | 469 | @(interaction 470 | #:eval maybe-eval 471 | (define (divide-first-two lst) 472 | (chain 473 | (λ (a) (chain 474 | (λ (xs) (chain 475 | (λ (b) (safe-/ a b)) 476 | (safe-first xs))) 477 | (safe-rest lst))) 478 | (safe-first lst))) 479 | 480 | (divide-first-two '(4 3 2 1)) 481 | (divide-first-two '(5 0)) 482 | (divide-first-two '(5)) 483 | (divide-first-two '())) 484 | 485 | It works! That is, itself, kinda cool. Unfortunately, following all the nested calls to @racket[chain] 486 | will very likely make your head spin. That’s where @racket[do] comes in. The same exact function can 487 | be rewritten using @racket[do] in a much clearer way: 488 | 489 | @(interaction 490 | #:eval maybe-eval 491 | (define (divide-first-two lst) 492 | (do [a <- (safe-first lst)] 493 | [xs <- (safe-rest lst)] 494 | [b <- (safe-first xs)] 495 | (safe-/ a b))) 496 | (divide-first-two '(20 11)) 497 | (divide-first-two '(3 0))) 498 | 499 | Using the monadic interface, we can sequence arbitrary computations that can fail without writing a 500 | single line of explicit error handling code. 501 | 502 | @(close-eval maybe-eval) 503 | 504 | @deftogether[(@defproc[(just [x any/c]) maybe?] 505 | @defthing[nothing maybe?] 506 | @defproc[(maybe? [v any/c]) boolean?] 507 | @defproc[(just? [v any/c]) boolean?] 508 | @defproc[(nothing? [v any/c]) boolean?])]{ 509 | Value constructors and predicates for @tech{optional values}. The @racket[just] function produces a 510 | boxed value, and the @racket[nothing] value represents the absence of a value. Optional values 511 | can be serialized with @racketmodname[racket/serialize] (as long as any nested value is 512 | serializable). 513 | 514 | @(functional-interaction 515 | (just 'hello) 516 | nothing) 517 | 518 | Optional values are @tech{monads} that short-circuit on @racket[nothing]. 519 | 520 | @(functional-interaction 521 | (map add1 (just 1)) 522 | (map add1 nothing) 523 | ((pure +) (just 1) (just 2)) 524 | (do [n <- (just 1)] 525 | (pure (add1 n)))) 526 | 527 | The @racket[nothing] binding also serves as a @reftech{match expander} that only recognizes the 528 | @racket[nothing] value, but it must be surrounded with parentheses to be compatible with the syntax of 529 | @racket[match]. 530 | 531 | @(functional-interaction 532 | (define/match (value-or-false mval) 533 | [((just val)) val] 534 | [((nothing)) #f ]) 535 | (value-or-false (just 'something)) 536 | (value-or-false nothing))} 537 | 538 | @defproc[(maybe/c [val-ctc contract?]) contract?]{ 539 | Produces a contract that accepts @racket[nothing] or a @racket[just] containing a value that satisfies 540 | @racket[val-ctc].} 541 | 542 | @defproc[(maybe [default-value any/c] [proc (any/c . -> . any/c)] [maybe-value maybe?]) any/c]{ 543 | Performs a sort of “first-class pattern-match” on @racket[maybe-value]—if @racket[maybe-value] is 544 | @racket[nothing], then @racket[default-value] is returned. Otherwise, if @racket[maybe-value] is 545 | @racket[(just _x)], then the result is @racket[(proc _x)]. 546 | 547 | @(functional-interaction 548 | (maybe 0 add1 nothing) 549 | (maybe 0 add1 (just 1)) 550 | (maybe 0 add1 (just 2)))} 551 | 552 | @defproc[(from-just [default-value any/c] [maybe-value maybe?]) any/c]{ 553 | Equivalent to @racket[(maybe default-value identity maybe-value)]. If @racket[maybe-value] is 554 | @racket[nothing], then the result is @racket[default-value]. Otherwise, if @racket[maybe-value] is 555 | @racket[(just _x)], then the result is @racket[_x]. 556 | 557 | @(functional-interaction 558 | (from-just #f nothing) 559 | (from-just #f (just "hello")))} 560 | 561 | @defproc[(from-just! [just-value just?]) any/c]{ 562 | Unwraps an @tech{optional value} if it is a @racket[just?], otherwise raises 563 | @racket[exn:fail:contract?]. Use this function sparingly—it negates much of the benefit of using 564 | @tech{optional values} in the first place, but sometimes there are instances in which the programmer 565 | can prove a value will never be @racket[nothing], so this function is helpful. 566 | 567 | @(functional-interaction 568 | (from-just! (just "hello")) 569 | (from-just! nothing))} 570 | 571 | @defproc[(filter-just [maybes-lst (listof maybe?)]) list?]{ 572 | Given a list of @tech{optional values}, returns a new list with all of the values in the list wrapped 573 | with @racket[just], discarding all of the values that were @racket[nothing]. 574 | 575 | @(functional-interaction 576 | (filter-just (list (just 1) nothing (just 3))))} 577 | 578 | @defproc[(map-maybe [proc (any/c . -> . maybe?)] [lst list?]) list?]{ 579 | Like @racket[map] combined with @racket[filter-just], but more efficient because there is no need to 580 | construct an intermediate list. 581 | 582 | @(functional-interaction 583 | (map-maybe (λ (x) (if (positive? x) (just (sqrt x)) nothing)) 584 | (list -2 3 0 9)))} 585 | 586 | @defproc[(false->maybe [v any/c]) any/c]{ 587 | Produces @racket[nothing] if @racket[v] is @racket[#f], otherwise produces @racket[(just v)]. This is 588 | useful when interacting with Racket APIs that follow the Scheme convention of using @racket[#f] as a 589 | null value to represent failure or lack of a value. 590 | 591 | @(functional-interaction 592 | (false->maybe #f) 593 | (false->maybe "hello"))} 594 | 595 | @defform[(with-maybe-handler exn-pred? body ...) 596 | #:contracts ([exn-pred? (any/c . -> . any/c)])]{ 597 | Executes each @racket[body] form as usual, but catches any exceptions that satisfy 598 | @racket[exn-pred?]. If such an exception is caught, the result of the whole form is @racket[nothing]; 599 | otherwise, the final @racket[body] form is evaluated to produce a value, @racket[_v], and the result 600 | is @racket[(just _v)]. 601 | 602 | This is useful for interacting with Racket APIs that throw exceptions upon failure and adapting them 603 | to produce @tech{optional values} instead. 604 | 605 | @(functional-interaction 606 | (with-maybe-handler exn:fail:contract? 607 | (bytes->string/utf-8 #"\xC3")) 608 | (with-maybe-handler exn:fail:contract? 609 | (bytes->string/utf-8 #"hello")))} 610 | 611 | @defproc[(exn->maybe [exn-pred? (any/c . -> . any/c)] [proc procedure?] [arg any/c] ...) maybe?]{ 612 | A procedure version of @racket[with-maybe-handler] that functions like @racket[apply], except that any 613 | exceptions thrown during the dynamic extent of the call that match @racket[exn-pred?] will cause the 614 | entire expression to evaluate to @racket[nothing]. Otherwise, the result is wrapped in @racket[just] 615 | and return as-is. 616 | 617 | This can be especially useful when paired with @racket[curry], which can be used to produce a wrapped 618 | version of a procedure that throws exceptions that instead reports failures in terms of 619 | @tech{optional values}. 620 | 621 | @(functional-interaction 622 | (define try-bytes->string/utf-8 623 | (curry exn->maybe exn:fail:contract? bytes->string/utf-8)) 624 | (try-bytes->string/utf-8 #"\xC3") 625 | (try-bytes->string/utf-8 #"hello"))} 626 | 627 | @subsection[#:tag "either"]{Either} 628 | 629 | @defmodule[data/either] 630 | 631 | The @deftech{either} type provides another implementation of @tech{optional values}, generally used to 632 | represent computations that can fail. However, it augments @racket[just] and @racket[nothing] by 633 | allowing the @emph{kind of failure} to be annotated. When a computation results in @racket[nothing], 634 | it clearly failed, but it is not always clear why (especially after a long chain of monadic 635 | computation). 636 | 637 | The @racket[success] constructor is exactly like @racket[just]—it signals a successful value, and it 638 | can be mapped over as a @tech{functor} or @tech{applicative functor} and sequenced as a @tech{monad}. 639 | The @racket[failure] constructor has the same short-circuiting behavior of @racket[nothing], but it 640 | accepts a value like @racket[success], which can be used to annotate the kind of failure. 641 | 642 | As an example, we can rewrite the @racket[safe-] functions from the @seclink["maybe"]{maybe} section 643 | using @tech{either}. 644 | 645 | @(functional-interaction 646 | (define (safe-/ a b) 647 | (if (zero? b) 648 | (failure "attempted to divide by zero") 649 | (success (/ a b)))) 650 | 651 | (define (safe-first lst) 652 | (if (empty? lst) 653 | (failure "attempted to get the first element of an empty list") 654 | (success (first lst)))) 655 | 656 | (define (safe-rest lst) 657 | (if (empty? lst) 658 | (failure "attempted to get the rest of an empty list") 659 | (success (rest lst)))) 660 | 661 | (define (divide-first-two lst) 662 | (do [a <- (safe-first lst)] 663 | [xs <- (safe-rest lst)] 664 | [b <- (safe-first xs)] 665 | (safe-/ a b))) 666 | (divide-first-two '(20 11)) 667 | (divide-first-two '(3 0)) 668 | (divide-first-two '(3))) 669 | 670 | @deftogether[(@defproc[(success [x any/c]) either?] 671 | @defproc[(failure [x any/c]) either?] 672 | @defproc[(either? [v any/c]) boolean?] 673 | @defproc[(success? [v any/c]) boolean?] 674 | @defproc[(failure? [v any/c]) boolean?])]{ 675 | Value constructors and predicates for @tech{either}, which are tagged @tech{optional values}. The 676 | @racket[success] function produces a successful value, and the @racket[failure] constructor creates a 677 | value that represents failure. Success and failure values can be serialized using 678 | @racketmodname[racket/serialize] as long as the inner values are serializable. 679 | 680 | @(functional-interaction 681 | (success 'hello) 682 | (failure 'failed)) 683 | 684 | Either values are @tech{monads} that short-circuit on @racket[failure]. 685 | 686 | @(functional-interaction 687 | (map add1 (success 1)) 688 | (map add1 (failure 'failed)) 689 | ((pure +) (success 1) (success 2)) 690 | (do [n <- (success 1)] 691 | (pure (add1 n))))} 692 | 693 | @defproc[(either/c [failure-ctc contract?] [success-ctc contract?]) contract?]{ 694 | Produces a contract that accepts @tech{either} values. If the value is a @racket[failure], the 695 | contained value must satisfy @racket[failure-ctc]; likewise, if the value is a @racket[success], it 696 | must satisfy @racket[success-ctc].} 697 | 698 | @defproc[(either [failure-proc (any/c . -> . any/c)] [success-proc (any/c . -> . any/c)] 699 | [either-value maybe?]) 700 | any/c]{ 701 | Like @racket[maybe] for @tech{either} values, performs a sort of “first-class pattern-match” on 702 | @racket[either-value]—if @racket[either-value] is @racket[(failure _x)], then the result is 703 | @racket[(failure-proc _x)]. Otherwise, if @racket[either-value] is @racket[(success _x)], then the 704 | result is @racket[(success-proc _x)]. 705 | 706 | @(functional-interaction 707 | (either string-length add1 (failure "failed")) 708 | (either string-length add1 (success 1)) 709 | (either string-length add1 (success 2)))} 710 | 711 | @defproc[(from-success [default-value any/c] [either-value either?]) any/c]{ 712 | Equivalent to @racket[(either (const default-value) identity either-value)]. If @racket[either-value] 713 | is a @racket[failure?], then the result is @racket[default-value]. Otherwise, if @racket[either-value] 714 | is @racket[(success _x)], then the result is @racket[_x]. 715 | 716 | @(functional-interaction 717 | (from-success #f (failure "failed")) 718 | (from-success #f (success 18)))} 719 | 720 | @defproc[(from-failure [default-value any/c] [either-value either?]) any/c]{ 721 | Equivalent to @racket[(either identity (const default-value) either-value)], which is also just 722 | @racket[from-success] with the sides flipped. If @racket[either-value] is a @racket[success?], then 723 | the result is @racket[default-value]. Otherwise, if @racket[either-value] is @racket[(failure _x)], 724 | then the result is @racket[_x]. 725 | 726 | @(functional-interaction 727 | (from-failure #f (failure "failed")) 728 | (from-failure #f (success 18)))} 729 | 730 | @defproc[(from-either [either-value either?]) any/c]{ 731 | Extracts the value from any @tech{either} value; equivalent to 732 | @racket[(either identity identity either-value)]. If @racket[either-value] is @racket[(success _x)], 733 | then the result is @racket[_x]. Otherwise, if @racket[either-value] is @racket[(failure _y)], then the 734 | result is @racket[_y]. 735 | 736 | @(functional-interaction 737 | (from-either (failure "failed")) 738 | (from-either (success 18)))} 739 | 740 | @defproc[(map-failure [f (any/c . -> . any/c)] [e either?]) either?]{ 741 | Like @racket[map] over @tech{either} values, but flipped: it applies @racket[f] to values inside of a 742 | @racket[failure] instead of a @racket[success]. 743 | 744 | @(functional-interaction 745 | (map-failure symbol->string (success 1)) 746 | (map-failure symbol->string (failure 'failed)))} 747 | 748 | @defproc[(flip-either [e either?]) either?]{ 749 | Converts @racket[success]es into @racket[failure]s and vice-versa. 750 | 751 | @(functional-interaction 752 | (flip-either (success 'foo)) 753 | (flip-either (failure 'bar)))} 754 | 755 | @defproc[(maybe->either [x any/c] [m maybe?]) either?]{ 756 | Converts @racket[m] to an @tech{either} value. A @racket[just] is converted to a @racket[success] 757 | containing the same value, and a @racket[nothing] is converted to a @racket[failure] containing 758 | @racket[x]. 759 | 760 | @(functional-interaction 761 | (maybe->either 'fail (just 42)) 762 | (maybe->either 'fail nothing))} 763 | 764 | @defproc[(either->maybe [e either?]) maybe?]{ 765 | Converts @racket[e] to an unannotated @tech{optional value}. A @racket[success] is converted to a 766 | @racket[just] containing the same value, and a @racket[failure] is converted to @racket[nothing]. 767 | 768 | @(functional-interaction 769 | (either->maybe (success 42)) 770 | (either->maybe (failure 'fail)))} 771 | -------------------------------------------------------------------------------- /functional-doc/scribblings/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define scribblings 4 | '(["data/functional.scrbl" (multi-page) ("Data Structures")])) 5 | -------------------------------------------------------------------------------- /functional-lib/data/applicative.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (prefix-in c: data/collection) 4 | (prefix-in r: racket/base) 5 | racket/contract 6 | racket/function 7 | racket/generic 8 | (only-in "functor.rkt" gen:functor) 9 | "monad.rkt" 10 | (for-syntax racket/base 11 | syntax/parse)) 12 | 13 | (provide gen:applicative applicative? applicative/c 14 | pure/c 15 | (rename-out [delayed-pure pure] 16 | [delayed-pure? pure?])) 17 | 18 | (require racket/trace) 19 | 20 | (module+ coerce-delayed 21 | (provide coerce-pure)) 22 | 23 | (module+ custom-app 24 | (provide (rename-out [#%app-applicative #%app]))) 25 | 26 | (define-generics applicative 27 | (apply applicative args) 28 | (pure applicative value) 29 | 30 | #:derive-property prop:procedure 31 | (λ (f . args) (apply-applicative f args)) 32 | 33 | #:defaults 34 | ([c:sequence? 35 | (define (pure _ x) (list x)) 36 | (define (apply fs args) 37 | (c:for*/sequence ([f (c:in fs)] 38 | [xs (c:in (c:apply c:cartesian-product args))]) 39 | (c:apply f xs)))])) 40 | 41 | ; given two applicative instances, the second of which might be delayed, coerce the second instance to 42 | ; be an instance of the first using its pure implementation 43 | ; applicative? -> applicative? -> applicative? 44 | (define ((coerce-pure applicative) delayed) 45 | (if (delayed-pure? delayed) 46 | (pure applicative (delayed-pure-value delayed)) 47 | delayed)) 48 | 49 | ; a wrapper function around the apply method for unwrapping delayed pure values 50 | ; any/c list? -> any 51 | (define (apply-applicative f args) 52 | (cond [(applicative? f) 53 | ; if f is a delayed-pure instance, check if any of the args are concrete instances to infer 54 | ; the real value of pure from them 55 | (let* ([concrete-instance (if (delayed-pure? f) 56 | (or (findf (negate delayed-pure?) args) f) 57 | f)] 58 | [coerce-concrete (coerce-pure concrete-instance)]) 59 | (apply (coerce-concrete f) (map coerce-concrete args)))] 60 | [else (c:apply f args)])) 61 | 62 | (define-syntax #%app-applicative 63 | (syntax-parser 64 | [(_ f:expr arg:expr ...) #'(apply-applicative f (list arg ...))] 65 | [(_ . rest) #'(#%app . rest)])) 66 | 67 | (struct delayed-pure (value) 68 | #:transparent 69 | #:reflection-name 'pure 70 | #:methods gen:functor 71 | [(define (map f x) 72 | (delayed-pure (f (delayed-pure-value x))))] 73 | #:methods gen:applicative 74 | [(define/generic -apply apply) 75 | (define (pure _ x) (delayed-pure x)) 76 | (define (apply f args) 77 | (delayed-pure (-apply (delayed-pure-value f) (map delayed-pure-value args))))] 78 | #:methods gen:monad 79 | [(define (chain f x) 80 | (f (delayed-pure-value x)))]) 81 | 82 | (define/subexpression-pos-prop (pure/c ctc) 83 | (let ([ctc (coerce-contract 'pure/c ctc)]) 84 | (rename-contract 85 | (struct/c delayed-pure ctc) 86 | (build-compound-type-name 'pure/c ctc)))) 87 | -------------------------------------------------------------------------------- /functional-lib/data/either.rkt: -------------------------------------------------------------------------------- 1 | #lang curly-fn racket/base 2 | 3 | (require racket/require 4 | (prefix-in c: data/collection) 5 | (multi-in data [functor applicative monad maybe]) 6 | (multi-in racket [contract generic match serialize]) 7 | (for-syntax racket/base 8 | syntax/parse)) 9 | 10 | (provide either? success success? failure failure? either/c 11 | (contract-out 12 | [either ((any/c . -> . any/c) (any/c . -> . any/c) either? . -> . any/c)] 13 | [from-success (any/c either? . -> . any/c)] 14 | [from-failure (any/c either? . -> . any/c)] 15 | [from-either (either? . -> . any/c)] 16 | [map-failure ((any/c . -> . any/c) either? . -> . either?)] 17 | [either->maybe (either? . -> . maybe?)] 18 | [maybe->either (any/c maybe? . -> . either?)] 19 | [flip-either (either? . -> . either?)])) 20 | 21 | (define (either? x) 22 | (or (success? x) (failure? x))) 23 | 24 | (serializable-struct success (value) 25 | #:transparent 26 | #:methods gen:functor 27 | [(define (map f x) 28 | (success (f (success-value x))))] 29 | #:methods gen:applicative 30 | [(define (pure _ x) (success x)) 31 | (define/contract (apply f args) 32 | (any/c (listof either?) . -> . any/c) 33 | (or (findf failure? args) 34 | (success (c:apply (success-value f) (map success-value args)))))] 35 | #:methods gen:monad 36 | [(define (chain f x) 37 | (f (success-value x)))]) 38 | 39 | (serializable-struct failure (value) 40 | #:transparent 41 | #:methods gen:functor 42 | [(define (map f x) x)] 43 | #:methods gen:applicative 44 | [(define (pure _ x) (success x)) 45 | (define (apply f args) f)] 46 | #:methods gen:monad 47 | [(define (chain f x) x)]) 48 | 49 | (define/subexpression-pos-prop (either/c failure/c success/c) 50 | (let ([failure/c (coerce-contract 'either/c failure/c)] 51 | [success/c (coerce-contract 'either/c success/c)]) 52 | (rename-contract 53 | (or/c (struct/c failure failure/c) 54 | (struct/c success success/c)) 55 | (build-compound-type-name 'either/c failure/c success/c)))) 56 | 57 | (define/match (either g f m) 58 | [(_ f (success x)) (f x)] 59 | [(g _ (failure y)) (g y)]) 60 | 61 | (define/match (from-success x m) 62 | [(_ (success x)) x] 63 | [(x (failure _)) x]) 64 | 65 | (define/match (from-failure x m) 66 | [(x (success _)) x] 67 | [(_ (failure x)) x]) 68 | 69 | (define/match (from-either x) 70 | [((success x)) x] 71 | [((failure x)) x]) 72 | 73 | (define/match (map-failure f x) 74 | [(_ (success x)) (success x)] 75 | [(f (failure x)) (failure (f x))]) 76 | 77 | (define/match (flip-either x) 78 | [((success x)) (failure x)] 79 | [((failure x)) (success x)]) 80 | 81 | (define (either->maybe x) 82 | (either nothing just x)) 83 | (define (maybe->either e x) 84 | (maybe (failure e) success x)) 85 | -------------------------------------------------------------------------------- /functional-lib/data/functor.rkt: -------------------------------------------------------------------------------- 1 | #lang curly-fn racket/base 2 | 3 | (require (prefix-in c: data/collection/collection) 4 | racket/generic 5 | racket/list 6 | static-rename) 7 | 8 | (provide gen:functor functor? functor/c 9 | (rename-out [variadic-map map])) 10 | 11 | (define-generics functor 12 | (map f functor) 13 | #:defaults 14 | ([c:sequence? (define map c:map)])) 15 | 16 | (define/renamed map (variadic-map f . args) 17 | (if (c:sequence? (first args)) 18 | (apply c:map f args) 19 | (apply map f args))) 20 | -------------------------------------------------------------------------------- /functional-lib/data/maybe.rkt: -------------------------------------------------------------------------------- 1 | #lang curly-fn racket/base 2 | 3 | (require racket/require 4 | (prefix-in c: data/collection) 5 | (multi-in data [functor applicative monad]) 6 | (multi-in racket [contract function generic match serialize]) 7 | (for-syntax racket/base 8 | syntax/parse)) 9 | 10 | (provide maybe? just just? nothing nothing? maybe/c 11 | with-maybe-handler 12 | (contract-out 13 | [maybe (any/c (any/c . -> . any/c) maybe? . -> . any/c)] 14 | [from-just (any/c maybe? . -> . any/c)] 15 | [from-just! (just? . -> . any/c)] 16 | [filter-just ((listof maybe?) . -> . list?)] 17 | [map-maybe ((any/c . -> . maybe?) list? . -> . list?)] 18 | [false->maybe (any/c . -> . maybe?)] 19 | [exn->maybe ([(any/c . -> . any/c) procedure?] #:rest any/c . ->* . any/c)])) 20 | 21 | (define (maybe? x) 22 | (or (just? x) (nothing? x))) 23 | 24 | (serializable-struct just (value) 25 | #:transparent 26 | #:methods gen:functor 27 | [(define (map f x) 28 | (just (f (just-value x))))] 29 | #:methods gen:applicative 30 | [(define (pure _ x) (just x)) 31 | (define/contract (apply f args) 32 | (any/c (listof maybe?) . -> . any/c) 33 | (if (andmap just? args) 34 | (just (c:apply (just-value f) (map just-value args))) 35 | nothing))] 36 | #:methods gen:monad 37 | [(define (chain f x) 38 | (f (just-value x)))]) 39 | 40 | (define nothing-value 41 | (let () 42 | (struct nothing () 43 | #:property prop:serializable 44 | (make-serialize-info (λ _ #()) 45 | #`deserialize-info:nothing-v0 46 | #f 47 | (or (current-load-relative-directory) 48 | (current-directory))) 49 | #:methods gen:custom-write 50 | [(define (write-proc x out mode) 51 | (display "#" out))] 52 | #:methods gen:functor 53 | [(define (map f x) nothing-value)] 54 | #:methods gen:applicative 55 | [(define (pure _ x) (just x)) 56 | (define (apply f args) 57 | nothing-value)] 58 | #:methods gen:monad 59 | [(define (chain f x) nothing-value)]) 60 | (define nothing-value (nothing)) 61 | nothing-value)) 62 | 63 | (define deserialize-info:nothing-v0 64 | (make-deserialize-info (λ _ nothing-value) 65 | (λ _ (error '|nothing: can't have cycles|)))) 66 | (module+ deserialize-info 67 | (provide deserialize-info:nothing-v0)) 68 | 69 | (define-match-expander nothing 70 | (syntax-parser [(_) #'(== nothing-value)]) 71 | (syntax-parser [(_ . args) #'(nothing-value . args)] 72 | [_ #'nothing-value])) 73 | 74 | (define nothing? #{eq? nothing}) 75 | 76 | (define/subexpression-pos-prop (maybe/c val/c) 77 | (let ([val/c (coerce-contract 'maybe/c val/c)]) 78 | (rename-contract 79 | (or/c nothing? (struct/c just val/c)) 80 | (build-compound-type-name 'maybe/c val/c)))) 81 | 82 | (define/match (maybe x f m) 83 | [(_ f (just x)) (f x)] 84 | [(x _ (nothing)) x]) 85 | 86 | (define/match (from-just x m) 87 | [(_ (just x)) x] 88 | [(x (nothing)) x]) 89 | 90 | (define (from-just! x) 91 | (just-value x)) 92 | 93 | (define/match (filter-just lst) 94 | [('()) '()] 95 | [((cons (just x) rest)) (cons x (filter-just rest))] 96 | [((cons (nothing) rest)) (filter-just rest)]) 97 | 98 | (define/match (map-maybe f lst) 99 | [(_ '()) '()] 100 | [(f (cons x rest)) 101 | (match (f x) 102 | [(just x) (cons x (map-maybe f rest))] 103 | [(nothing) (map-maybe f rest)])]) 104 | 105 | (define (false->maybe x) 106 | (if x (just x) nothing)) 107 | 108 | (define-syntax-rule (with-maybe-handler pred? body ...) 109 | (with-handlers ([pred? (λ (_) nothing)]) 110 | (just (let () body ...)))) 111 | 112 | (define (exn->maybe pred? proc . args) 113 | (with-maybe-handler pred? (apply proc args))) 114 | -------------------------------------------------------------------------------- /functional-lib/data/monad.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/require 4 | data/collection 5 | (multi-in racket [contract generic lazy-require match]) 6 | (for-syntax racket/base 7 | racket/syntax 8 | syntax/parse)) 9 | 10 | (lazy-require ["applicative.rkt" (pure)] 11 | [(submod "applicative.rkt" coerce-delayed) (coerce-pure)]) 12 | 13 | (provide gen:monad monad? 14 | do <- (rename-out [chain-monad chain] [<- ←]) 15 | (contract-out [join (monad? . -> . monad?)] 16 | [map/m ((any/c . -> . monad?) sequence? . -> . monad?)])) 17 | 18 | (define-generics monad 19 | (chain f monad) 20 | #:defaults 21 | ([sequence? 22 | (define/contract (chain f xs) 23 | ((any/c . -> . sequence?) any/c . -> . sequence?) 24 | (for*/sequence ([x (in xs)] 25 | [y (in (f x))]) 26 | y))])) 27 | 28 | ; wrap a binding function so that delayed-pure instances will be properly converted to 29 | ; instance-specific values using their pure implementation 30 | ; monad? (any/c -> monad?) -> any/c -> monad? 31 | (define ((wrap-unpure x f) y) 32 | ((coerce-pure x) (f y))) 33 | 34 | (define (chain-monad f x) 35 | (chain (wrap-unpure x f) x)) 36 | 37 | (define-syntax (<- stx) 38 | (raise-syntax-error '<- "cannot be used outside of a do block" stx)) 39 | 40 | (begin-for-syntax 41 | (define-syntax-class internal-definition 42 | #:attributes [expansion] 43 | #:description "internal definition" 44 | [pattern form 45 | #:with expansion 46 | (local-expand #'form (list (generate-temporary #'form)) 47 | (list #'define #'define-values #'define-syntax #'define-syntaxes)) 48 | #:when (internal-definition? #'expansion)]) 49 | 50 | (define internal-definition? 51 | (syntax-parser 52 | #:literals [begin define define-values define-syntax define-syntaxes] 53 | [(begin form ...) 54 | (ormap internal-definition? (attribute form))] 55 | [({~or define define-values define-syntax define-syntaxes} . _) #t] 56 | [_ #f]))) 57 | 58 | (define-syntax do 59 | (syntax-parser 60 | #:literals [<-] 61 | [(_ x:expr) #'x] 62 | [(_ [pat {~and arrow <-} mx:expr] . rest) 63 | (with-disappeared-uses 64 | (begin 65 | (record-disappeared-uses (list #'arrow)) 66 | #'(chain-monad (match-lambda [pat (do . rest)]) mx)))] 67 | [(_ def:internal-definition ...+ . rest) 68 | #'(let () def.expansion ... (do . rest))] 69 | [(_ mx:expr . rest) 70 | #'(chain-monad (λ (_) (do . rest)) mx)])) 71 | 72 | (define (join x) 73 | (chain-monad values x)) 74 | 75 | (define/match (map/m f xs) 76 | [(f (sequence x xs ...)) 77 | (do [y <- (f x)] 78 | [ys <- (map/m f xs)] 79 | (pure (cons y ys)))] 80 | [(_ _) (pure '())]) 81 | -------------------------------------------------------------------------------- /functional-lib/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define version "0.7") 4 | 5 | (define collection 'multi) 6 | 7 | (define deps 8 | '(["base" #:version "6.3"] 9 | ["collections-lib" #:version "1.3"] 10 | "curly-fn-lib" 11 | "static-rename-lib")) 12 | (define build-deps 13 | '()) 14 | -------------------------------------------------------------------------------- /functional-test/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps 6 | '()) 7 | (define build-deps 8 | '("base" 9 | "collections-lib" 10 | "curly-fn-lib" 11 | "functional-lib" 12 | "rackunit-lib" 13 | "rackunit-spec")) 14 | -------------------------------------------------------------------------------- /functional-test/tests/data/applicative.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (prefix-in c: data/collection) 4 | data/functor 5 | data/applicative 6 | (only-in (submod data/applicative custom-app) [#%app #%app-applicative]) 7 | racket/contract 8 | rackunit 9 | rackunit/spec) 10 | 11 | (define (indirected-identity? x) 12 | (identity? x)) 13 | 14 | (struct identity (value) 15 | #:transparent 16 | #:methods gen:functor 17 | [(define (map f x) 18 | (identity (f (identity-value x))))] 19 | #:methods gen:applicative 20 | [(define (pure _ x) (identity x)) 21 | (define/contract (apply f args) 22 | (indirected-identity? (listof indirected-identity?) . -> . indirected-identity?) 23 | (identity (c:apply (identity-value f) (map identity-value args))))]) 24 | 25 | (describe "gen:applicative" 26 | (describe "pure" 27 | (it "wraps a plain value in a context" 28 | (define (pure-wrapper->identity x) 29 | ((identity values) x)) 30 | (check-equal? (pure-wrapper->identity (pure 3)) 31 | (identity 3)))) 32 | 33 | (describe "apply" 34 | (it "applies a function in a context to values in a context" 35 | (check-equal? ((identity +) (identity 1) (identity 2)) 36 | (identity 3))) 37 | 38 | (it "determines the instance from the arguments if the function is pure" 39 | (check-equal? ((pure +) (identity 1) (identity 2)) 40 | (identity 3))))) 41 | 42 | (describe "sequence" 43 | (describe "pure" 44 | (it "wraps a single value in a sequence" 45 | (check-equal? (c:sequence->list (#%app-applicative (list values) (pure 3))) 46 | (list 3)))) 47 | 48 | (describe "apply" 49 | (it "applies a function to all combinations of values" 50 | (check-equal? (c:sequence->list (#%app-applicative (list + *) (list 1 2) (list 3 4))) 51 | (list 4 5 5 6 3 4 6 8))))) 52 | -------------------------------------------------------------------------------- /functional-test/tests/data/either.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/require 4 | racket/serialize 5 | (multi-in data [functor applicative monad maybe either]) 6 | rackunit 7 | rackunit/spec) 8 | 9 | (describe "either" 10 | (it "is serializable" 11 | (check-equal? (deserialize (serialize (success 12))) (success 12)) 12 | (check-equal? (deserialize (serialize (failure 12))) (failure 12))) 13 | 14 | (describe "map" 15 | (it "maps over the internal value for success" 16 | (check-equal? (map add1 (success 12)) (success 13))) 17 | 18 | (it "is the identity for failure" 19 | (check-equal? (map add1 (failure 12)) (failure 12)))) 20 | 21 | (describe "pure" 22 | (it "wraps pure values in success" 23 | (check-equal? ((success values) (pure 'hello)) (success 'hello)))) 24 | 25 | (describe "apply" 26 | (it "applies functions to values wrapped in just" 27 | (check-equal? ((success +) (success 1) (success 2)) (success 3))) 28 | 29 | (it "returns the first failure if any of the values are failure" 30 | (check-equal? ((failure +) (failure 1) (pure 2)) (failure +)) 31 | (check-equal? ((success +) (failure 1) (failure 2)) (failure 1)) 32 | (check-equal? ((success +) (success 1) (failure 2)) (failure 2)))) 33 | 34 | (describe "chain" 35 | (it "threads a success value through the computation" 36 | (check-equal? (do [x <- (success 3)] 37 | [y <- (success (* x 2))] 38 | [z <- (success (sub1 y))] 39 | (success (/ z 3))) 40 | (success 5/3))) 41 | 42 | (it "aborts if any value returns failure" 43 | (check-equal? (do [x <- (success 3)] 44 | [y <- (failure 'die)] 45 | [z <- (success (sub1 y))] 46 | (success (/ z 3))) 47 | (failure 'die))))) 48 | 49 | (describe "either" 50 | (it "applies a function to a success value" 51 | (check-equal? (either symbol->string add1 (success 2)) 3)) 52 | 53 | (it "applies a function to a failure value" 54 | (check-equal? (either symbol->string add1 (failure 'fail)) "fail"))) 55 | 56 | (describe "from-success" 57 | (it "returns a value inside of a success" 58 | (check-equal? (from-success #f (success 3)) 3)) 59 | 60 | (it "returns a default for a failure value" 61 | (check-equal? (from-success #f (failure 'fail)) #f))) 62 | 63 | (describe "from-failure" 64 | (it "returns a value inside of a failure" 65 | (check-equal? (from-failure #f (failure 'fail)) 'fail)) 66 | 67 | (it "returns a default for a success value" 68 | (check-equal? (from-failure #f (success 3)) #f))) 69 | 70 | (describe "from-either" 71 | (it "returns a value from inside of a success" 72 | (check-equal? (from-either (success 3)) 3)) 73 | 74 | (it "returns a value inside of a failure" 75 | (check-equal? (from-either (failure 'fail)) 'fail))) 76 | 77 | (describe "map-failure" 78 | (it "maps over failure values" 79 | (check-equal? (map-failure add1 (failure 1)) (failure 2))) 80 | 81 | (it "leaves success values unchanged" 82 | (check-equal? (map-failure add1 (success 1)) (success 1)))) 83 | 84 | (describe "either->maybe" 85 | (it "converts success values to just values" 86 | (check-equal? (either->maybe (success 'x)) (just 'x))) 87 | 88 | (it "converts failure values to nothing" 89 | (check-equal? (either->maybe (failure 'x)) nothing))) 90 | 91 | (describe "maybe->either" 92 | (it "converts just values to success values" 93 | (check-equal? (maybe->either 'a (just 'b)) (success 'b))) 94 | 95 | (it "creates a failure value from a default given nothing" 96 | (check-equal? (maybe->either 'x nothing) (failure 'x)))) 97 | 98 | (describe "flip-either" 99 | (it "converts success values to failure values" 100 | (check-equal? (flip-either (success 'x)) (failure 'x))) 101 | 102 | (it "converts failure values to success values" 103 | (check-equal? (flip-either (failure 'x)) (success 'x)))) 104 | -------------------------------------------------------------------------------- /functional-test/tests/data/functor.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (except-in data/collection map) 4 | data/functor 5 | rackunit 6 | rackunit/spec) 7 | 8 | (struct identity (value) 9 | #:transparent 10 | #:methods gen:functor 11 | [(define (map f x) 12 | (identity (f (identity-value x))))]) 13 | 14 | (describe "gen:functor" 15 | (describe "map" 16 | (it "applies a function to the values inside a context" 17 | (check-equal? (map add1 (identity 25)) 18 | (identity 26))) 19 | 20 | (it "works like zip when applied to sequences" 21 | (check-equal? (sequence->list (map + '(1 2 3) '(10 20 30))) '(11 22 33))))) 22 | -------------------------------------------------------------------------------- /functional-test/tests/data/maybe.rkt: -------------------------------------------------------------------------------- 1 | #lang curly-fn racket/base 2 | 3 | (require racket/require 4 | racket/serialize 5 | (multi-in data [functor applicative monad maybe]) 6 | racket/match 7 | rackunit 8 | rackunit/spec) 9 | 10 | (describe "maybe" 11 | (it "is serializable" 12 | (check-eq? (deserialize (serialize nothing)) nothing) 13 | (check-equal? (deserialize (serialize (just 3))) (just 3))) 14 | 15 | (describe "map" 16 | (it "maps over the internal value for just" 17 | (check-equal? (map add1 (just 12)) (just 13))) 18 | 19 | (it "returns nothing for nothing" 20 | (check-equal? (map add1 nothing) nothing))) 21 | 22 | (describe "pure" 23 | (it "wraps pure values in just" 24 | (check-equal? ((just values) (pure 'hello)) (just 'hello)))) 25 | 26 | (describe "apply" 27 | (it "applies functions to values wrapped in just" 28 | (check-equal? ((just +) (just 1) (just 2)) (just 3))) 29 | 30 | (it "returns nothing if the arguments are nothing" 31 | (check-equal? ((just +) nothing (just 2)) nothing)) 32 | 33 | (it "returns nothing if the procedure is nothing" 34 | (check-equal? (nothing (pure 1) (just 2)) nothing))) 35 | 36 | (describe "chain" 37 | (it "threads a just value through the computation" 38 | (check-equal? (do [x <- (just 3)] 39 | [y <- (just (* x 2))] 40 | [z <- (just (sub1 y))] 41 | (just (/ z 3))) 42 | (just 5/3))) 43 | 44 | (it "aborts if any value returns nothing" 45 | (check-equal? (do [x <- (just 3)] 46 | [y <- nothing] 47 | [z <- (just (sub1 y))] 48 | (just (/ z 3))) 49 | nothing))) 50 | 51 | (describe "nothing" 52 | (it "prints like an opaque value" 53 | (check-equal? (format "~a" nothing) "#")) 54 | 55 | (it "functions as a match expander" 56 | (check-equal? (match (just 3) [(just _) #t] [(nothing) #f]) #t) 57 | (check-equal? (match nothing [(just _) #t] [(nothing) #f]) #f)))) 58 | 59 | (describe "maybe" 60 | (it "applies a function to a just value" 61 | (check-equal? (maybe #f add1 (just 2)) 3)) 62 | 63 | (it "returns a default for nothing" 64 | (check-equal? (maybe #f add1 nothing) #f))) 65 | 66 | (describe "from-just" 67 | (it "returns a value inside of a just" 68 | (check-equal? (from-just #f (just 3)) 3)) 69 | 70 | (it "returns a default for nothing" 71 | (check-equal? (from-just #f nothing) #f))) 72 | 73 | (describe "false->maybe" 74 | (it "returns nothing for #f" 75 | (check-equal? (false->maybe #f) nothing)) 76 | 77 | (it "returns just for non-#f values" 78 | (check-equal? (false->maybe 'hello) (just 'hello)))) 79 | 80 | (describe "with-maybe-handler" 81 | (it "converts exceptions to nothing" 82 | (check-equal? (with-maybe-handler exn:fail? 83 | (bytes->string/utf-8 #"\xC3")) 84 | nothing)) 85 | 86 | (it "wraps successful computations in just" 87 | (check-equal? (with-maybe-handler exn:fail? 88 | (bytes->string/utf-8 #"hello")) 89 | (just "hello")))) 90 | 91 | (describe "exn->maybe" 92 | (define try-bytes->string/utf-8 93 | #{exn->maybe exn:fail? bytes->string/utf-8}) 94 | 95 | (it "converts exceptions to nothing" 96 | (check-equal? (try-bytes->string/utf-8 #"\xC3") nothing)) 97 | 98 | (it "wraps successful computations in just" 99 | (check-equal? (try-bytes->string/utf-8 #"hello") (just "hello")))) 100 | -------------------------------------------------------------------------------- /functional-test/tests/data/monad.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require (prefix-in c: data/collection) 4 | data/functor 5 | data/applicative 6 | data/monad 7 | data/maybe 8 | racket/contract 9 | racket/match 10 | rackunit 11 | rackunit/spec) 12 | 13 | (define (indirected-identity? x) 14 | (identity? x)) 15 | 16 | (struct identity (value) 17 | #:transparent 18 | #:methods gen:functor 19 | [(define (map f x) 20 | (identity (f (identity-value x))))] 21 | #:methods gen:applicative 22 | [(define (pure _ x) (identity x)) 23 | (define/contract (apply f args) 24 | (indirected-identity? (listof indirected-identity?) . -> . indirected-identity?) 25 | (identity (c:apply (identity-value f) (map identity-value args))))] 26 | #:methods gen:monad 27 | [(define (chain f x) 28 | (f (identity-value x)))]) 29 | 30 | (describe "gen:monad" 31 | (describe "chain" 32 | (it "applies a function in a monadic context" 33 | (check-equal? (chain (compose identity add1) (identity 11)) 34 | (identity 12))))) 35 | 36 | (describe "do" 37 | (it "performs a sequence of chain calls" 38 | (check-equal? (do [x <- (identity 96)] 39 | [y <- (identity (add1 x))] 40 | [c <- (identity (integer->char y))] 41 | (identity c)) 42 | (identity #\a))) 43 | 44 | (it "permits pattern-matching in binding position" 45 | (check-equal? (do [(? number? x) <- (identity 96)] 46 | (identity x)) 47 | (identity 96))) 48 | 49 | (it "supports mutually recursive internal definitions" 50 | (check-equal? (do [x <- (identity 12)] 51 | (define (call-b) 52 | (* 2 (b))) 53 | (define (b) 54 | (- x)) 55 | [y <- (identity (call-b))] 56 | (identity (add1 y))) 57 | (identity -23))) 58 | 59 | (it "supports macros that expand into internal definitions" 60 | (check-equal? (do [x <- (identity 12)] 61 | (match-define (? number? y) x) 62 | (identity y)) 63 | (identity 12))) 64 | 65 | (it "supports macros that expand into internal syntax definitions" 66 | (check-equal? (do [x <- (identity 12)] 67 | (struct container (value) #:prefab) 68 | (identity (container x))) 69 | (identity #s(container 12))))) 70 | 71 | (describe "sequence" 72 | (describe "chain" 73 | (it "runs a computation through all possible paths" 74 | (check-equal? (c:sequence->list 75 | (do [f <- (list + *)] 76 | [a <- (list 1 2)] 77 | [b <- (list 5 6)] 78 | (pure (f a b)))) 79 | (list 6 7 7 8 5 6 10 12))))) 80 | 81 | (describe "join" 82 | (it "flattens two levels of monadic context" 83 | (check-equal? (join (identity (identity 3))) (identity 3)))) 84 | 85 | (describe "map/m" 86 | (it "maps a function over a sequence and chains the results into a single monadic value" 87 | (check-equal? (map/m just '(1 2 3)) (just '(1 2 3))) 88 | (check-equal? (map/m values (list (just 1) (just 2) (just 3))) (just '(1 2 3))) 89 | (check-equal? (map/m values (list (just 1) nothing (just 2))) nothing))) 90 | -------------------------------------------------------------------------------- /functional/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection 'multi) 4 | 5 | (define deps 6 | '("base" 7 | "functional-lib" 8 | "functional-doc")) 9 | (define build-deps 10 | '()) 11 | 12 | (define implies 13 | '("functional-lib" 14 | "functional-doc")) --------------------------------------------------------------------------------