├── .ghci ├── .github └── workflows │ └── ci.yml ├── .gitignore ├── CHANGES.md ├── LICENSE ├── README.md ├── examples ├── Build.hs ├── Parser.hs ├── Processor.hs ├── Query.hs ├── Teletype.hs ├── Teletype │ └── Rigid.hs └── Validation.hs ├── paper ├── .gitignore ├── 1-intro.tex ├── 2-selective.tex ├── 3-static.tex ├── 4-haxl.tex ├── 5-free.tex ├── 6-alternatives.tex ├── 7-related.tex ├── 8-conclusions.tex ├── ACM-Reference-Format.bst ├── Makefile ├── acmart.cls ├── artefact │ ├── Dockerfile │ ├── README-ACMDL.md │ └── README.md ├── cover-letter.txt ├── fig │ ├── add.pdf │ ├── add.svg │ ├── addAndJump.pdf │ ├── addAndJump.svg │ ├── build-dependencies.pdf │ ├── build-dependencies.svg │ ├── comment-haxl-applicative.pdf │ ├── comment-haxl-applicative.svg │ ├── comment-haxl-monad.pdf │ ├── comment-haxl-monad.svg │ ├── comment-haxl-selective-1.pdf │ ├── comment-haxl-selective-1.svg │ ├── comment-haxl-selective-2.pdf │ ├── comment-haxl-selective-2.svg │ ├── jumpZero.pdf │ └── jumpZero.svg ├── irc-log-branchy.md ├── main.tex ├── refs.bib ├── response.md └── todo.md ├── selective.cabal ├── src └── Control │ ├── Selective.hs │ └── Selective │ ├── Free.hs │ ├── Multi.hs │ ├── Rigid │ ├── Free.hs │ └── Freer.hs │ └── Trans │ └── Except.hs ├── stack.yaml └── test ├── Laws.hs ├── Main.hs ├── Sketch.hs └── Test.hs /.ghci: -------------------------------------------------------------------------------- 1 | :set -Wall -fno-warn-name-shadowing -Wcompat 2 | :set -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints 3 | :set -Wunused-binds -Wunused-imports -Worphans 4 | 5 | :set -isrc 6 | :set -itest 7 | 8 | :set prompt "\x03BB> " 9 | :set prompt-cont "\x03BB| " 10 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | # Adapted from: https://github.com/ndmitchell/hlint/blob/master/.github/workflows/ci.yml 2 | name: ci 3 | 4 | on: 5 | push: 6 | pull_request: 7 | schedule: 8 | - cron: '0 3 * * 6' # 3am Saturday 9 | workflow_dispatch: 10 | 11 | jobs: 12 | test: 13 | runs-on: ${{ matrix.os }} 14 | 15 | strategy: 16 | fail-fast: false 17 | matrix: 18 | os: [ubuntu-latest] 19 | ghc: ['9.8.2', '9.6.3', '9.4.7', '9.2.8', '9.0.2', '8.10.7', '8.8.4', '8.6.5'] 20 | include: 21 | - os: windows-latest 22 | # Testing on MacOS is disabled until GitHub actions support 'allow-failure' 23 | # - os: macOS-latest 24 | 25 | steps: 26 | - run: git config --global core.autocrlf false 27 | - uses: actions/checkout@v3 28 | - uses: haskell-actions/setup@v2 29 | id: setup-haskell 30 | with: 31 | ghc-version: ${{ matrix.ghc }} 32 | - name: Get GHC libdir 33 | id: get-ghc-libdir 34 | run: | 35 | echo "name=libdir::$(ghc --print-libdir)" >> $GITHUB_OUTPUT 36 | shell: bash 37 | - run: cabal v2-freeze --enable-tests 38 | - uses: actions/cache@v2 39 | with: 40 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 41 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ steps.get-ghc-libdir.outputs.libdir }}-${{ hashFiles('cabal.project.freeze') }} 42 | - uses: snowleopard/neil@master 43 | with: 44 | github-user: snowleopard 45 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | cabal.project.local~ 21 | .HTF/ 22 | .ghc.environment.* 23 | stack.yaml.lock 24 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # Change log 2 | 3 | ## 0.7.0.1 4 | 5 | * Start supporting GHC 9.6. See #72. 6 | 7 | ## 0.7 8 | 9 | * Drop `MonadTrans (ExceptT e)` instance to allow `transformers-0.6.1`. 10 | See #70. 11 | 12 | ## 0.6 13 | 14 | * Start supporting GHC 9.4. See #66. 15 | * Add `ComposeTraversable`. See #65. 16 | * Make the `Applicative` instance of `ComposeEither` more interesting by relying 17 | on the `Selective f` constraint. See #64. 18 | * Make the `Lift` instance lazier. See #63. 19 | * Stop supporting GHC <= 8.6. See #62. 20 | * Add `Control.Selective.Trans.Except` transformer. See #39. 21 | 22 | ## 0.5 23 | 24 | * Allow `transformers-0.6`, see #47. 25 | * Drop dependencies on `mtl` and `tasty`. See #45, #46. 26 | * Derive the stock `Eq` and `Ord` instances for `Validation`, see #43. 27 | * Add `selectT`, see #42. 28 | * Add more general instances for `IdentityT` and `ReaderT`. This is technically 29 | a breaking change because `Selective` is not a superclass of `Monad`. See #38. 30 | 31 | ## 0.4.1 32 | 33 | * Allow newer QuickCheck. 34 | 35 | ## 0.4 36 | 37 | * Add multi-way selective functors: `Control.Selective.Multi`. 38 | 39 | ## 0.3 40 | 41 | * Add freer rigid selective functors: `Control.Selective.Rigid.Freer`. 42 | * Rename `Control.Selective.Free.Rigid` to `Control.Selective.Rigid.Free`. 43 | * Add free selective functors: `Control.Selective.Free`. 44 | * Switch to more conventional field names in `SelectA` and `SelectM`. 45 | 46 | ## 0.2 47 | 48 | * Make compatible with GHC >= 8.0.2. 49 | * Add another free construction `Control.Selective.Free`. 50 | * Add several new `Selective` instances. 51 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018-2024 Andrey Mokhov 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 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, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Selective applicative functors 2 | 3 | [![Hackage version](https://img.shields.io/hackage/v/selective.svg?label=Hackage)](https://hackage.haskell.org/package/selective) [![Build status](https://img.shields.io/github/actions/workflow/status/snowleopard/selective/ci.yml?branch=main)](https://github.com/snowleopard/selective/actions) 4 | 5 | This is a library for *selective applicative functors*, or just *selective functors* 6 | for short, an abstraction between applicative functors and monads, introduced in 7 | [this paper](https://dl.acm.org/doi/10.1145/3341694). 8 | 9 | ## What are selective functors? 10 | 11 | While you're encouraged to read the paper, here is a brief description of 12 | the main idea. Consider the following new type class introduced between 13 | `Applicative` and `Monad`: 14 | 15 | ```haskell 16 | class Applicative f => Selective f where 17 | select :: f (Either a b) -> f (a -> b) -> f b 18 | 19 | -- | An operator alias for 'select'. 20 | (<*?) :: Selective f => f (Either a b) -> f (a -> b) -> f b 21 | (<*?) = select 22 | 23 | infixl 4 <*? 24 | ``` 25 | 26 | Think of `select` as a *selective function application*: you **must apply** the function 27 | of type `a -> b` when given a value of type `Left a`, but you **may skip** the 28 | function and associated effects, and simply return `b` when given `Right b`. 29 | 30 | Note that you can write a function with this type signature using 31 | `Applicative` functors, but it will always execute the effects associated 32 | with the second argument, hence being potentially less efficient: 33 | 34 | ```haskell 35 | selectA :: Applicative f => f (Either a b) -> f (a -> b) -> f b 36 | selectA x f = (\e f -> either f id e) <$> x <*> f 37 | ``` 38 | 39 | Any `Applicative` instance can thus be given a corresponding `Selective` 40 | instance simply by defining `select = selectA`. The opposite is also true 41 | in the sense that one can recover the operator `<*>` from `select` as 42 | follows (I'll use the suffix `S` to denote `Selective` equivalents of 43 | commonly known functions). 44 | 45 | ```haskell 46 | apS :: Selective f => f (a -> b) -> f a -> f b 47 | apS f x = select (Left <$> f) ((&) <$> x) 48 | ``` 49 | 50 | Here we wrap a given function `a -> b` into `Left` and turn the value `a` 51 | into a function `($a)`, which simply feeds itself to the function `a -> b` 52 | yielding `b` as desired. Note: `apS` is a perfectly legal 53 | application operator `<*>`, i.e. it satisfies the laws dictated by the 54 | `Applicative` type class as long as [the laws](#laws) of the `Selective` 55 | type class hold. 56 | 57 | The `branch` function is a natural generalisation of `select`: instead of 58 | skipping an unnecessary effect, it chooses which of the two given effectful 59 | functions to apply to a given argument; the other effect is unnecessary. It 60 | is possible to implement `branch` in terms of `select`, which is a good 61 | puzzle (give it a try!). 62 | 63 | ```haskell 64 | branch :: Selective f => f (Either a b) -> f (a -> c) -> f (b -> c) -> f c 65 | branch = ... -- Try to figure out the implementation! 66 | ``` 67 | 68 | Finally, any `Monad` is `Selective`: 69 | 70 | ```haskell 71 | selectM :: Monad f => f (Either a b) -> f (a -> b) -> f b 72 | selectM mx mf = do 73 | x <- mx 74 | case x of 75 | Left a -> fmap ($a) mf 76 | Right b -> pure b 77 | ``` 78 | 79 | Selective functors are sufficient for implementing many conditional constructs, 80 | which traditionally require the (more powerful) `Monad` type class. For example: 81 | 82 | ```haskell 83 | -- | Branch on a Boolean value, skipping unnecessary effects. 84 | ifS :: Selective f => f Bool -> f a -> f a -> f a 85 | ifS i t e = branch (bool (Right ()) (Left ()) <$> i) (const <$> t) (const <$> e) 86 | 87 | -- | Conditionally perform an effect. 88 | whenS :: Selective f => f Bool -> f () -> f () 89 | whenS x act = ifS x act (pure ()) 90 | 91 | -- | Keep checking an effectful condition while it holds. 92 | whileS :: Selective f => f Bool -> f () 93 | whileS act = whenS act (whileS act) 94 | 95 | -- | A lifted version of lazy Boolean OR. 96 | (<||>) :: Selective f => f Bool -> f Bool -> f Bool 97 | (<||>) a b = ifS a (pure True) b 98 | 99 | -- | A lifted version of 'any'. Retains the short-circuiting behaviour. 100 | anyS :: Selective f => (a -> f Bool) -> [a] -> f Bool 101 | anyS p = foldr ((<||>) . p) (pure False) 102 | 103 | -- | Return the first @Right@ value. If both are @Left@'s, accumulate errors. 104 | orElse :: (Selective f, Semigroup e) => f (Either e a) -> f (Either e a) -> f (Either e a) 105 | orElse x = select (Right <$> x) . fmap (\y e -> first (e <>) y) 106 | ``` 107 | 108 | See more examples in [src/Control/Selective.hs](src/Control/Selective.hs). 109 | 110 | Code written using selective combinators can be both statically analysed 111 | (by reporting all possible effects of a computation) and efficiently 112 | executed (by skipping unnecessary effects). 113 | 114 | ## Laws 115 | 116 | Instances of the `Selective` type class must satisfy a few laws to make 117 | it possible to refactor selective computations. These laws also allow us 118 | to establish a formal relation with the `Applicative` and `Monad` type 119 | classes. 120 | 121 | * Identity: 122 | ```haskell 123 | x <*? pure id = either id id <$> x 124 | ``` 125 | 126 | * Distributivity (note that `y` and `z` have the same type `f (a -> b)`): 127 | ```haskell 128 | pure x <*? (y *> z) = (pure x <*? y) *> (pure x <*? z) 129 | ``` 130 | * Associativity: 131 | ```haskell 132 | x <*? (y <*? z) = (f <$> x) <*? (g <$> y) <*? (h <$> z) 133 | where 134 | f x = Right <$> x 135 | g y = \a -> bimap (,a) ($a) y 136 | h z = uncurry z 137 | ``` 138 | * Monadic select (for selective functors that are also monads): 139 | ```haskell 140 | select = selectM 141 | ``` 142 | 143 | There are also a few useful theorems: 144 | 145 | * Apply a pure function to the result: 146 | ```haskell 147 | f <$> select x y = select (fmap f <$> x) (fmap f <$> y) 148 | ``` 149 | 150 | * Apply a pure function to the `Left` case of the first argument: 151 | ```haskell 152 | select (first f <$> x) y = select x ((. f) <$> y) 153 | ``` 154 | 155 | * Apply a pure function to the second argument: 156 | ```haskell 157 | select x (f <$> y) = select (first (flip f) <$> x) ((&) <$> y) 158 | ``` 159 | 160 | * Generalised identity: 161 | ```haskell 162 | x <*? pure y = either y id <$> x 163 | ``` 164 | 165 | * A selective functor is *rigid* if it satisfies `<*> = apS`. The following 166 | *interchange* law holds for rigid selective functors: 167 | ```haskell 168 | x *> (y <*? z) = (x *> y) <*? z 169 | ``` 170 | 171 | Note that there are no laws for selective application of a function to a pure 172 | `Left` or `Right` value, i.e. we do not require that the following laws hold: 173 | 174 | ```haskell 175 | select (pure (Left x)) y = ($x) <$> y -- Pure-Left 176 | select (pure (Right x)) y = pure x -- Pure-Right 177 | ``` 178 | 179 | In particular, the following is allowed too: 180 | 181 | ```haskell 182 | select (pure (Left x)) y = pure () -- when y :: f (a -> ()) 183 | select (pure (Right x)) y = const x <$> y 184 | ``` 185 | 186 | We therefore allow `select` to be selective about effects in these cases, which 187 | in practice allows to under- or over-approximate possible effects in static 188 | analysis using instances like `Under` and `Over`. 189 | 190 | If `f` is also a `Monad`, we require that `select = selectM`, from which one 191 | can prove `apS = <*>`, and furthermore the above `Pure-Left` and `Pure-Right` 192 | properties now hold. 193 | 194 | ## Static analysis of selective functors 195 | 196 | Like applicative functors, selective functors can be analysed statically. 197 | We can make the `Const` functor an instance of `Selective` as follows. 198 | 199 | ```haskell 200 | instance Monoid m => Selective (Const m) where 201 | select = selectA 202 | ``` 203 | 204 | Although we don't need the function `Const m (a -> b)` (note that 205 | `Const m (Either a b)` holds no values of type `a`), we choose to 206 | accumulate the effects associated with it. This allows us to extract 207 | the static structure of any selective computation very similarly 208 | to how this is done with applicative computations. 209 | 210 | The `Validation` instance is perhaps a bit more interesting. 211 | 212 | ```haskell 213 | data Validation e a = Failure e | Success a deriving (Functor, Show) 214 | 215 | instance Semigroup e => Applicative (Validation e) where 216 | pure = Success 217 | Failure e1 <*> Failure e2 = Failure (e1 <> e2) 218 | Failure e1 <*> Success _ = Failure e1 219 | Success _ <*> Failure e2 = Failure e2 220 | Success f <*> Success a = Success (f a) 221 | 222 | instance Semigroup e => Selective (Validation e) where 223 | select (Success (Right b)) _ = Success b 224 | select (Success (Left a)) f = Success ($a) <*> f 225 | select (Failure e ) _ = Failure e 226 | ``` 227 | 228 | Here, the last line is particularly interesting: unlike the `Const` 229 | instance, we choose to actually skip the function effect in case of 230 | `Failure`. This allows us not to report any validation errors which 231 | are hidden behind a failed conditional. 232 | 233 | Let's clarify this with an example. Here we define a function to 234 | construct a `Shape` (a circle or a rectangle) given a choice of the 235 | shape `s` and the shape's parameters (`r`, `w`, `h`) in a selective 236 | context `f`. 237 | 238 | ```haskell 239 | type Radius = Int 240 | type Width = Int 241 | type Height = Int 242 | 243 | data Shape = Circle Radius | Rectangle Width Height deriving Show 244 | 245 | shape :: Selective f => f Bool -> f Radius -> f Width -> f Height -> f Shape 246 | shape s r w h = ifS s (Circle <$> r) (Rectangle <$> w <*> h) 247 | ``` 248 | 249 | We choose `f = Validation [String]` to report the errors that occurred 250 | when parsing a value. Let's see how it works. 251 | 252 | ```haskell 253 | > shape (Success True) (Success 10) (Failure ["no width"]) (Failure ["no height"]) 254 | Success (Circle 10) 255 | 256 | > shape (Success False) (Failure ["no radius"]) (Success 20) (Success 30) 257 | Success (Rectangle 20 30) 258 | 259 | > shape (Success False) (Failure ["no radius"]) (Success 20) (Failure ["no height"]) 260 | Failure ["no height"] 261 | 262 | > shape (Success False) (Failure ["no radius"]) (Failure ["no width"]) (Failure ["no height"]) 263 | Failure ["no width","no height"] 264 | 265 | > shape (Failure ["no choice"]) (Failure ["no radius"]) (Success 20) (Failure ["no height"]) 266 | Failure ["no choice"] 267 | ``` 268 | 269 | In the last example, since we failed to parse which shape has been chosen, 270 | we do not report any subsequent errors. But it doesn't mean we are short-circuiting 271 | the validation. We will continue accumulating errors as soon as we get out of the 272 | opaque conditional, as demonstrated below. 273 | 274 | ```haskell 275 | twoShapes :: Selective f => f Shape -> f Shape -> f (Shape, Shape) 276 | twoShapes s1 s2 = (,) <$> s1 <*> s2 277 | 278 | > s1 = shape (Failure ["no choice 1"]) (Failure ["no radius 1"]) (Success 20) (Failure ["no height 1"]) 279 | > s2 = shape (Success False) (Failure ["no radius 2"]) (Success 20) (Failure ["no height 2"]) 280 | > twoShapes s1 s2 281 | Failure ["no choice 1","no height 2"] 282 | ``` 283 | 284 | ## Do we still need monads? 285 | 286 | Yes! Here is what selective functors cannot do: `join :: Selective f => f (f a) -> f a`. 287 | 288 | ## Further reading 289 | 290 | * An ICFP'19 paper introducing selective functors: https://doi.org/10.1145/3341694. 291 | * An older blog post introducing selective functors: https://blogs.ncl.ac.uk/andreymokhov/selective. 292 | -------------------------------------------------------------------------------- /examples/Build.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds, DeriveFunctor, FlexibleInstances, GADTs, RankNTypes #-} 2 | module Build where 3 | 4 | import Control.Selective 5 | import Control.Selective.Rigid.Free 6 | 7 | -- See Section 3 of the paper: https://dl.acm.org/doi/10.1145/3341694. 8 | 9 | -- | Selective build tasks. 10 | -- See "Build Systems à la Carte": https://dl.acm.org/citation.cfm?id=3236774. 11 | newtype Task k v = Task { run :: forall f. Selective f => (k -> f v) -> f v } 12 | 13 | -- | Selective build scripts. 14 | type Script k v = k -> Maybe (Task k v) 15 | 16 | -- | Build dependencies with over-approximation. 17 | dependenciesOver :: Task k v -> [k] 18 | dependenciesOver task = getOver $ run task (\k -> Over [k]) 19 | 20 | -- | Build dependencies with under-approximation. 21 | dependenciesUnder :: Task k v -> [k] 22 | dependenciesUnder task = getUnder $ run task (\k -> Under [k]) 23 | 24 | -- | A build script with a static dependency cycle, which always resolves into 25 | -- an acyclic dependency graph in runtime. 26 | -- 27 | -- @ 28 | -- 'dependenciesOver' ('fromJust' $ 'cyclic' "B1") == ["C1","B2","A2"] 29 | -- 'dependenciesOver' ('fromJust' $ 'cyclic' "B2") == ["C1","A1","B1"] 30 | -- 'dependenciesUnder' ('fromJust' $ 'cyclic' "B1") == ["C1"] 31 | -- 'dependenciesUnder' ('fromJust' $ 'cyclic' "B2") == ["C1"] 32 | -- @ 33 | cyclic :: Script String Integer 34 | cyclic "B1" = Just $ Task $ \fetch -> ifS ((1==) <$> fetch "C1") (fetch "B2") (fetch "A2") 35 | cyclic "B2" = Just $ Task $ \fetch -> ifS ((1==) <$> fetch "C1") (fetch "A1") (fetch "B1") 36 | cyclic _ = Nothing 37 | 38 | -- | A build task demonstrating the use of 'bindS'. 39 | -- 40 | -- @ 41 | -- 'dependenciesOver' 'taskBind' == ["A1","A2","C5","C6","D5","D6"] 42 | -- 'dependenciesUnder' 'taskBind' == ["A1"] 43 | -- @ 44 | taskBind :: Task String Integer 45 | taskBind = Task $ \fetch -> (odd <$> fetch "A1") `bindS` \x -> 46 | (odd <$> fetch "A2") `bindS` \y -> 47 | let c = if x then "C" else "D" 48 | n = if y then "5" else "6" 49 | in fetch (c ++ n) 50 | 51 | data Key = A Int | B Int | C Int Int deriving (Eq, Show) 52 | 53 | editDistance :: Script Key Int 54 | editDistance (C i 0) = Just $ Task $ const $ pure i 55 | editDistance (C 0 j) = Just $ Task $ const $ pure j 56 | editDistance (C i j) = Just $ Task $ \fetch -> 57 | ((==) <$> fetch (A i) <*> fetch (B j)) `bindS` \equals -> 58 | if equals 59 | then fetch (C (i - 1) (j - 1)) 60 | else (\insert delete replace -> 1 + minimum [insert, delete, replace]) 61 | <$> fetch (C i (j - 1)) 62 | <*> fetch (C (i - 1) j ) 63 | <*> fetch (C (i - 1) (j - 1)) 64 | editDistance _ = Nothing 65 | 66 | -- | Example from the paper: a mock for the @tar@ archiving utility. 67 | tar :: Applicative f => [f String] -> f String 68 | tar xs = concat <$> sequenceA xs 69 | 70 | -- | Example from the paper: a mock for the configuration parser. 71 | parse :: Functor f => f String -> f Bool 72 | parse = fmap null 73 | 74 | -- | Example from the paper: a mock for the OCaml compiler parser. 75 | compile :: Applicative f => [f String] -> f String 76 | compile xs = concat <$> sequenceA xs 77 | 78 | -- | Example from the paper. 79 | script :: Script FilePath String 80 | script "release.tar" = Just $ Task $ \fetch -> tar [fetch "LICENSE", fetch "exe"] 81 | script "exe" = Just $ Task $ \fetch -> 82 | let src = fetch "src.ml" 83 | cfg = fetch "config" 84 | libc = fetch "lib.c" 85 | libml = fetch "lib.ml" 86 | in compile [src, ifS (parse cfg) libc libml] 87 | script _ = Nothing 88 | 89 | --------------------------------- Free example --------------------------------- 90 | 91 | -- | Base functor for a free build system. 92 | data Fetch k v a = Fetch k (v -> a) deriving Functor 93 | 94 | instance Eq k => Eq (Fetch k v ()) where 95 | Fetch x _ == Fetch y _ = x == y 96 | 97 | instance Show k => Show (Fetch k v a) where 98 | show (Fetch k _) = "Fetch " ++ show k 99 | 100 | -- | A convenient alias. 101 | fetch :: k -> Select (Fetch k v) v 102 | fetch key = liftSelect $ Fetch key id 103 | 104 | -- | Analyse a build task via free selective functors. 105 | -- 106 | -- @ 107 | -- runBuild (fromJust $ cyclic "B1") == [ Fetch "C1" (const ()) 108 | -- , Fetch "B2" (const ()) 109 | -- , Fetch "A2" (const ()) ] 110 | -- @ 111 | runBuild :: Task k v -> [Fetch k v ()] 112 | runBuild task = getEffects (run task fetch) 113 | -------------------------------------------------------------------------------- /examples/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds, GADTs, LambdaCase, RankNTypes #-} 2 | module Parser where 3 | 4 | import Control.Applicative 5 | import Control.Monad 6 | import Control.Selective 7 | 8 | -- See Section 7.2 of the paper: https://dl.acm.org/doi/10.1145/3341694. 9 | 10 | newtype Parser a = Parser { parse :: String -> [(a, String)] } 11 | 12 | instance Functor Parser where 13 | fmap f p = Parser $ \x -> [ (f a, s) | (a, s) <- parse p x ] 14 | 15 | instance Applicative Parser where 16 | pure a = Parser $ \s -> [(a, s)] 17 | (<*>) = ap 18 | 19 | instance Alternative Parser where 20 | empty = Parser (const []) 21 | p <|> q = Parser $ \s -> parse p s ++ parse q s 22 | 23 | instance Selective Parser where 24 | select = selectM 25 | 26 | instance Monad Parser where 27 | return = pure 28 | p >>= f = Parser $ \x -> concat [ parse (f a) y | (a, y) <- parse p x ] 29 | 30 | class MonadZero f where 31 | zero :: f a 32 | 33 | instance MonadZero Parser where 34 | zero = Parser (const []) 35 | 36 | item :: Parser Char 37 | item = Parser $ \case 38 | "" -> [] 39 | (c:cs) -> [(c,cs)] 40 | 41 | sat :: (Char -> Bool) -> Parser Char 42 | sat p = do { c <- item; if p c then pure c else zero } 43 | 44 | char :: Char -> Parser Char 45 | char c = sat (==c) 46 | 47 | string :: String -> Parser String 48 | string [] = pure "" 49 | string (c:cs) = do 50 | _ <- char c 51 | _ <- string cs 52 | pure (c:cs) 53 | 54 | bin :: Parser Int 55 | bin = undefined 56 | 57 | hex :: Parser Int 58 | hex = undefined 59 | 60 | numberA :: Parser Int 61 | numberA = (string "0b" *> bin) <|> (string "0x" *> hex) 62 | 63 | numberS :: Parser Int 64 | numberS = string "0" *> ifS (('b'==) <$> sat (`elem` "bx")) bin hex 65 | -------------------------------------------------------------------------------- /examples/Processor.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds, DeriveFunctor, GADTs, LambdaCase #-} 2 | {-# LANGUAGE FunctionalDependencies, FlexibleContexts, FlexibleInstances #-} 3 | 4 | module Processor where 5 | 6 | import Control.Selective 7 | import Control.Selective.Rigid.Free 8 | import Data.Bool 9 | import Data.Functor 10 | import Data.Int (Int16) 11 | import Data.Map.Strict (Map) 12 | import Data.Word (Word8) 13 | import Foreign.Marshal.Utils (fromBool) 14 | import Prelude hiding (read, log) 15 | 16 | import qualified Control.Monad.Trans.State as S 17 | import qualified Data.Map.Strict as Map 18 | 19 | -- See Section 5.3 of the paper: https://dl.acm.org/doi/10.1145/3341694. 20 | -- Note that we have changed the naming. 21 | 22 | -- | A standard @MonadState@ class extended with the 'Selective' interface. 23 | class (Selective m, Monad m) => MonadState s m | m -> s where 24 | get :: m s 25 | put :: s -> m () 26 | state :: (s -> (a, s)) -> m a 27 | 28 | instance Monad m => MonadState s (S.StateT s m) where 29 | get = S.get 30 | put = S.put 31 | state = S.state 32 | 33 | gets :: MonadState s m => (s -> a) -> m a 34 | gets f = f <$> get 35 | 36 | modify :: MonadState s m => (s -> s) -> m () 37 | modify f = state (\s -> ((), f s)) 38 | 39 | -------------------------------------------------------------------------------- 40 | -------- Types ----------------------------------------------------------------- 41 | -------------------------------------------------------------------------------- 42 | 43 | -- | All values are signed 16-bit words. 44 | type Value = Int16 45 | 46 | -- | The processor has four registers. 47 | data Register = R0 | R1 | R2 | R3 deriving (Show, Eq, Ord) 48 | 49 | -- | The register bank maps registers to values. 50 | type RegisterBank = Map Register Value 51 | 52 | -- | The address space is indexed by one byte. 53 | type Address = Word8 54 | 55 | -- | The memory maps addresses to signed 16-bit words. 56 | type Memory = Map.Map Address Value 57 | 58 | -- | The processor has two status flags. 59 | data Flag = Zero -- ^ tracks if the result of the last arithmetical operation was zero 60 | | Overflow -- ^ tracks integer overflow 61 | deriving (Show, Eq, Ord) 62 | 63 | -- | A flag assignment. 64 | type Flags = Map Flag Value 65 | 66 | -- | Address in the program memory. 67 | type InstructionAddress = Value 68 | 69 | -- | A program execution log entry, recording either a read from a key and the 70 | -- obtained value, or a write to a key, along with the written value. 71 | data LogEntry k v where 72 | ReadEntry :: k -> v -> LogEntry k v 73 | WriteEntry :: k -> v -> LogEntry k v 74 | 75 | -- | A log is a sequence of log entries, in the execution order. 76 | type Log k v = [LogEntry k v] 77 | 78 | -- | The complete processor state. 79 | data State = State { registers :: RegisterBank 80 | , memory :: Memory 81 | , pc :: InstructionAddress 82 | , flags :: Flags 83 | , log :: Log Key Value} 84 | 85 | -- | Various elements of the processor state. 86 | data Key = Reg Register | Cell Address | Flag Flag | PC deriving Eq 87 | 88 | instance Show Key where 89 | show (Reg r) = show r 90 | show (Cell a) = show a 91 | show (Flag f) = show f 92 | show PC = "PC" 93 | 94 | -- | The base functor for mutable processor state. 95 | data RW a = Read Key (Value -> a) 96 | | Write Key (Program Value) (Value -> a) 97 | deriving Functor 98 | 99 | -- | A program is a free selective on top of the 'RW' base functor. 100 | type Program a = Select RW a 101 | 102 | instance Show (RW a) where 103 | show (Read k _) = "Read " ++ show k 104 | show (Write k (Pure v) _) = "Write " ++ show k ++ " " ++ show v 105 | show (Write k _ _) = "Write " ++ show k 106 | 107 | logEntry :: MonadState State m => LogEntry Key Value -> m () 108 | logEntry item = modify $ \s -> s { log = log s ++ [item] } 109 | 110 | -- | Interpret the base functor in a 'MonadState'. 111 | toState :: MonadState State m => RW a -> m a 112 | toState = \case 113 | (Read k t) -> do 114 | v <- case k of Reg r -> gets ((Map.! r) . registers) 115 | Cell addr -> gets ((Map.! addr) . memory) 116 | Flag f -> gets ((Map.! f) . flags) 117 | PC -> gets pc 118 | logEntry (ReadEntry k v) 119 | pure (t v) 120 | (Write k p t) -> do 121 | v <- runSelect toState p 122 | logEntry (WriteEntry k v) 123 | case k of 124 | Reg r -> let regs' s = Map.insert r v (registers s) 125 | in state (\s -> (t v, s {registers = regs' s})) 126 | Cell addr -> let mem' s = Map.insert addr v (memory s) 127 | in state (\s -> (t v, s {memory = mem' s})) 128 | Flag f -> let flags' s = Map.insert f v (flags s) 129 | in state (\s -> (t v, s {flags = flags' s})) 130 | PC -> state (\s -> (t v, s {pc = v})) 131 | 132 | -- | Interpret a program as a state transformer. 133 | runProgramState :: Program a -> State -> (a, State) 134 | runProgramState f = S.runState (runSelect toState f) 135 | 136 | -- | Interpret the base functor in the selective functor 'Over'. 137 | toOver :: RW a -> Over [RW ()] a 138 | toOver (Read k _ ) = Over [Read k (const ())] 139 | toOver (Write k fv _) = runSelect toOver fv *> Over [Write k fv (const ())] 140 | 141 | -- | Get all possible program effects. 142 | getProgramEffects :: Program a -> [RW ()] 143 | getProgramEffects = getOver . runSelect toOver 144 | 145 | -- | A convenient alias for reading an element of the processor state. 146 | read :: Key -> Program Value 147 | read k = liftSelect (Read k id) 148 | 149 | -- | A convenient alias for writing into an element of the processor state. 150 | write :: Key -> Program Value -> Program Value 151 | write k fv = liftSelect (Write k fv id) 152 | 153 | -------------------------------------------------------------------------------- 154 | -------- Instructions ---------------------------------------------------------- 155 | -------------------------------------------------------------------------------- 156 | 157 | -- | The addition instruction, which reads the summands from a 'Register' and a 158 | -- memory 'Address', adds them, writes the result back into the same register, 159 | -- and also updates the state of the 'Zero' flag to indicate whether the 160 | -- resulting 'Value' is zero. 161 | add :: Register -> Address -> Program Value 162 | add reg addr = let arg1 = read (Reg reg) 163 | arg2 = read (Cell addr) 164 | result = (+) <$> arg1 <*> arg2 165 | isZero = (==0) <$> write (Reg reg) result 166 | in write (Flag Zero) (bool 0 1 <$> isZero) 167 | 168 | -- | A conditional branching instruction that performs a jump if the result of 169 | -- the previous operation was zero. 170 | jumpZero :: Value -> Program () 171 | jumpZero offset = let zeroSet = (==1) <$> read (Flag Zero) 172 | modifyPC = void $ write PC ((+offset) <$> read PC) 173 | in whenS zeroSet modifyPC 174 | 175 | -- | A simple block of instructions. 176 | addAndJump :: Program () 177 | addAndJump = add R0 1 *> jumpZero 42 178 | 179 | ----------------------------------- 180 | -- Add with overflow tracking ----- 181 | ----------------------------------- 182 | 183 | {- The following example demonstrates how important it is to be aware of your 184 | effects. 185 | 186 | Problem: implement the semantics of the @add@ instruction which calculates 187 | the sum of two values and writes it to the specified destination, updates 188 | the 'Zero' flag if the result is zero, and also detects if integer overflow 189 | has occurred, updating the 'Overflow' flag accordingly. 190 | 191 | We'll take a look at two approaches that implement this semantics and see 192 | the crucial deference between them. 193 | -} 194 | 195 | -- | Add two values and detect integer overflow. 196 | -- 197 | -- The interesting bit here is the call to the 'willOverflowPure' function. 198 | -- Since the function is pure, the call @willOverflowPure <$> arg1 <*> arg2@ 199 | -- triggers only one 'read' of @arg1@ and @arg2@, even though we use the 200 | -- variables many times in the 'willOverflowPure' implementation. Thus, 201 | -- 'willOverflowPure' might be thought as an atomic processor microcommand. 202 | addOverflow :: Key -> Key -> Key -> Program Value 203 | addOverflow x y z = 204 | let arg1 = read x 205 | arg2 = read y 206 | result = (+) <$> arg1 <*> arg2 207 | isZero = (==0) <$> write z result 208 | overflow = willOverflowPure <$> arg1 <*> arg2 209 | in write (Flag Zero) (fromBool <$> isZero) *> 210 | write (Flag Overflow) (fromBool <$> overflow) 211 | 212 | -- | A pure check for integer overflow during addition. 213 | willOverflowPure :: Value -> Value -> Bool 214 | willOverflowPure x y = 215 | let o1 = (>) y 0 216 | o2 = (>) x((-) maxBound y) 217 | o3 = (<) y 0 218 | o4 = (<) x((-) minBound y) 219 | in (||) ((&&) o1 o2) 220 | ((&&) o3 o4) 221 | 222 | -- | Add two values and detect integer overflow. 223 | -- 224 | -- In this implementations we take a different approach and, when implementing 225 | -- overflow detection, lift all the pure operations into 'Applicative'. This 226 | -- forces the semantics to read the input variables more times than 227 | -- 'addOverflow' does (@x@ is read 3x times, and @y@ is read 5x times). 228 | addOverflowNaive :: Key -> Key -> Key -> Program Value 229 | addOverflowNaive x y z = 230 | let arg1 = read x 231 | arg2 = read y 232 | result = (+) <$> arg1 <*> arg2 233 | isZero = (==0) <$> write z result 234 | overflow = willOverflow arg1 arg2 235 | in write (Flag Zero) (fromBool <$> isZero) *> 236 | write (Flag Overflow) (fromBool <$> overflow) 237 | 238 | -- | An 'Applicative' check for integer overflow during addition. 239 | willOverflow :: Program Value -> Program Value -> Program Bool 240 | willOverflow arg1 arg2 = 241 | let o1 = (>) <$> arg2 <*> pure 0 242 | o2 = (>) <$> arg1 <*> ((-) maxBound <$> arg2) 243 | o3 = (<) <$> arg2 <*> pure 0 244 | o4 = (<) <$> arg1 <*> ((-) minBound <$> arg2) 245 | in (||) <$> ((&&) <$> o1 <*> o2) 246 | <*> ((&&) <$> o3 <*> o4) 247 | 248 | ----------------------------------- 249 | -- Example simulations ------------ 250 | ----------------------------------- 251 | 252 | renderState :: State -> String 253 | renderState state = 254 | "Registers: " ++ show (registers state) ++ "\n" ++ 255 | "Flags: " ++ show (Map.toList $ flags state) ++ "\n" ++ 256 | "Log: " ++ show (log state) 257 | 258 | instance Show State where 259 | show = renderState 260 | 261 | emptyRegisters :: RegisterBank 262 | emptyRegisters = Map.fromList [(R0, 0), (R1, 0), (R2, 0), (R3, 0)] 263 | 264 | emptyFlags :: Flags 265 | emptyFlags = Map.fromList $ zip [Zero, Overflow] [0, 0..] 266 | 267 | initialiseMemory :: [(Address, Value)] -> Memory 268 | initialiseMemory m = 269 | let blankMemory = Map.fromList $ zip [0..maxBound] [0, 0..] 270 | in foldr (\(addr, value) acc -> Map.adjust (const value) addr acc) blankMemory m 271 | 272 | boot :: Memory -> State 273 | boot mem = State { registers = emptyRegisters 274 | , pc = 0 275 | , flags = emptyFlags 276 | , memory = mem 277 | , log = [] } 278 | 279 | twoAdds :: Program Value 280 | twoAdds = add R0 0 *> add R0 0 281 | 282 | addExample :: IO () 283 | addExample = do 284 | let initState = boot (initialiseMemory [(0, 2)]) 285 | print . snd $ runProgramState twoAdds initState 286 | 287 | ---------------------------- Some boilerplate code ----------------------------- 288 | 289 | instance (Show k, Show v) => Show (LogEntry k v) where 290 | show (ReadEntry k v) = "Read (" ++ show k ++ ", " ++ show v ++ ")" 291 | show (WriteEntry k v) = "Write (" ++ show k ++ ", " ++ show v ++ ")" 292 | -------------------------------------------------------------------------------- /examples/Query.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | module Query where 3 | 4 | import Control.Selective 5 | import Data.List (isInfixOf, stripPrefix) 6 | 7 | type Prompt = String 8 | 9 | data Query a where 10 | Terminal :: Prompt -> Query String 11 | File :: FilePath -> Query String 12 | Pure :: a -> Query a 13 | Apply :: Query (a -> b) -> Query a -> Query b 14 | Select :: Query (Either a b) -> Query (a -> b) -> Query b 15 | 16 | instance Functor Query where 17 | fmap f = Apply (Pure f) 18 | 19 | instance Applicative Query where 20 | pure = Pure 21 | (<*>) = Apply 22 | 23 | instance Selective Query where 24 | select = Select 25 | 26 | pureQuery :: Query String 27 | pureQuery = (++) <$> Pure "Hello " <*> Pure "World!" 28 | 29 | replace :: String -> String -> String -> String 30 | replace [] _ xs = xs 31 | replace from to xs | Just xs <- stripPrefix from xs = to ++ replace from to xs 32 | replace from to (x:xs) = x : replace from to xs 33 | replace _ _ [] = [] 34 | 35 | welcomeQuery :: Query String 36 | welcomeQuery = replace "[NAME]" <$> Terminal "Name" <*> File "welcome.txt" 37 | 38 | welcomeBackQuery :: Query String 39 | welcomeBackQuery = (++) <$> welcomeQuery <*> pure "It's great to have you back!\n" 40 | 41 | welcomeQuery2 :: Query String 42 | welcomeQuery2 = 43 | ifS (isInfixOf <$> Terminal "Name" <*> File "past-participants.txt") 44 | welcomeBackQuery 45 | welcomeQuery 46 | 47 | getPure :: Query a -> Maybe a 48 | getPure (Terminal _) = Nothing 49 | getPure (File _) = Nothing 50 | getPure (Pure a) = Just a 51 | getPure (Apply f x) = do 52 | pf <- getPure f 53 | px <- getPure x 54 | pure (pf px) 55 | getPure (Select x y) = do 56 | px <- getPure x 57 | py <- getPure y 58 | pure (either py id px) 59 | 60 | getEffects :: Query a -> ([Prompt], [FilePath]) 61 | getEffects (Terminal p) = ([p], [] ) 62 | getEffects (File f) = ([] , [f]) 63 | getEffects (Pure _) = ([] , [] ) 64 | getEffects (Apply f x) = (p1 ++ p2, f1 ++ f2) 65 | where 66 | (p1, f1) = getEffects f 67 | (p2, f2) = getEffects x 68 | getEffects (Select x y) = (px ++ py, fx ++ fy) 69 | where 70 | (px, fx) = getEffects x 71 | (py, fy) = getEffects y 72 | -------------------------------------------------------------------------------- /examples/Teletype.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, FlexibleInstances, GADTs #-} 2 | module Teletype where 3 | 4 | import Prelude hiding (getLine, putStrLn) 5 | import qualified Prelude as IO 6 | import qualified Control.Monad as IO 7 | import Control.Selective 8 | import Control.Selective.Free 9 | 10 | -- See Section 5.2 of the paper: https://dl.acm.org/doi/10.1145/3341694. 11 | 12 | -- | The classic @Teletype@ base functor. 13 | data TeletypeF a = Read (String -> a) | Write String a deriving Functor 14 | 15 | instance Eq (TeletypeF ()) where 16 | Read _ == Read _ = True 17 | Write x () == Write y () = x == y 18 | _ == _ = False 19 | 20 | instance Show (TeletypeF a) where 21 | show (Read _) = "Read" 22 | show (Write s _) = "Write " ++ show s 23 | 24 | -- | Interpret 'TeletypeF' commands as 'IO' actions. 25 | toIO :: TeletypeF a -> IO a 26 | toIO (Read f) = f <$> IO.getLine 27 | toIO (Write s a) = a <$ IO.putStrLn s 28 | 29 | -- | A Teletype program is a free selective functor on top of the base functor 30 | -- 'TeletypeF'. 31 | type Teletype a = Select TeletypeF a 32 | 33 | -- | A convenient alias for reading a string. 34 | getLine :: Teletype String 35 | getLine = liftSelect (Read id) 36 | 37 | -- | A convenient alias for writing a string. 38 | putStrLn :: String -> Teletype () 39 | putStrLn s = liftSelect (Write s ()) 40 | 41 | -- | The ping-pong example from the introduction section of the paper 42 | -- implemented using free selective functors. 43 | -- 44 | -- It can be statically analysed for effects: 45 | -- 46 | -- @ 47 | -- > getEffects pingPongS 48 | -- [Read,Write "pong"] 49 | -- @ 50 | -- 51 | -- @ 52 | -- > getNecessaryEffects pingPongS 53 | -- [Read] 54 | -- @ 55 | -- 56 | -- If can also be executed in IO: 57 | -- 58 | -- @ 59 | -- > runSelect toIO pingPongS 60 | -- hello 61 | -- > runSelect toIO pingPongS 62 | -- ping 63 | -- pong 64 | -- @ 65 | pingPongS :: Teletype () 66 | pingPongS = whenS (fmap ("ping"==) getLine) (putStrLn "pong") 67 | 68 | ------------------------------- Ping-pong example ------------------------------ 69 | -- | Monadic ping-pong, which has the desired behaviour, but cannot be 70 | -- statically analysed. 71 | pingPongM :: IO () 72 | pingPongM = IO.getLine >>= \s -> IO.when (s == "ping") (IO.putStrLn "pong") 73 | 74 | -- | Applicative ping-pong, which always executes both effect, but can be 75 | -- statically analysed. 76 | pingPongA :: IO () 77 | pingPongA = IO.getLine *> IO.putStrLn "pong" 78 | 79 | -- | A monadic greeting. Cannot be implemented using selective functors. 80 | greeting :: IO () 81 | greeting = IO.getLine >>= \name -> IO.putStrLn ("Hello, " ++ name) 82 | -------------------------------------------------------------------------------- /examples/Teletype/Rigid.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, FlexibleInstances, GADTs #-} 2 | module Teletype.Rigid where 3 | 4 | import Prelude hiding (getLine, putStrLn) 5 | import qualified Prelude as IO 6 | import qualified Control.Monad as IO 7 | import Control.Selective 8 | import Control.Selective.Rigid.Free 9 | 10 | -- See Section 5.2 of the paper: https://dl.acm.org/doi/10.1145/3341694. 11 | 12 | -- | The classic @Teletype@ base functor. 13 | data TeletypeF a = Read (String -> a) | Write String a deriving Functor 14 | 15 | instance Eq (TeletypeF ()) where 16 | Read _ == Read _ = True 17 | Write x () == Write y () = x == y 18 | _ == _ = False 19 | 20 | instance Show (TeletypeF a) where 21 | show (Read _) = "Read" 22 | show (Write s _) = "Write " ++ show s 23 | 24 | -- | Interpret 'TeletypeF' commands as 'IO' actions. 25 | toIO :: TeletypeF a -> IO a 26 | toIO (Read f) = f <$> IO.getLine 27 | toIO (Write s a) = a <$ IO.putStrLn s 28 | 29 | -- | A Teletype program is a free selective functor on top of the base functor 30 | -- 'TeletypeF'. 31 | type Teletype a = Select TeletypeF a 32 | 33 | -- | A convenient alias for reading a string. 34 | getLine :: Teletype String 35 | getLine = liftSelect (Read id) 36 | 37 | -- | A convenient alias for writing a string. 38 | putStrLn :: String -> Teletype () 39 | putStrLn s = liftSelect (Write s ()) 40 | 41 | -- | The ping-pong example from the introduction section of the paper 42 | -- implemented using free selective functors. 43 | -- 44 | -- @ 45 | -- > getEffects pingPongS 46 | -- [Read,Write "pong"] 47 | -- @ 48 | -- 49 | -- If can also be executed in IO: 50 | -- 51 | -- @ 52 | -- > runSelect toIO pingPongS 53 | -- hello 54 | -- > runSelect toIO pingPongS 55 | -- ping 56 | -- pong 57 | -- @ 58 | pingPongS :: Teletype () 59 | pingPongS = whenS (fmap ("ping"==) getLine) (putStrLn "pong") 60 | 61 | ------------------------------- Ping-pong example ------------------------------ 62 | -- | Monadic ping-pong, which has the desired behaviour, but cannot be 63 | -- statically analysed. 64 | pingPongM :: IO () 65 | pingPongM = IO.getLine >>= \s -> IO.when (s == "ping") (IO.putStrLn "pong") 66 | 67 | -- | Applicative ping-pong, which always executes both effect, but can be 68 | -- statically analysed. 69 | pingPongA :: IO () 70 | pingPongA = IO.getLine *> IO.putStrLn "pong" 71 | 72 | -- | A monadic greeting. Cannot be implemented using selective functors. 73 | greeting :: IO () 74 | greeting = IO.getLine >>= \name -> IO.putStrLn ("Hello, " ++ name) 75 | -------------------------------------------------------------------------------- /examples/Validation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ConstraintKinds, GADTs, RankNTypes #-} 2 | module Validation where 3 | 4 | import Control.Selective 5 | 6 | -- See Section 2.2 of the paper: https://dl.acm.org/doi/10.1145/3341694. 7 | 8 | type Radius = Word 9 | type Width = Word 10 | type Height = Word 11 | 12 | -- | A circle or rectangle. 13 | data Shape = Circle Radius | Rectangle Width Height deriving (Eq, Show) 14 | 15 | -- Some validation examples: 16 | -- 17 | -- > shape (Success True) (Success 1) (Failure ["width?"]) (Failure ["height?"]) 18 | -- > Success (Circle 1) 19 | -- 20 | -- > shape (Success False) (Failure ["radius?"]) (Success 2) (Success 3) 21 | -- > Success (Rectangle 2 3) 22 | -- 23 | -- > shape (Success False) (Failure ["radius?"]) (Success 2) (Failure ["height?"]) 24 | -- > Failure ["height?"] 25 | -- 26 | -- > shape (Success False) (Success 1) (Failure ["width?"]) (Failure ["height?"]) 27 | -- > Failure ["width?", "height?"] 28 | -- 29 | -- > shape (Failure ["choice?"]) (Failure ["radius?"]) (Success 2) (Failure ["height?"]) 30 | -- > Failure ["choice?"] 31 | shape :: Selective f => f Bool -> f Radius -> f Width -> f Height -> f Shape 32 | shape s r w h = ifS s (Circle <$> r) (Rectangle <$> w <*> h) 33 | 34 | -- > s1 = shape (Failure ["choice 1?"]) (Success 1) (Failure ["width 1?"]) (Success 3) 35 | -- > s2 = shape (Success False) (Success 1) (Success 2) (Failure ["height 2?"]) 36 | -- > twoShapes s1 s2 37 | -- > Failure ["choice 1?","height 2?"] 38 | twoShapes :: Selective f => f Shape -> f Shape -> f (Shape, Shape) 39 | twoShapes s1 s2 = (,) <$> s1 <*> s2 40 | -------------------------------------------------------------------------------- /paper/.gitignore: -------------------------------------------------------------------------------- 1 | ## Core latex/pdflatex auxiliary files: 2 | *.aux 3 | *.lof 4 | *.log 5 | *.lot 6 | *.fls 7 | *.out 8 | *.toc 9 | *.fmt 10 | *.fot 11 | *.cb 12 | *.cb2 13 | 14 | ## Intermediate documents: 15 | *.dvi 16 | *-converted-to.* 17 | # these rules might exclude image files for figures etc. 18 | # *.ps 19 | # *.eps 20 | main.pdf 21 | selective-functors.pdf 22 | comment.cut 23 | 24 | ## Bibliography auxiliary files (bibtex/biblatex/biber): 25 | *.bbl 26 | *.bcf 27 | *.blg 28 | *-blx.aux 29 | *-blx.bib 30 | *.brf 31 | *.run.xml 32 | 33 | ## Build tool auxiliary files: 34 | *.fdb_latexmk 35 | *.synctex 36 | *.synctex.gz 37 | *.synctex.gz(busy) 38 | *.pdfsync 39 | 40 | ## Auxiliary and intermediate files from other packages: 41 | # algorithms 42 | *.alg 43 | *.loa 44 | 45 | # achemso 46 | acs-*.bib 47 | 48 | # amsthm 49 | *.thm 50 | 51 | # beamer 52 | *.nav 53 | *.snm 54 | *.vrb 55 | 56 | # cprotect 57 | *.cpt 58 | 59 | # fixme 60 | *.lox 61 | 62 | #(r)(e)ledmac/(r)(e)ledpar 63 | *.end 64 | *.?end 65 | *.[1-9] 66 | *.[1-9][0-9] 67 | *.[1-9][0-9][0-9] 68 | *.[1-9]R 69 | *.[1-9][0-9]R 70 | *.[1-9][0-9][0-9]R 71 | *.eledsec[1-9] 72 | *.eledsec[1-9]R 73 | *.eledsec[1-9][0-9] 74 | *.eledsec[1-9][0-9]R 75 | *.eledsec[1-9][0-9][0-9] 76 | *.eledsec[1-9][0-9][0-9]R 77 | 78 | # glossaries 79 | *.acn 80 | *.acr 81 | *.glg 82 | *.glo 83 | *.gls 84 | *.glsdefs 85 | 86 | # gnuplottex 87 | *-gnuplottex-* 88 | 89 | # hyperref 90 | *.brf 91 | 92 | # knitr 93 | *-concordance.tex 94 | # TODO Comment the next line if you want to keep your tikz graphics files 95 | *.tikz 96 | *-tikzDictionary 97 | 98 | # listings 99 | *.lol 100 | 101 | # makeidx 102 | *.idx 103 | *.ilg 104 | *.ind 105 | *.ist 106 | 107 | # minitoc 108 | *.maf 109 | *.mlf 110 | *.mlt 111 | *.mtc 112 | *.mtc[0-9] 113 | *.mtc[1-9][0-9] 114 | 115 | # minted 116 | _minted* 117 | *.pyg 118 | 119 | # morewrites 120 | *.mw 121 | 122 | # mylatexformat 123 | *.fmt 124 | 125 | # nomencl 126 | *.nlo 127 | 128 | # sagetex 129 | *.sagetex.sage 130 | *.sagetex.py 131 | *.sagetex.scmd 132 | 133 | # sympy 134 | *.sout 135 | *.sympy 136 | sympy-plots-for-*.tex/ 137 | 138 | # pdfcomment 139 | *.upa 140 | *.upb 141 | 142 | # pythontex 143 | *.pytxcode 144 | pythontex-files-*/ 145 | 146 | # thmtools 147 | *.loe 148 | 149 | # TikZ & PGF 150 | *.dpth 151 | *.md5 152 | *.auxlock 153 | 154 | # todonotes 155 | *.tdo 156 | 157 | # xindy 158 | *.xdy 159 | 160 | # xypic precompiled matrices 161 | *.xyc 162 | 163 | # endfloat 164 | *.ttt 165 | *.fff 166 | 167 | # Latexian 168 | TSWLatexianTemp* 169 | 170 | ## Editors: 171 | # WinEdt 172 | *.bak 173 | *.sav 174 | 175 | # Texpad 176 | .texpadtmp 177 | 178 | # Kile 179 | *.backup 180 | 181 | # KBibTeX 182 | *~[0-9]* 183 | -------------------------------------------------------------------------------- /paper/1-intro.tex: -------------------------------------------------------------------------------- 1 | \vspace{-0.5mm} 2 | \section{Introduction}\label{sec-intro} 3 | 4 | \emph{Monads}, introduced to functional programming 5 | by~\citet{1995_wadler_monads}, are a powerful and general approach for 6 | describing effectful (or impure) computations using pure functions. The key 7 | ingredient of the monad abstraction is the \emph{bind} operator, denoted by 8 | \hs{>>=} in Haskell\footnote{We use Haskell throughout this paper, but the 9 | presented ideas are not language specific. We release two libraries for 10 | selective applicative functors along with this paper, written in Haskell 11 | (\cmd{https://hackage.haskell.org/package/selective}) 12 | and~OCaml~(\cmd{https://opam.ocaml.org/packages/selective}). The ideas have also 13 | been translated to Coq~\citep{selective2019coq}, 14 | Kotlin~\citep{selective2019kotlin}, PureScript~\citep{selective2018purescript}, 15 | Scala~\citep{selective2019scala} and Swift~\citep{selective2019swift}.}: 16 | 17 | \vspace{1mm} 18 | \begin{minted}[xleftmargin=10pt]{haskell} 19 | (>>=) :: Monad f => f a -> (a -> f b) -> f b 20 | \end{minted} 21 | \vspace{1mm} 22 | 23 | \noindent 24 | The operator takes two arguments: an effectful computation \hs{f}~\hs{a}, which 25 | yields a value of type~\hs{a} when executed, and a recipe, i.e. a pure function 26 | of type \hs{a}~\hs{->}~\hs{f}~\hs{b}, for turning~\hs{a} into a subsequent 27 | computation of type \hs{f}~\hs{b}. This approach to composing effectful 28 | computations is inherently sequential: until we execute the effects in 29 | \hs{f}~\hs{a}, there is no way of obtaining the computation \hs{f}~\hs{b}, i.e. 30 | these computations must be performed in sequence. The ability to enforce 31 | a \emph{sequential execution} order is crucial for non-commutative effects, such 32 | as printing to the terminal. Furthermore, the dependence between subsequent 33 | effects can be used for \emph{conditional effect execution}, as demonstrated 34 | below. 35 | 36 | Consider a simple example, where we use the monad \hs{f}~\hs{=}~\hs{IO} to 37 | describe an effectful program that prints \hs{"pong"} to the terminal if the 38 | user enters \hs{"ping"}: 39 | 40 | \vspace{1mm} 41 | \begin{minted}[xleftmargin=10pt]{haskell} 42 | pingPongM :: IO () 43 | pingPongM = getLine >>= \s -> if s@\,@==@\,@"ping" then putStrLn "pong" else pure () 44 | \end{minted} 45 | \vspace{1mm} 46 | 47 | \noindent 48 | The first argument of the bind operator reads a string using 49 | \hs{getLine}~\hs{::}~\hs{IO}~\hs{String}, and the second argument is the 50 | function of type \hs{String}~\hs{->}~\hs{IO}~\hs{()}, which prints \hs{"pong"} 51 | when~\hs{s}~\hs{==}~\hs{"ping"}. 52 | 53 | As we will see in sections~\S\ref{sec-static} and~\S\ref{sec-haxl}, in some 54 | applications it is desirable to know all possible effects \emph{statically}, 55 | i.e. \emph{before the execution}. Alas, this is not possible with monadic effect 56 | composition. To \emph{inspect} the function \hs{\s}~\hs{->}~\hs{...}, we need 57 | a string~\hs{s}, which becomes available only \emph{during execution}. We are 58 | therefore unable to predict the effects that \hs{pingPongM} might perform: 59 | instead of conditionally executing \hs{putStrLn}, as intended, it might delete a 60 | file from disk, or launch proverbial missiles. 61 | 62 | \emph{Applicative functors}, introduced by~\citet{mcbride2008applicative}, can 63 | be used for composing statically known collections of effectful computations, as 64 | long as these computations are \emph{independent} from each other. The key 65 | ingredient of applicative functors is the \emph{apply} operator, denoted 66 | by~\hs{<*>}: 67 | 68 | \vspace{1mm} 69 | \begin{minted}[xleftmargin=10pt]{haskell} 70 | (<*>) :: Applicative f => f (a -> b) -> f a -> f b 71 | \end{minted} 72 | \vspace{1mm} 73 | 74 | \noindent 75 | The operator takes two effectful computations, which --- independently --- 76 | compute values of types \hs{a}~\hs{->}~\hs{b} and \hs{a}, and returns their 77 | composition that performs both computations, and then applies the obtained 78 | function to the obtained value producing the result of type \hs{b}. Crucially, 79 | both arguments and associated effects are known statically, which, for example, 80 | allows us to pre-allocate all necessary computation resources upfront 81 | (\S\ref{sec-static}) and execute all computations in parallel 82 | (\S\ref{sec-haxl}). 83 | 84 | Our ping-pong example cannot be expressed using applicative functors. Since the 85 | two computations must be independent, the best we can do is to print \hs{"pong"} 86 | unconditionally: 87 | 88 | \vspace{0.5mm} 89 | \begin{minted}[xleftmargin=10pt]{haskell} 90 | pingPongA :: IO () 91 | pingPongA = fmap (\s -> id) getLine <*> putStrLn "pong" 92 | \end{minted} 93 | \vspace{0.5mm} 94 | 95 | \noindent 96 | Here we use \hs{fmap}~\hs{(\s}~\hs{->}~\hs{id)} to replace the input string 97 | \hs{s}, which we now have no need for, with the identity function 98 | \hs{id}~\hs{::}~\hs{()}~\hs{->}~\hs{()}, thus matching the type of 99 | \hs{putStrLn}~\hs{"pong"}~\hs{::}~\hs{IO}~\hs{()}. We cannot execute the 100 | \hs{putStrLn}~\hs{"pong"} effect conditionally but, on the positive side, the 101 | effects are no longer hidden behind opaque effect-generating functions, which 102 | makes it possible for the applicative functor \hs{f}~\hs{=}~\hs{IO} to 103 | statically know the two effects embedded in \hs{pingPongA}. 104 | 105 | At this point the reader is hopefully wondering: can we combine the advantages 106 | of applicative functors and monads, i.e. allow for conditional execution of some 107 | effects while retaining the ability to statically know all effects embedded in 108 | a computation? It will hardly be a surprise that the answer is positive, but it 109 | is far from obvious what the right abstraction should be. For example, one might 110 | consider adding a new primitive called \hs{whenS} to \hs{IO}: 111 | 112 | \vspace{1mm} 113 | \begin{minted}[xleftmargin=10pt]{haskell} 114 | whenS :: IO Bool -> IO () -> IO () 115 | \end{minted} 116 | \vspace{1mm} 117 | 118 | \noindent 119 | This primitive executes the first computation, and then uses the obtained 120 | \hs{Bool} to decide whether to execute the second computation or skip it. Let us 121 | rewrite the ping-pong example using \hs{whenS}: 122 | 123 | \vspace{1mm} 124 | \begin{minted}[xleftmargin=10pt]{haskell} 125 | pingPongS :: IO () 126 | pingPongS = whenS (fmap (=="ping") getLine) (putStrLn "pong") 127 | \end{minted} 128 | \vspace{1mm} 129 | 130 | \noindent 131 | We replace the input string~\hs{s} with \hs{True} if it is equal to \hs{"ping"}, 132 | and \hs{False} otherwise, thereby appropriately \emph{selecting} the subsequent 133 | effectful computation. This approach gives us both conditional execution of 134 | \hs{putStrLn}~\hs{"pong"}, and static visibility of both effects 135 | (see~\S\ref{sec-free-ping-pong}). Crucially, \hs{whenS} must be an \hs{IO} 136 | primitive instead of being implemented in terms of the monadic bind (\hs{>>=}), 137 | because the latter would result in wrapping \hs{putStrLn}~\hs{"pong"} into an 138 | opaque function, as in \hs{pingPongM}. 139 | 140 | The main idea of this paper is that \hs{whenS}, as well as many other similar 141 | combinators, can be seen as special cases of a new intermediate abstraction, 142 | called \emph{selective applicative functors}, whose main operator for composing 143 | effectful computations is \emph{select}: 144 | 145 | \vspace{1mm} 146 | \begin{minted}[xleftmargin=10pt]{haskell} 147 | select :: Selective f => f (Either a b) -> f (a -> b) -> f b 148 | \end{minted} 149 | \vspace{1mm} 150 | 151 | \noindent 152 | Intuitively, the first effectful computation is used to select what happens 153 | next: if it yields a \hs{Left}~\hs{a} you \emph{must execute} the second 154 | computation in order to produce a \hs{b} in the end; otherwise, if it yields a 155 | \hs{Right}~\hs{b}, you \emph{may skip} the subsequent effect, because you have 156 | no use for the resulting function. Note the possibility of \emph{speculative 157 | execution}: in some contexts, we can execute both computations in parallel, 158 | cancelling the second computation if/when the first one evaluates to a 159 | \hs{Right}~\hs{b}. 160 | 161 | \vspace{1mm} 162 | The contributions of this paper are as follows: 163 | 164 | % \vspace{-1mm} 165 | \begin{itemize} 166 | \item We introduce \emph{selective applicative functors} as a general 167 | abstraction situated between applicative functors and monads, characterising 168 | the relationships between all three abstractions with a set of laws, and 169 | defining a few important instances (\S\ref{sec-selective}). 170 | \item We discuss applications of the abstraction on two industrial case 171 | studies: the OCaml build system \Dune~\citep{dune} (\S\ref{sec-static}) and 172 | Facebook's \Haxl library~\cite{marlow2014haxl} (\S\ref{sec-haxl}). 173 | \item We present \emph{free selective applicative functors} and show how to 174 | use them to implement embedded domain-specific languages with both 175 | conditional effects and static analysis (\S\ref{sec-free}). 176 | \end{itemize} 177 | 178 | \noindent 179 | We discuss alternatives to selective applicative functors and related work in 180 | sections~\S\ref{sec-alternatives} and \S\ref{sec-related}. 181 | -------------------------------------------------------------------------------- /paper/3-static.tex: -------------------------------------------------------------------------------- 1 | \section{Static Analysis}\label{sec-static} 2 | 3 | In this section we discuss a real-life application that benefits from static 4 | analysis of effectful computations -- the \Dune build system~\citep{dune}. We 5 | start by introducing \Dune and motivating the need for static analysis with 6 | over-approximation~(\S\ref{sec-dune-intro}), and then show how one can implement 7 | static analysis of build system dependencies using selective 8 | functors~(\S\ref{sec-static-example}). 9 | 10 | \subsection{\Dune Build System}\label{sec-dune-intro} 11 | 12 | \Dune was originally developed at Jane Street and has by now become a standard 13 | build system for OCaml packages~\citep{dune}. At the time of writing, more than 14 | 1000 OCaml packages are using \Dune as the build system. The original motivation 15 | for developing \Dune (earlier known as \cmd{jbuilder}) was to make it easier 16 | to open source code developed in an industrial environment, and so \Dune was not 17 | meant to be used for everyday software development. However, \Dune's ability to 18 | extract maximum parallelism from build scripts meant it was faster than existing 19 | build systems, such as \textsc{OCamlbuild}, and it quickly became popular, with 20 | major projects switching to \Dune, for example, the \textsc{Coq} proof 21 | assistant~\citep{bertot2013coq}. 22 | 23 | % TODO: Can we get any performance improvement figures on how much more 24 | % parallelism can be gained through static analysis? 25 | 26 | One unusual feature of \Dune is the ability to statically 27 | over-approximate all build dependencies of a package. This is used at 28 | Jane Street to automatically produce \emph{package manifest files} for 29 | more than 100 packages instead of maintaining them by hand. Package 30 | manifest files are consumed by \emph{package managers}, such as 31 | OPAM~\citep{opam}, which download and install all required dependencies 32 | \emph{before the build starts}. 33 | 34 | % The original aim of this feature was to automatically generate package manifest 35 | % files, so that they do not need to be maintained. An alternative approach would 36 | % be to integrate the build system with the package manager itself, i.e. whenever 37 | % the build system discovers a new external dependency, the package manager would 38 | % download and install it, temporarily suspending the build. 39 | 40 | % The reason Dune could not follow this approach is because package managers are 41 | % typically designed to be build system agnostic. 42 | 43 | % There are also optional package dependencies. Shall we give more details? 44 | 45 | To generate a manifest file automatically \Dune needs to analyse the build graph 46 | statically, i.e. \emph{without actually running any build commands}, because at 47 | this point the project cannot yet be built (due to missing dependencies). 48 | Package dependencies can be conditional and depend on values that can only be 49 | computed during the build, therefore in many situations it is impossible to 50 | statically compute an exact set of dependencies, and hence an over-approximation 51 | is used instead. 52 | 53 | In general, one can view such static dependency analysis as a function from a 54 | build script to a set of package dependencies, and implement it directly by 55 | parsing the script and extracting all possible dependencies from it. \Dune 56 | adopts a different approach: it reuses the existing script execution engine that 57 | executes build commands, but in a mock environment where commands are skipped, 58 | but their dependencies are recorded in all branches of conditional statements. 59 | By doing static analysis at this level, one can reuse a lot of code, e.g. for 60 | parsing and interpreting build scripts. 61 | 62 | In this mock environment, some parts of the code cannot be fully evaluated as 63 | they need the output produced by external commands. However, these parts still 64 | need to be analysed. To achieve this, the original implementation of \Dune uses 65 | the \emph{arrow} abstraction discussed in~\S\ref{sec-arrows}. To evaluate 66 | suitability of selective functors for this task, we have successfully prototyped 67 | an alternative core for \Dune, which uses applicative and selective functors 68 | instead of arrows. 69 | 70 | \subsection{Static Analysis of Build Dependencies}\label{sec-static-example} 71 | 72 | \Dune is written in OCaml, and we therefore developed an OCaml library for 73 | selective functors. In this section, however, we choose to continue using 74 | Haskell to avoid confusion. 75 | 76 | We follow the approach by~\citet{mokhov2018build} for modelling \emph{build 77 | tasks}, where a single task is represented as a higher-order function 78 | parameterised by the type of \emph{keys} \hs{k}, e.g. file names, and the type 79 | of \emph{values} \hs{v}, e.g. file contents. A task takes a \emph{callback} of 80 | type \hs{k}~\hs{->}~\hs{f}~\hs{v}, that the task can use to find values of its 81 | dependencies, and returns the result embedded in a selective context~\hs{f}: 82 | 83 | \vspace{1mm} 84 | \begin{minted}[xleftmargin=10pt]{haskell} 85 | newtype Task k v = Task { run :: forall f. Selective f => (k -> f v) -> f v } 86 | \end{minted} 87 | \vspace{1mm} 88 | 89 | \noindent 90 | The task needs to be polymorphic over \hs{f} so that it can be run both in 91 | \emph{build mode}, by actually executing build commands, and in the \emph{mock 92 | mode}, where build commands are skipped but dependencies are recorded, as 93 | explained in \S\ref{sec-dune-intro}. For example, to compute over- and 94 | under-approximation of build dependencies we run the task in selective functors 95 | \hs{f}~\hs{=}~\hs{Over}~\hs{[}\hs{k]} and 96 | \hs{f}~\hs{=}~\hs{Under}~\hs{[}\hs{k]}, respectively: 97 | 98 | \vspace{1mm} 99 | \begin{minted}[xleftmargin=10pt]{haskell} 100 | dependenciesOver :: Task k v -> [k] 101 | dependenciesOver task = getOver $ run task (\k -> Over [k]) 102 | \end{minted} 103 | \vspace{0mm} 104 | \begin{minted}[xleftmargin=10pt]{haskell} 105 | dependenciesUnder :: Task k v -> [k] 106 | dependenciesUnder task = getUnder $ run task (\k -> Under [k]) 107 | \end{minted} 108 | \vspace{1mm} 109 | 110 | \noindent 111 | Thanks to the polymorphism of \hs{Task} over \hs{f}, we can ``execute'' a given 112 | task with a mock callback like 113 | \hs{(\}\hs{k}~\hs{->}~\hs{Over}~\hs{[}\hs{k])}~\hs{::}~\hs{k}~\hs{->}~\hs{Over}~\hs{[}\hs{k]}~\hs{v}, 114 | whose only effect is recording the given key. 115 | 116 | To demonstrate this on an example, we need a way to model a \emph{build script}, 117 | i.e. a collection of build tasks. One simple approach~\citep{mokhov2018build} 118 | is to use a function that, given a key~\hs{k} returns either the corresponding 119 | build \hs{Task} or \hs{Nothing} to indicate that this key is an input~(external) 120 | dependency that cannot be built and should therefore be available before the 121 | build starts: 122 | 123 | \vspace{1mm} 124 | \begin{minted}[xleftmargin=10pt]{haskell} 125 | type Script k v = k -> Maybe (Task k v) 126 | \end{minted} 127 | \vspace{1mm} 128 | 129 | \noindent 130 | Now we have all the ingredients for creating a simple build script comprising 131 | two tasks: (i)~the top-level task for building \cmd{release.tar} by archiving 132 | the file \cmd{LICENSE} and the executable \cmd{exe}; and (ii)~the task for 133 | compiling the executable from the source \cmd{src.ml} and one of the two 134 | libraries: \cmd{lib.c} or \cmd{lib.ml}, depending on the configuration option 135 | stored in the \cmd{config} file (it is common to use an optimised low-level C 136 | implementation of a performance-critical function, falling back to high-level 137 | OCaml implementation if the former is unavailable on the system): 138 | 139 | \vspace{1mm} 140 | \begin{minted}[xleftmargin=10pt]{haskell} 141 | script :: Script FilePath String 142 | script "release.tar" = Just $ Task $ \fetch -> tar [fetch@\,@"LICENSE",@\,\blk{fetch}\,@"exe"] 143 | script "exe" = Just $ Task $ \fetch -> 144 | let src = fetch "src.ml" 145 | cfg = fetch "config" 146 | libc = fetch "lib.c" 147 | libml = fetch "lib.ml" 148 | in compile [src, ifS (parse cfg) libc libml] 149 | script _ = Nothing 150 | \end{minted} 151 | \vspace{1mm} 152 | 153 | \noindent 154 | Functions 155 | \hs{tar},~\hs{compile}~\hs{::}~\hs{Selective}~\hs{f}~\hs{=>}~\hs{[@@f}~\hs{String]}~\hs{->}~\hs{f}~\hs{String} 156 | create an archive and compile an OCaml executable from sources/libraries, while 157 | \hs{parse}~\hs{::}~\hs{Selective}~\hs{f}~\hs{=>}~\hs{f}~\hs{String}~\hs{->}~\hs{f}~\hs{Bool} 158 | parses a configuration file; their implementation is irrelevant for our purposes. 159 | 160 | \begin{figure} 161 | \centerline{\includegraphics[scale=0.3]{fig/build-dependencies.pdf}} 162 | \vspace{-2mm} 163 | \caption{An example build dependency graph. Input files are shown in rectangles, 164 | intermediate and output files are shown in rounded rectangles. Conditional 165 | dependencies are highlighted with dashed lines.} 166 | \label{fig-build} 167 | \vspace{-4mm} 168 | \end{figure} 169 | 170 | By analysing individual build tasks using \hs{dependenciesOver} and 171 | \hs{dependenciesUnder}, we can construct a dependency graph, where some of the 172 | dependencies are conditional, see Fig.~\ref{fig-build}: 173 | 174 | \vspace{1mm} 175 | \begin{minted}[xleftmargin=10pt]{haskell} 176 | @\ghci@ dependenciesOver (fromJust $ script "release.tar") 177 | ["LICENSE","exe"] 178 | @\ghci@ dependenciesUnder (fromJust $ script "release.tar") 179 | ["LICENSE","exe"] 180 | @\ghci@ dependenciesOver (fromJust $ script "exe") 181 | ["src.ml","config","lib.c","lib.ml"] 182 | @\ghci@ dependenciesUnder (fromJust $ script "exe") 183 | ["src.ml","config"] 184 | \end{minted} 185 | \vspace{1mm} 186 | 187 | Note that while over-approximation is useful for installing all possible 188 | dependencies \emph{before the build}, under-approximation is useful for 189 | maximising parallelism \emph{during the build}: for example, if all input files 190 | are actually generated by running a text preprocessor, then we can start the 191 | three preprocessing tasks that are definitely needed (\cmd{LICENSE}, 192 | \cmd{src.ml}, \cmd{config}) in parallel, i.e. without waiting for the outcome of 193 | parsing the \cmd{config} file. 194 | 195 | \emph{Applicative and monadic build systems} studied in~\citep{mokhov2018build} 196 | cannot support such over- and under-approximating static analysis, and the 197 | associated abstractions are therefore unsuitable for \Dune. This explains why 198 | \Dune developers have chosen to use the \emph{arrow} abstraction 199 | (\S\ref{sec-arrows}). As our case study and the developed prototype demonstrate, 200 | selective functors provide a viable alternative to arrows in the context of 201 | build systems. 202 | 203 | % Dune is another example where the extra power provided by selective 204 | % functions is relevant. To understand why, let's consider the following 205 | % example: a user wants to use some optimized C function if it is 206 | % available on the system, and fallback to an OCaml implementation if 207 | % not. The C and OCaml implementations might have different external 208 | % dependencies. Such a test is dynamic since it depends on the system 209 | % the users builds the software on. During compilation, we only want to 210 | % follow one of the branch, as we clearly don't want to build 211 | % implementation only to keep a single one. However, during dependency 212 | % analysis for the project manifest we need to scan both branches. The 213 | % dependencies discovered in both branches will be considered as 214 | % optional dependencies given that neither is always required. 215 | 216 | % For parallelism use underapproximation: take intersection of optional 217 | % dependencies, and then union with necessary dependencies. 218 | % Note that this requires 'branch' to be in the type class, so we 219 | % can see both branches and intersect their effects. 220 | -------------------------------------------------------------------------------- /paper/4-haxl.tex: -------------------------------------------------------------------------------- 1 | \section{Speculative Execution}\label{sec-haxl} 2 | 3 | \Haxl~\citep{marlow2014haxl} is a framework for efficiently executing 4 | code that fetches data from external sources, typically databases or 5 | remote services. The \Haxl framework allows code written in a natural 6 | style using \hs{Applicative} and \hs{Monad} combinators to run 7 | efficiently, by automatically parallelising the data fetch operations 8 | and batching together multiple fetches from the same data source. 9 | \Haxl has been in use at Facebook, at scale, for several years now in 10 | a system that proactively detects and remediates various forms of 11 | abuse. \Haxl allows the engineers working on the anti-abuse code to 12 | write clear and concise application logic, because the framework 13 | abstracts away from the details of concurrency and efficient data fetching. 14 | 15 | To illustrate the idea using a fragment of the example code 16 | by~\citet{marlow2014haxl}, suppose we are writing the code to render a blog 17 | into HTML. The blog consists of a set of posts, where each post is identified by 18 | a \hs{PostId}. The data for the blog is stored in a remote database, and the API 19 | for fetching the data from the database is as follows: 20 | 21 | \vspace{1mm} 22 | \begin{minted}[xleftmargin=10pt]{haskell} 23 | getPostIds :: Haxl [PostId] 24 | getPostContent :: PostId -> Haxl PostContent 25 | \end{minted} 26 | \vspace{1mm} 27 | 28 | \noindent 29 | We can fetch the set of all \hs{PostId}s using \hs{getPostIds}, and we can fetch 30 | the content of one post using \hs{getPostContent}. To get the content of all 31 | posts we could write: 32 | 33 | \vspace{0.5mm} 34 | \begin{minted}[xleftmargin=10pt]{haskell} 35 | getAllPostsContent :: Haxl [PostContent] 36 | getAllPostsContent = getPostIds >>= mapM getPostContent 37 | \end{minted} 38 | \vspace{0.5mm} 39 | 40 | \noindent 41 | Now, when we \hs{mapM}~\hs{getPostContent} we would really like the 42 | database queries to happen in parallel, because there are no 43 | dependencies between them. Furthermore, we might even be able to batch 44 | up the queries into a single request to the remote database. 45 | 46 | \begin{figure} 47 | \begin{minted}[fontsize=\small]{haskell} 48 | -- A Haxl computation is either completed (Done) or Blocked on pending data requests 49 | data Result a = Done a | Blocked BlockedRequests (Haxl a) deriving Functor 50 | newtype Haxl a = Haxl { runHaxl :: IO (Result a) } deriving Functor 51 | \end{minted} 52 | \vspace{0mm} 53 | \begin{minted}[fontsize=\small]{haskell} 54 | instance Applicative Haxl where 55 | pure = Haxl . return . Done 56 | Haxl iof <*> Haxl iox = Haxl $ do 57 | rf <- iof 58 | rx <- iox 59 | return $ case (rf, rx) of 60 | (Done f , _ ) -> f <$> rx 61 | (_ , Done x ) -> ($x) <$> rf 62 | (Blocked bf f, Blocked bx x) -> Blocked (bf <> bx) (f <*> x) 63 | \end{minted} 64 | \vspace{-13.5mm}\hspace{95mm}\includegraphics[scale=0.32]{fig/comment-haxl-applicative.pdf} 65 | \vspace{3mm} 66 | \begin{minted}[fontsize=\small]{haskell} 67 | instance Selective Haxl where 68 | select (Haxl iox) (Haxl iof) = Haxl $ do 69 | rx <- iox 70 | rf <- iof 71 | return $ case (rx, rf) of 72 | (Done (Right b), _ ) -> Done b 73 | (Done (Left a), _ ) -> ($a) <$> rf 74 | (_ , Done f) -> either f id <$> rx 75 | (Blocked bx x , Blocked bf f) -> Blocked (bx <> bf) (select x f) 76 | \end{minted} 77 | \vspace{-26mm}\hspace{31.5mm}\includegraphics[scale=0.32]{fig/comment-haxl-selective-1.pdf} 78 | \vspace{11.5mm}\hspace{110.5mm}\includegraphics[scale=0.32]{fig/comment-haxl-selective-2.pdf} 79 | \vspace{-7.5mm} 80 | \begin{minted}[fontsize=\small]{haskell} 81 | instance Monad Haxl where 82 | return = Haxl . return . Done 83 | Haxl iox >>= f = Haxl $ do 84 | rx <- iox 85 | case rx of Done x -> runHaxl (f x) 86 | Blocked bx x -> return (Blocked bx (x >>= f)) 87 | \end{minted} 88 | \vspace{-19mm}\hspace{31mm}\includegraphics[scale=0.32]{fig/comment-haxl-monad.pdf} 89 | \vspace{5mm} 90 | \caption{An implementation of \hs{Applicative}, \hs{Selective} and \hs{Monad} 91 | instances for the \Haxl monad.} 92 | \label{fig-haxl} 93 | \vspace{-3mm} 94 | \end{figure} 95 | 96 | These optimisations are performed automatically by \Haxl, using a 97 | special \hs{Applicative} instance that exploits the lack of 98 | dependency between the two computations to explore the computations 99 | and collect the data fetch requests that can be performed in parallel or batched 100 | together. Fig.~\ref{fig-haxl} shows an implementation adapted from the code 101 | by~\citet{marlow2014haxl}. For the purposes of the presentation here we have 102 | renamed \hs{Fetch} to \hs{Haxl} and omitted the exception-handling code. 103 | The key piece of \Haxl's design is the \hs{Blocked}/\hs{Blocked} case, where 104 | two independent sets of \hs{BlockedRequests} are combined together (the 105 | semigroup operator \hs{<>} is just a customised set union). \Haxl also has a 106 | \hs{Monad} instance, also shown in Fig.~\ref{fig-haxl}, which provides support 107 | for \emph{dynamic} data fetches that are based on results obtained earlier. 108 | Such dynamic data fetches are sequentialised as you would expect, but code 109 | written to use \hs{Applicative} operations benefits from the automatic 110 | concurrency. This optimisation is further exploited by using a transformation 111 | on the monadic \cmd{do}-notation to automatically use \hs{Applicative} 112 | operators where possible~\cite{marlow2016applicativedo}. 113 | 114 | One of the key tools found to be useful in the kind of code written 115 | using \Haxl at Facebook is the ``lazy'' conditional operators: 116 | 117 | \vspace{1mm} 118 | \begin{minted}[xleftmargin=10pt]{haskell} 119 | (.||), (.&&) :: Haxl Bool -> Haxl Bool -> Haxl Bool 120 | @\blk{x}@ .|| y = do b <- x; if b then return True else y 121 | @\blk{x}@ .&& y = do b <- x; if b then y else return False 122 | \end{minted} 123 | \vspace{1mm} 124 | 125 | \noindent 126 | These are typically used to improve performance by guarding slow 127 | checks with faster checks. For example, we might write: 128 | 129 | \begin{minted}[xleftmargin=10pt]{haskell} 130 | if simpleCondition .&& complexCondition then ... else ... 131 | \end{minted} 132 | 133 | \noindent 134 | The idea is that \hs{simpleCondition} is quick to evaluate and 135 | returns \hs{False} in a large proportion of cases, so that we can 136 | often avoid needing to evaluate \hs{complexCondition}. 137 | 138 | This does not require any additional extensions or special support in 139 | \Haxl. But we also noticed that sometimes there is a pair of conditions 140 | where neither is obviously faster than the other, yet we would still 141 | like to benefit from bailing out early when the answer is known. 142 | Therefore, \Haxl contains two more conditional operators \hs{pOr} and 143 | \hs{pAnd} for ``parallel OR'' and ``parallel AND'': 144 | 145 | \begin{minted}[xleftmargin=10pt]{haskell} 146 | pOr, @\blu{pAnd}@ :: Haxl Bool -> Haxl Bool -> Haxl Bool 147 | \end{minted} 148 | 149 | \noindent 150 | These have the behaviour that: (i)~both arguments are evaluated in parallel; 151 | (ii)~the computation is aborted as soon as the answer is known, even if the 152 | other argument is still being evaluated. Data fetches are not observable 153 | effects, so the parallelism is not observable to the programmer (\Haxl relies 154 | on this property for the soundness of its parallel \hs{Applicative} 155 | instance). However, \hs{pOr} and \hs{pAnd} are non-deterministic with 156 | respect to exceptions: if an exception is thrown by either side, it 157 | will be thrown by the computation as a whole immediately without 158 | waiting for the other side to complete. One could imagine an 159 | alternative implementation which waits for the completion of the other 160 | argument when an exception is raised; this would be deterministic, but 161 | would be less efficient in the case of exceptions. 162 | 163 | It should come as no surprise that \hs{pOr} and \hs{pAnd} can be 164 | implemented using \hs{select}, indeed \hs{pOr}~\hs{=}~\hs{(<||>)} and 165 | \hs{pAnd}~\hs{=}~\hs{(<&&>)} from Fig.~\ref{fig-library}. The corresponding 166 | \hs{Selective} instance is given in Fig.~\ref{fig-haxl}: in the 167 | \hs{Blocked}/\hs{Blocked} case we speculatively explore both computations, 168 | and if we obtain a \hs{Done}/\hs{Right} result, the second computation is 169 | safely abandoned and subsequently cancelled. 170 | 171 | There is one wrinkle with implementing \hs{pOr} and \hs{pAnd} 172 | in terms of \hs{select}. Ideally, \hs{pOr} and \hs{pAnd} would be 173 | symmetric: just as we can cancel the second computation if the first 174 | one determines the answer, we should be able to cancel the first 175 | computation in the same way. Yet \hs{select} is inherently left-biased: 176 | it requires that all the effects of the first argument are performed. 177 | In~\S\ref{sec-alt-symmetric} we consider an alternative combinator 178 | related to \hs{select} that allows this kind of symmetry to be expressed. 179 | 180 | We have prototyped an implementation of \Haxl with the \hs{Selective}~\hs{Haxl} 181 | instance, which allowed us to reuse generic selective combinators 182 | \hs{<||>}, \hs{<&&>}, \hs{anyS} and \hs{allS} instead of providing custom 183 | implementations for conditional operators \hs{pOr} and \hs{pAnd} and 184 | their generalisations on lists. This case study highlights the fact that 185 | selective functors are useful not only in the static context, but in the dynamic 186 | context too, by allowing us to benefit from speculative execution. 187 | 188 | \subsection{Results} 189 | 190 | We mentioned above that \hs{pOr} and \hs{pAnd} are effective when the 191 | relative size of the conditional computations is unknown, so 192 | evaluating them in parallel with early exit is an effective 193 | alternative to either sequencing them manually (with \hs{Monad}) or 194 | evaluating them in parallel to completion (with 195 | \hs{Applicative}). This argument becomes even more compelling as the 196 | set of conditions to evaluate grows: imagine trying to efficiently 197 | sequence a set of ten or more conditions, and then repeating the 198 | exercise every time the set changes. 199 | 200 | For this reason, in \Haxl we found that list operations built on top 201 | of \hs{pOr} and \hs{pAnd}, which in this paper we call \hs{anyS} and 202 | \hs{allS} (see Fig.~\ref{fig-library}), offer an important balance 203 | between performance and maintainability that is not provided by the 204 | \hs{Applicative} or \hs{Monad}-based combinators. 205 | 206 | One could construct examples to demonstrate arbitrarily large 207 | performance gains from using \hs{pOr} and \hs{pAnd}, however that 208 | would not be particularly useful. Perhaps more useful would be a 209 | real-world measurement showing how much performance was improved in an 210 | actual application but again, the value of that would depend to a 211 | large extent on how the application uses \hs{pOr} and \hs{pAnd}, and 212 | unfortunately the application code in our case is 213 | proprietary. Therefore instead we offer this anecdote: we first 214 | introduced a use of \hs{pOr} to solve some performance issues in a 215 | complex production workload where we had long chains of conditionals 216 | that were difficult to optimise by hand, and \hs{pOr} resulted in 217 | significant performance improvements. 218 | -------------------------------------------------------------------------------- /paper/6-alternatives.tex: -------------------------------------------------------------------------------- 1 | \section{Alternative Formulations for Selective Functors} 2 | \label{sec-alternatives} 3 | 4 | This section discusses alternative versions of the \hs{Selective} type class 5 | that are based on different \hs{select} operators: specifically, the 6 | multi-way~(\S\ref{sec-alt-multi}) and symmetric~(\S\ref{sec-alt-symmetric}) 7 | generalisations of \hs{select}, as well as operators that are equivalent to 8 | \hs{select} but may be more convenient to use~(\S\ref{sec-alt-equivalent}). All 9 | of these ideas can be readily integrated into the presented definition of the 10 | \hs{Selective} type class by extending it with new methods and adding new laws 11 | that ensure that the new methods interact with \hs{select} in an appropriate 12 | manner. This is common in standard Haskell libraries, where type classes 13 | \hs{Applicative} and \hs{Monad} include methods like \hs{*>} and \hs{>>} for 14 | performance reasons. 15 | 16 | Another alternative, which is worth a remark, is to simply add \hs{select} to 17 | the \hs{Applicative} type class, with the default implementation 18 | \hs{select}~\hs{=}~\hs{selectA}. While this works for the purposes discussed in 19 | this paper, it would make it harder to reason about code with the 20 | \hs{Applicative}~\hs{f} constraint, since the \hs{select} method makes it 21 | possible for effects to depend on values; declaring such a significant ability 22 | by the \hs{Selective}~\hs{f} constraint is arguably a more prudent approach. 23 | 24 | \subsection{Multiway Selective Functors}\label{sec-alt-multi} 25 | 26 | As mentioned in~\S\ref{sec-selective}, \hs{branch} is a strong contender to be 27 | the main method of the \hs{Selective} type class; it is parametric and all 28 | selective combinators, including \hs{select} itself, can be derived from it: 29 | 30 | \vspace{1mm} 31 | \begin{minted}[xleftmargin=10pt]{haskell} 32 | branch :: Selective f => f (Either a b) -> f (a -> c) -> f (b -> c) -> f c 33 | \end{minted} 34 | \vspace{0mm} 35 | \begin{minted}[xleftmargin=10pt]{haskell} 36 | selectB :: Selective f => f (Either a b) -> f (a -> b) -> f b 37 | selectB x y = branch x y (pure id) 38 | \end{minted} 39 | \vspace{1mm} 40 | 41 | \noindent 42 | While we prefer \hs{select} for its simplicity, \hs{branch} does provide an 43 | interesting advantage in the context of static analysis. Specifically, it makes 44 | it statically apparent that the two branches are \emph{mutually exclusive}. When 45 | \hs{branch} is ``desugared'' into a sequence of two \hs{select} operations, the 46 | information about the mutual exclusion between the two branches is lost, which 47 | rules out some static analysis scenarios. For example, it may be useful to know 48 | that in our build systems example in~\S\ref{sec-static-example} we never depend 49 | on both \cmd{lib.c} and \cmd{lib.ml}. 50 | 51 | Another point in favour of \hs{branch} is performance: the \hs{select}-based 52 | implementation of the \hs{ifS} combinator checks for the \hs{Left} and 53 | \hs{Right} cases in sequence, instead of directly jumping to the correct case, 54 | so a \hs{branch}-based implementation would be more efficient. Furthermore, 55 | $N$-way generalisations of \hs{select} are possible, although the design space 56 | here is quite large. As an example, one might consider adding \hs{bindS} to the 57 | \hs{Selective} type class, i.e. a special case of the monadic bind operator that 58 | is applicable only to enumerable types: 59 | 60 | \vspace{1mm} 61 | \begin{minted}[xleftmargin=10pt]{haskell} 62 | bindS :: Selective f => (Bounded a, Enum a, Eq a) => f a -> (a -> f b) -> f b 63 | \end{minted} 64 | \vspace{1mm} 65 | 66 | \noindent 67 | The default implementation could be based on sequentially checking for every 68 | possible value using \hs{select}, but monadic instances would supply a much 69 | faster implementation, namely \hs{bindS}~\hs{=}~\hs{(>>=)}. This would allow 70 | static analysis instances to record all possible cases, without incurring 71 | the $O(N)$ slowdown during the execution of an $N$-way branch. 72 | 73 | Interestingly, adding the ability to branch on infinite number of cases makes 74 | selective functors equivalent to monads, e.g. see~\citet{peebles2019sigma}. 75 | However, it is worth pointing out that static analysis of such 76 | infinitely-branching selective functors might take infinite time too. 77 | 78 | Exploring the design space for ``multiway selective functors'', and using them 79 | for efficient translation of Haskell's \cmd{do}-notation into selective 80 | combinators in the spirit of the \cmd{ApplicativeDo} 81 | extension~\citep{marlow2016applicativedo} is left for future research. For now, 82 | we believe that adding \hs{branch} and/or an equivalent of \hs{bindS} to the 83 | \hs{Selective} type class would be beneficial for performance-sensitive 84 | applications. 85 | 86 | \subsection{Symmetric Selective Functors}\label{sec-alt-symmetric} 87 | 88 | In this section we address the asymmetry of \hs{select}, which we remarked on 89 | in~\S\ref{sec-haxl} and~\S\ref{sec-free}. The asymmetry can be seen in the fact 90 | that the first argument of \hs{select} must always be executed, while the second 91 | argument may sometimes be skipped. Consider a more symmetric alternative: 92 | 93 | \vspace{1mm} 94 | \begin{minted}[xleftmargin=5pt]{haskell} 95 | biselect :: Selective f => f@\,@(Either a b) -> f@\,@(Either a c) -> f@\,@(Either a (b,c)) 96 | \end{minted} 97 | \vspace{1mm} 98 | 99 | \noindent 100 | This definition is pleasantly symmetric: if either of the arguments yields a 101 | \hs{Left}~\hs{a} value, the other argument \emph{may be skipped} since the 102 | result must be a \hs{Left}~\hs{a} too, by parametricity. On the other hand, if 103 | one of the arguments yields a \hs{Right} value, then the other argument 104 | \emph{must be executed} in order to either get an \hs{a} or the other half of 105 | the resulting pair. As an added bonus, the rather obscure associativity law 106 | from~\S\ref{sec-laws} looks much more natural for 107 | \hs{(?*?)}~\hs{=}~\hs{biselect}: 108 | 109 | \vspace{1mm} 110 | \begin{minted}[xleftmargin=10pt]{haskell} 111 | @\blk{x}@ ?*? (y ?*? z) = fmap assoc <$> ((x ?*? y) ?*? z) 112 | where 113 | assoc ((a, b), c) = (a, (b, c)) 114 | \end{minted} 115 | \vspace{1mm} 116 | 117 | \noindent 118 | While beautiful, we found \hs{biselect} to be a bit more awkward to work with 119 | than \hs{select}, and also more subtle when the order in which the arguments 120 | are executed is not fixed. So far we have identified only one example where the 121 | symmetry of \hs{biselect} is beneficial: speculative execution of parallel OR 122 | and AND combinators --- see the \Haxl case study~\S\ref{sec-haxl}. To support 123 | such use-cases it is possible to add \hs{biselect} to the \hs{Selective} type 124 | class with the following default implementation: 125 | 126 | \vspace{1mm} 127 | \begin{minted}[xleftmargin=5pt]{haskell} 128 | biselect :: Selective f => f@\,@(Either a b) -> f@\,@(Either a c) -> f@\,@(Either a (b,c)) 129 | biselect x y = select ((fmap Left . swap) <$> x) ((\e a -> fmap (a,) e) <$> y) 130 | where 131 | swap = either Right Left -- Swap Left and Right 132 | \end{minted} 133 | \vspace{1mm} 134 | 135 | \noindent 136 | This implementation breaks the symmetry, which may be acceptable for most 137 | instances of selective functors, but instances like \hs{Haxl} would override it 138 | in order to gain additional performance benefits. Note that the selective 139 | combinators like \hs{<||>} would need to be redefined via \hs{biselect} in order 140 | to take advantage of the symmetry. 141 | 142 | From the theoretical viewpoint, the type signature of \hs{biselect} makes it 143 | more apparent that a selective functor \hs{f} is a composition of an applicative 144 | functor \hs{f} and the \hs{Either} monad. 145 | 146 | \subsection{Equivalent Formulations}\label{sec-alt-equivalent} 147 | 148 | In this section we briefly mention three equivalent operators that can be used 149 | instead of \hs{select}. 150 | 151 | \begin{itemize} 152 | \item Lennox S. Leary and Edward Kmett suggested to move the function to the 153 | first argument: 154 | 155 | \vspace{1mm} 156 | \begin{minted}{haskell} 157 | select :: Selective f => f (Either (a -> b) b) -> f a -> f b 158 | \end{minted} 159 | \vspace{1mm} 160 | 161 | This operator is similar to \hs{Applicative}'s \hs{<*>} but with a 162 | twist: the first argument might turn out to be a constant function 163 | \hs{const}~\hs{b}, in which case the effect \hs{f}~\hs{a} may be 164 | skipped. 165 | 166 | \item One can take one step further and extract the selection logic into a 167 | separate function: 168 | 169 | \vspace{1mm} 170 | \begin{minted}{haskell} 171 | selectBy :: Selective f => (a -> Either (b -> c) c) -> f a -> f b -> f c 172 | \end{minted} 173 | \vspace{1mm} 174 | 175 | This operator is very convenient for implementing selective 176 | combinators, and also provides more opportunities for optimisation by 177 | fusing construction and deconstruction of \hs{Either}'s. 178 | 179 | \item Finally, it is possible to get rid of functions altogether: 180 | 181 | \vspace{1mm} 182 | \begin{minted}{haskell} 183 | select :: Selective f => f (Either a b) -> f c -> f (Either a (b, c)) 184 | \end{minted} 185 | \vspace{1mm} 186 | 187 | While this formulation requires an extra tuple allocation, it uses 188 | only sum and product types, and may therefore be useful in contexts 189 | where functions are unavailable. 190 | \end{itemize} 191 | 192 | 193 | 194 | 195 | % Arseniy's raise/catch 196 | 197 | % Loops 198 | -------------------------------------------------------------------------------- /paper/7-related.tex: -------------------------------------------------------------------------------- 1 | \section{Related Work}\label{sec-related} 2 | 3 | Composing effectful computations is a rich research area and there is a vast 4 | body of related work. We build on the fundamental notions of applicative 5 | functors~\citep{mcbride2008applicative} and 6 | monads~\citep{moggi1991notions,1995_wadler_monads}, but these notions are not 7 | isolated: the space between them is inhabited by 8 | \emph{arrows}~\citep{hughes2000arrows} and \emph{generalised 9 | arrows}~\citep{megacz2011hardware}, which we discuss in~\S\ref{sec-arrows}. 10 | 11 | The idea of extending the \hs{Applicative} interface to gain more expressive 12 | power is not new.~Parser combinators by \citet{swierstra1996parsers} paved the 13 | way to the \hs{Alternative} type class~(\S\ref{sec-alternative-functors}). 14 | \citet{yallop2010phd} proposed to extend \hs{Applicative} with a method of type 15 | \hs{f}~\hs{Bool}~\hs{->}~\hs{f}~\hs{a}~\hs{->}~\hs{f}~\hs{a}~\hs{->}~\hs{f}~\hs{a} 16 | ``for capturing computations where control flow is dynamic, but dataflow is 17 | static''; similar ideas were studied by hardware designers in the context of 18 | synchronous~\citep{dennis1975preliminary} and 19 | asynchronous~\citep{mokhov2009cpog,sokolov2018reconfigurable} control circuits. 20 | We have also found early online 21 | discussions~\citep{yorgey2009irc,permyakov2012irc} that searched for type 22 | classes like \hs{Selective} but did not progress further. \hs{ApplicativeFix} 23 | proposed by~\citet{devriese2013fixing} can be combined with selective functors 24 | to allow for static analysis of effectful computations with cycles. 25 | 26 | Many selective combinators appeared earlier on an ad hoc basis, including 27 | \Haxl's speculative execution functions \hs{pOr} and 28 | \hs{pAnd}~(\S\ref{sec-haxl}), the ``parallel conjunction'' operator (\hs{*&*}) 29 | in Lazy SmallCheck~\citep{runciman2008smallcheck}, and various examples 30 | of the \cmd{if} statement using special optimisations instead of relying on the 31 | monadic interface~\citep{incremental_bind}. Finally, the type signature of 32 | \hs{select} resembles an \emph{exception handler}~\cite{benton2001exceptional} 33 | where the first argument may raise an exception to be handled by the second 34 | argument~---~this explains why the initial blog post exploring selective 35 | functors used \hs{handle} as the operator name instead of 36 | \hs{select}~\cite{mokhov2019selective}. 37 | 38 | Our free construction for rigid selective functors~(\S\ref{sec-free}) is 39 | inspired by the works on free applicative functors~\citep{free-applicatives}, 40 | free monads~\citep{swierstra2008data}, and insightful blog posts 41 | by~\citet{fancher2016free,fancher2017static}. \emph{Batching and remote 42 | execution} of effectful computations~\citep{gill2015remote} can be greatly 43 | simplified by using free applicative functors, as 44 | demonstrated by~\citet{gibbons2016free}, and we believe that free selective 45 | functors uncover new opportunities in this area. 46 | 47 | \subsection{Arrows and Profunctors}\label{sec-arrows} 48 | 49 | Arrows, introduced by~\citet{hughes2000arrows}, generalise functors by making 50 | the \emph{input} of a computation explicit. Rather than giving the type 51 | \hs{f}~\hs{a} to an effectful computation that yields a value of type~\hs{a}, as 52 | we have done in this paper so far, arrows give the type \hs{a}~\hs{i}~\hs{o} to 53 | an effectful computation that takes values of type \hs{i} as input and yields 54 | values of type \hs{o} as output. There is a rich \emph{arrow hierarchy} of type 55 | classes, each providing a new ability, where \hs{ArrowChoice} is particularly 56 | relevant for us: 57 | 58 | \vspace{0.5mm} 59 | \begin{minted}[xleftmargin=10pt,fontsize=\small]{haskell} 60 | class Category a -- Identity arrow, sequential arrow composition 61 | class Category a => Arrow a -- Pure arrows, parallel arrow composition 62 | class Arrow a => ArrowChoice a -- Arrows with choice 63 | class Arrow a => ArrowApply a -- Arrows that take arrows as input 64 | class Arrow a => ArrowLoop a -- Arrows with loops 65 | \end{minted} 66 | \vspace{0.5mm} 67 | 68 | \noindent 69 | The relationships between applicative functors, monads and arrows have been 70 | studied in depth. It is known, e.g. see~\citet{lindley2011idioms} 71 | and~\citet{rivas2017notions}, that applicative functors correspond to so called 72 | \emph{static arrows}, for which there is an isomorphism between 73 | \hs{a}~\hs{()}~\hs{(}\hs{i}~\hs{->}~\hs{o)} and~\hs{a}~\hs{i}~\hs{o}. The 74 | standard module \cmd{Control.Arrow} therefore provides the following 75 | definitions: 76 | 77 | \vspace{0.5mm} 78 | \begin{minted}[xleftmargin=10pt,fontsize=\small]{haskell} 79 | newtype ArrowMonad a o = ArrowMonad (a () o) -- See Control.Arrow 80 | \end{minted} 81 | \vspace{0mm} 82 | \begin{minted}[xleftmargin=10pt,fontsize=\small]{haskell} 83 | instance Arrow a => Functor (ArrowMonad a) 84 | instance Arrow a => Applicative (ArrowMonad a) 85 | instance ArrowChoice a => ... -- Missing?! 86 | instance ArrowApply a => Monad (ArrowMonad a) 87 | \end{minted} 88 | \vspace{0.5mm} 89 | 90 | \noindent 91 | Selective functors provide the missing counterpart for \hs{ArrowChoice} in the 92 | \emph{functor hierarchy}, as demonstrated by the following instance: 93 | 94 | \vspace{1mm} 95 | \begin{minted}[xleftmargin=10pt]{haskell} 96 | instance ArrowChoice a => Selective (ArrowMonad a) where 97 | select (ArrowMonad x) y = ArrowMonad $ x >>> (toArrow y ||| returnA) 98 | \end{minted} 99 | \vspace{1mm} 100 | \begin{minted}[xleftmargin=10pt]{haskell} 101 | toArrow :: Arrow a => ArrowMonad a (i -> o) -> a i o 102 | toArrow (ArrowMonad f) = arr (\x -> ((), x)) >>> first f >>> arr (uncurry ($)) 103 | \end{minted} 104 | \vspace{1mm} 105 | 106 | \noindent 107 | Here \hs{toArrow} witnesses one half of the aforementioned isomorphism between 108 | \hs{a}~\hs{()}~\hs{(}\hs{i}~\hs{->}~\hs{o)} and~\hs{a}~\hs{i}~\hs{o}. The 109 | obtained \hs{Selective} instance is lawful thanks to the \hs{ArrowChoice} laws. 110 | 111 | Arrows are more general and powerful than selective functors. We could have used 112 | arrows to solve our static analysis and speculative execution examples, and not 113 | just in theory --- \Dune is a great example of successful application of arrows 114 | in practice. However, introducing arrows to an existing codebase built around 115 | applicative functors and monads, such as \Haxl, would require pervasive changes 116 | to the whole abstraction stack, as well as rewriting all existing \Haxl user 117 | code in the arrow notation~\citep{paterson2001new}. Needless to say, 118 | introduction of selective functors to \Haxl is a much easier task, which we have 119 | accomplished by adding 13 lines of new code for the definition of the 120 | \hs{Selective}~\hs{Haxl} instance, and removing 26 lines of code corresponding 121 | to similarly-sized definitions of \hs{pOr} and \hs{pAnd}, reusing the selective 122 | combinators \hs{<||>} and \hs{<&&>} instead. 123 | 124 | \emph{Profunctors} is an abstraction closely related to arrows; 125 | see~\citep{pickering2017profunctor} for a good overview of profunctors in the 126 | context of modular data accessors, or \emph{lenses}. Similarly to 127 | \hs{ArrowChoice}, so-called \emph{Cocartesian profunctors} are counterparts of 128 | selective functors in the \emph{profunctor hierarchy}. 129 | 130 | Establishing a formal correspondence between \hs{ArrowChoice}, Cocartesian 131 | profunctors, and selective functors is beyond the scope of this paper and is 132 | left for future research. 133 | 134 | \subsection{Parser Combinators}\label{sec-alternative-functors} 135 | 136 | \hs{Alternative} is a type class originally motivated by non-monadic parsers; 137 | see, for example,~\citet{swierstra1996parsers}, where the methods of the 138 | \hs{Alternative} type class appear as part a bigger \hs{Parsing} type class. In 139 | modern Haskell, \hs{Alternative} is a subclass of \hs{Applicative}: 140 | 141 | \vspace{1mm} 142 | \begin{minted}[xleftmargin=10pt]{haskell} 143 | class Applicative f => Alternative f where 144 | empty :: f a 145 | (<|>) :: f a -> f a -> f a 146 | \end{minted} 147 | \vspace{1mm} 148 | 149 | \noindent 150 | The operator \hs{<|>} allows us to naturally express \emph{choice} in parsers. 151 | As an example, consider the task of parsing binary and hexadecimal numbers, 152 | which are prefixed with \hs{"0b"} and \hs{"0x"}, respectively. Following the 153 | classic parser combinator approach~\citep{hutton1998monadic}, let us assume the 154 | existence of the following parsers: 155 | 156 | \vspace{1mm} 157 | \begin{minted}[xleftmargin=10pt]{haskell} 158 | sat :: (Char -> Bool) -> Parser Char -- Parse a specified character 159 | string :: String -> Parser String -- Parse a string literal 160 | bin :: Parser Int -- Parse a binary-encoded number 161 | hex :: Parser Int -- Parse a hexadecimal-encoded number 162 | \end{minted} 163 | \vspace{1mm} 164 | 165 | \noindent 166 | Now the desired parser can be obtained as a choice between parsers for binary 167 | and hexadecimal numbers, each augmented with the prefix-parsing part: 168 | 169 | \vspace{1mm} 170 | \begin{minted}[xleftmargin=10pt]{haskell} 171 | numberA :: Parser Int 172 | numberA = (string "0b" *> bin) <|> (string "0x" *> hex) 173 | \end{minted} 174 | \vspace{1mm} 175 | 176 | \noindent 177 | When parsing \hs{"0x7E3"}, the first parser fails (due to the prefix mismatch), 178 | but the second one succeeds. Note that parsing of the leading \hs{"0"} can be 179 | factored out into a separate parser \hs{string}~\hs{"0"} to avoid backtracking. 180 | 181 | Selective functors also allow us to implement the desired parser, and arguably 182 | in a more direct style that does not involve trying one parser after another: 183 | 184 | \vspace{1mm} 185 | \begin{minted}[xleftmargin=10pt]{haskell} 186 | numberS :: Parser Int 187 | numberS = string "0" *> ifS (('b'==) <$> sat (`elem` "bx")) bin hex 188 | \end{minted} 189 | \vspace{1mm} 190 | 191 | \noindent 192 | Here we first parse the leading \hs{"0"}, then the second character of the 193 | prefix, failing if it is neither \hs{"b"} nor \hs{"x"}, and finally select an 194 | appropriate subsequent parser using \hs{ifS}. Note that we can move the parser 195 | \hs{string}~\hs{"0"} in and out of the condition \hs{ifS} thanks to the 196 | interchange law (\S\ref{sec-laws}). 197 | 198 | Investigation of the relationship between \hs{Alternative} and \hs{Selective} 199 | type classes, as well as application of selective functors to parsers is an 200 | interesting research opportunity. 201 | -------------------------------------------------------------------------------- /paper/8-conclusions.tex: -------------------------------------------------------------------------------- 1 | \section{Conclusions}\label{sec-conclusions} 2 | 3 | We have introduced selective functors, an abstraction between applicative 4 | functors and monads. Like applicative functors, selective functors require all 5 | effects to be known statically, before the execution starts. Like monads, 6 | selective functors allow for effects to depend on values of earlier effects but 7 | in a limited way: it is possible to skip some of the effects, but not create 8 | new ones. In this sense selective functors allow you to describe computations 9 | that are very much like hardware circuits: statically fixed, yet dynamically 10 | reconfigurable. 11 | 12 | We have demonstrated usefulness of the new abstraction on several examples, and 13 | hope that the reader will find it useful in their next project too. 14 | -------------------------------------------------------------------------------- /paper/Makefile: -------------------------------------------------------------------------------- 1 | TARGET=paper 2 | all: pdf 3 | 4 | paper.pdf: $(wildcard *.tex) $(wildcard *.bib) 5 | - pdflatex -shell-escape main 6 | - bibtex main 7 | - pdflatex -shell-escape main 8 | pdflatex -shell-escape main 9 | 10 | pdf: paper.pdf 11 | 12 | clean: 13 | rm -f *.eps 14 | rm -f *.aux *.log *.out *.bbl *.blg *~ *.bak $(TARGET).ps $(TARGET).pdf 15 | rm *.brf *.lof *.lot *.toc 16 | 17 | # End 18 | -------------------------------------------------------------------------------- /paper/artefact/Dockerfile: -------------------------------------------------------------------------------- 1 | # Docker image prepared for ICFP'19 Artifact Evaluation. 2 | # 3 | # To build the image, run the following command in the directory containing 4 | # this Dockerfile: `docker build -t geo2a/selective-icfp19 .` 5 | # 6 | # To run a container interactively: 7 | # `docker run -it geo2a/selective-icfp19` 8 | # 9 | # We chose to use the Coq base image as a base because it includes all 10 | # software required for building the Coq and OCaml parts of the artefact. 11 | # We have augmented the image with the software required for the Haskell part. 12 | FROM coqorg/coq:8.9 13 | 14 | MAINTAINER Georgy Lukyanov 15 | 16 | RUN sudo apt-get update 17 | RUN sudo apt-get install -y wget m4 18 | RUN curl -sSL https://get.haskellstack.org/ | sh 19 | 20 | # Pull the OCaml sources from GitHub 21 | RUN wget -O selective-ocaml.zip https://github.com/snowleopard/selective-ocaml/archive/0.1.0.zip && \ 22 | unzip selective-ocaml.zip && rm selective-ocaml.zip && \ 23 | cd selective-ocaml-0.1.0 && \ 24 | opam install -y dune base stdio expect_test_helpers_kernel 25 | RUN cd selective-ocaml-0.1.0 && eval $(opam env) && make test 26 | RUN mv selective-ocaml-0.1.0 selective-ocaml 27 | 28 | # Pull the Coq sources from GitHub 29 | RUN wget -O selective-coq.zip https://github.com/tuura/selective-theory-coq/archive/v0.1.1.zip 30 | RUN unzip selective-coq.zip && rm selective-coq.zip && mv selective-theory-coq-0.1.1 selective-coq 31 | RUN cd selective-coq && eval $(opam env) && make && make clean && cd .. 32 | 33 | # Pull the Haskell sources from GitHub 34 | RUN wget -O selective.zip https://github.com/snowleopard/selective/archive/v0.2.zip 35 | RUN unzip selective.zip && rm selective.zip 36 | RUN cd selective-0.2 && stack build && stack test 37 | RUN mv selective-0.2 selective-haskell 38 | 39 | RUN exit 40 | -------------------------------------------------------------------------------- /paper/artefact/README-ACMDL.md: -------------------------------------------------------------------------------- 1 | # Selective Applicative Functors: ICFP 2019 Artefact 2 | 3 | This Docker image contains a snapshot of the software packages related to the 4 | paper "Selective Applicative Functors" and all their dependencies. 5 | 6 | The image and this description are also available at Docker Hub: 7 | 8 | https://hub.docker.com/r/geo2a/selective-icfp19 9 | 10 | ## Running the image 11 | 12 | Unzip the archive, obtaining file `geo2a-selective-icfp19.tar` 13 | 14 | To load the image into Docker use the command: `docker load --input geo2a-selective-icfp19.tar` 15 | 16 | To run it interactively use the command: `docker run -it geo2a/selective-icfp19`. 17 | 18 | You will find yourself in the directory `/home/coq`. 19 | 20 | The Haskell package contains a comprehensive suite of QuickCheck properties as 21 | well as working examples from the paper, and is the most informative part of the 22 | artefact. We recommend taking a look at it first. 23 | 24 | ## Haskell implementation 25 | 26 | Change into the Haskell implementation directory: 27 | 28 | ``` 29 | cd ~/selective-haskell 30 | ``` 31 | 32 | And run tests with `stack`: 33 | 34 | ``` 35 | stack test 36 | ``` 37 | 38 | Then you might want to browse the code and documentation in the top-level module 39 | `src/Control/Selective.hs`, which provides the `Selective` type class and 40 | selective combinators. The free construction for rigid selective functors can be 41 | found in `src/Control/Selective/Free/Rigid.hs`. Another free construction for 42 | general selective functors is available in `src/Control/Selective/Free.hs`. 43 | 44 | This package is also available on Hackage: http://hackage.haskell.org/package/selective-0.2. 45 | 46 | ## Coq proofs 47 | 48 | We also provide a formalisation of selective functors in Coq, along with proofs 49 | of correctness of several `Selective` instances. 50 | 51 | To access Coq proofs, execute the following command: 52 | 53 | ``` 54 | cd ~/selective-coq 55 | ``` 56 | 57 | To typecheck all the Coq files in the development and verify the Coq proofs of 58 | several Selective instances being lawful, execute: 59 | 60 | ``` 61 | make 62 | ``` 63 | 64 | Start by taking a look at the simple proofs in files `src/Data/Over.v`, 65 | `src/Data/Under.v` and `src/Data/Validation.v`. 66 | 67 | ## OCaml implementation 68 | 69 | We also provide an implementation of selective functors in OCaml. To access it, 70 | change to the corresponding directory: 71 | 72 | ``` 73 | cd ~/selective-ocaml 74 | ``` 75 | 76 | You can build and test the project using the Dune build system: 77 | 78 | ``` 79 | dune build 80 | dune runtest 81 | ``` 82 | 83 | Note that lack of output means all tests have passed. 84 | 85 | The file `src/selective_intf.ml` contains the signature of the definition of the 86 | main module `Selective.S`, which provides the interface comprising all the 87 | selective combinators. 88 | 89 | You can take a look at an example S-expression parser, a `List` instance, and 90 | the `Task` abstraction from section 3.2 in the `example` directory. 91 | 92 | This package is available on OPAM: https://opam.ocaml.org/packages/selective/selective.0.1.0/. 93 | -------------------------------------------------------------------------------- /paper/artefact/README.md: -------------------------------------------------------------------------------- 1 | # Selective Applicative Functors: ICFP 2019 Artefact 2 | 3 | This Docker image contains a snapshot of the software packages related to the 4 | paper "Selective Applicative Functors" and all their dependencies. 5 | 6 | The image and this description are also available at Docker Hub: 7 | 8 | https://hub.docker.com/r/geo2a/selective-icfp19 9 | 10 | ## Running the image 11 | 12 | To run it interactively use the command: `docker run -it geo2a/selective-icfp19`. 13 | You will find yourself in the directory `/home/coq`. 14 | 15 | The Haskell package contains a comprehensive suite of QuickCheck properties as 16 | well as working examples from the paper, and is the most informative part of the 17 | artefact. We recommend taking a look at it first. 18 | 19 | ## Haskell implementation 20 | 21 | Change into the Haskell implementation directory: 22 | 23 | ``` 24 | cd ~/selective-haskell 25 | ``` 26 | 27 | And run tests with `stack`: 28 | 29 | ``` 30 | stack test 31 | ``` 32 | 33 | Then you might want to browse the code and documentation in the top-level module 34 | `src/Control/Selective.hs`, which provides the `Selective` type class and 35 | selective combinators. The free construction for rigid selective functors can be 36 | found in `src/Control/Selective/Free/Rigid.hs`. Another free construction for 37 | general selective functors is available in `src/Control/Selective/Free.hs`. 38 | 39 | This package is also available on Hackage: http://hackage.haskell.org/package/selective-0.2. 40 | 41 | ## Coq proofs 42 | 43 | We also provide a formalisation of selective functors in Coq, along with proofs 44 | of correctness of several `Selective` instances. 45 | 46 | To access Coq proofs, execute the following command: 47 | 48 | ``` 49 | cd ~/selective-coq 50 | ``` 51 | 52 | To typecheck all the Coq files in the development and verify the Coq proofs of 53 | several Selective instances being lawful, execute: 54 | 55 | ``` 56 | make 57 | ``` 58 | 59 | Start by taking a look at the simple proofs in files `src/Data/Over.v`, 60 | `src/Data/Under.v` and `src/Data/Validation.v`. 61 | 62 | ## OCaml implementation 63 | 64 | We also provide an implementation of selective functors in OCaml. To access it, 65 | change to the corresponding directory: 66 | 67 | ``` 68 | cd ~/selective-ocaml 69 | ``` 70 | 71 | You can build and test the project using the Dune build system: 72 | 73 | ``` 74 | dune build 75 | dune runtest 76 | ``` 77 | 78 | Note that lack of output means all tests have passed. 79 | 80 | The file `src/selective_intf.ml` contains the signature of the definition of the 81 | main module `Selective.S`, which provides the interface comprising all the 82 | selective combinators. 83 | 84 | You can take a look at an example S-expression parser, a `List` instance, and 85 | the `Task` abstraction from section 3.2 in the `example` directory. 86 | 87 | This package is available on OPAM: https://opam.ocaml.org/packages/selective/selective.0.1.0/. 88 | -------------------------------------------------------------------------------- /paper/cover-letter.txt: -------------------------------------------------------------------------------- 1 | Dear reviewers, 2 | 3 | We thank you once again for your suggestions and feedback. In the revised 4 | version of our paper "Selective Applicative Functors" we addressed your 5 | suggestions, including one mandatory change, copied below: 6 | 7 | ========================================================================= 8 | MANDATORY CHANGE: Please clarify your stance on the (non-)inclusion of 9 | applicative/selective/monad, at it would be most helpful for the reader 10 | who are likely to try and situate your work in the existing hierarchy. 11 | ========================================================================= 12 | 13 | To clarify the applicative-selective-monad hierarchy, we added a new paragraph 14 | on page 5 (line 220), which starts with "It is worth emphasising that...". We 15 | also added Table 1 on top of the same page 5, which compares the expressive 16 | power of the three operators in question (apply, select and bind). We hope that 17 | you will find this change satisfactory. Please do not hesitate to get in touch 18 | with us in case anything remains unclear. 19 | 20 | Kind regards, 21 | Andrey, Georgy, Simon and Jeremie 22 | -------------------------------------------------------------------------------- /paper/fig/add.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/add.pdf -------------------------------------------------------------------------------- /paper/fig/add.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 22 | 24 | 25 | 27 | image/svg+xml 28 | 30 | 31 | 32 | 33 | 34 | 36 | 44 | 50 | 51 | 59 | 65 | 66 | 75 | 81 | 82 | 91 | 97 | 98 | 106 | 112 | 113 | 122 | 128 | 129 | 136 | 137 | 161 | 172 | 183 | 186 | 195 | add R0 1 208 | 209 | 212 | 221 | Flag Zero 235 | 236 | Cell 1 250 | 259 | 262 | 271 | Register R0 285 | 286 | 292 | 298 | 301 | 307 | 313 | 314 | 315 | -------------------------------------------------------------------------------- /paper/fig/addAndJump.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/addAndJump.pdf -------------------------------------------------------------------------------- /paper/fig/build-dependencies.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/build-dependencies.pdf -------------------------------------------------------------------------------- /paper/fig/comment-haxl-applicative.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/comment-haxl-applicative.pdf -------------------------------------------------------------------------------- /paper/fig/comment-haxl-applicative.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 22 | 24 | 25 | 27 | image/svg+xml 28 | 30 | 31 | 32 | 33 | 34 | 36 | 44 | 50 | 51 | 59 | 65 | 66 | 74 | 80 | 81 | 88 | 89 | 122 | 127 | 128 | 134 | 145 | 156 | Parallelismand batching 173 | 174 | -------------------------------------------------------------------------------- /paper/fig/comment-haxl-monad.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/comment-haxl-monad.pdf -------------------------------------------------------------------------------- /paper/fig/comment-haxl-monad.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 22 | 24 | 25 | 27 | image/svg+xml 28 | 30 | 31 | 32 | 33 | 34 | 36 | 43 | 51 | 57 | 58 | 66 | 72 | 73 | 81 | 87 | 88 | 95 | 96 | 129 | 134 | 135 | 141 | 152 | 163 | Dynamicdependency onruntime value 'x' 185 | 186 | -------------------------------------------------------------------------------- /paper/fig/comment-haxl-selective-1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/comment-haxl-selective-1.pdf -------------------------------------------------------------------------------- /paper/fig/comment-haxl-selective-1.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 22 | 24 | 25 | 27 | image/svg+xml 28 | 30 | 31 | 32 | 33 | 34 | 36 | 44 | 50 | 51 | 59 | 65 | 66 | 74 | 80 | 81 | 88 | 89 | 122 | 127 | 128 | 134 | 145 | 156 | Abandonthe secondcomputation 178 | 179 | -------------------------------------------------------------------------------- /paper/fig/comment-haxl-selective-2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/comment-haxl-selective-2.pdf -------------------------------------------------------------------------------- /paper/fig/comment-haxl-selective-2.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 22 | 24 | 25 | 27 | image/svg+xml 28 | 30 | 31 | 32 | 33 | 34 | 36 | 44 | 50 | 51 | 59 | 65 | 66 | 74 | 80 | 81 | 88 | 89 | 122 | 127 | 128 | 134 | 145 | 156 | Speculativeexecution 173 | 174 | -------------------------------------------------------------------------------- /paper/fig/jumpZero.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/snowleopard/selective/4fcdeb1882ad8ee328bf6f9068e5d6201e65e220/paper/fig/jumpZero.pdf -------------------------------------------------------------------------------- /paper/fig/jumpZero.svg: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 22 | 24 | 25 | 27 | image/svg+xml 28 | 30 | 31 | 32 | 33 | 34 | 36 | 45 | 51 | 52 | 61 | 67 | 68 | 76 | 82 | 83 | 84 | 108 | 110 | 121 | 124 | 133 | jumpZero 42 146 | 147 | 150 | 159 | Flag Zero 173 | 174 | 183 | Register PC 197 | 203 | 209 | 215 | 216 | 217 | -------------------------------------------------------------------------------- /paper/main.tex: -------------------------------------------------------------------------------- 1 | \documentclass[acmsmall,screen]{acmart} 2 | 3 | %%% The following is specific to ICFP '19 and the paper 4 | %%% 'Selective Applicative Functors' 5 | %%% by Andrey Mokhov, Georgy Lukyanov, Simon Marlow, and Jeremie Dimino. 6 | %%% 7 | \setcopyright{rightsretained} 8 | \acmPrice{} 9 | \acmDOI{10.1145/3341694} 10 | \acmYear{2019} 11 | \copyrightyear{2019} 12 | \acmJournal{PACMPL} 13 | \acmVolume{3} 14 | \acmNumber{ICFP} 15 | \acmArticle{90} 16 | \acmMonth{8} 17 | 18 | \bibliographystyle{ACM-Reference-Format} 19 | \citestyle{acmauthoryear} 20 | 21 | %% Some recommended packages. 22 | \usepackage{booktabs} %% For formal tables: 23 | %% http://ctan.org/pkg/booktabs 24 | \usepackage{subcaption} %% For complex figures with subfigures/subcaptions 25 | %% http://ctan.org/pkg/subcaption 26 | 27 | \usepackage{bookmark} 28 | \usepackage[utf8]{inputenc} 29 | \usepackage[T1]{fontenc} 30 | \usepackage{xspace} 31 | \usepackage{fancyhdr} 32 | 33 | % Haskell code snippets and useful shortcuts 34 | \usepackage{minted} 35 | \setminted[haskell]{escapeinside=@@} 36 | \newcommand{\hs}{\mintinline{haskell}} 37 | \newcommand{\cmd}[1]{\textsf{\color[rgb]{0,0,0.5} #1}} 38 | \newcommand{\teq}{\smaller $\sim$} 39 | \newcommand{\ghci}{$\lambda$>} 40 | \newcommand{\defeq}{\stackrel{\text{def}}{=}} 41 | \newcommand{\dollar}{{\color[rgb]{0.40,0.40,0.40} \$}} 42 | \newcommand{\std}[1]{{\color[rgb]{0,0.3,0} #1}} 43 | \newcommand{\blk}[1]{{\color[rgb]{0,0,0} #1}} 44 | \newcommand{\blu}[1]{{\color[rgb]{0,0,1.0} #1}} 45 | 46 | % Questions and tasks 47 | \newcommand{\q}[2]{\textbf{\color{blue} Question #1:} #2} 48 | \newcommand{\todo}[2]{[\textbf{\color{red} #1:} #2]} 49 | 50 | % Abbreviations for projects 51 | \newcommand{\Dune}{\textsc{Dune}\xspace} 52 | \newcommand{\Haxl}{\textsc{Haxl}\xspace} 53 | 54 | \begin{document} 55 | 56 | %% Title information 57 | \title{Selective Applicative Functors} 58 | 59 | %% Sadly, it looks like we can't have a subtitle that doesn't also appear in the 60 | %% ACM Reference. 61 | % \subtitle{Declare Your Effects Statically, Select Which to Execute Dynamically} 62 | 63 | \author{Andrey Mokhov} 64 | \affiliation{ 65 | \institution{Newcastle University} 66 | \country{United Kingdom} 67 | } 68 | \email{andrey.mokhov@ncl.ac.uk} 69 | \author{Georgy Lukyanov} 70 | \affiliation{ 71 | \institution{Newcastle University} 72 | \country{United Kingdom} 73 | } 74 | \email{g.lukyanov2@ncl.ac.uk} 75 | \author{Simon Marlow} 76 | \affiliation{ 77 | \institution{Facebook} 78 | \city{London} 79 | \country{United Kingdom} 80 | } 81 | \email{smarlow@fb.com} 82 | \author{Jeremie Dimino} 83 | \affiliation{ 84 | \institution{Jane Street} 85 | \city{London} 86 | \country{United Kingdom} 87 | } 88 | \email{jdimino@janestreet.com} 89 | 90 | % Don't forget \thispagestyle{firstpagestyle} after \maketitle 91 | % \fancypagestyle{firstpagestyle} 92 | % { 93 | % \fancyhf{} 94 | % \renewcommand{\headrulewidth}{0.2pt} 95 | % \fancyhead[C]{Under review, feedback is sought} 96 | % } 97 | 98 | \begin{abstract} 99 | Applicative functors and monads have conquered the world of functional 100 | programming by providing general and powerful ways of describing effectful 101 | computations using pure functions. Applicative functors provide a way to compose 102 | \emph{independent effects} that cannot depend on values produced by earlier 103 | computations, and all of which are declared statically. Monads extend the 104 | applicative interface by making it possible to compose \emph{dependent effects}, 105 | where the value computed by one effect determines all subsequent effects, 106 | dynamically. 107 | 108 | This paper introduces an intermediate abstraction called \emph{selective 109 | applicative functors} that requires all effects to be declared statically, but 110 | provides a way to select which of the effects to execute dynamically. We 111 | demonstrate applications of the new abstraction on several examples, including 112 | two industrial case studies. 113 | \end{abstract} 114 | 115 | %% 2012 ACM Computing Classification System (CSS) concepts 116 | %% Generate at 'http://dl.acm.org/ccs/ccs.cfm'. 117 | \begin{CCSXML} 118 | 119 | 120 | 10011007 121 | Software and its engineering 122 | 500 123 | 124 | 125 | 10002950 126 | Mathematics of computing 127 | 300 128 | 129 | 130 | \end{CCSXML} 131 | \ccsdesc[500]{Software and its engineering} 132 | \ccsdesc[300]{Mathematics of computing} 133 | 134 | \keywords{applicative functors, selective functors, monads, effects} 135 | 136 | \maketitle 137 | % \thispagestyle{firstpagestyle} 138 | 139 | \input{1-intro} 140 | \input{2-selective} 141 | \input{3-static} 142 | \input{4-haxl} 143 | \input{5-free} 144 | \input{6-alternatives} 145 | \input{7-related} 146 | \input{8-conclusions} 147 | 148 | \begin{acks} 149 | %% Commands \grantsponsor{}{}{} and 150 | %% \grantnum[]{}{} should be used to 151 | %% acknowledge financial support and will be used by metadata 152 | %% extraction tools. 153 | We are very grateful to everyone who contributed by participating in numerous 154 | discussions and providing feedback on earlier drafts of this paper. 155 | 156 | Arseniy Alekseyev, Ulan Degenbaev and Neil Mitchell have been closely 157 | following the work on selective functors from the very first blog post; their 158 | early and constructive feedback encouraged and guided our research. 159 | 160 | Many others have joined and helped as the work progressed, including: 161 | Thorsten Altenkirch, \mbox{Baldur} Bl{\"o}ndal, Dominique Devriese, 162 | Ivan Gotovchits, Oleg Grenrus, Jennifer Hackett, Graham Hutton, 163 | Luka Jacobowitz, Edward Kmett, Lennox S. Leary, G\'abor Lehel, Sam Lindley, 164 | Tim McGilchrist, James McKinna, Yaron Minsky, Alexandre Moine, Matthew Naylor, 165 | Daniel Peebles, Artem Pelenitsyn, Simon Peyton Jones, Ivan Polyakov, 166 | Gabriel Radanne, Asad Saeeduddin, Irakli Safareli, Carter Schonwald, 167 | Danil Sokolov, Ian Treyball, Anton Trunov, Cristian Urlea, Sjoerd Visscher, 168 | Alexa de Wit, Brent Yorgey, Vladislav Zavialov, and reddit users 169 | \cmd{Darwin226}, \cmd{dmwit}, \cmd{sclv}, \cmd{viercc} and \cmd{yakrar}. With 170 | such an active and helpful community, we are certain that the above list is 171 | just an under-approximation of all our interactions, and we apologise for any 172 | omissions. 173 | 174 | Last but not least, we would like to thank the four ICFP reviewers who 175 | discovered and helped to fix a few important issues in the submitted version 176 | of the paper. 177 | 178 | Andrey Mokhov's research is supported by a Royal Society Industry Fellowship 179 | \cmd{IF160117} on the topic ``Towards Cloud Build Systems with Dynamic 180 | Dependency Graphs''. 181 | \end{acks} 182 | 183 | \newpage 184 | \bibliography{refs} 185 | \end{document} 186 | -------------------------------------------------------------------------------- /paper/response.md: -------------------------------------------------------------------------------- 1 | We thank the reviewers for their feedback, and will address all minor suggestions in the revision. 2 | 3 | # Key points 4 | 5 | > **A:** The paper fails to clearly convey what makes Applicative functors (strictly) weaker than Selective functors. 6 | 7 | The `Applicative` operator `<*>` composes independent computations. The `Selective` interface adds the operator `select` to compose dependent computations, where *a computation can depend on the value produced by a previous computation*. This makes the `Selective` interface strictly more powerful. While we already state this at the beginning of S2, we'll make this key insight more prominent in the revision. 8 | 9 | > **A:** I was not entirely convinced about the interface, laws or the relationship with Applicative Functors... Is there any type constructor f, which is Applicative but not Selective? 10 | 11 | The answer is "No" (we say this in line 192). 12 | 13 | > **A:** this is odd because the authors argue that Applicative < Selective < Monad. Thus I would have expected some things to be Applicative, but not Selective. 14 | 15 | The relationship between `Applicative` and `Selective` differs from the relationship between `Applicative` and `Monad`. Not every `Applicative` is a `Monad`, but every `Applicative` is a `Selective`. The subclass relationship `Applicative < Selective` is justified not by possible instances, but by the extra method `select` in `Selective`. While `select = selectA` is a valid implementation of `select`, *it is not the only useful implementation*, as demonstrated by `Selective` instances `Over` and `Under`: indeed, `Over` uses `select = selectA`, but `Under` doesn't. 16 | 17 | The hierarchy therefore reflects method set inclusion: `{<*>}` < `{<*>, select}` < `{<*>, select, >>=}`. Different applications require different sets of methods. For example, *Haxl requires all three*: `<*>` gives parallelism, `select` gives speculative execution, and `>>=` gives arbitrary dynamic effects. 18 | 19 | We'll clarify this subtle point in the revision. 20 | 21 | > **B:** In the implementation of `write` you evaluate the value to get the associated effects. It's clear that this is needed for the static analysis, but I worry that it will lead to quadratic or exponential blowup in the simulation. 22 | 23 | Thank you for pointing out this problem! Indeed, the implementation of `write` presented in S5.3 causes an exponential blowup when simulating `write` chains, such as `write k0 (write k1 (write k2 (read k3)))`, performing `read k3` 2^3=8 times. 24 | 25 | Fortunately, we can fix the problem as follows. We simplify the implementation of `write` in line 919 to: 26 | 27 | ``` 28 | write k fv = liftSelect (Write k fv id) 29 | ``` 30 | 31 | Static analysis (`getProgramEffects` below) is then performed via the natural transformation `toOver` that records effects in `fv` plus the write effect `Write k` itself: 32 | 33 | ``` 34 | toOver :: RW a -> Over [RW ()] a 35 | toOver (Read k _ ) = Over [Read k (const ())] 36 | toOver (Write k fv _) = runSelect toOver fv *> Over [Write k fv (const ())] 37 | 38 | getProgramEffects :: Program a -> [RW ()] 39 | getProgramEffects = getOver . runSelect toOver 40 | ``` 41 | 42 | The natural transformation `toState` needs no changes. The above fix not only removes effect duplication, but also makes the implementation more uniform. We'll include the fix into the revision. 43 | 44 | > **C:** At least, I would like to see a concrete instance that is Selective but (at least believed) not (to be) ArrowChoice... I do not believe that we "could use arrows to solve our static analysis and speculative execution examples" 45 | 46 | A `Selective` instance cannot be an instance of `ArrowChoice` because of kind mismatch, so it's unclear how to respond to the first comment without making additional assumptions. Here is an example of static analysis based on free `ArrowChoice`: 47 | 48 | ``` 49 | newtype FreeArrowChoice f a b = FreeArrowChoice { 50 | runFreeArrowChoice :: forall arr. ArrowChoice arr => 51 | (forall i o. f i o -> arr i o) -> arr a b } 52 | 53 | newtype ConstArrow m a b = ConstArrow { getConstArrow :: m } 54 | 55 | foldArrowChoice :: Monoid m => (forall i o. f i o -> m) -> FreeArrowChoice f a b -> m 56 | foldArrowChoice t arr = getConstArrow $ runFreeArrowChoice arr (ConstArrow . t) 57 | ``` 58 | 59 | `ConstArrow` is similar to the `Const` functor: we convert the "base arrow" `f` to `ConstArrow` using the function `t`, and statically accumulate the resulting monoidal effect labels. 60 | 61 | To execute a `FreeArrowChoice` with actual values and branching we can use the `Kleisli` arrow. We'll provide a complete implementation as supplementary material and link to it. 62 | 63 | # Details 64 | 65 | > **A:** Wouldn't there also be quite a few advantages of having selective in the Applicative instance? 66 | 67 | One advantage is that adding `select` to `Applicative` avoids breaking the `Applicative => Monad` hierarchy. However, that would still break some code, because `select` would clash with existing definitions with the same name. We can elaborate on this in the revision. 68 | 69 | > **A:** Laws: The associativity law does indeed look rather ugly. I do wonder if an alternative interface would have not indeed be a better option. 70 | 71 | The `biselect` method (S6.2) has a simpler associativity law, but is more complex in other aspects. While future implementations of selective functors might use `biselect`, we believe that `select` is more appropriate for introducing the idea of selective functors to the broader community. 72 | 73 | > **B:** You write "parametricity dictates that, when given a `Left a`, we must execute the effects in `f (a -> b)`". It should be pointed out that this is only true if you are required to produce a `b`. 74 | 75 | > **B:** Validation does in fact satisfy both the pure Left and pure Right 76 | 77 | Indeed! We'll fix both issues. 78 | 79 | > **C:** Maybe, I have missed some descriptions, but the rigidness is the key insight for Section 5, the discussions about typical reasons for a selective functor to be not rigid would strengthen the paper. 80 | 81 | > **C:** It is hard to understand the program presented here [in Fig. 6] 82 | 83 | We agree and will address these suggestions. 84 | 85 | > **C:** "Interestingly, adding the ability to branch on infinite number of cases makes selective functors equivalent to a monad" -- Is it really true? How can we perform such a branching for a function for example without breaking parametricity? 86 | 87 | Daniel Peebles pointed out a variation of `branch`, which is `>>=` in disguise: 88 | 89 | ``` 90 | branch :: f (Sigma h) -> (forall a. h a -> f (a -> b)) -> f b 91 | ``` 92 | 93 | `Sigma h` is a "tagged union" with generalised "tags" `h`, which can in particular be functions. We'll provide a complete implementation as supplementary material. -------------------------------------------------------------------------------- /paper/todo.md: -------------------------------------------------------------------------------- 1 | # Things to think about and try to squeeze into the paper 2 | 3 | ## Connections/applications 4 | 5 | * Build systems: Bazel is also a selective build system built on top of monadic build engine. Also, selective 6 | functors are relevant for shallow builds, when one can materialise the end target by providing a hash 7 | of an over-approximation of all possible dependencies. 8 | 9 | * Connections to linear logic: https://twitter.com/phadej/status/1102660761938284544 10 | 11 | * Connections to lenses/traversable functors: https://twitter.com/andreymokhov/status/1102733512812232704 12 | 13 | * Connections to probabilistic programming: http://mlg.eng.cam.ac.uk/pub/pdf/SciGhaGor15.pdf. 14 | Also: https://www.quora.com/Can-you-give-some-exampes-of-Applicative-Functors-which-are-not-Monads. 15 | 16 | * `Selective ZipList` and SIMT execution model: https://en.wikipedia.org/wiki/Single_instruction,_multiple_threads 17 | 18 | > to handle an IF-ELSE block where various threads of a processor execute 19 | > different paths, all threads must actually process both paths (as all threads 20 | > of a processor always execute in lock-step), but masking is used to disable 21 | > and enable the various threads as appropriate 22 | 23 | * Connections to FRP: https://discuss.ocaml.org/t/an-intermediate-abstraction-between-applicatives-and-monads/3441/3 24 | 25 | * ISA modelling: https://discuss.ocaml.org/t/an-intermediate-abstraction-between-applicatives-and-monads/3441/13 26 | 27 | * Go's `select` statement: https://golangbot.com/select/, as suggested 28 | [in this Tweet](https://twitter.com/igstan/status/1102560124726583297). 29 | 30 | ## Existing similar abstractions 31 | 32 | * Mirage's configuration DSL: https://docs.mirage.io/mirage/Mirage/index.html#val-if_impl 33 | 34 | * The Typed Tagless Final paper has type class `BoolSYM` with method `if_`: http://okmij.org/ftp/tagless-final/course/lecture.pdf 35 | 36 | > > Good point! Typed Tagless Final deserves a discussion. Actually, I think our approach is an example of Typed 37 | > > Tagless Final: it’s a type class that gives you a (generalised version of) if statement, which you can 38 | > > mix&match with other capabilities! In fact, one of the examples in Typed Tagless Final is the type class 39 | > > BoolSYM with if_ method. 40 | 41 | > That’s exactly how I’m seeing it. Not to diminish the value of the work, but just to fit into the 42 | > mathematical framework, I would say that Selective is a signature of a particular language (structure) 43 | > and you’re applying the tagless-final approach to investigate its behavior and capabilities. 44 | 45 | ## Towards monadic bind 46 | 47 | * @sclv: https://www.reddit.com/r/haskell/comments/axje88/selective_applicative_functors/ehw5x6l/ 48 | 49 | > one could actually use `unsafePerformIO` to very unsafely actually get the binary representation 50 | > of the thunk, and "read it out" byte by byte, then based on branching on that, only enter actual 51 | > "proper" value. (i.e. since we're inside a machine, we actually only have finitary representations, 52 | > even if our data structures "look" infinite -- this is actually a form of "Skolem's Paradox"!). 53 | > (The idea of this bitwise testing thing is inspired by some of the tricks used in the classic 54 | > "Implicit Configurations" paper: http://okmij.org/ftp/Haskell/tr-15-04.pdf) 55 | > So in "real" terms, bind is by a series of dirty hacks, fully recoverable from select. 56 | 57 | 58 | ## Remaining bits and pieces from reviews: address if enough space 59 | 60 | > You omit various performance improvements for clarity, but can you say something about the performance of the free selective functors. It looks like there would be a lot of book-keeping overhead from all the nested sum types. 61 | 62 | > Now that I read more on the paper I see that such an alternative is briefly discussed in Section 6. Wouldn't there also be quite a few advantages of having selective in the Applicative instance? 63 | 64 | * One advantage is that adding select to Applicative avoids breaking the Applicative => Monad hierarchy. However, that would still break some code, because select would clash with existing definitions with the same name. We can elaborate on this in the revision. 65 | -------------------------------------------------------------------------------- /selective.cabal: -------------------------------------------------------------------------------- 1 | name: selective 2 | version: 0.7.0.1 3 | synopsis: Selective applicative functors 4 | license: MIT 5 | license-file: LICENSE 6 | author: Andrey Mokhov , github: @snowleopard 7 | maintainer: Andrey Mokhov , github: @snowleopard 8 | copyright: Andrey Mokhov, 2018-2024 9 | homepage: https://github.com/snowleopard/selective 10 | bug-reports: https://github.com/snowleopard/selective/issues 11 | category: Control 12 | build-type: Simple 13 | cabal-version: 1.18 14 | tested-with: GHC==9.8.2, GHC==9.6.3, GHC==9.4.7, GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5 15 | description: Selective applicative functors: declare your effects statically, 16 | select which to execute dynamically. 17 | . 18 | This is a library for /selective applicative functors/, or just 19 | /selective functors/ for short, an abstraction between 20 | applicative functors and monads, introduced in 21 | . 22 | 23 | extra-doc-files: 24 | CHANGES.md 25 | README.md 26 | 27 | source-repository head 28 | type: git 29 | location: https://github.com/snowleopard/selective.git 30 | 31 | library 32 | hs-source-dirs: src 33 | exposed-modules: Control.Selective, 34 | Control.Selective.Free, 35 | Control.Selective.Multi, 36 | Control.Selective.Rigid.Free, 37 | Control.Selective.Rigid.Freer, 38 | Control.Selective.Trans.Except 39 | build-depends: base >= 4.12 && < 5, 40 | transformers >= 0.4.2.0 && < 0.7 41 | default-language: Haskell2010 42 | other-extensions: DeriveFunctor, 43 | FlexibleInstances, 44 | GADTs, 45 | GeneralizedNewtypeDeriving, 46 | RankNTypes, 47 | StandaloneDeriving, 48 | TupleSections, 49 | DerivingVia 50 | ghc-options: -Wall 51 | -fno-warn-name-shadowing 52 | -Wcompat 53 | -Wincomplete-record-updates 54 | -Wincomplete-uni-patterns 55 | -Wredundant-constraints 56 | if impl(ghc >= 9.2) 57 | ghc-options: -Wno-operator-whitespace-ext-conflict 58 | 59 | test-suite main 60 | hs-source-dirs: test, examples 61 | other-modules: Build, 62 | Laws, 63 | Parser, 64 | Processor, 65 | Query, 66 | Sketch, 67 | Teletype, 68 | Teletype.Rigid, 69 | Test, 70 | Validation 71 | type: exitcode-stdio-1.0 72 | main-is: Main.hs 73 | build-depends: base >= 4.7 && < 5, 74 | containers >= 0.5.5.1 && < 0.8, 75 | QuickCheck >= 2.8 && < 2.15, 76 | selective, 77 | transformers >= 0.4.2.0 && < 0.7 78 | default-language: Haskell2010 79 | ghc-options: -Wall 80 | -fno-warn-name-shadowing 81 | -Wcompat 82 | -Wincomplete-record-updates 83 | -Wincomplete-uni-patterns 84 | -Wredundant-constraints 85 | if impl(ghc >= 9.2) 86 | ghc-options: -Wno-operator-whitespace-ext-conflict 87 | -------------------------------------------------------------------------------- /src/Control/Selective/Free.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Control.Selective.Free 5 | -- Copyright : (c) Andrey Mokhov 2018-2024 6 | -- License : MIT (see the file LICENSE) 7 | -- Maintainer : andrey.mokhov@gmail.com 8 | -- Stability : experimental 9 | -- 10 | -- This is a library for /selective applicative functors/, or just 11 | -- /selective functors/ for short, an abstraction between applicative functors 12 | -- and monads, introduced in this paper: https://dl.acm.org/doi/10.1145/3341694. 13 | -- 14 | -- This module defines /free selective functors/ using the ideas from the 15 | -- Sjoerd Visscher's package 'free-functors': 16 | -- https://hackage.haskell.org/package/free-functors-1.0.1/docs/Data-Functor-HFree.html. 17 | -- 18 | ----------------------------------------------------------------------------- 19 | module Control.Selective.Free ( 20 | -- * Free selective functors 21 | Select (..), liftSelect, 22 | 23 | -- * Static analysis 24 | getPure, getEffects, getNecessaryEffects, runSelect, foldSelect 25 | ) where 26 | 27 | import Control.Selective 28 | import Data.Functor 29 | 30 | -- | Free selective functors. 31 | newtype Select f a = Select (forall g. Selective g => (forall x. f x -> g x) -> g a) 32 | 33 | -- Ignoring the hint, since GHC can't type check the suggested code. 34 | {-# ANN module "HLint: ignore Use fmap" #-} 35 | instance Functor (Select f) where 36 | fmap f (Select x) = Select $ \k -> f <$> x k 37 | 38 | instance Applicative (Select f) where 39 | pure a = Select $ \_ -> pure a 40 | Select x <*> Select y = Select $ \k -> x k <*> y k 41 | 42 | instance Selective (Select f) where 43 | select (Select x) (Select y) = Select $ \k -> x k <*? y k 44 | 45 | -- | Lift a functor into a free selective computation. 46 | liftSelect :: f a -> Select f a 47 | liftSelect x = Select (\f -> f x) 48 | 49 | -- | Given a natural transformation from @f@ to @g@, this gives a canonical 50 | -- natural transformation from @Select f@ to @g@. Note that here we rely on the 51 | -- fact that @g@ is a lawful selective functor. 52 | runSelect :: Selective g => (forall x. f x -> g x) -> Select f a -> g a 53 | runSelect k (Select x) = x k 54 | 55 | -- | Concatenate all effects of a free selective computation. 56 | foldSelect :: Monoid m => (forall x. f x -> m) -> Select f a -> m 57 | foldSelect f = getOver . runSelect (Over . f) 58 | 59 | -- | Extract the resulting value if there are no necessary effects. 60 | getPure :: Select f a -> Maybe a 61 | getPure = runSelect (const Nothing) 62 | 63 | -- | Collect /all possible effects/ in the order they appear in a free selective 64 | -- computation. 65 | getEffects :: Functor f => Select f a -> [f ()] 66 | getEffects = foldSelect (pure . void) 67 | 68 | -- | Extract /all necessary effects/ in the order they appear in a free 69 | -- selective computation. 70 | getNecessaryEffects :: Functor f => Select f a -> [f ()] 71 | getNecessaryEffects = getUnder . runSelect (Under . pure . void) 72 | -------------------------------------------------------------------------------- /src/Control/Selective/Multi.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, GADTs, RankNTypes, TupleSections, TypeOperators #-} 2 | {-# LANGUAGE ScopedTypeVariables, LambdaCase #-} 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Control.Selective.Multi 6 | -- Copyright : (c) Andrey Mokhov 2018-2024 7 | -- License : MIT (see the file LICENSE) 8 | -- Maintainer : andrey.mokhov@gmail.com 9 | -- Stability : experimental 10 | -- 11 | -- This is a library for /selective applicative functors/, or just 12 | -- /selective functors/ for short, an abstraction between applicative functors 13 | -- and monads, introduced in this paper: https://dl.acm.org/doi/10.1145/3341694. 14 | -- 15 | -- This module defines /multi-way selective functors/, which are more efficient 16 | -- when selecting from a large number of options. They also fully subsume the 17 | -- 'Applicative' type class because they allow to express the notion of 18 | -- independet effects. 19 | -- 20 | -- This definition is inspired by the following construction by Daniel Peebles, 21 | -- with the main difference being the added @Enumerable@ constraint: 22 | -- https://gist.github.com/copumpkin/d5bdbc7afda54ff04049b6bdbcffb67e 23 | -- 24 | ----------------------------------------------------------------------------- 25 | module Control.Selective.Multi ( 26 | -- * Generalised sum types 27 | Sigma (..), inject, Zero, One (..), Two (..), Many (..), many, matchPure, 28 | eitherToSigma, sigmaToEither, 29 | 30 | -- * Selective functors 31 | Some (..), Enumerable (..), Selective (..), Over (..), Under (..), select, 32 | branch, apS, bindS, 33 | 34 | -- * Applicative functors 35 | ApplicativeS (..), ap, matchA, 36 | 37 | -- * Monads 38 | MonadS (..), bind, matchM, 39 | 40 | -- * Generalised products and various combinators 41 | type (~>), Pi, project, identity, compose, apply, toSigma, fromSigma, toPi, 42 | fromPi, pairToPi, piToPair, Case (..), matchCases, 43 | ) where 44 | 45 | import Control.Applicative ((<**>)) 46 | import Data.Functor.Identity 47 | 48 | ------------------------ Meet two friends: Sigma and Pi ------------------------ 49 | -- | A generalised sum type where @t@ stands for the type of constructor "tags". 50 | -- Each tag has a type parameter @x@ which determines the type of the payload. 51 | -- A 'Sigma' @t@ value therefore contains a payload whose type is not visible 52 | -- externally but is revealed when pattern-matching on the tag. 53 | -- 54 | -- See 'Two', 'eitherToSigma' and 'sigmaToEither' for an example. 55 | data Sigma t where 56 | Sigma :: t x -> x -> Sigma t 57 | 58 | -- | An injection into a generalised sum. An alias for 'Sigma'. 59 | inject :: t x -> x -> Sigma t 60 | inject = Sigma 61 | 62 | -- | A data type defining no tags. Similar to 'Data.Void.Void' but parameterised. 63 | data Zero a where 64 | 65 | -- | A data type with a single tag. This data type is commonly known as @Refl@, 66 | -- see "Data.Type.Equality". 67 | data One a b where 68 | One :: One a a 69 | 70 | -- | A data type with two tags 'A' and 'B' that allows us to encode the good old 71 | -- 'Either' as 'Sigma' 'Two', where the tags 'A' and 'B' correspond to 'Left' 72 | -- and 'Right', respectively. See 'eitherToSigma' and 'sigmaToEither' that 73 | -- witness the isomorphism between 'Either' @a b@ and 'Sigma' @(@'Two'@ a b)@. 74 | data Two a b c where 75 | A :: Two a b a 76 | B :: Two a b b 77 | 78 | -- | Encode 'Either' into a generalised sum type. 79 | eitherToSigma :: Either a b -> Sigma (Two a b) 80 | eitherToSigma = \case 81 | Left a -> inject A a 82 | Right b -> inject B b 83 | 84 | -- | Decode 'Either' from a generalised sum type. 85 | sigmaToEither :: Sigma (Two a b) -> Either a b 86 | sigmaToEither = \case 87 | Sigma A a -> Left a 88 | Sigma B b -> Right b 89 | 90 | -- | A potentially uncountable collection of tags for the same unit @()@ payload. 91 | data Many a b where 92 | Many :: a -> Many a () 93 | 94 | many :: a -> Sigma (Many a) 95 | many a = Sigma (Many a) () 96 | 97 | -- | Generalised pattern matching on a Sigma type using a Pi type to describe 98 | -- how to handle each case. 99 | -- 100 | -- This is a specialisation of 'matchCases' for @f = Identity@. We could also 101 | -- have also given it the following type: 102 | -- 103 | -- @ 104 | -- matchPure :: Sigma t -> (t ~> Case Identity a) -> a 105 | -- @ 106 | -- 107 | -- We chose to simplify it by inlining '~>', 'Case' and 'Identity'. 108 | matchPure :: Sigma t -> (forall x. t x -> x -> a) -> a 109 | matchPure (Sigma t x) pi = pi t x 110 | 111 | ------------------------- Mutli-way selective functors ------------------------- 112 | -- | Hide the type of the payload a tag. 113 | -- 114 | -- There is a whole library dedicated to this nice little GADT: 115 | -- http://hackage.haskell.org/package/some. 116 | data Some t where 117 | Some :: t a -> Some t 118 | 119 | -- | A class of tags that can be enumerated. 120 | -- 121 | -- A valid instance must list every tag in the resulting list exactly once. 122 | class Enumerable t where 123 | enumerate :: [Some t] 124 | 125 | instance Enumerable Zero where 126 | enumerate = [] 127 | 128 | instance Enumerable (One a) where 129 | enumerate = [Some One] 130 | 131 | instance Enumerable (Two a b) where 132 | enumerate = [Some A, Some B] 133 | 134 | instance Enum a => Enumerable (Many a) where 135 | enumerate = [ Some (Many x) | x <- enumFrom (toEnum 0) ] 136 | 137 | -- | Multi-way selective functors. Given a computation that produces a value of 138 | -- a sum type, we can 'match' it to the corresponding computation in a given 139 | -- product type. 140 | -- 141 | -- For greater similarity with 'matchCases', we could have given the following 142 | -- type to 'match': 143 | -- 144 | -- @ 145 | -- match :: f (Sigma t) -> (t ~> Case f a) -> f a 146 | -- @ 147 | -- 148 | -- We chose to simplify it by inlining '~>' and 'Case'. 149 | class Applicative f => Selective f where 150 | match :: Enumerable t => f (Sigma t) -> (forall x. t x -> f (x -> a)) -> f a 151 | 152 | -- | The basic "if-then" selection primitive from "Control.Selective". 153 | select :: Selective f => f (Either a b) -> f (a -> b) -> f b 154 | select x f = match (eitherToSigma <$> x) $ \case 155 | A -> f 156 | B -> pure id 157 | 158 | -- | Choose a matching effect with 'Either'. 159 | branch :: Selective f => f (Either a b) -> f (a -> c) -> f (b -> c) -> f c 160 | branch x f g = match (eitherToSigma <$> x) $ \case 161 | A -> f 162 | B -> g 163 | 164 | -- | Recover the application operator '<*>' from 'match'. 165 | apS :: Selective f => f a -> f (a -> b) -> f b 166 | apS x f = match (inject One <$> x) (\One -> f) 167 | 168 | -- | A restricted version of monadic bind. 169 | bindS :: (Enum a, Selective f) => f a -> (a -> f b) -> f b 170 | bindS x f = match (many <$> x) (\(Many x) -> const <$> f x) 171 | 172 | -- | Static analysis of selective functors with over-approximation. 173 | newtype Over m a = Over { getOver :: m } 174 | deriving (Eq, Functor, Ord, Show) 175 | 176 | instance Monoid m => Applicative (Over m) where 177 | pure _ = Over mempty 178 | Over x <*> Over y = Over (mappend x y) 179 | 180 | instance Monoid m => Selective (Over m) where 181 | match (Over m) pi = Over (mconcat (m : ms)) 182 | where 183 | ms = [ getOver (pi t) | Some t <- enumerate ] 184 | 185 | -- | Static analysis of selective functors with under-approximation. 186 | newtype Under m a = Under { getUnder :: m } 187 | deriving (Eq, Functor, Ord, Show) 188 | 189 | instance Monoid m => Applicative (Under m) where 190 | pure _ = Under mempty 191 | Under x <*> Under y = Under (mappend x y) 192 | 193 | instance Monoid m => Selective (Under m) where 194 | match (Under m) _ = Under m 195 | 196 | -- | An alternative definition of applicative functors, as witnessed by 'ap' and 197 | -- 'matchOne'. This class is almost like 'Selective' but has a strict constraint 198 | -- on @t@. 199 | class Functor f => ApplicativeS f where 200 | pureA :: a -> f a 201 | matchOne :: t ~ One x => f (Sigma t) -> (forall x. t x -> f (x -> a)) -> f a 202 | 203 | -- | Recover the application operator '<*>' from 'matchOne'. 204 | ap :: ApplicativeS f => f a -> f (a -> b) -> f b 205 | ap x f = matchOne (Sigma One <$> x) (\One -> f) 206 | 207 | -- | Every 'Applicative' is also an 'ApplicativeS'. 208 | matchA :: (Applicative f, t ~ One x) => f (Sigma t) -> (forall x. t x -> f (x -> a)) -> f a 209 | matchA x pi = (\(Sigma One x) -> x) <$> x <**> pi One 210 | 211 | -- | An alternative definition of monads, as witnessed by 'bind' and 'matchM'. 212 | -- This class is almost like 'Selective' but has no the constraint on @t@. 213 | class Applicative f => MonadS f where 214 | matchUnconstrained :: f (Sigma t) -> (forall x. t x -> f (x -> a)) -> f a 215 | 216 | -- Adapted from the original implementation by Daniel Peebles: 217 | -- https://gist.github.com/copumpkin/d5bdbc7afda54ff04049b6bdbcffb67e 218 | 219 | -- | Monadic bind. 220 | bind :: MonadS f => f a -> (a -> f b) -> f b 221 | bind x f = matchUnconstrained (many <$> x) (\(Many x) -> const <$> f x) 222 | 223 | -- | Every monad is a multi-way selective functor. 224 | matchM :: Monad f => f (Sigma t) -> (forall x. t x -> f (x -> a)) -> f a 225 | matchM sigma pi = sigma >>= \case Sigma t x -> ($x) <$> pi t 226 | 227 | -- | A generalised product type (Pi), which holds an appropriately tagged 228 | -- payload @u x@ for every possible tag @t x@. 229 | -- 230 | -- Note that this looks different than the standard formulation of Pi types. 231 | -- Maybe it's just all wrong! 232 | -- 233 | -- See 'Two', 'pairToPi' and 'piToPair' for an example. 234 | type (~>) t u = forall x. t x -> u x 235 | infixl 4 ~> 236 | 237 | -- | A product type where the payload has the type specified with the tag. 238 | type Pi t = t ~> Identity 239 | 240 | -- | A projection from a generalised product. 241 | project :: t a -> Pi t -> a 242 | project t pi = runIdentity (pi t) 243 | 244 | -- | A trivial product type that stores nothing and simply returns the given tag 245 | -- as the result. 246 | identity :: t ~> t 247 | identity = id 248 | 249 | -- | As it turns out, one can compose such generalised products. Why not: given 250 | -- a tag, get the payload of the first product and then pass it as input to the 251 | -- second. This feels too trivial to be useful but is still somewhat cute. 252 | compose :: (u ~> v) -> (t ~> u) -> (t ~> v) 253 | compose f g = f . g 254 | 255 | -- | Update a generalised sum given a generalised product that takes care of all 256 | -- possible cases. 257 | apply :: (t ~> u) -> Sigma t -> Sigma u 258 | apply pi (Sigma t x) = Sigma (pi t) x 259 | 260 | -- | Encode a value into a generalised sum type that has a single tag 'One'. 261 | toSigma :: a -> Sigma (One a) 262 | toSigma = inject One 263 | 264 | -- | Decode a value from a generalised sum type that has a single tag 'One'. 265 | fromSigma :: Sigma (One a) -> a 266 | fromSigma (Sigma One a) = a 267 | 268 | -- | Encode a value into a generalised product type that has a single tag 'One'. 269 | toPi :: a -> Pi (One a) 270 | toPi a One = Identity a 271 | 272 | -- | Decode a value from a generalised product type that has a single tag 'One'. 273 | fromPi :: Pi (One a) -> a 274 | fromPi = project One 275 | 276 | -- | Encode @(a, b)@ into a generalised product type. 277 | pairToPi :: (a, b) -> Pi (Two a b) 278 | pairToPi (a, b) = \case 279 | A -> Identity a 280 | B -> Identity b 281 | 282 | -- | Decode @(a, b)@ from a generalised product type. 283 | piToPair :: Pi (Two a b) -> (a, b) 284 | piToPair pi = (project A pi, project B pi) 285 | 286 | -- | Handler of a single case in a generalised pattern matching 'matchCases'. 287 | newtype Case f a x = Case { handleCase :: f (x -> a) } 288 | 289 | -- | Generalised pattern matching on a Sigma type using a Pi type to describe 290 | -- how to handle each case. 291 | matchCases :: Functor f => Sigma t -> (t ~> Case f a) -> f a 292 | matchCases (Sigma t x) pi = ($x) <$> handleCase (pi t) 293 | -------------------------------------------------------------------------------- /src/Control/Selective/Rigid/Free.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs, RankNTypes, TupleSections #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Control.Selective.Rigid.Free 5 | -- Copyright : (c) Andrey Mokhov 2018-2024 6 | -- License : MIT (see the file LICENSE) 7 | -- Maintainer : andrey.mokhov@gmail.com 8 | -- Stability : experimental 9 | -- 10 | -- This is a library for /selective applicative functors/, or just 11 | -- /selective functors/ for short, an abstraction between applicative functors 12 | -- and monads, introduced in this paper: https://dl.acm.org/doi/10.1145/3341694. 13 | -- 14 | -- This module defines /free rigid selective functors/. Rigid selective functors 15 | -- are those that satisfy the property @\<*\> = apS@. 16 | -- 17 | -- Intuitively, a selective functor @f@ is "rigid" if any expression @f a@ is 18 | -- equivalent to a list of effects chained with @select@ operators (the normal 19 | -- form given by the free construction). In contrast, "non-rigid" selective 20 | -- functors can have non-linear, tree-like shapes, because @<*>@ nodes can't be 21 | -- straightened using the @\<*\> = apS@ equation. 22 | -- 23 | ----------------------------------------------------------------------------- 24 | module Control.Selective.Rigid.Free ( 25 | -- * Free rigid selective functors 26 | Select (..), liftSelect, 27 | 28 | -- * Static analysis 29 | getPure, getEffects, getNecessaryEffect, runSelect, foldSelect 30 | ) where 31 | 32 | import Control.Selective.Trans.Except 33 | import Control.Selective 34 | import Data.Bifunctor 35 | import Data.Functor 36 | 37 | -- Inspired by free applicative functors by Capriotti and Kaposi. 38 | -- See: https://arxiv.org/pdf/1403.0749.pdf 39 | 40 | -- TODO: The current approach is simple but very slow: 'fmap' costs O(N), where 41 | -- N is the number of effects, and 'select' is even worse -- O(N^2). It is 42 | -- possible to improve both bounds to O(1) by using the idea developed for free 43 | -- applicative functors by Dave Menendez. See this blog post: 44 | -- https://www.eyrie.org/~zednenem/2013/05/27/freeapp 45 | -- An example implementation can be found here: 46 | -- http://hackage.haskell.org/package/free/docs/Control-Applicative-Free-Fast.html 47 | 48 | -- | Free rigid selective functors. 49 | data Select f a where 50 | Pure :: a -> Select f a 51 | Select :: Select f (Either a b) -> f (a -> b) -> Select f b 52 | 53 | -- TODO: Prove that this is a lawful 'Functor'. 54 | instance Functor f => Functor (Select f) where 55 | fmap f (Pure a) = Pure (f a) 56 | fmap f (Select x y) = Select (fmap f <$> x) (fmap f <$> y) 57 | 58 | -- TODO: Prove that this is a lawful 'Applicative'. 59 | instance Functor f => Applicative (Select f) where 60 | pure = Pure 61 | (<*>) = apS -- Rigid selective functors 62 | 63 | -- TODO: Prove that this is a lawful 'Selective'. 64 | instance Functor f => Selective (Select f) where 65 | -- Identity law 66 | select x (Pure y) = either y id <$> x 67 | 68 | -- Associativity law 69 | select x (Select y z) = Select (select (f <$> x) (g <$> y)) (h <$> z) 70 | where 71 | f = fmap Right 72 | g y a = bimap (,a) ($a) y 73 | h = uncurry 74 | 75 | {- The following can be used in the above implementation as select = selectOpt. 76 | 77 | -- An optimised implementation of select for the free instance. It accumulates 78 | -- the calls to fmap on the @y@ parameter to avoid traversing the list on every 79 | -- recursive step. 80 | selectOpt :: Functor f => Select f (Either a b) -> Select f (a -> b) -> Select f b 81 | selectOpt x y = go x y id 82 | 83 | -- We turn @Select f (a -> b)@ to @(Select f c, c -> (a -> b))@. Hey, co-Yoneda! 84 | go :: Functor f => Select f (Either a b) -> Select f c -> (c -> (a -> b)) -> Select f b 85 | go x (Pure y) k = either (k y) id <$> x 86 | go x (Select y z) k = Select (go (f <$> x) y (g . second k)) ((h . (k.)) <$> z) 87 | where 88 | f x = Right <$> x 89 | g y = \a -> bimap (,a) ($a) y 90 | h z = uncurry z 91 | -} 92 | 93 | -- | Lift a functor into a free selective computation. 94 | liftSelect :: Functor f => f a -> Select f a 95 | liftSelect f = Select (Pure (Left ())) (const <$> f) 96 | 97 | -- | Given a natural transformation from @f@ to @g@, this gives a canonical 98 | -- natural transformation from @Select f@ to @g@. 99 | runSelect :: Selective g => (forall x. f x -> g x) -> Select f a -> g a 100 | runSelect _ (Pure a) = pure a 101 | runSelect t (Select x y) = select (runSelect t x) (t y) 102 | 103 | -- | Concatenate all effects of a free selective computation. 104 | foldSelect :: Monoid m => (forall x. f x -> m) -> Select f a -> m 105 | foldSelect f = getOver . runSelect (Over . f) 106 | 107 | -- | Extract the resulting value if there are no necessary effects. 108 | getPure :: Select f a -> Maybe a 109 | getPure = runSelect (const Nothing) 110 | 111 | -- | Collect all possible effects in the order they appear in a free selective 112 | -- computation. 113 | getEffects :: Functor f => Select f a -> [f ()] 114 | getEffects = foldSelect (pure . void) 115 | 116 | -- Implementation used in the paper: 117 | -- getEffects = getOver . runSelect (Over . pure . void) 118 | 119 | -- | Extract the necessary effect from a free selective computation. Note: there 120 | -- can be at most one effect that is statically guaranteed to be necessary. 121 | getNecessaryEffect :: Functor f => Select f a -> Maybe (f ()) 122 | getNecessaryEffect = leftToMaybe . runExcept . runSelect (throwE . void) 123 | 124 | leftToMaybe :: Either a b -> Maybe a 125 | leftToMaybe (Left a) = Just a 126 | leftToMaybe _ = Nothing 127 | -------------------------------------------------------------------------------- /src/Control/Selective/Rigid/Freer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor, GADTs, RankNTypes #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Control.Selective.Rigid.Freer 5 | -- Copyright : (c) Andrey Mokhov 2018-2024 6 | -- License : MIT (see the file LICENSE) 7 | -- Maintainer : andrey.mokhov@gmail.com 8 | -- Stability : experimental 9 | -- 10 | -- This is a library for /selective applicative functors/, or just 11 | -- /selective functors/ for short, an abstraction between applicative functors 12 | -- and monads, introduced in this paper: https://dl.acm.org/doi/10.1145/3341694. 13 | -- 14 | -- This module defines /freer rigid selective functors/. Rigid selective 15 | -- functors are those that satisfy the property @\<*\> = apS@. Compared to the 16 | -- "free" construction from "Control.Selective.Rigid.Free", this "freer" 17 | -- construction does not require the underlying base data type to be a functor. 18 | -- 19 | ----------------------------------------------------------------------------- 20 | module Control.Selective.Rigid.Freer ( 21 | -- * Free rigid selective functors 22 | Select (..), liftSelect, 23 | 24 | -- * Static analysis 25 | getPure, getEffects, getNecessaryEffect, runSelect, foldSelect 26 | ) where 27 | 28 | import Control.Selective.Trans.Except 29 | import Control.Selective 30 | import Data.Bifunctor 31 | import Data.Function 32 | import Data.Functor 33 | 34 | -- Inspired by free applicative functors by Capriotti and Kaposi. 35 | -- See: https://arxiv.org/pdf/1403.0749.pdf 36 | 37 | -- Note: In the current implementation, 'fmap' and 'select' cost O(N), where N 38 | -- is the number of effects. It is possible to improve this to O(1) by using the 39 | -- idea developed for free applicative functors by Dave Menendez, see this blog 40 | -- post: https://www.eyrie.org/~zednenem/2013/05/27/freeapp. 41 | -- An example implementation can be found here: 42 | -- http://hackage.haskell.org/package/free/docs/Control-Applicative-Free-Fast.html 43 | 44 | -- | Free rigid selective functors. 45 | data Select f a where 46 | Pure :: a -> Select f a 47 | Select :: Select f (Either (x -> a) a) -> f x -> Select f a 48 | 49 | -- TODO: Prove that this is a lawful 'Functor'. 50 | instance Functor (Select f) where 51 | fmap f (Pure a) = Pure (f a) 52 | fmap f (Select x y) = Select (bimap (f.) f <$> x) y -- O(N) 53 | 54 | -- TODO: Prove that this is a lawful 'Applicative'. 55 | instance Applicative (Select f) where 56 | pure = Pure 57 | (<*>) = apS -- Rigid selective functors 58 | 59 | -- TODO: Prove that this is a lawful 'Selective'. 60 | instance Selective (Select f) where 61 | select = selectBy (first (&)) 62 | where 63 | selectBy :: (a -> Either (b -> c) c) -> Select f a -> Select f b -> Select f c 64 | selectBy f x (Pure y) = either ($y) id . f <$> x 65 | selectBy f x (Select y z) = Select (selectBy g x y) z -- O(N) 66 | where 67 | g a = case f a of Right c -> Right (Right c) 68 | Left bc -> Left (bimap (bc.) bc) 69 | 70 | -- | Lift a functor into a free selective computation. 71 | liftSelect :: f a -> Select f a 72 | liftSelect = Select (Pure (Left id)) 73 | 74 | -- | Given a natural transformation from @f@ to @g@, this gives a canonical 75 | -- natural transformation from @Select f@ to @g@. 76 | runSelect :: Selective g => (forall x. f x -> g x) -> Select f a -> g a 77 | runSelect _ (Pure a) = pure a 78 | runSelect t (Select x y) = select (runSelect t x) ((&) <$> t y) 79 | 80 | -- | Concatenate all effects of a free selective computation. 81 | foldSelect :: Monoid m => (forall x. f x -> m) -> Select f a -> m 82 | foldSelect f = getOver . runSelect (Over . f) 83 | 84 | -- | Extract the resulting value if there are no necessary effects. 85 | getPure :: Select f a -> Maybe a 86 | getPure = runSelect (const Nothing) 87 | 88 | -- | Collect all possible effects in the order they appear in a free selective 89 | -- computation. 90 | getEffects :: Functor f => Select f a -> [f ()] 91 | getEffects = foldSelect (pure . void) 92 | 93 | -- | Extract the necessary effect from a free selective computation. Note: there 94 | -- can be at most one effect that is statically guaranteed to be necessary. 95 | getNecessaryEffect :: Functor f => Select f a -> Maybe (f ()) 96 | getNecessaryEffect = leftToMaybe . runExcept . runSelect (throwE . void) 97 | 98 | leftToMaybe :: Either a b -> Maybe a 99 | leftToMaybe (Left a) = Just a 100 | leftToMaybe _ = Nothing 101 | -------------------------------------------------------------------------------- /src/Control/Selective/Trans/Except.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveTraversable, DerivingVia #-} 2 | {-# OPTIONS_GHC -Wno-redundant-constraints #-} 3 | ----------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Control.Selective.Trans.Except 6 | -- Copyright : (c) Andrey Mokhov 2018-2024 7 | -- License : MIT (see the file LICENSE) 8 | -- Maintainer : andrey.mokhov@gmail.com 9 | -- Stability : experimental 10 | -- 11 | -- This is a library for /selective applicative functors/, or just 12 | -- /selective functors/ for short, an abstraction between applicative functors 13 | -- and monads, introduced in this paper: https://dl.acm.org/doi/10.1145/3341694. 14 | -- 15 | -- This module defines a newtype around 'ExceptT' from @transformers@ with less 16 | -- restrictive 'Applicative', 'Selective', and 'Alternative' implementations. 17 | -- It supplies an @instance 'Selective' f => 'Selective' ('ExceptT' e f)@, which 18 | -- makes 'ExceptT' a bona-fide 'Selective' transformer. 19 | -- 20 | -- The API follows the API from the @transformers@ package, so it can be used as 21 | -- a drop-in replacement. The documentation can be found in the 22 | -- [@transformers@](https://hackage.haskell.org/package/transformers/docs/Control-Monad-Trans-Except.html) package. 23 | ----------------------------------------------------------------------------- 24 | module Control.Selective.Trans.Except where 25 | 26 | import Control.Applicative (Alternative) 27 | import Control.Monad (MonadPlus) 28 | import Control.Monad.Fix (MonadFix) 29 | import Control.Monad.IO.Class (MonadIO) 30 | import Control.Monad.Zip (MonadZip) 31 | import Data.Functor.Classes 32 | import Data.Functor.Contravariant (Contravariant) 33 | import Data.Functor.Identity 34 | #if MIN_VERSION_base(4,13,0) 35 | -- MonadFail is imported already 36 | #else 37 | import Control.Monad.Fail 38 | #endif 39 | 40 | import qualified Control.Monad.Trans.Except as T 41 | 42 | import Control.Selective 43 | import Control.Monad.Signatures 44 | 45 | -- | A newtype wrapper around 'T.ExceptT' from @transformers@ that provides less 46 | -- restrictive 'Applicative', 'Selective' and 'Alternative' instances. 47 | newtype ExceptT e f a = ExceptT { unwrap :: T.ExceptT e f a } 48 | deriving stock (Functor, Foldable, Traversable, Eq, Ord, Read, Show) 49 | deriving newtype 50 | (Monad, Contravariant, MonadFix, MonadFail, MonadZip, MonadIO, MonadPlus 51 | , Eq1, Ord1, Read1, Show1 ) -- These require -Wno-redundant-constraints 52 | deriving (Applicative, Selective, Alternative) via (ComposeEither f e) 53 | 54 | {- Why don't we provide a `MonadTrans (ExceptT e)` instance? 55 | 56 | Recall the definition of the MonadTrans type class: 57 | 58 | class (forall m. Monad m => Monad (t m)) => MonadTrans t where 59 | lift :: Monad m => m a -> t m a 60 | 61 | If we instantiate `t` to `ExceptT e` in the constraint, we get 62 | 63 | forall m. Monad m => Monad (ExceptT e m) 64 | 65 | but the `Applicative (ExceptT e m)` instance comes with the `Selective m` 66 | constraint, and since Selective is not a superclass of Monad, we're stuck. 67 | In other words, `ExceptT` is really not a universal monad transformer: it 68 | works only for monads `m` that also happen to have a `Selective m` instance. 69 | 70 | I can see three possible solutions but none of them has a chance of working 71 | in practice: 72 | 73 | * Change the constraint in the definition of MonadTrans to 74 | 75 | forall m. (Selective m, Monad m) => Monad (ExceptT e m) 76 | 77 | * Make Selective a superclass of Monad 78 | * Revert the "Applicative is a superclass of Monad" proposal (lol!) 79 | 80 | And so we just don't provide `MonadTrans (ExceptT e)` instance. 81 | 82 | We could provide a SelectiveTrans instance instead, where 83 | 84 | class (forall f. Selective f => Selective (t f)) => SelectiveTrans t where 85 | lift :: Selective f => f a -> t f a 86 | 87 | Sounds fun! 88 | -} 89 | 90 | -- | Inject an 'T.ExceptT' value into the newtype wrapper. 91 | wrap :: T.ExceptT e m a -> ExceptT e m a 92 | wrap = ExceptT 93 | 94 | type Except e = ExceptT e Identity 95 | 96 | except :: Monad m => Either e a -> ExceptT e m a 97 | except = ExceptT . T.except 98 | 99 | runExcept :: Except e a -> Either e a 100 | runExcept = T.runExcept . unwrap 101 | 102 | mapExcept :: (Either e a -> Either e' b) -> Except e a -> Except e' b 103 | mapExcept f = ExceptT . T.mapExcept f . unwrap 104 | 105 | withExcept :: (e -> e') -> Except e a -> Except e' a 106 | withExcept f = ExceptT . T.withExcept f . unwrap 107 | 108 | runExceptT :: ExceptT e m a -> m (Either e a) 109 | runExceptT = T.runExceptT . unwrap 110 | 111 | mapExceptT :: (m (Either e a) -> n (Either e' b)) -> ExceptT e m a -> ExceptT e' n b 112 | mapExceptT f = ExceptT . T.mapExceptT f . unwrap 113 | 114 | withExceptT :: Functor m => (e -> e') -> ExceptT e m a -> ExceptT e' m a 115 | withExceptT f = ExceptT . T.withExceptT f . unwrap 116 | 117 | throwE :: Monad m => e -> ExceptT e m a 118 | throwE = ExceptT . T.throwE 119 | 120 | catchE :: Monad m => ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a 121 | catchE action continuation = ExceptT $ T.catchE (unwrap action) (unwrap . continuation) 122 | 123 | liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b 124 | liftCallCC callCC caller = ExceptT $ T.liftCallCC callCC (unwrap . caller . (ExceptT .)) 125 | 126 | liftListen :: Monad m => Listen w m (Either e a) -> Listen w (ExceptT e m) a 127 | liftListen listen (ExceptT action) = ExceptT $ T.liftListen listen action 128 | 129 | liftPass :: Monad m => Pass w m (Either e a) -> Pass w (ExceptT e m) a 130 | liftPass pass (ExceptT action) = ExceptT $ T.liftPass pass action 131 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-20.19 # ghc-9.2.7 2 | 3 | ghc-options: 4 | '$everything': -haddock 5 | -------------------------------------------------------------------------------- /test/Laws.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances, TupleSections, TypeApplications #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} 5 | module Laws where 6 | 7 | import Control.Arrow hiding (first, second) 8 | import qualified Control.Monad.Trans.Except as Transformers 9 | import Control.Monad.Trans.Writer 10 | import Control.Selective 11 | import Control.Selective.Trans.Except 12 | import Data.Bifunctor (bimap, first, second) 13 | import Data.Function 14 | import Data.Functor.Identity 15 | import Test.QuickCheck hiding (Failure, Success) 16 | import Text.Show.Functions() 17 | 18 | -- | TODO: 19 | -- ifS (pure x) a1 b1 *> ifS (pure x) a2 b2 = ifS (pure x) (a1 *> a2) (b1 *> b2) 20 | 21 | -------------------------------------------------------------------------------- 22 | ------------------------ Laws -------------------------------------------------- 23 | -------------------------------------------------------------------------------- 24 | -- | Identity 25 | lawIdentity :: (Selective f, Eq (f a)) => f (Either a a) -> Bool 26 | lawIdentity x = (x <*? pure id) == (either id id <$> x) 27 | 28 | -- | Distributivity 29 | lawDistributivity :: (Selective f, Eq (f b)) => Either a b -> f (a -> b) -> f (a -> b) -> Bool 30 | lawDistributivity x y z = (pure x <*? (y *> z)) == ((pure x <*? y) *> (pure x <*? z)) 31 | 32 | -- | Associativity 33 | lawAssociativity :: (Selective f, Eq (f c)) => 34 | f (Either b c) -> f (Either a (b -> c)) -> f (a -> b -> c) -> Bool 35 | lawAssociativity x y z = 36 | (x <*? (y <*? z)) == ((f <$> x) <*? (g <$> y) <*? (h <$> z)) 37 | where 38 | f = fmap Right 39 | g y a = bimap (,a) ($a) y 40 | h = uncurry 41 | 42 | {- | If 'f' is a 'Monad' |-} 43 | 44 | lawMonad :: (Selective f, Monad f, Eq (f b)) => f (Either a b) -> f (a -> b) -> Bool 45 | lawMonad x f = select x f == selectM x f 46 | 47 | selectALaw :: (Selective f, Eq (f b)) => f (Either a b) -> f (a -> b) -> Bool 48 | selectALaw x f = select x f == selectA x f 49 | 50 | -------------------------------------------------------------------------------- 51 | ------------------------ Theorems ---------------------------------------------- 52 | -------------------------------------------------------------------------------- 53 | {-| Theorems about selective applicative functors, see Fig. 4 of the paper |-} 54 | 55 | -- | Apply a pure function to the result: 56 | theorem1 :: (Selective f, Eq (f c)) => (a -> c) -> f (Either b a) -> f (b -> a) -> Bool 57 | theorem1 f x y = (f <$> select x y) == select (second f <$> x) ((f .) <$> y) 58 | 59 | -- | Apply a pure function to the Left case of the first argument: 60 | theorem2 :: (Selective f, Eq (f c)) => (a -> b) -> f (Either a c) -> f (b -> c) -> Bool 61 | theorem2 f x y = select (first f <$> x) y == select x ((. f) <$> y) 62 | 63 | -- | Apply a pure function to the second argument: 64 | theorem3 :: (Selective f, Eq (f c)) => (a -> b -> c) -> f (Either b c) -> f a -> Bool 65 | theorem3 f x y = select x (f <$> y) == select (first (flip f) <$> x) ((&) <$> y) 66 | 67 | -- | Generalised identity: 68 | theorem4 :: (Selective f, Eq (f b)) => f (Either a b) -> (a -> b) -> Bool 69 | theorem4 x y = (x <*? pure y) == (either y id <$> x) 70 | 71 | {-| For rigid selective functors (in particular, for monads) |-} 72 | 73 | -- | Selective apply 74 | theorem5 :: (Selective f, Eq (f b)) => f (a -> b) -> f a -> Bool 75 | theorem5 f g = (f <*> g) == (f `apS` g) 76 | 77 | -- | Interchange 78 | theorem6 :: (Selective f, Eq (f c)) => f a -> f (Either b c) -> f (b -> c) -> Bool 79 | theorem6 x y z = (x *> (y <*? z)) == ((x *> y) <*? z) 80 | 81 | -------------------------------------------------------------------------------- 82 | ------------------------ Properties ---------------------------------------------- 83 | -------------------------------------------------------------------------------- 84 | 85 | -- | Pure-Right: pure (Right x) <*? y = pure x 86 | propertyPureRight :: (Selective f, Eq (f a)) => a -> f (b -> a) -> Bool 87 | propertyPureRight x y = (pure (Right x) <*? y) == pure x 88 | 89 | -- | Pure-Left: pure (Left x) <*? y = ($x) <$> y 90 | propertyPureLeft :: (Selective f, Eq (f b)) => a -> f (a -> b) -> Bool 91 | propertyPureLeft x y = (pure (Left x) <*? y) == (($x) <$> y) 92 | 93 | -------------------------------------------------------------------------------- 94 | ------------------------ Over -------------------------------------------------- 95 | -------------------------------------------------------------------------------- 96 | instance Arbitrary a => Arbitrary (Over a b) where 97 | arbitrary = Over <$> arbitrary 98 | shrink = map Over . shrink . getOver 99 | 100 | propertyPureRightOver :: IO () 101 | propertyPureRightOver = quickCheck (propertyPureRight @(Over String) @Int) 102 | 103 | -------------------------------------------------------------------------------- 104 | ------------------------ Under ------------------------------------------------- 105 | -------------------------------------------------------------------------------- 106 | instance Arbitrary a => Arbitrary (Under a b) where 107 | arbitrary = Under <$> arbitrary 108 | shrink = map Under . shrink . getUnder 109 | 110 | propertyPureRightUnder :: IO () 111 | propertyPureRightUnder = quickCheck (propertyPureRight @(Under String) @Int) 112 | 113 | -------------------------------------------------------------------------------- 114 | ------------------------ Validation -------------------------------------------- 115 | -------------------------------------------------------------------------------- 116 | instance (Arbitrary e, Arbitrary a) => Arbitrary (Validation e a) where 117 | arbitrary = oneof [Failure <$> arbitrary, Success <$> arbitrary] 118 | shrink (Failure x) = [ Failure x' | x' <- shrink x ] 119 | shrink (Success y) = [ Success y' | y' <- shrink y ] 120 | 121 | -------------------------------------------------------------------------------- 122 | ------------------------ ArrowMonad -------------------------------------------- 123 | -------------------------------------------------------------------------------- 124 | instance Eq a => Eq (ArrowMonad (->) a) where 125 | ArrowMonad f == ArrowMonad g = f () == g () 126 | 127 | instance Arbitrary a => Arbitrary (ArrowMonad (->) a) where 128 | arbitrary = ArrowMonad . const <$> arbitrary 129 | 130 | instance Show a => Show (ArrowMonad (->) a) where 131 | show (ArrowMonad f) = show (f ()) 132 | -------------------------------------------------------------------------------- 133 | ------------------------ Maybe ------------------------------------------------- 134 | -------------------------------------------------------------------------------- 135 | 136 | propertyPureRightMaybe :: IO () 137 | propertyPureRightMaybe = quickCheck (propertyPureRight @Maybe @Int @Int) 138 | 139 | -------------------------------------------------------------------------------- 140 | ------------------------ Identity ---------------------------------------------- 141 | -------------------------------------------------------------------------------- 142 | 143 | propertyPureRightIdentity :: IO () 144 | propertyPureRightIdentity = quickCheck (propertyPureRight @Identity @Int @Int) 145 | 146 | 147 | -------------------------------------------------------------------------------- 148 | ------------------------ Writer ------------------------------------------------ 149 | -------------------------------------------------------------------------------- 150 | 151 | instance (Arbitrary w, Arbitrary a) => Arbitrary (Writer w a) where 152 | arbitrary = curry writer <$> arbitrary <*> arbitrary 153 | 154 | deriving instance (Arbitrary e, Arbitrary a) => Arbitrary (Transformers.Except e a) 155 | deriving instance (Arbitrary e, Arbitrary a) => Arbitrary (Except e a) 156 | -------------------------------------------------------------------------------- /test/Test.hs: -------------------------------------------------------------------------------- 1 | -- A little testing framework 2 | module Test where 3 | 4 | import Data.List (intercalate) 5 | import System.Exit (exitFailure) 6 | import Test.QuickCheck hiding (Success, Failure, expectFailure) 7 | 8 | data Expect = ExpectSuccess | ExpectFailure deriving Eq 9 | 10 | data Test = Test String Expect Property 11 | 12 | data Tests = Leaf Test | Node String [Tests] 13 | 14 | testGroup :: String -> [Tests] -> Tests 15 | testGroup = Node 16 | 17 | expectSuccess :: Testable a => String -> a -> Tests 18 | expectSuccess name p = Leaf $ Test name ExpectSuccess (property p) 19 | 20 | expectFailure :: Testable a => String -> a -> Tests 21 | expectFailure name p = Leaf $ Test name ExpectFailure (property p) 22 | 23 | runTest :: [String] -> Test -> IO () 24 | runTest labels (Test name expect property) = do 25 | let label = "[" ++ intercalate "." (reverse labels) ++ "] " ++ name 26 | result <- quickCheckWithResult (stdArgs { chatty = False }) property 27 | case (expect, isSuccess result) of 28 | (ExpectSuccess, True) -> 29 | putStrLn $ "[OK] " ++ label 30 | (ExpectFailure, False) -> 31 | putStrLn $ "[OK, expected failure] " ++ label 32 | (ExpectFailure, True) -> 33 | putStrLn $ "[Warning, unexpected success] " ++ label 34 | (ExpectSuccess, False) -> do 35 | putStrLn $ "\n[Failure] " ++ label ++ "\n" 36 | putStrLn $ output result 37 | exitFailure 38 | 39 | runTests :: Tests -> IO () 40 | runTests = go [] 41 | where 42 | go labels (Leaf test) = runTest labels test 43 | go labels (Node label tests) = mapM_ (go (label : labels)) tests 44 | --------------------------------------------------------------------------------