├── .gitignore ├── src └── CallByName │ ├── Monoid.purs │ ├── Class.purs │ ├── Applicative.purs │ ├── Syntax.purs │ └── Alt.purs ├── .tidyrc.json ├── .github └── workflows │ └── ci.yml ├── bower.json ├── LICENSE ├── test └── Main.purs └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | -------------------------------------------------------------------------------- /src/CallByName/Monoid.purs: -------------------------------------------------------------------------------- 1 | module CallByName.Monoid where 2 | 3 | import Prelude 4 | 5 | guard :: forall m. Monoid m => Boolean -> (Unit -> m) -> m 6 | guard true k = k unit 7 | guard _ _ = mempty 8 | -------------------------------------------------------------------------------- /src/CallByName/Class.purs: -------------------------------------------------------------------------------- 1 | module CallByName.Class where 2 | 3 | class CallByName :: Type -> Constraint 4 | class CallByName a 5 | 6 | instance cbn :: CallByName a 7 | 8 | type CBN a = CallByName a => a 9 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importSort": "ide", 3 | "importWrap": "source", 4 | "indent": 2, 5 | "operatorsFile": null, 6 | "ribbon": 1, 7 | "typeArrowPlacement": "first", 8 | "unicode": "source", 9 | "width": null 10 | } 11 | -------------------------------------------------------------------------------- /src/CallByName/Applicative.purs: -------------------------------------------------------------------------------- 1 | module CallByName.Applicative where 2 | 3 | import Prelude 4 | 5 | when :: forall m. Applicative m => Boolean -> (Unit -> m Unit) -> m Unit 6 | when true k = k unit 7 | when _ _ = pure unit 8 | 9 | unless :: forall m. Applicative m => Boolean -> (Unit -> m Unit) -> m Unit 10 | unless false k = k unit 11 | unless _ _ = pure unit 12 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | 8 | jobs: 9 | build: 10 | runs-on: ubuntu-latest 11 | 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@v2.0.0 16 | with: 17 | purs-tidy: "latest" 18 | 19 | - name: Install and build 20 | run: | 21 | npx bower install 22 | npx pulp build 23 | npx pulp test 24 | 25 | - name: Check formatting 26 | run: purs-tidy check src test 27 | -------------------------------------------------------------------------------- /src/CallByName/Syntax.purs: -------------------------------------------------------------------------------- 1 | module CallByName.Syntax where 2 | 3 | import Prelude 4 | 5 | import CallByName.Class (CBN) 6 | import Data.Lazy (Lazy) 7 | import Data.Lazy as Lazy 8 | import Unsafe.Coerce (unsafeCoerce) 9 | 10 | defer :: forall a. CBN a -> Unit -> a 11 | defer = unsafeCoerce 12 | 13 | deferApply :: forall a b. ((Unit -> a) -> b) -> CBN a -> b 14 | deferApply = unsafeCoerce 15 | 16 | infixl 10 deferApply as \\ 17 | 18 | lazy :: forall a. CBN a -> Lazy a 19 | lazy = unsafeCoerce Lazy.defer 20 | 21 | lazyApply :: forall a b. (Lazy a -> b) -> CBN a -> b 22 | lazyApply f = unsafeCoerce (f <<< Lazy.defer) 23 | 24 | infixl 10 lazyApply as ~ 25 | -------------------------------------------------------------------------------- /src/CallByName/Alt.purs: -------------------------------------------------------------------------------- 1 | module CallByName.Alt where 2 | 3 | import Prelude 4 | 5 | import CallByName.Class (CBN) 6 | import Control.Alt as Strict 7 | import Data.Either (Either(..)) 8 | import Data.Maybe (Maybe(..)) 9 | import Unsafe.Coerce (unsafeCoerce) 10 | 11 | class Strict.Alt f <= Alt f where 12 | alt :: forall a. f a -> (Unit -> f a) -> f a 13 | 14 | cbnAlt :: forall f a. Alt f => f a -> CBN (f a) -> f a 15 | cbnAlt = unsafeCoerce (alt :: f a -> (Unit -> f a) -> f a) 16 | 17 | infixr 3 cbnAlt as <|> 18 | 19 | instance altMaybe :: Alt Maybe where 20 | alt a k = case a of 21 | Just _ -> a 22 | Nothing -> k unit 23 | 24 | instance altEither :: Alt (Either e) where 25 | alt a k = case a of 26 | Right _ -> a 27 | Left _ -> k unit 28 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-call-by-name", 3 | "homepage": "https://github.com/natefaubion/purescript-call-by-name", 4 | "authors": [ 5 | "Nathan Faubion " 6 | ], 7 | "license": "MIT", 8 | "repository": { 9 | "type": "git", 10 | "url": "https://github.com/natefaubion/purescript-call-by-name.git" 11 | }, 12 | "ignore": [ 13 | "**/.*", 14 | "node_modules", 15 | "bower_components", 16 | "output" 17 | ], 18 | "dependencies": { 19 | "purescript-prelude": "^6.0.0", 20 | "purescript-unsafe-coerce": "^6.0.0", 21 | "purescript-lazy": "^6.0.0", 22 | "purescript-maybe": "^6.0.0", 23 | "purescript-either": "^6.0.0", 24 | "purescript-control": "^6.0.0" 25 | }, 26 | "devDependencies": { 27 | "purescript-psci-support": "^6.0.0", 28 | "purescript-effect": "^4.0.0", 29 | "purescript-console": "^6.0.0", 30 | "purescript-exceptions": "^6.0.0", 31 | "purescript-refs": "^6.0.0" 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017 Nathan Faubion 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude hiding (unless, when) 4 | 5 | import CallByName.Alt ((<|>)) 6 | import CallByName.Applicative (unless, when) 7 | import CallByName.Monoid (guard) 8 | import CallByName.Syntax ((\\), (~)) 9 | import Data.Either (Either(..)) 10 | import Data.Lazy (Lazy, force) 11 | import Data.Maybe (Maybe(..)) 12 | import Effect (Effect) 13 | import Effect.Exception.Unsafe (unsafeThrow) 14 | import Effect.Ref as Ref 15 | import Effect.Unsafe (unsafePerformEffect) 16 | 17 | forceTwice :: forall a. Lazy a -> a 18 | forceTwice a = 19 | let 20 | _ = force a 21 | in 22 | force a 23 | 24 | main :: Effect Unit 25 | main = do 26 | ref <- Ref.new false 27 | let 28 | lazyTest = 29 | forceTwice ~ 30 | ( unsafePerformEffect do 31 | val <- Ref.read ref 32 | if val then unsafeThrow "Not lazy!" 33 | else Ref.write true ref 34 | ) 35 | 36 | altTest1 = 37 | Just unit <|> unsafeThrow "Too strict!" 38 | 39 | altTest2 = 40 | Right unit <|> unsafeThrow "Too strict!" 41 | 42 | when false \\ do 43 | unsafeThrow "Too strict!" 44 | 45 | unless true \\ do 46 | unsafeThrow "Too strict!" 47 | 48 | guard false \\ do 49 | unsafeThrow "Too strict!" 50 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## purescript-call-by-name 2 | 3 | [![Latest release](http://img.shields.io/github/release/natefaubion/purescript-call-by-name.svg)](https://github.com/natefaubion/purescript-call-by-name/releases) 4 | [![Build status](https://github.com/natefaubion/purescript-call-by-name/workflows/CI/badge.svg?branch=master)](https://github.com/natefaubion/purescript-call-by-name/actions?query=workflow%3ACI+branch%3Amaster) 5 | 6 | Syntactically light-weight call-by-name arguments in PureScript. No guarantees. 7 | Completely gratuitous. 8 | 9 | ## What is this library? 10 | 11 | This library takes advantage of term-abstraction incurred by type class 12 | dictionaries to approximate call-by-name evaluation for arguments. We 13 | simulate call-by-name by taking a `Unit -> a` argument which defers evaluation 14 | of `a` until invoked. We then provide operators to coerce these 15 | type-class-abstracted terms into the more reliable call-by-name form. 16 | 17 | Take the `when` function from `Prelude`: 18 | 19 | ```purescript 20 | when :: forall m. Applicative m => Boolean -> m Unit -> m Unit 21 | ``` 22 | 23 | It is strict in both arguments, so it will _allocate_ the provided effect 24 | even though it may be discarded. This can be problematic, especially if there 25 | are `let` bound values: 26 | 27 | ```purescript 28 | example = 29 | when that do 30 | let 31 | a = somethingExpensive 42 32 | b = somethingElseExpensive a 33 | this a b 34 | ``` 35 | 36 | Both `a` and `b` will be evaluated, which we don't want. The alternative is to 37 | use a call-by-name approximation: 38 | 39 | ```purescript 40 | when :: forall m. Applicative m => Boolean -> (Unit -> m Unit) -> m Unit 41 | 42 | example = 43 | when that \_ -> do 44 | let 45 | a = somethingExpensive 42 46 | b = somethingElseExpensive a 47 | this a b 48 | ``` 49 | 50 | But wow that's irritating. This library exports an application operator `\\` 51 | that makes this look better. 52 | 53 | ```purescript 54 | import CallByName.Applicative (when) 55 | import CallByName.Syntax ((\\)) 56 | 57 | example = 58 | when that \\do 59 | let 60 | a = somethingExpensive 42 61 | b = somethingElseExpensive a 62 | this a b 63 | ``` 64 | 65 | We've saved four arduous characters. 66 | 67 | There's also the `~` operator which lifts terms into `Lazy`. 68 | 69 | ```purescript 70 | somethingLazy :: Lazy Int -> Int 71 | 72 | example = 73 | somethingLazy ~(evaluate expensive int) 74 | ``` 75 | 76 | Versus the old: 77 | 78 | ```purescript 79 | example = 80 | somethingLazy (Lazy.defer \_ -> evaluate expensive int) 81 | ``` 82 | 83 | ## Somewhat actually useful things 84 | 85 | This library also exports some call-by-name variants of functions that don't 86 | exist in current Prelude or ecosystem. 87 | 88 | ```purescript 89 | CallByName.Applicative.when :: 90 | forall m. Applicative m => Boolean -> (Unit -> m Unit) -> m Unit 91 | 92 | CallByName.Applicative.unless :: 93 | forall m. Applicative m => Boolean -> (Unit -> m Unit) -> m Unit 94 | 95 | CallByName.Monoid.guard :: 96 | forall m. Monoid m => Boolean -> (Unit -> m) -> m 97 | ``` 98 | 99 | And also exports a version of the `Alt` type class which defers it's second 100 | argument. 101 | 102 | ```purescript 103 | class Strict.Alt f <= Alt f where 104 | alt :: forall a. f a -> (Unit -> f a) -> f a 105 | ``` 106 | 107 | This can be combined with a magic, right-associated version of `<|>` which 108 | _does not_ strictly evaluate it's second argument. 109 | 110 | ```purescript 111 | example = 112 | Just 42 <|> unsafeThrow "Too strict!" 113 | ``` 114 | --------------------------------------------------------------------------------