├── .gitignore ├── spago.dhall ├── packages.dhall ├── test ├── Main.purs └── Example.purs ├── LICENSE ├── src └── ConvertableOptions.purs └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | /.spago 11 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "convertable-options" 2 | , dependencies = [ "console", "effect", "maybe", "prelude", "record" ] 3 | , packages = ./packages.dhall 4 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 5 | } 6 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220522/packages.dhall 3 | sha256:43895efaec7af246b60b59cfbf451cd9d3d84a5327de8c0945e2de5c9fd2fcf2 4 | 5 | let overrides = {=} 6 | 7 | let additions = {=} 8 | 9 | in upstream // overrides // additions 10 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Effect (Effect) 7 | import Effect.Class.Console (logShow) 8 | import Test.Example (example) 9 | 10 | main :: Effect Unit 11 | main = do 12 | logShow $ example { foo: "ok", poly: ["ok"] } 13 | logShow $ example { foo: 42, poly: Just "ok" } 14 | logShow $ example { foo: 42, poly: ["ok"], bar: 12 } 15 | logShow $ example { foo: 42, poly: ["ok"], bar: 12 } 16 | logShow $ example { foo: 42, poly: ["ok"], bar: Nothing } 17 | -------------------------------------------------------------------------------- /test/Example.purs: -------------------------------------------------------------------------------- 1 | module Test.Example where 2 | 3 | import Prelude 4 | 5 | import ConvertableOptions (class ConvertOption, class ConvertOptionsWithDefaults, convertOptionsWithDefaults) 6 | import Data.Maybe (Maybe(..)) 7 | 8 | type All f = 9 | ( foo :: String 10 | , poly :: f String 11 | | Optional 12 | ) 13 | 14 | type Optional = 15 | ( bar :: Maybe Int 16 | ) 17 | 18 | example 19 | :: forall f r 20 | . ConvertOptionsWithDefaults (Example f) { | Optional } { | r } { | All f } 21 | => Functor f 22 | => { | r } 23 | -> { | All f } 24 | example = convertOptionsWithDefaults (Example :: _ f) { bar: Nothing } 25 | 26 | data Example (f :: Type -> Type) = Example 27 | 28 | instance convertExampleFoo1 :: ConvertOption (Example f) "foo" Int String where 29 | convertOption _ _ = show 30 | 31 | else instance convertExampleBar1 :: ConvertOption (Example f) "bar" Int (Maybe Int) where 32 | convertOption _ _ = Just 33 | 34 | else instance convertExampleIdentity :: ConvertOption (Example f) option a a where 35 | convertOption _ _ = identity 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2021 Nathan Faubion 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /src/ConvertableOptions.purs: -------------------------------------------------------------------------------- 1 | module ConvertableOptions where 2 | 3 | import Prelude 4 | 5 | import Data.Symbol (class IsSymbol) 6 | import Prim.Row as Row 7 | import Prim.RowList (class RowToList, RowList) 8 | import Prim.RowList as RowList 9 | import Record as Record 10 | import Record.Builder (Builder) 11 | import Record.Builder as Builder 12 | import Type.Proxy (Proxy(..)) 13 | 14 | class ConvertOptionsWithDefaults t defaults provided all | t -> defaults all where 15 | convertOptionsWithDefaults :: t -> defaults -> provided -> all 16 | 17 | instance convertOptionsWithDefaultsRecord :: 18 | ( ConvertOptions t { | provided } provided' 19 | , Defaults { | defaults } provided' { | all } 20 | ) => 21 | ConvertOptionsWithDefaults t { | defaults } { | provided } { | all } where 22 | convertOptionsWithDefaults t def = 23 | defaults def <<< convertOptions t 24 | 25 | class ConvertOptions t i o | t -> o where 26 | convertOptions :: t -> i -> o 27 | 28 | class ConvertOption t (p :: Symbol) i o | t p -> o where 29 | convertOption :: t -> Proxy p -> i -> o 30 | 31 | class ConvertRecordOptions t (rl :: RowList Type) i o | t rl -> o where 32 | convertRecordOptions :: t -> Proxy rl -> i -> o 33 | 34 | instance convertRecordOptionsNil :: ConvertRecordOptions t RowList.Nil { | r } (Builder {} {}) where 35 | convertRecordOptions _ _ _ = identity 36 | 37 | instance convertRecordOptionsCons :: 38 | ( ConvertRecordOptions t rest { | r } (Builder { | i } { | o' }) 39 | , ConvertOption t sym a b 40 | , Row.Cons sym a r' r 41 | , Row.Cons sym b o' o 42 | , Row.Lacks sym o' 43 | , IsSymbol sym 44 | ) => 45 | ConvertRecordOptions t (RowList.Cons sym a rest) { | r } (Builder { | i } { | o }) where 46 | convertRecordOptions t _ r = 47 | Builder.insert (Proxy :: _ sym) (convertOption t (Proxy :: _ sym) (Record.get (Proxy :: _ sym) r)) 48 | <<< convertRecordOptions t (Proxy :: _ rest) r 49 | 50 | instance convertOptionsRecord :: 51 | ( RowToList i rl 52 | , ConvertRecordOptions t rl { | i } (Builder {} { | o }) 53 | ) => 54 | ConvertOptions t { | i } { | o } where 55 | convertOptions t i = Builder.buildFromScratch $ convertRecordOptions t (Proxy :: _ rl) i 56 | 57 | class Defaults defaults provided all | defaults provided -> all where 58 | defaults :: defaults -> provided -> all 59 | 60 | instance defaultsRecord :: 61 | ( Row.Union provided defaults all' 62 | , Row.Nub all' all 63 | ) => 64 | Defaults { | defaults } { | provided } { | all } where 65 | defaults = flip Record.merge 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-convertable-options 2 | 3 | PureScript semantics for highly-overloaded API interfaces. 4 | 5 | * Options with implicit defaults. 6 | * Options with conversions - feels a lot like untagged unions. 7 | * Options with `Maybe` lifting - feels a lot like nullable fields. 8 | 9 | ## Introduction 10 | 11 | Say we have an API: 12 | 13 | ```purescript 14 | flub :: { foo :: Int, bar :: String, baz :: Maybe Boolean } -> String 15 | ``` 16 | 17 | This API has very straightforward and understandable options. 18 | 19 | ```purescript 20 | example = flub 21 | { foo: 42 22 | , bar: "Hello" 23 | , baz: Nothing 24 | } 25 | ``` 26 | 27 | But we find this inconvenient. 28 | * `foo` has an obvious default value. 29 | * `bar` is a `String`, but we also want to provide an `Int`. 30 | * `baz` is often `Nothing`, and we don't want to always have to wrap with `Just`. 31 | 32 | That is, we'd like to call it in many different ways at our leisure: 33 | 34 | ```purescript 35 | flub { bar: "Hello" } 36 | flub { bar: 99, baz: true } 37 | flub { foo: 12, bar: "OK", baz: Just false } 38 | ``` 39 | 40 | To start, we should separate out type declarations for defaulted (optional) 41 | fields and all fields. 42 | 43 | ```purescript 44 | type Optional = 45 | ( foo :: Int 46 | , baz :: Maybe Boolean 47 | ) 48 | 49 | type All = 50 | ( bar :: String 51 | | Optional 52 | ) 53 | 54 | defaultOptions :: { | Optional } 55 | defaultOptions = 56 | { foo: 42 57 | , baz: Nothing 58 | } 59 | 60 | flub :: { | All } -> String 61 | ``` 62 | 63 | If all we want is defaulting, we can use a `Defaults` constraint. 64 | 65 | ```purescript 66 | flub 67 | :: forall provided 68 | . Defaults { | Optional } { | provided } { | All } 69 | => { | provided } 70 | -> String 71 | flub provided = ... 72 | where 73 | all :: { | All } 74 | all = defaults defaultOptions provided 75 | ``` 76 | 77 | This will let us omit `foo` and `baz`: 78 | 79 | ```purescript 80 | flub { bar: "Hello" } 81 | flub { foo: 99, bar: "Hello" } 82 | flub { foo: 99, bar: "Hello", baz: Just true } 83 | ``` 84 | 85 | However, we still must always wrap `baz` with `Just`, and we cannot provide 86 | an `Int` for `bar`. To do that we must define `ConvertOption` instances. 87 | 88 | To dispatch `ConvertOption` instances, we must define a new nominal `data` type 89 | which we will use to index all the options of our function. 90 | 91 | ```purescript 92 | data Flub = Flub 93 | ``` 94 | 95 | It can just be a unit type, but it may be useful to add parameters for more 96 | dynamic configuration of conversions or to handle polymorphism. 97 | 98 | Lets overload `bar`. We want it to take either an `Int` or a `String`. 99 | 100 | ```purescript 101 | instance convertFlubBar1 :: ConvertOption Flub "bar" Int String where 102 | convertOption _ _ int = show int 103 | 104 | instance convertFlubBar2 :: ConvertOptions Flub "bar" String String where 105 | convertOption _ _ str = str 106 | ``` 107 | 108 | The first two arguments can generally be ignored. They are the `Flub` 109 | constructor and `Proxy "bar"` respectively. These are used to dispatch the 110 | instance. 111 | 112 | An `Int` can be converted to a `String` via `Show`, and `String` can be given 113 | an identity conversion. 114 | 115 | Let's overload `baz`. We want to treat it more like a nullable field. This can 116 | be accomplished with a conversion that lifts a value with `Just`. 117 | 118 | ```purescript 119 | instance convertFlubBaz1 :: ConvertOption Flub "baz" Boolean (Maybe Boolean) where 120 | convertOption _ _ bool = Just bool 121 | 122 | instance convertFlubBaz2 :: ConvertOption Flub "baz" (Maybe Boolean) (Maybe Boolean) where 123 | convertOption _ _ mb = mb 124 | ``` 125 | 126 | Just like `bar`, we've provided an identity conversion. 127 | 128 | To extend our defaulting behavior with conversions, we should use 129 | `ConvertOptionsWithDefaults`. 130 | 131 | ```purescript 132 | flub 133 | :: forall provided 134 | . ConvertOptionsWithDefaults Flub { | Optional } { | provided } { | All } 135 | => { | provided } 136 | -> String 137 | flub provided = ... 138 | where 139 | all :: { | All } 140 | all = convertOptionsWithDefaults Flub defaultOptions provided 141 | ``` 142 | 143 | And now we have our highly-overloaded API. 144 | 145 | > What happens if I don't write an identity conversion? 146 | 147 | An identity conversion isn't strictly necessary, it just means you won't be able 148 | to call the API with the canonical type. This means for something like `baz`, 149 | you could only express the absence of that option by omitting the field 150 | altogether. This is rarely a good idea, since it means a user can't easily guard 151 | the value on a condition. 152 | 153 | ```purescript 154 | example = flub 155 | { bar: "Hello" 156 | , baz: guard shouldBaz *> Just true 157 | } 158 | ``` 159 | 160 | Instead they must write: 161 | 162 | ```purescript 163 | example = 164 | if shouldBaz then 165 | flub { bar: "Hello", baz: true } 166 | else 167 | flub { bar: "Hello" } 168 | ``` 169 | 170 | Because it is not possible to express the absence of `baz` via `Nothing`. 171 | 172 | > Do I need to write an identity conversion for every option, or can there be a default? 173 | 174 | You can express your conversions as an instance chain, with a default identity 175 | case at the end. 176 | 177 | ```purescript 178 | instance convertFlubBar :: ConvertOption Flub "bar" Int String where 179 | convertOption _ _ int = show int 180 | else instance convertFlubBaz :: ConvertOption Flub "baz" Boolean (Maybe Boolean) where 181 | convertOption _ _ bool = Just bool 182 | else instance convertFlubDefault :: ConvertOption Flub option a a where 183 | convertOption _ _ = identity 184 | ``` 185 | 186 | In some cases, this can actually improve type inference. For example: 187 | 188 | ```purescript 189 | example = flub { bar: "Hello", baz: Nothing } 190 | ``` 191 | 192 | Without the instance chain, this will result in an error since there is no 193 | type annotation on `Nothing`. The compiler does not know that we want 194 | `Maybe Boolean` rather than some other type. If we provide the identity 195 | instance chain, then we get type-defaulting behavior, and this will typecheck 196 | as `Maybe Boolean`. 197 | 198 | However, one disadvantage of this approach is that users cannot extend your API 199 | with their _own_ conversions. By avoiding instance chains, your set of options 200 | are _extensible_ via normal typeclass machinery. That is, an end-user can 201 | overload your API with their own types after-the-fact to suit their convenience. 202 | 203 | ```purescript 204 | data Wat = Wat String 205 | 206 | instance convertFlubWat :: ConvertOption Flub "bar" Wat String where 207 | convertOption _ _ (Wat str) = str 208 | ``` 209 | 210 | Now they can call your API with their new conversion. 211 | 212 | ## Polymorphic Options 213 | 214 | If we wanted to extend the above API with a polymorphic option, we will need 215 | to make a couple of adjustments. 216 | 217 | ```purescript 218 | type Optional = 219 | ( foo :: Int 220 | , baz :: Maybe Boolean 221 | ) 222 | 223 | type All f = 224 | ( bar :: String 225 | , poly :: f String 226 | | Optional 227 | ) 228 | 229 | -- The polymorphic type must be added to our data type. 230 | data Flub (f :: Type -> Type) = Flub 231 | 232 | flub 233 | :: forall f provided 234 | . ConvertOptionsWithDefaults (Flub f) { | Optional } { | provided } { | All f } 235 | => Functor f 236 | => { | provided } 237 | -> String 238 | flub provided = ... 239 | where 240 | all :: { | All f } 241 | all = convertOptionsWithDefaults 242 | (Flub :: Flub f) -- Our data type will need an annotation when called. 243 | defaultOptions 244 | provided 245 | 246 | instance convertFlubBar :: ConvertOption (Flub f) "bar" Int String where 247 | convertOption _ _ int = show int 248 | else instance convertFlubBaz :: ConvertOption (Flub f) "baz" Boolean (Maybe Boolean) where 249 | convertOption _ _ bool = Just bool 250 | else instance convertFlubDefault :: ConvertOption (Flub f) option a a where 251 | convertOption _ _ = identity 252 | ``` 253 | --------------------------------------------------------------------------------