├── .github ├── stack-8.10.7.yaml ├── stack-8.6.5.yaml ├── stack-8.8.4.yaml ├── stack-9.0.2.yaml ├── stack-9.2.2.yaml └── workflows │ └── build.yaml ├── .gitignore ├── .stylish-haskell.yaml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── avail.cabal ├── package.yaml ├── src ├── Avail.hs └── Avail │ ├── Derive.hs │ ├── Instances.hs │ └── Internal.hs ├── stack.yaml └── stack.yaml.lock /.github/stack-8.10.7.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-18.28 2 | 3 | packages: 4 | - . 5 | 6 | flags: 7 | avail: 8 | capability: true 9 | exceptions: true 10 | monad-control: true 11 | mtl: true 12 | primitive: true 13 | semigroupoids: true 14 | unliftio: true 15 | 16 | ghc-options: 17 | "$everything": -haddock 18 | -------------------------------------------------------------------------------- /.github/stack-8.6.5.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-14.27 2 | 3 | packages: 4 | - . 5 | 6 | flags: 7 | avail: 8 | capability: false 9 | exceptions: true 10 | monad-control: true 11 | mtl: true 12 | primitive: true 13 | semigroupoids: true 14 | unliftio: false 15 | 16 | ghc-options: 17 | "$everything": -haddock 18 | -------------------------------------------------------------------------------- /.github/stack-8.8.4.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.31 2 | 3 | packages: 4 | - . 5 | 6 | flags: 7 | avail: 8 | capability: false 9 | exceptions: true 10 | monad-control: true 11 | mtl: true 12 | primitive: true 13 | semigroupoids: true 14 | unliftio: false 15 | 16 | ghc-options: 17 | "$everything": -haddock 18 | -------------------------------------------------------------------------------- /.github/stack-9.0.2.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-19.0 2 | 3 | packages: 4 | - . 5 | 6 | flags: 7 | avail: 8 | capability: true 9 | exceptions: true 10 | monad-control: true 11 | mtl: true 12 | primitive: true 13 | semigroupoids: true 14 | unliftio: true 15 | 16 | ghc-options: 17 | "$everything": -haddock 18 | -------------------------------------------------------------------------------- /.github/stack-9.2.2.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2022-03-25 2 | 3 | packages: 4 | - . 5 | 6 | extra-deps: 7 | - capability-0.5.0.1 8 | 9 | flags: 10 | avail: 11 | capability: true 12 | exceptions: true 13 | monad-control: true 14 | mtl: true 15 | primitive: true 16 | semigroupoids: true 17 | unliftio: true 18 | 19 | ghc-options: 20 | "$everything": -haddock 21 | -------------------------------------------------------------------------------- /.github/workflows/build.yaml: -------------------------------------------------------------------------------- 1 | name: build 2 | 3 | on: 4 | workflow_dispatch: 5 | push: 6 | branches: 7 | - master 8 | pull_request: 9 | branches: 10 | - master 11 | 12 | jobs: 13 | build: 14 | strategy: 15 | matrix: 16 | ghc: 17 | - 8.6.5 18 | - 8.8.4 19 | - 8.10.7 20 | - 9.0.2 21 | - 9.2.2 22 | runs-on: ubuntu-latest 23 | steps: 24 | - uses: actions/checkout@v2 25 | - name: Copy stack.yaml 26 | run: | 27 | rm stack.yaml 28 | rm stack.yaml.lock 29 | cp .github/stack-${{ matrix.ghc }}.yaml stack.yaml 30 | - uses: actions/cache@v2 31 | name: Cache ~/.stack/ 32 | with: 33 | path: ~/.stack 34 | key: ${{ matrix.ghc }}-stack-root 35 | - uses: actions/cache@v2 36 | name: Cache .stack-work/ 37 | with: 38 | path: .stack-work 39 | key: ${{ matrix.ghc }}-stack-work 40 | - name: Build 41 | run: stack build 42 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ 3 | dist-newstyle/ 4 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | 2 | 3 | steps: 4 | - simple_align: 5 | cases: always 6 | top_level_patterns: always 7 | records: always 8 | multi_way_if: always 9 | 10 | - imports: 11 | align: global 12 | list_align: after_alias 13 | pad_module_names: true 14 | long_list_align: inline 15 | empty_list_align: inherit 16 | list_padding: 2 17 | separate_lists: true 18 | space_surround: false 19 | post_qualify: false 20 | 21 | - language_pragmas: 22 | style: vertical 23 | align: true 24 | remove_redundant: true 25 | language_prefix: LANGUAGE 26 | 27 | - tabs: 28 | spaces: 2 29 | 30 | - trailing_whitespace: {} 31 | 32 | columns: 120 33 | newline: native 34 | cabal: true 35 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog for avail 2 | 3 | ## 0.1.0.0 4 | 5 | - Initial API 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Xy Ren (c) 2021 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Xy Ren nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # avail 2 | 3 | `avail` is a companion to monad transformers that allows you to impose effect constraints on *concrete monads*. Specifically, instead of writing 4 | 5 | ```haskell 6 | myApp :: (MonadWriter Log m, MonadState Store m, MonadReader Env m) => m () 7 | ``` 8 | 9 | it allows you to write 10 | 11 | ```haskell 12 | myApp :: Effs '[MonadWriter Log, MonadState Store, MonadReader Env] => App () 13 | ``` 14 | 15 | where `App` is a specific, concrete monad stack. 16 | 17 | ## Introduction 18 | 19 | Current effects libraries all have one principle of effect restriction: an effect can be used in a monad if it can be interpreted in terms of the monad. This works well with a polymorphic monad type, but a polymorphic type is unfriendly to compiler optimization. In contrast, a concrete monad can be easily optimized, but if we fix a monad that supplies all the effects we need, we can no longer restrict what effects each function can use. 20 | 21 | `avail` solves this problem with the [*phantom constraint pattern*](https://xn--i2r.xn--rhqv96g/2021/09/14/redundant-constraints/). We use a newtype wrapper `M` to screen out the user from directly manipulating the underlying monad, and performing any operation in a typeclass (for example, `MonadIO`) requires the corresponding *phantom* `Eff` constraint (in this case. `Eff MonadIO`) to be in scope. In other words, one can perform operations of a class only if: 22 | 23 | - The class is implemented for the monad, and 24 | - The *effect constraint* `Eff e` is available in the context. 25 | 26 | The second requirement decouples the availability of effects from the monad implementation. At last, we use a function `runM` to clear the constraints and restore the underlying monad. A typical example looks like this: 27 | 28 | ```haskell 29 | import Avail 30 | import Control.Monad.Reader 31 | import Control.Monad.State 32 | 33 | type App = M (ReaderT Int (State Bool)) 34 | 35 | testParity :: Effs '[MonadReader Int, MonadState Bool] => App () 36 | testParity = do 37 | num <- ask 38 | put (even num) 39 | 40 | example :: IO () 41 | example = do 42 | print $ runM @'[MonadReader Int, MonadState Bool] testParity 43 | & (`runReaderT` 2) 44 | & (`execState` False) 45 | print $ runM @'[MonadReader Int, MonadState Bool] testParity 46 | & (`runReaderT` 3) 47 | & (`execState` False) 48 | ``` 49 | 50 | Through microbenchmarks and tests in some applications, the performance of using `avail` is at least on par with, and often better than, using the polymorphic counterparts. 51 | 52 | ## Making `avail` work with new typeclasses 53 | 54 | `avail` already comes with support of all `mtl`, `exceptions`, `unliftio`, `monad-control` and [`capability`](https://hackage.haskell.org/package/capability) typeclasses. To add support for your own typeclass, for example: 55 | 56 | ```haskell 57 | class MonadOvO m where 58 | ... 59 | ``` 60 | 61 | You can use the Template Haskell utilities in the `Avail.Derive` module. 62 | 63 | ```haskell 64 | import Avail.Derive 65 | avail [t| MonadOvO |] 66 | ``` 67 | 68 | There may be other more complicated cases, such as dependencies between classes and multi-param classes: 69 | 70 | ```haskell 71 | class (MonadOvO m, MonadQwQ m) => MonadUwU r m where 72 | ... 73 | ``` 74 | 75 | `avail` gets you covered: 76 | 77 | ```haskell 78 | import Avail.Derive 79 | with1 \r -> avail' 80 | [ [t| MonadOvO |] 81 | , [t| MonadQwQ |] 82 | ] [t| MonadUwU $r |] 83 | ``` 84 | 85 | ## Limitations 86 | 87 | - Running effects: 88 | Because effect constraints in `avail` are detached from the monad structure, they cannot be run on a one-by-one basis. Practically, one can only run all effects and obtain the underlying concrete monad at once via `runM`. This means there is no exact equivalent to `runReaderT`, `runExceptT` etc on the `M` monad. 89 | 90 | If your application can entirely run on a single transformer stack (in particular, `ReaderT IO`, but also other transformer stacks), this is a non-issue because there will be no need to run effects one-by-one. For some other scenarios, there are some solutions that may be used solve this issue: 91 | 92 | - `local` is an almost identical substitute to `runReaderT` without destructing the monad. 93 | - Similarly, `tryError` is a substitute to `runExceptT`. 94 | - To simulate `runStateT`, simply set the value before the action and get the value after it. 95 | - `listen` is a very close analog to `runWriterT`. 96 | 97 | ## Where is `availability`? 98 | 99 | The old `availability` is abandoned due to its attempt at addressing two problems at once (capability *and* availability management), and may introduce confusion to new users on the choice between `capability` and `availability`. The new `avail` library focuses on availability management and acts not as a standalone effects library, but an alternative effect management layer that is used together with `mtl` or `capability` (which also reduces preformance overhead). 100 | 101 | The old `availability` can be found at [`re-xyr/availability-old`](https://github.com/re-xyr/availability-old). 102 | -------------------------------------------------------------------------------- /avail.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.4. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: avail 8 | version: 0.1.0.0 9 | synopsis: Low-overhead effect management for concrete monads 10 | description: Please see the README on GitHub at 11 | category: Control 12 | homepage: https://github.com/re-xyr/avail#readme 13 | bug-reports: https://github.com/re-xyr/avail/issues 14 | author: Xy Ren 15 | maintainer: xy.r@outlook.com 16 | copyright: 2021 Xy Ren 17 | license: BSD3 18 | license-file: LICENSE 19 | build-type: Simple 20 | extra-source-files: 21 | README.md 22 | CHANGELOG.md 23 | 24 | source-repository head 25 | type: git 26 | location: https://github.com/re-xyr/avail 27 | 28 | flag capability 29 | description: Supports the @capability@ library. Only for GHC >= 8.6. 30 | manual: True 31 | default: False 32 | 33 | flag exceptions 34 | description: Supports the @exceptions@ library. 35 | manual: True 36 | default: True 37 | 38 | flag monad-control 39 | description: Supports the @transformers-base@ and @monad-control@ library. 40 | manual: True 41 | default: False 42 | 43 | flag mtl 44 | description: Supports the @mtl@ library. 45 | manual: True 46 | default: True 47 | 48 | flag primitive 49 | description: Supports the @primitive@ library. 50 | manual: True 51 | default: True 52 | 53 | flag semigroupoids 54 | description: Supports the @semigroupoids@ library. 55 | manual: True 56 | default: False 57 | 58 | flag unliftio 59 | description: Supports the @unliftio@ library. 60 | manual: True 61 | default: True 62 | 63 | library 64 | exposed-modules: 65 | Avail 66 | Avail.Derive 67 | Avail.Instances 68 | Avail.Internal 69 | other-modules: 70 | Paths_avail 71 | hs-source-dirs: 72 | src 73 | default-extensions: 74 | ConstraintKinds 75 | DataKinds 76 | DerivingStrategies 77 | FlexibleContexts 78 | FlexibleInstances 79 | GeneralizedNewtypeDeriving 80 | KindSignatures 81 | MultiParamTypeClasses 82 | PolyKinds 83 | RankNTypes 84 | ScopedTypeVariables 85 | StandaloneDeriving 86 | TemplateHaskell 87 | TypeApplications 88 | TypeFamilies 89 | TypeOperators 90 | UndecidableInstances 91 | ghc-options: -Wall -Wincomplete-uni-patterns -Wpartial-fields -Wincomplete-record-updates -Widentities -Wunused-type-patterns 92 | build-depends: 93 | base >=4.12 && <5 94 | , template-haskell >=2.14 && <3 95 | if impl(ghc >= 8.8) 96 | ghc-options: -Wmissing-deriving-strategies 97 | if flag(capability) 98 | cpp-options: -DAVAIL_capability 99 | build-depends: 100 | capability >=0.3 && <0.6 101 | if flag(exceptions) 102 | cpp-options: -DAVAIL_exceptions 103 | build-depends: 104 | exceptions ==0.10.* 105 | if flag(monad-control) 106 | cpp-options: -DAVAIL_monad_control 107 | build-depends: 108 | monad-control ==1.0.* 109 | , transformers-base ==0.4.* 110 | if flag(mtl) 111 | cpp-options: -DAVAIL_mtl 112 | build-depends: 113 | mtl >=2.2.1 && <2.3 114 | if flag(primitive) 115 | cpp-options: -DAVAIL_primitive 116 | build-depends: 117 | primitive >=0.6 && <0.8 118 | if flag(semigroupoids) 119 | cpp-options: -DAVAIL_semigroupoids 120 | build-depends: 121 | semigroupoids >=5 && <5.4 122 | if flag(unliftio) 123 | cpp-options: -DAVAIL_unliftio 124 | build-depends: 125 | unliftio-core ==0.2.* 126 | default-language: Haskell2010 127 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: avail 2 | version: 0.1.0.0 3 | github: "re-xyr/avail" 4 | license: BSD3 5 | author: "Xy Ren" 6 | maintainer: "xy.r@outlook.com" 7 | copyright: "2021 Xy Ren" 8 | 9 | tested-on: 10 | - GHC == 8.6.5 11 | - GHC == 8.8.4 12 | - GHC == 8.10.7 13 | - GHC == 9.0.2 14 | - GHC == 9.2.2 15 | 16 | extra-source-files: 17 | - README.md 18 | - CHANGELOG.md 19 | 20 | synopsis: Low-overhead effect management for concrete monads 21 | category: Control 22 | 23 | description: Please see the README on GitHub at 24 | 25 | dependencies: 26 | - base >= 4.12 && < 5 27 | - template-haskell >= 2.14 && < 3 28 | 29 | flags: 30 | capability: 31 | description: Supports the @capability@ library. Only for GHC >= 8.6. 32 | manual: true 33 | default: false 34 | exceptions: 35 | description: Supports the @exceptions@ library. 36 | manual: true 37 | default: true 38 | monad-control: 39 | description: Supports the @transformers-base@ and @monad-control@ library. 40 | manual: true 41 | default: false 42 | mtl: 43 | description: Supports the @mtl@ library. 44 | manual: true 45 | default: true 46 | primitive: 47 | description: Supports the @primitive@ library. 48 | manual: true 49 | default: true 50 | semigroupoids: 51 | description: Supports the @semigroupoids@ library. 52 | manual: true 53 | default: false 54 | unliftio: 55 | description: Supports the @unliftio@ library. 56 | manual: true 57 | default: true 58 | 59 | ghc-options: 60 | - -Wall 61 | - -Wincomplete-uni-patterns 62 | - -Wpartial-fields 63 | - -Wincomplete-record-updates 64 | - -Widentities 65 | - -Wunused-type-patterns 66 | 67 | when: 68 | - condition: impl(ghc >= 8.8) 69 | ghc-options: 70 | - -Wmissing-deriving-strategies 71 | 72 | - condition: flag(capability) 73 | dependencies: 74 | - capability >= 0.3 && < 0.6 75 | cpp-options: 76 | - -DAVAIL_capability 77 | 78 | - condition: flag(exceptions) 79 | dependencies: 80 | - exceptions >= 0.10 && < 0.11 81 | cpp-options: 82 | - -DAVAIL_exceptions 83 | 84 | - condition: flag(monad-control) 85 | dependencies: 86 | - monad-control >= 1.0 && < 1.1 87 | - transformers-base >= 0.4 && < 0.5 88 | cpp-options: 89 | - -DAVAIL_monad_control 90 | 91 | - condition: flag(mtl) 92 | dependencies: 93 | - mtl >= 2.2.1 && < 2.3 94 | cpp-options: 95 | - -DAVAIL_mtl 96 | 97 | - condition: flag(primitive) 98 | dependencies: 99 | - primitive >= 0.6 && < 0.8 100 | cpp-options: 101 | - -DAVAIL_primitive 102 | 103 | - condition: flag(semigroupoids) 104 | dependencies: 105 | - semigroupoids >= 5 && < 5.4 106 | cpp-options: 107 | - -DAVAIL_semigroupoids 108 | 109 | - condition: flag(unliftio) 110 | dependencies: 111 | - unliftio-core >= 0.2 && < 0.3 112 | cpp-options: 113 | - -DAVAIL_unliftio 114 | 115 | library: 116 | source-dirs: src 117 | 118 | default-extensions: 119 | - ConstraintKinds 120 | - DataKinds 121 | - DerivingStrategies 122 | - FlexibleContexts 123 | - FlexibleInstances 124 | - GeneralizedNewtypeDeriving 125 | - KindSignatures 126 | - MultiParamTypeClasses 127 | - PolyKinds 128 | - RankNTypes 129 | - ScopedTypeVariables 130 | - StandaloneDeriving 131 | - TemplateHaskell 132 | - TypeApplications 133 | - TypeFamilies 134 | - TypeOperators 135 | - UndecidableInstances 136 | -------------------------------------------------------------------------------- /src/Avail.hs: -------------------------------------------------------------------------------- 1 | -- | @avail@ is a companion to monad transformers that allows you to add effect management to /concrete monads/, 2 | -- i.e. specify what effects a piece of code can perform. 3 | -- 4 | -- Traditionally, in order to manage effects, the /effect typeclasses/ are placed on a polymorphic monad type 5 | -- @m@ so that other details of the monad type is not known at that point, effectively limiting what a function can do: 6 | -- 7 | -- @ 8 | -- (MonadWriter Log m, MonadState Store m, MonadReader Env m) => m () 9 | -- @ 10 | -- 11 | -- While this works well, it has inevitable performance drawback because of the polymorphic @m@. GHC doesn't know the 12 | -- implementation of @m@, hence cannot perform much optimization. On the other hand, if we use a concrete monad stack 13 | -- that supports all the effects we need, we will not be able to restrict the effects that can be performed. 14 | -- 15 | -- @avail@ addresses this by a monad transformer 'M'. For any monad @m@, the monad type @'M' m@ adds effect 16 | -- management on top of it. Specifically, for an effect typeclass @c@ (such as 'Control.Monad.MonadIO' or 17 | -- @'Control.Monad.Reader.MonadReader' r@), its methods can be used on @'M' m@ only if: 18 | -- 19 | -- * The monad @m@ actually supports the effect, i.e. has an instance @c m@ of the effect typeclass; 20 | -- * The effect is /available/ in current context, i.e. a /phantom constraint/ @'Eff' c@ (which doesn't contain any 21 | -- information) is added to the function signature. 22 | -- 23 | -- This pattern was first outlined in the blog post 24 | -- [/Effect is a phantom/](https://喵.世界/2021/09/14/redundant-constraints/). 25 | -- In @avail@, it allows you to manage effects via the phantom 'Eff' constraint while still using a 26 | -- concrete monad stack; the 'Eff' constarint is not tied to the stack anyhow. Finally, 'Eff' has no instances, 27 | -- and can only be removed all at once via the 'runM' function, obtaining the underlying monad. 28 | -- 29 | -- @avail@ supports libraries including @mtl@, @unliftio@, @monad-control@ and @capability@ out of the box, so there 30 | -- should be near-zero boilerplate to get started with @avail@. For other effect typeclasses, the @avail@ support 31 | -- of them can be easily derived via the TH functions in "Avail.Derive". 32 | -- 33 | -- You need these language extensions when using this module: 34 | -- 35 | -- @ 36 | -- DataKinds 37 | -- FlexibleContexts 38 | -- FlexibleInstances 39 | -- RankNTypes 40 | -- TypeApplications 41 | -- @ 42 | -- 43 | -- You need more extensions when using "Avail.Derive"; see documentation in that module. 44 | module Avail 45 | ( M, Effect, IsEff (Superclasses), Eff, Effs, KnownList, unM, runM 46 | ) where 47 | 48 | import Avail.Instances () 49 | import Avail.Internal 50 | -------------------------------------------------------------------------------- /src/Avail/Derive.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 2 | -- | This module contains mechanisms for deriving necessary instances for a new 'Effect' typeclass to work with 3 | -- @avail@. If you only need functionalities from @mtl@, @monad-control@, @unliftio@ and @capability@, you don't need 4 | -- to use this module. 5 | -- 6 | -- You need these extensions when using the module: 7 | -- 8 | -- @ 9 | -- DataKinds 10 | -- DerivingStrategies 11 | -- FlexibleContexts 12 | -- FlexibleInstances 13 | -- GeneralizedNewtypeDeriving 14 | -- StandaloneDeriving 15 | -- TemplateHaskell 16 | -- TypeFamilies 17 | -- UndecidableInstances 18 | -- @ 19 | module Avail.Derive 20 | ( -- * Deriving 21 | avail, avail' 22 | , -- * Helpers for deriving instances for multi-param classes 23 | with1, with2, with3, with4, with5, withN, 24 | with1', with2', with3', with4', with5', withN' 25 | , -- * Necessary reexports - do not use directly 26 | M (UnsafeLift) 27 | ) where 28 | 29 | import Avail.Internal 30 | import Language.Haskell.TH hiding (Type) 31 | import qualified Language.Haskell.TH as TH 32 | 33 | -- | Derive necessary instances for an 'Effect' typeclass to work with @avail@. Specifically, this only works with 34 | -- typeclasses without superclasses; see 'avail'' for a version that takes care of superclasses. 35 | avail :: Q TH.Type -> Q [Dec] 36 | avail = avail' [] 37 | 38 | -- | Derive necessary instances for an 'Effect' typeclass to work with @avail@. This is a generalized version of 39 | -- 'avail' that allows you to pass in a list of superclasses. 40 | -- 41 | -- For superclasses @Sup :: ['Effect']@ and current class @Cls :: 'Effect'@, the code generated is: 42 | -- 43 | -- @ 44 | -- instance 'IsEff' Cls where 45 | -- type 'Superclasses' Cls = Sup 46 | -- deriving newtype instance (Cls m, 'Eff' Cls) => Cls ('M' m) 47 | -- @ 48 | -- 49 | -- Although this is very little code, it is still boilerplate and defining them by hand is error-prone. Therefore, 50 | -- /please/ do not define instances for 'M' by hand (except when doing dirty hacks); use this function instead. 51 | avail' :: [Q TH.Type] -> Q TH.Type -> Q [Dec] 52 | avail' = avail'' $ \m -> [t| M $m |] 53 | 54 | avail'' :: (Q TH.Type -> Q TH.Type) -> [Q TH.Type] -> Q TH.Type -> Q [Dec] 55 | avail'' mm pre cls = do 56 | mName <- newName "m" 57 | let m = pure $ VarT mName 58 | [d| 59 | instance IsEff $cls where 60 | type Superclasses $cls = $(makeList <$> sequence pre) 61 | deriving newtype instance ($cls $m, Eff $cls) => $cls $(mm m) |] 62 | where 63 | makeList [] = PromotedNilT 64 | makeList (x : xs) = PromotedConsT `AppT` x `AppT` makeList xs 65 | 66 | -- | Introduce one type variable @a@. 67 | with1 :: (Q TH.Type -> Q a) -> Q a 68 | with1 = with1' "a" 69 | 70 | -- | Introduce one type variable with given name. 71 | with1' :: String -> (Q TH.Type -> Q a) -> Q a 72 | with1' n f = withN' [n] (\[a] -> f a) 73 | 74 | -- | Introduce two type variables @a, b@. 75 | with2 :: (Q TH.Type -> Q TH.Type -> Q a) -> Q a 76 | with2 = with2' "a" "b" 77 | 78 | -- | Introduce two type variables with given names. 79 | with2' :: String -> String -> (Q TH.Type -> Q TH.Type -> Q a) -> Q a 80 | with2' n1 n2 f = withN' [n1, n2] (\[a, b] -> f a b) 81 | 82 | -- | Introduce three type variables @a, b, c@. 83 | with3 :: (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a 84 | with3 = with3' "a" "b" "c" 85 | 86 | -- | Introduce three type variables with given names. 87 | with3' :: String -> String -> String -> (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a 88 | with3' n1 n2 n3 f = withN' [n1, n2, n3] (\[a, b, c] -> f a b c) 89 | 90 | -- | Introduce four type variables @a, b, c, d@. 91 | with4 :: (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a 92 | with4 = with4' "a" "b" "c" "d" 93 | 94 | -- | Introduce four type variables with given names. 95 | with4' :: String -> String -> String -> String -> (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a 96 | with4' n1 n2 n3 n4 f = withN' [n1, n2, n3, n4] (\[a, b, c, d] -> f a b c d) 97 | 98 | -- | Introduce five type variables @a, b, c, d, e@. 99 | with5 :: (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a 100 | with5 = with5' "a" "b" "c" "d" "e" 101 | 102 | -- | Introduce five type variables with given names. 103 | with5' :: String -> String -> String -> String -> String -> (Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q TH.Type -> Q a) -> Q a 104 | with5' n1 n2 n3 n4 n5 f = withN' [n1, n2, n3, n4, n5] (\[a, b, c, d, e] -> f a b c d e) 105 | 106 | -- | Introduce arbitrarily many type variables @a1, a2, a3, ...@. 107 | withN :: Int -> ([Q TH.Type] -> Q a) -> Q a 108 | withN n = withN' $ ('a' :) . show <$> [1..n] 109 | 110 | -- | Introduce arbitrarily many type variables with given names. 111 | withN' :: [String] -> ([Q TH.Type] -> Q a) -> Q a 112 | withN' n f = do 113 | as <- traverse (fmap VarT . newName) n 114 | f (pure <$> as) 115 | -------------------------------------------------------------------------------- /src/Avail/Instances.hs: -------------------------------------------------------------------------------- 1 | -- | This module exports instances of the 'M' monad for all typeclasses in @capability@, @transformers-base@, 2 | -- @monad-control@, @exceptions@, @unliftio@ and @mtl@. 3 | -- 4 | -- All instances are reexported in the "Avail" module, so you don't need to import this module. 5 | {-# LANGUAGE CPP #-} 6 | {-# LANGUAGE UnboxedTuples #-} 7 | {-# OPTIONS_GHC -Wno-orphans #-} 8 | module Avail.Instances () where 9 | 10 | import Avail.Derive 11 | import Avail.Internal 12 | import Control.Applicative (Alternative) 13 | import Control.Monad (MonadPlus) 14 | import Control.Monad.Fail (MonadFail) 15 | import Control.Monad.IO.Class (MonadIO) 16 | import Prelude hiding (MonadFail) 17 | 18 | #ifdef AVAIL_exceptions 19 | import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) 20 | #endif 21 | 22 | #ifdef AVAIL_mtl 23 | import Control.Monad.Cont (MonadCont) 24 | import Control.Monad.Except (MonadError) 25 | import Control.Monad.RWS (MonadRWS) 26 | import Control.Monad.Reader (MonadReader) 27 | import Control.Monad.State (MonadState) 28 | import Control.Monad.Writer (MonadWriter) 29 | #endif 30 | 31 | #ifdef AVAIL_semigroupoids 32 | import Data.Functor.Alt (Alt (())) 33 | import Data.Functor.Plus (Plus) 34 | #endif 35 | 36 | #ifdef AVAIL_unliftio 37 | import Control.Monad.IO.Unlift (MonadUnliftIO) 38 | #endif 39 | 40 | #ifdef AVAIL_monad_control 41 | import Control.Monad.Base (MonadBase) 42 | import Control.Monad.Trans.Control (MonadBaseControl) 43 | #endif 44 | 45 | #ifdef AVAIL_primitive 46 | import Control.Monad.Primitive (PrimMonad) 47 | #endif 48 | 49 | #ifdef AVAIL_capability 50 | import Capability.Error (HasCatch, HasThrow) 51 | import Capability.Reader (HasReader) 52 | import Capability.Sink (HasSink) 53 | import Capability.Source (HasSource) 54 | import Capability.State (HasState) 55 | import Capability.Writer (HasWriter) 56 | #endif 57 | 58 | avail [t| MonadIO |] 59 | avail [t| MonadFail |] 60 | avail [t| Alternative |] 61 | avail' [[t| Alternative |]] [t| MonadPlus |] 62 | 63 | #ifdef AVAIL_exceptions 64 | avail [t| MonadThrow |] 65 | avail' [[t| MonadThrow |]] [t| MonadCatch |] 66 | avail' [[t| MonadCatch |]] [t| MonadMask |] 67 | #endif 68 | 69 | #ifdef AVAIL_mtl 70 | avail [t| MonadCont |] 71 | with1' "r" $ \r -> avail [t| MonadReader $r |] 72 | with1' "w" $ \w -> avail [t| MonadWriter $w |] 73 | with1' "s" $ \s -> avail [t| MonadState $s |] 74 | with1' "e" $ \e -> avail [t| MonadError $e |] 75 | with3' "r" "w" "s" $ \r w s -> avail' 76 | [ [t| MonadReader $r |] 77 | , [t| MonadWriter $w |] 78 | , [t| MonadState $s |] 79 | ] [t| MonadRWS $r $w $s |] 80 | #endif 81 | 82 | #ifdef AVAIL_semigroupoids 83 | avail [t| Plus |] 84 | instance IsEff Alt where 85 | type Superclasses Alt = '[] 86 | instance Alt m => Alt (M m) where 87 | UnsafeLift m UnsafeLift n = UnsafeLift $ m n 88 | #endif 89 | 90 | #ifdef AVAIL_unliftio 91 | avail' [[t| MonadIO |]] [t| MonadUnliftIO |] 92 | #endif 93 | 94 | #ifdef AVAIL_monad_control 95 | with1' "b" $ \b -> avail [t| MonadBase $b |] 96 | with1' "b" $ \b -> avail' [[t| MonadBase $b |]] [t| MonadBaseControl $b |] 97 | #endif 98 | 99 | #ifdef AVAIL_primitive 100 | avail [t| PrimMonad |] 101 | #endif 102 | 103 | #ifdef AVAIL_capability 104 | with2' "tag" "a" $ \tag a -> avail [t| HasSource $tag $a |] 105 | with2' "tag" "a" $ \tag a -> avail [t| HasSink $tag $a |] 106 | with2' "tag" "e" $ \tag e -> avail [t| HasThrow $tag $e |] 107 | 108 | with2' "tag" "r" $ \tag r -> avail' [[t| HasSource $tag $r |]] [t| HasReader $tag $r |] 109 | with2' "tag" "w" $ \tag w -> avail' [[t| HasSink $tag $w |]] [t| HasWriter $tag $w |] 110 | with2' "tag" "e" $ \tag e -> avail' [[t| HasThrow $tag $e |]] [t| HasCatch $tag $e |] 111 | 112 | with2' "tag" "s" $ \tag s -> avail' 113 | [ [t| HasSource $tag $s |] 114 | , [t| HasSink $tag $s |] 115 | ] [t| HasState $tag $s |] 116 | #endif 117 | -------------------------------------------------------------------------------- /src/Avail/Internal.hs: -------------------------------------------------------------------------------- 1 | -- | This module defines the 'M' wrapper monad and the 'Eff' phantom constraint. All safe functionalities in this 2 | -- module are reexported in the "Avail" module, so you wouldn't need to import this module most of the times. 3 | {-# LANGUAGE AllowAmbiguousTypes #-} 4 | {-# LANGUAGE CPP #-} 5 | {-# OPTIONS_HADDOCK not-home #-} 6 | module Avail.Internal where 7 | 8 | import Control.Monad.Fix (MonadFix) 9 | import Control.Monad.Zip (MonadZip) 10 | import Data.Kind (Constraint, Type) 11 | import Data.Proxy (Proxy (Proxy)) 12 | import Unsafe.Coerce (unsafeCoerce) 13 | 14 | #ifdef AVAIL_semigroupoids 15 | import Data.Functor.Apply (Apply) 16 | import Data.Functor.Bind (Bind (join, (>>-))) 17 | #endif 18 | 19 | -- | The 'M' monad transformer acts as a /barrier of effects/. For example, for a monad type @App@ and any 20 | -- effect typeclass @MonadOvO@ that @App@ has an instance of, the constraint @Eff MonadOvO@ is required to perform 21 | -- the methods of @MonadOvO@ in the monad @'M' App@ as defined for the @App@ monad. 22 | -- 23 | -- In particular, 'M' is expected to be used on a __concrete__ monad instead of a /polymorphic/ one. This is 24 | -- particularly good in terms of program performance, and generally means instead of writing this: 25 | -- 26 | -- @ 27 | -- f :: 'Control.Monad.State.MonadState' 'Int' m => m () 28 | -- @ 29 | -- 30 | -- You should write 31 | -- 32 | -- @ 33 | -- f :: 'Eff' ('Control.Monad.State.MonadState' 'Int') => 'M' App () 34 | -- @ 35 | -- 36 | -- where @App@ is a monad stack of your choice that has support of @'Control.Monad.State.MonadState' 'Int'@. This also 37 | -- means there is no 'Control.Monad.Trans.Class.MonadTrans' instance for 'M'. 38 | -- 39 | -- Note: __you should not define instances of 'M' for effect typeclasses directly by hand__ as that is error-prone 40 | -- and may create holes in effect management. For defining instances of effect typeclasses for 'M', check out 41 | -- the "Avail.Derive" module and specifically the 'Avail.Derive.avail' and 'Avail.Derive.avail'' TH functions. 42 | -- 43 | -- Also keep in mind that typeclasses inside @mtl@, @exceptions@, @unliftio@, @monad-control@ and @capability@ work 44 | -- with 'M' out-of-the-box so no instance for them is needed to be defined on 'M' /by you/. 45 | 46 | newtype M m a = UnsafeLift (m a) -- ^ Unsafely lift an @m@ action into @'M' m@. This completely sidesteps the 47 | -- effect management mechanism; __You should not use this.__ 48 | deriving newtype (Functor, Applicative, Monad, MonadFix, MonadZip) 49 | 50 | #ifdef AVAIL_semigroupoids 51 | deriving newtype instance Apply m => Apply (M m) 52 | 53 | instance Bind m => Bind (M m) where 54 | UnsafeLift m >>- f = UnsafeLift $ m >>- (unM . f) 55 | join (UnsafeLift m) = UnsafeLift $ join $ unM <$> m 56 | #endif 57 | 58 | -- | The kind of /effect typeclasses/, i.e. those that define a set of operations on a monad. Examples include 59 | -- 'Control.Monad.IO.Class.MonadIO' and 'Control.Monad.Reader.MonadReader'. 60 | -- 61 | -- This type is the same as the 'Capability.Constraints.Capability' type in @capability@. 62 | type Effect = (Type -> Type) -> Constraint 63 | 64 | -- | Any 'Effect' being used with @avail@ should have an instance of this class. Specifically, this class stores 65 | -- the /superclasses/ of effect typeclasses. For example, 'Control.Monad.IO.Unlift.MonadUnliftIO' has a superclass 66 | -- 'Control.Monad.IO.Class.MonadIO'. 67 | -- 68 | -- You won't need to define instances of this by hand; instead, use the 'Avail.Derive.avail'' Template Haskell function. 69 | class KnownList (Superclasses e) => IsEff (e :: Effect) where 70 | -- | The superclasses of this typeclass. 71 | type Superclasses e :: [Effect] 72 | 73 | -- | The /primitive/ phantom effect constraint that does not take superclasses into account. You should not use this 74 | -- directly; use 'Eff' or 'Effs' instead. Additionally, you definitely shouldn't define instances for this class. 75 | class Eff' (e :: Effect) where 76 | -- | The dummy method of the phantom typeclass, to be instantiated via the reflection trick in 'rip''. 77 | instEffect :: Proxy e 78 | instEffect = error "unimplemented" 79 | 80 | -- | The constraint that indicates an effect is available for use, i.e. you can perform methods defined by instances 81 | -- of the effect typeclass @e@ in a 'M' monad. 82 | type Eff (e :: Effect) = (Eff' e, Effs (Superclasses e)) 83 | 84 | -- | Convenient alias for @('Eff' e1, 'Eff' e2, ..., 'Eff' en)@. 85 | type family Effs (es :: [Effect]) :: Constraint where 86 | Effs '[] = () 87 | Effs (e ': es) = (Eff e, Effs es) 88 | 89 | -- | The newtype wrapper used to circumvent the impredicative problem of GHC and perform the reflection trick in 90 | -- 'rip''. You have no reason to use this directly. 91 | newtype InstEff e a = InstEff (Eff' e => a) 92 | 93 | -- | Brutally rip off an 'Eff'' constraint, a la 94 | -- [the reflection trick](https://hackage.haskell.org/package/base-4.16.0.0/docs/Unsafe-Coerce.html#v:unsafeCoerce). 95 | -- __This is highly unsafe__ in terms of effect management. 96 | rip' :: forall e a. (Eff' e => a) -> a 97 | rip' x = unsafeCoerce (InstEff @e x) Proxy 98 | 99 | -- | Brutally rip off an 'Eff' constraint. This means 'rip''ing off the 'Eff'' constraint of the current 'Effect' 100 | -- and then 'rips' off constraints of all 'Superclasses' recursively. __This is highly unsafe__ in terms of effect 101 | -- management. 102 | rip :: forall e a. IsEff e => (Eff e => a) -> a 103 | rip x = rips @(Superclasses e) $ rip' @e x 104 | 105 | -- | The list of effect typeclasses @es@ is known at compile time. This is required for functions like 'runM'. 106 | class KnownList (es :: [Effect]) where 107 | -- | Brutally rip off many 'Eff' constraints. __This is highly unsafe__ in terms of effect management. 108 | rips :: (Effs es => a) -> a 109 | rips _ = error "unimplemented" 110 | 111 | instance KnownList '[] where 112 | rips x = x 113 | 114 | instance (IsEff e, KnownList es) => KnownList (e ': es) where 115 | rips x = rips @es $ rip @e x 116 | 117 | -- | Unwrap the 'M' monad into the underlying concrete monad. This is rarely needed as most of the time you would also 118 | -- want to eliminate 'Eff' constraints at the same time; for that see 'runM'. 119 | unM :: M m a -> m a 120 | unM (UnsafeLift m) = m 121 | 122 | -- | Unwrap the 'M' monad into the underlying concrete monad and also eliminating 'Eff' constraints. You need 123 | -- @TypeApplications@ in order to specify the list of 'Effect's you want to eliminate 'Eff' constraints for: 124 | -- 125 | -- @ 126 | -- 'runM' @'[MonadReader Env, MonadState Store, MonadError MyErr] app 127 | -- @ 128 | -- 129 | -- Note that functions like '(Data.Function.&)' generally does not work with this function; either apply directly or 130 | -- use '($)' only. 131 | runM :: forall es m a. KnownList es => (Effs es => M m a) -> m a 132 | runM m = rips @es $ unM m 133 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-18.28 2 | 3 | packages: 4 | - . 5 | 6 | flags: 7 | avail: 8 | capability: true 9 | exceptions: true 10 | monad-control: true 11 | mtl: true 12 | primitive: true 13 | semigroupoids: true 14 | unliftio: true 15 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 590100 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml 11 | sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 12 | original: lts-18.28 13 | --------------------------------------------------------------------------------