├── .gitignore ├── README.md ├── bsconfig.json ├── package.json ├── src └── OrderTaking │ ├── OT_Common.re │ ├── OT_Common_CompoundTypes.re │ ├── OT_Common_SimpleTypes.re │ ├── OT_PlaceOrder.re │ ├── OT_PlaceOrder_Api.re │ ├── OT_PlaceOrder_Dto.re │ ├── OT_PlaceOrder_Implementation.re │ ├── OT_PlaceOrder_PublicTypes.re │ └── ResultUtils.re └── yarn.lock /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .merlin 3 | .bsb.lock 4 | npm-debug.log 5 | /lib/ 6 | *.bs.js 7 | /node_modules/ 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Domain Modeling Made Functional - in ReasonML! 2 | 3 | This repository contains an attempt to convert all the examples of the book "Domain Modeling Made Functional - Tackle Software Complexity with Domain-Driven Design and F#" into ReasonML code (BuckleScript). 4 | 5 | I wanted to prove the point that functional DDD (Domain-Driven Design) can also be done in ReasonML, which makes sense when you think about the roots of F# and ReasonML being both in OCaml. Still, F# grew it's own feet since then, and is especially powered by the .NET ecosystem and Microsoft sheer financial- and manpower. It therefore _may_ have a better take at being used for writing enterprise software. Let's see if we can do the same in ReasonML via [BuckleScript](https://bucklescript.github.io/). 6 | 7 | For the original F# source code please refer to the corresponding [The Pragmatic Programmer page](https://pragprog.com/titles/swdddf/source_code). 8 | 9 | Similar to the original, the folder structure is as follows: `/src` contains the folders `Chapters`, `OrderTaking` and `OrderTakingEvolved`. For the sake of simplicity, I only put any of them in their own namespace module and did not make three different projects out of them. `Chapters` files are prefixed with `Ch_`, `OrderTaking` files are prefixed with `OT_` and `OrderTakingEvolved` files are prefixed with `OTE_` accordingly. 10 | 11 | 12 | 13 | 28 | 29 | ## Status 30 | 31 | - [ ] Chapters (0 %) 32 | - [ ] OrderTaking (70 %) 33 | - [ ] OrderTakingEvolved (0 %) 34 | -------------------------------------------------------------------------------- /bsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "domain-modeling-made-functional-reason", 3 | "version": "0.1.0", 4 | "sources": { 5 | "dir": "src", 6 | "subdirs": true 7 | }, 8 | "package-specs": { 9 | "module": "commonjs", 10 | "in-source": true 11 | }, 12 | "suffix": ".bs.js", 13 | "bs-dependencies": ["@glennsl/bs-json"], 14 | "warnings": { 15 | "error": "+101" 16 | }, 17 | "namespace": true, 18 | "refmt": 3 19 | } 20 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "domain-modeling-made-functional-reason", 3 | "version": "1.0.0", 4 | "description": "Code examples from Scott Wlaschin's book \"Domain Modeling Made Functional\" converted from F# to ReasonML.", 5 | "main": "index.js", 6 | "scripts": { 7 | "bs:world": "bsb -clean-world -make-world", 8 | "bs:build": "bsb", 9 | "bs:watch": "BS_WATCH_CLEAR=1 bsb -w", 10 | "bs:clean": "bsb -clean", 11 | "test": "echo \"Error: no test specified\" && exit 1" 12 | }, 13 | "keywords": [ 14 | "domain", 15 | "modeling", 16 | "made", 17 | "functional", 18 | "F#", 19 | "ReasonML", 20 | "Domain-Driven-Design", 21 | "DDD" 22 | ], 23 | "author": "Florian Hammerschmidt", 24 | "license": "MIT", 25 | "dependencies": { 26 | "@glennsl/bs-json": "^5.0.1", 27 | "bs-platform": "^5.2.1", 28 | "mongo-db": "^1.0.2" 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /src/OrderTaking/OT_Common.re: -------------------------------------------------------------------------------- 1 | module CompoundTypes = OT_Common_CompoundTypes; 2 | module SimpleTypes = OT_Common_SimpleTypes; -------------------------------------------------------------------------------- /src/OrderTaking/OT_Common_CompoundTypes.re: -------------------------------------------------------------------------------- 1 | open OT_Common_SimpleTypes; 2 | 3 | module PersonalName = { 4 | type t = { 5 | firstName: String50.t, 6 | lastName: String50.t, 7 | }; 8 | }; 9 | 10 | module CustomerInfo = { 11 | type t = { 12 | name: PersonalName.t, 13 | emailAddress: EmailAddress.t, 14 | }; 15 | }; 16 | 17 | module Address = { 18 | type t = { 19 | addressLine1: String50.t, 20 | addressLine2: option(String50.t), 21 | addressLine3: option(String50.t), 22 | addressLine4: option(String50.t), 23 | city: String50.t, 24 | zipCode: ZipCode.t, 25 | }; 26 | }; -------------------------------------------------------------------------------- /src/OrderTaking/OT_Common_SimpleTypes.re: -------------------------------------------------------------------------------- 1 | open Belt; 2 | 3 | module type PdfAttachment = { 4 | type t = { 5 | name: string, 6 | bytes: array(string) // string = byte 7 | }; 8 | }; 9 | 10 | module ListUtils = { 11 | let sumInt = list => List.reduce(list, 0, (a, b) => a + b); 12 | let sumFloat = list => List.reduce(list, 0.0, (a, b) => a +. b); 13 | }; 14 | 15 | module ConstrainedType = { 16 | let createString = (fieldName, ctor, maxLen, str) => 17 | switch (str) { 18 | | "" => Result.Error({j|"$fieldName must not be empty"|j}) 19 | | str when str->Js.String2.length > maxLen => 20 | Result.Error({j|"$fieldName must not be more than $maxLen chars"|j}) 21 | | _ => Result.Ok(ctor) 22 | }; 23 | 24 | let createStringOption = (fieldName, ctor, maxLen, str) => 25 | switch (str) { 26 | | "" => Result.Ok(None) 27 | | str when str->Js.String2.length > maxLen => 28 | Result.Error({j|"$fieldName must not be more than $maxLen chars"|j}) 29 | | _ => Result.Ok(ctor) 30 | }; 31 | 32 | let createInt = (fieldName, ctor, minVal, maxVal, i: int) => 33 | if (i < minVal) { 34 | Result.Error({j|"$fieldName must not be less than $minVal"|j}); 35 | } else if (i > maxVal) { 36 | Result.Error({j|"$fieldName must not be greater than $maxVal"|j}); 37 | } else { 38 | Result.Ok(ctor); 39 | }; 40 | 41 | let createFloat = (fieldName, ctor, minVal, maxVal, i: float) => 42 | if (i < minVal) { 43 | Result.Error({j|"$fieldName must not be less than $minVal"|j}); 44 | } else if (i > maxVal) { 45 | Result.Error({j|"$fieldName must not be greater than $maxVal"|j}); 46 | } else { 47 | Result.Ok(ctor); 48 | }; 49 | 50 | let createLike = (fieldName, ctor, pattern, str) => 51 | switch (str) { 52 | | "" => Result.Error({j|"$fieldName must not be empty"|j}) 53 | | str when str->Js.String2.match(pattern->Js.Re.fromString)->Option.isSome => 54 | Result.Ok(ctor) 55 | | _ => 56 | Result.Error( 57 | {j|"$fieldName: ' $str ' must match the pattern ' $pattern '"|j}, 58 | ) 59 | }; 60 | }; 61 | 62 | module type String50 = { 63 | type t = pri | String50(string); 64 | let value: t => string; 65 | let create: (string, string) => Belt.Result.t(t, string); 66 | let createOption: (string, string) => Belt.Result.t(t, string); 67 | }; 68 | 69 | module String50 = { 70 | type t = 71 | | String50(string); 72 | 73 | let value = (String50(str)) => str; 74 | 75 | let create = (fieldName, str) => 76 | ConstrainedType.createString(fieldName, String50(str), 50, str); 77 | 78 | let createOption = (fieldName, str) => 79 | ConstrainedType.createStringOption( 80 | fieldName, 81 | Some(String50(str)), 82 | 50, 83 | str, 84 | ); 85 | }; 86 | 87 | module type EmailAddress = { 88 | type t = pri | EmailAddress(string); 89 | let value: t => string; 90 | let create: (string, string) => Belt.Result.t(t, string); 91 | }; 92 | 93 | module EmailAddress: EmailAddress = { 94 | type t = 95 | | EmailAddress(string); 96 | 97 | let value = (EmailAddress(str)) => str; 98 | 99 | let create = (fieldName, str) => { 100 | let pattern = ".+@.+"; 101 | ConstrainedType.createLike(fieldName, EmailAddress(str), pattern, str); 102 | }; 103 | }; 104 | 105 | module type ZipCode = { 106 | type t = pri | ZipCode(string); 107 | let value: t => string; 108 | let create: (string, string) => Belt.Result.t(t, string); 109 | }; 110 | 111 | module ZipCode = { 112 | type t = 113 | | ZipCode(string); 114 | 115 | let value = (ZipCode(str)) => str; 116 | 117 | let create = (fieldName, str) => { 118 | let pattern = "\d{5}"; 119 | ConstrainedType.createLike(fieldName, ZipCode(str), pattern, str); 120 | }; 121 | }; 122 | 123 | module type OrderId = { 124 | type t = pri | OrderId(string); 125 | let value: t => string; 126 | let create: (string, string) => Belt.Result.t(t, string); 127 | }; 128 | 129 | module OrderId: OrderId = { 130 | type t = 131 | | OrderId(string); 132 | 133 | let value = (OrderId(str)) => str; 134 | 135 | let create = (fieldName, str) => 136 | ConstrainedType.createString(fieldName, OrderId(str), 50, str); 137 | }; 138 | 139 | module type OrderLineId = { 140 | type t = pri | OrderLineId(string); 141 | let value: t => string; 142 | let create: (string, string) => Belt.Result.t(t, string); 143 | }; 144 | 145 | module OrderLineId: OrderLineId = { 146 | type t = 147 | | OrderLineId(string); 148 | 149 | let value = (OrderLineId(str)) => str; 150 | 151 | let create = (fieldName, str) => 152 | ConstrainedType.createString(fieldName, OrderLineId(str), 50, str); 153 | }; 154 | 155 | module type WidgetCode = { 156 | type t = pri | WidgetCode(string); 157 | let value: t => string; 158 | let create: (string, string) => Belt.Result.t(t, string); 159 | }; 160 | 161 | module WidgetCode: WidgetCode = { 162 | type t = 163 | | WidgetCode(string); 164 | 165 | let value = (WidgetCode(str)) => str; 166 | 167 | let create = (fieldName, code) => { 168 | let pattern = "W\d{4}"; 169 | ConstrainedType.createLike(fieldName, WidgetCode(code), pattern, code); 170 | }; 171 | }; 172 | 173 | module type GizmoCode = { 174 | type t = pri | GizmoCode(string); 175 | let value: t => string; 176 | let create: (string, string) => Belt.Result.t(t, string); 177 | }; 178 | 179 | module GizmoCode: GizmoCode = { 180 | type t = 181 | | GizmoCode(string); 182 | 183 | let value = (GizmoCode(str)) => str; 184 | 185 | let create = (fieldName, code) => { 186 | let pattern = "G\d{3}"; 187 | ConstrainedType.createLike(fieldName, GizmoCode(code), pattern, code); 188 | }; 189 | }; 190 | 191 | module type ProductCode = { 192 | type t = pri | Widget(WidgetCode.t) | Gizmo(GizmoCode.t); 193 | let value: t => string; 194 | let create: (string, string) => Belt.Result.t(t, string); 195 | }; 196 | 197 | module ProductCode: ProductCode = { 198 | type t = 199 | | Widget(WidgetCode.t) 200 | | Gizmo(GizmoCode.t); 201 | 202 | let value = 203 | fun 204 | | Widget(WidgetCode(wc)) => wc 205 | | Gizmo(GizmoCode(gc)) => gc; 206 | 207 | let create = (fieldName, code) => { 208 | switch (code) { 209 | | "" => Result.Error({j|$fieldName: Must not be null or empty|j}) 210 | | code when code->Js.String2.startsWith("W") => 211 | WidgetCode.create(fieldName, code)->Result.map(code => Widget(code)) 212 | | code when code->Js.String2.startsWith("G") => 213 | GizmoCode.create(fieldName, code)->Result.map(code => Gizmo(code)) 214 | | _ => Result.Error({j|$fieldName: Format not recognized ' $code '|j}) 215 | }; 216 | }; 217 | }; 218 | 219 | module type UnitQuantity = { 220 | type t = pri | UnitQuantity(int); 221 | let value: t => int; 222 | let create: (string, int) => Belt.Result.t(t, string); 223 | }; 224 | 225 | module UnitQuantity: UnitQuantity = { 226 | type t = 227 | | UnitQuantity(int); 228 | 229 | let value = (UnitQuantity(v)) => v; 230 | 231 | let create = (fieldName, v) => { 232 | ConstrainedType.createInt(fieldName, UnitQuantity(v), 1, 1000, v); 233 | }; 234 | }; 235 | 236 | module type KilogramQuantity = { 237 | type t = pri | KilogramQuantity(float); 238 | let value: t => float; 239 | let create: (string, float) => Belt.Result.t(t, string); 240 | }; 241 | 242 | module KilogramQuantity: KilogramQuantity = { 243 | type t = 244 | | KilogramQuantity(float); 245 | 246 | let value = (KilogramQuantity(v)) => v; 247 | 248 | let create = (fieldName, v) => { 249 | ConstrainedType.createFloat( 250 | fieldName, 251 | KilogramQuantity(v), 252 | 0.5, 253 | 100.0, 254 | v, 255 | ); 256 | }; 257 | }; 258 | 259 | module type OrderQuantity = { 260 | type t = pri | Unit(UnitQuantity.t) | Kilogram(KilogramQuantity.t); 261 | let value: t => float; 262 | let create: (string, ProductCode.t, float) => Belt.Result.t(t, string); 263 | }; 264 | 265 | module OrderQuantity: OrderQuantity = { 266 | type t = 267 | | Unit(UnitQuantity.t) 268 | | Kilogram(KilogramQuantity.t); 269 | 270 | let value = 271 | fun 272 | | Unit(UnitQuantity(uq)) => uq->float_of_int 273 | | Kilogram(KilogramQuantity(kq)) => kq; 274 | 275 | let create = (fieldName, productCode, quantity) => 276 | switch (productCode) { 277 | | ProductCode.Widget(_) => 278 | UnitQuantity.create(fieldName, quantity->int_of_float) 279 | ->Result.map(qty => Unit(qty)) 280 | | ProductCode.Gizmo(_) => 281 | KilogramQuantity.create(fieldName, quantity) 282 | ->Result.map(qty => Kilogram(qty)) 283 | }; 284 | }; 285 | 286 | module type Price = { 287 | type t = pri | Price(float); 288 | let value: t => float; 289 | let create: float => Belt.Result.t(t, string); 290 | let createExn: float => t; 291 | }; 292 | 293 | module Price: Price = { 294 | type t = 295 | | Price(float); 296 | 297 | let value = (Price(v)) => v; 298 | 299 | let create = v => 300 | ConstrainedType.createFloat("Price", Price(v), 0.0, 1000.0, v); 301 | 302 | let createExn = v => create(v)->Result.getExn; 303 | }; 304 | 305 | module type BillingAmount = { 306 | type t = pri | BillingAmount(float); 307 | let value: t => float; 308 | let create: float => Belt.Result.t(t, string); 309 | let sumPrices: list(Price.t) => Belt.Result.t(t, string); 310 | }; 311 | 312 | module BillingAmount: BillingAmount = { 313 | type t = 314 | | BillingAmount(float); 315 | 316 | let value = (BillingAmount(v)) => v; 317 | 318 | /// Create a BillingAmount from a decimal. 319 | /// Return Error if input is not a decimal between 0.0 and 10000.00 320 | let create = v => 321 | ConstrainedType.createFloat( 322 | "BillingAmount", 323 | BillingAmount(v), 324 | 0.0, 325 | 10000.0, 326 | v, 327 | ); 328 | 329 | /// Sum a list of prices to make a billing amount 330 | /// Return Error if total is out of bounds 331 | let sumPrices = prices => 332 | prices->List.map(price => Price.value(price))->ListUtils.sumFloat->create; 333 | }; -------------------------------------------------------------------------------- /src/OrderTaking/OT_PlaceOrder.re: -------------------------------------------------------------------------------- 1 | module Api = OT_PlaceOrder_Api; 2 | module Dto = OT_PlaceOrder_Dto; 3 | module Implementation = OT_PlaceOrder_Implementation; 4 | module PublicTypes = OT_PlaceOrder_PublicTypes; -------------------------------------------------------------------------------- /src/OrderTaking/OT_PlaceOrder_Api.re: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fhammerschmidt/domain-modeling-made-functional-reason/c20261fe749f9927ed6064b7dff823e14b9fc473/src/OrderTaking/OT_PlaceOrder_Api.re -------------------------------------------------------------------------------- /src/OrderTaking/OT_PlaceOrder_Dto.re: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fhammerschmidt/domain-modeling-made-functional-reason/c20261fe749f9927ed6064b7dff823e14b9fc473/src/OrderTaking/OT_PlaceOrder_Dto.re -------------------------------------------------------------------------------- /src/OrderTaking/OT_PlaceOrder_Implementation.re: -------------------------------------------------------------------------------- 1 | open OT_Common.SimpleTypes; 2 | open OT_Common.CompoundTypes; 3 | open OT_PlaceOrder_PublicTypes; 4 | open ResultUtils; 5 | 6 | type checkProductCodexists = ProductCode.t => bool; 7 | 8 | module AddressValidationError = { 9 | type t = 10 | | InvalidFormat 11 | | AddressNotFound; 12 | }; 13 | 14 | module CheckedAddress = { 15 | type t = 16 | | CheckedAddress(UnvalidatedAddress.t); 17 | }; 18 | 19 | type checkAddressExists = UnvalidatedAddress.t => CheckedAddress.t; 20 | 21 | module ValidatedOrderLine = { 22 | type t = { 23 | orderLineId: OrderLineId.t, 24 | productCode: ProductCode.t, 25 | quantity: OrderQuantity.t, 26 | }; 27 | }; 28 | 29 | module ValidatedOrder = { 30 | type t = { 31 | orderId: OrderId.t, 32 | customerInfo: CustomerInfo.t, 33 | shippingAddress: Address.t, 34 | billingAddress: Address.t, 35 | lines: list(ValidatedOrderLine.t), 36 | }; 37 | }; 38 | 39 | type validateOrder = 40 | (checkProductCodexists, checkAddressExists, UnvalidatedOrder.t) => 41 | AsyncResult.t(ValidatedOrder.t, ValidationError.t); 42 | 43 | type getProductPrice = ProductCode.t => Price.t; 44 | 45 | type priceOrder = 46 | (getProductPrice, ValidatedOrder.t) => 47 | Result.t(PricedOrder.t, PricingError.t); 48 | 49 | module HtmlString = { 50 | type t = 51 | | HtmlString(string); 52 | }; 53 | 54 | module OrderAcknowledgment = { 55 | type t = { 56 | emailAddress: EmailAddress.t, 57 | letter: HtmlString.t, 58 | }; 59 | }; 60 | 61 | type createOrderAcknowledgementLetter = PricedOrder.t => HtmlString.t; 62 | 63 | module SendResult = { 64 | type t = 65 | | Sent 66 | | NotSent; 67 | }; 68 | 69 | type sendOrderAcknowledgement = OrderAcknowledgment.t => SendResult.t; 70 | 71 | type acknowledgeOrder = 72 | ( 73 | createOrderAcknowledgementLetter, 74 | sendOrderAcknowledgement, 75 | PricedOrder.t 76 | ) => 77 | option(OrderAcknowledgmentSent.t); 78 | 79 | type createEvents = 80 | (PricedOrder.t, option(OrderAcknowledgmentSent.t)) => 81 | list(PlaceOrderEvent.t); -------------------------------------------------------------------------------- /src/OrderTaking/OT_PlaceOrder_PublicTypes.re: -------------------------------------------------------------------------------- 1 | open OT_Common.SimpleTypes; 2 | open OT_Common.CompoundTypes; 3 | 4 | module UnvalidatedCustomerInfo = { 5 | type t = { 6 | firstName: string, 7 | lastName: string, 8 | emailAddress: string, 9 | }; 10 | }; 11 | 12 | module UnvalidatedAddress = { 13 | type t = { 14 | addressLine1: string, 15 | addressLine2: string, 16 | addressLine3: string, 17 | addressLine4: string, 18 | city: string, 19 | zipCode: string, 20 | }; 21 | }; 22 | 23 | module UnvalidatedOrderLine = { 24 | type t = { 25 | orderLineId: string, 26 | productCode: string, 27 | quantity: float, 28 | }; 29 | }; 30 | 31 | module UnvalidatedOrder = { 32 | type t = { 33 | orderId: string, 34 | customerInfo: UnvalidatedCustomerInfo.t, 35 | shippingAddress: UnvalidatedAddress.t, 36 | billingAddress: UnvalidatedAddress.t, 37 | lines: list(UnvalidatedOrderLine.t), 38 | }; 39 | }; 40 | 41 | module OrderAcknowledgmentSent = { 42 | type t = { 43 | orderId: OrderId.t, 44 | emailAddress: EmailAddress.t, 45 | }; 46 | }; 47 | 48 | module PricedOrderLine = { 49 | type t = { 50 | orderLineId: OrderLineId.t, 51 | productCode: ProductCode.t, 52 | quantity: OrderQuantity.t, 53 | linePrice: Price.t, 54 | }; 55 | }; 56 | 57 | module PricedOrder = { 58 | type t = { 59 | orderId: OrderId.t, 60 | customerInfo: CustomerInfo.t, 61 | shippingAddress: Address.t, 62 | billingAddress: Address.t, 63 | amountToBill: BillingAmount.t, 64 | lines: list(PricedOrderLine.t), 65 | }; 66 | }; 67 | 68 | module OrderPlaced = PricedOrder; 69 | 70 | module BillableOrderPlaced = { 71 | type t = { 72 | orderId: OrderId.t, 73 | billingAddress: Address.t, 74 | amountToBill: BillingAmount.t, 75 | }; 76 | }; 77 | 78 | module PlaceOrderEvent = { 79 | type t = 80 | | OrderPlaced(OrderPlaced.t) 81 | | BillableOrderPlaced(BillableOrderPlaced.t) 82 | | OrderAcknowledgmentSent(OrderAcknowledgmentSent.t); 83 | }; 84 | 85 | module ValidationError = { 86 | type t = 87 | | ValidationError(string); 88 | }; 89 | 90 | module PricingError = { 91 | type t = 92 | | PricingError(string); 93 | }; 94 | 95 | module ServiceInfo = { 96 | type t = { 97 | name: string, 98 | endpoint: string, 99 | }; 100 | }; 101 | 102 | module RemoteServiceError = { 103 | type t = { 104 | service: ServiceInfo.t, 105 | exception_: string // System.Exception 106 | }; 107 | }; 108 | 109 | module PlaceOrderError = { 110 | type t = 111 | | Validation(ValidationError.t) 112 | | Pricing(PricingError.t) 113 | | RemoteService(RemoteServiceError.t); 114 | }; 115 | 116 | module PlaceOrder = { 117 | type t = 118 | UnvalidatedOrder.t => 119 | Belt.Result.t(list(PlaceOrderEvent.t), PlaceOrderError.t); 120 | }; -------------------------------------------------------------------------------- /src/OrderTaking/ResultUtils.re: -------------------------------------------------------------------------------- 1 | open Belt.Result; 2 | 3 | // Identity function. 4 | let id = x => x; 5 | 6 | module Result = { 7 | type t('success, 'failure) = Belt.Result.t('success, 'failure); 8 | 9 | let bimap = (onSuccess, onError, xR) => 10 | switch (xR) { 11 | | Ok(x) => onSuccess(x) 12 | | Error(err) => onError(err) 13 | }; 14 | 15 | let map = (f, result) => 16 | switch (result) { 17 | | Ok(success) => Ok(f(success)) 18 | | Error(err) => Error(err) 19 | }; 20 | 21 | let mapError = (f, result) => 22 | switch (result) { 23 | | Ok(success) => Ok(success) 24 | | Error(err) => Error(f(err)) 25 | }; 26 | 27 | let bind = (f, result) => 28 | switch (result) { 29 | | Ok(success) => f(success) 30 | | Error(err) => Error(err) 31 | }; 32 | 33 | let iter = (f, result) => map(f, result) |> ignore; 34 | 35 | let apply = (fR, xR) => 36 | switch (fR, xR) { 37 | | (Ok(f), Ok(x)) => Ok(f(x)) 38 | | (Error(err1), Ok(_)) => Error(err1) 39 | | (Ok(_), Error(err2)) => Error(err2) 40 | | (Error(err1), Error(_)) => Error(err1) 41 | }; 42 | 43 | let sequence = aListOfResults => { 44 | let (<*>) = apply; 45 | let () = map; 46 | let cons = (head, tail) => [head, ...tail]; 47 | let consR = (headR, tailR) => cons headR <*> tailR; 48 | let initialValue = Ok([]); 49 | 50 | // List.foldBack in F# 51 | List.fold_right(consR, aListOfResults, initialValue); 52 | }; 53 | 54 | let lift2 = (f, x1, x2) => { 55 | let () = map; 56 | let (<*>) = apply; 57 | f x1 <*> x2; 58 | }; 59 | 60 | let lift3 = (f, x1, x2, x3) => { 61 | let () = map; 62 | let (<*>) = apply; 63 | f x1 <*> x2 <*> x3; 64 | }; 65 | 66 | let lift4 = (f, x1, x2, x3, x4) => { 67 | let () = map; 68 | let (<*>) = apply; 69 | f x1 <*> x2 <*> x3 <*> x4; 70 | }; 71 | 72 | let bind2 = (f, x1, x2) => lift2(f, x1, x2) |> bind(id); 73 | 74 | let bind3 = (f, x1, x2, x3) => lift3(f, x1, x2, x3) |> bind(id); 75 | 76 | let isOk = 77 | fun 78 | | Ok(_) => true 79 | | Error(_) => false; 80 | 81 | let isError = xR => !isOk(xR); 82 | 83 | let filter = pred => 84 | fun 85 | | Ok(x) => pred(x) 86 | | Error(_) => true; 87 | 88 | let ifError = defaultVal => 89 | fun 90 | | Ok(x) => x 91 | | Error(_) => defaultVal; 92 | 93 | let bindOption = (f, xR) => 94 | switch (xR) { 95 | | Some(x) => f(x) |> map(x => Some(x)) 96 | | None => Ok(None) 97 | }; 98 | 99 | let ofOption = (errorValue, opt) => 100 | switch (opt) { 101 | | Some(x) => Ok(x) 102 | | None => Error(errorValue) 103 | }; 104 | 105 | let toOption = xR => 106 | switch (xR) { 107 | | Ok(x) => Some(x) 108 | | Error(_) => None 109 | }; 110 | 111 | let toErrorOption = 112 | fun 113 | | Ok(_) => None 114 | | Error(err) => Some(err); 115 | }; 116 | 117 | module ResultComputationExpression = { 118 | /* TODO: Implement something comparable to F# computation expressions*/ 119 | }; 120 | 121 | module Validation = { 122 | type t('success, 'failure) = Result.t('success, list('failure)); 123 | 124 | let apply = (fV: t(_, _), xV: t(_, _)) => { 125 | switch (fV, xV) { 126 | | (Ok(f), Ok(x)) => Ok(f(x)) 127 | | (Error(err1), Ok(_)) => Error(err1) 128 | | (Ok(_), Error(err2)) => Error(err2) 129 | | (Error(err1), Error(err2)) => Error(err1 @ err2) 130 | }; 131 | }; 132 | 133 | let sequence = (aListOfValidations: list(t(_, _))) => { 134 | let (<*>) = apply; 135 | let () = Result.map; 136 | let cons = (head, tail) => [head, ...tail]; 137 | let consR = (headR, tailR) => cons headR <*> tailR; 138 | let initialValue = Ok([]); 139 | 140 | // List.foldBack in F# 141 | List.fold_right(consR, aListOfValidations, initialValue); 142 | }; 143 | 144 | let ofResult = (xR: t(_, _)) => xR |> Result.mapError(err => [err]); 145 | 146 | let toResult = (xV: t(_, _)): Result.t(_, _) => xV; 147 | }; 148 | 149 | module Async = { 150 | /* TODO: Implement something comparable to F# async */ 151 | }; 152 | 153 | module AsyncResult = { 154 | type t('success, 'failure) = Result.t('success, 'failure); 155 | /* TODO: Implement something comparable to AsyncResult */ 156 | }; 157 | 158 | module AsyncResultComputationExpression = { 159 | /* TODO: Implement something comparable to F# computation expressions*/ 160 | }; -------------------------------------------------------------------------------- /yarn.lock: -------------------------------------------------------------------------------- 1 | # THIS IS AN AUTOGENERATED FILE. DO NOT EDIT THIS FILE DIRECTLY. 2 | # yarn lockfile v1 3 | 4 | 5 | "@glennsl/bs-json@^5.0.1": 6 | version "5.0.1" 7 | resolved "https://registry.yarnpkg.com/@glennsl/bs-json/-/bs-json-5.0.1.tgz#b19d0b45f4a80d52e6bfefa032ac99f4548f3083" 8 | integrity sha512-tDxqeO4LCUz3HIwsdqyM4OIUk/bIV8QwDuhNbqy3hHIVEciePbJXTSyXMKsoIFs3ukQY8ZsQXskONtOK4TyLfA== 9 | 10 | bluebird@^3.4.1: 11 | version "3.7.1" 12 | resolved "https://registry.yarnpkg.com/bluebird/-/bluebird-3.7.1.tgz#df70e302b471d7473489acf26a93d63b53f874de" 13 | integrity sha512-DdmyoGCleJnkbp3nkbxTLJ18rjDsE4yCggEwKNXkeV123sPNfOCYeDoeuOY+F2FrSjO1YXcTU+dsy96KMy+gcg== 14 | 15 | bs-platform@^5.2.1: 16 | version "5.2.1" 17 | resolved "https://registry.yarnpkg.com/bs-platform/-/bs-platform-5.2.1.tgz#3f76f6d4f4c7255296375a8104c8be332770b691" 18 | integrity sha512-3ISP+RBC/NYILiJnphCY0W3RTYpQ11JGa2dBBLVug5fpFZ0qtSaL3ZplD8MyjNeXX2bC7xgrWfgBSn8Tc9om7Q== 19 | 20 | bson@~1.0.4: 21 | version "1.0.9" 22 | resolved "https://registry.yarnpkg.com/bson/-/bson-1.0.9.tgz#12319f8323b1254739b7c6bef8d3e89ae05a2f57" 23 | integrity sha512-IQX9/h7WdMBIW/q/++tGd+emQr0XMdeZ6icnT/74Xk9fnabWn+gZgpE+9V+gujL3hhJOoNrnDVY7tWdzc7NUTg== 24 | 25 | buffer-shims@~1.0.0: 26 | version "1.0.0" 27 | resolved "https://registry.yarnpkg.com/buffer-shims/-/buffer-shims-1.0.0.tgz#9978ce317388c649ad8793028c3477ef044a8b51" 28 | integrity sha1-mXjOMXOIxkmth5MCjDR37wRKi1E= 29 | 30 | core-util-is@~1.0.0: 31 | version "1.0.2" 32 | resolved "https://registry.yarnpkg.com/core-util-is/-/core-util-is-1.0.2.tgz#b5fd54220aa2bc5ab57aab7140c940754503c1a7" 33 | integrity sha1-tf1UIgqivFq1eqtxQMlAdUUDwac= 34 | 35 | es6-promise@3.2.1: 36 | version "3.2.1" 37 | resolved "https://registry.yarnpkg.com/es6-promise/-/es6-promise-3.2.1.tgz#ec56233868032909207170c39448e24449dd1fc4" 38 | integrity sha1-7FYjOGgDKQkgcXDDlEjiREndH8Q= 39 | 40 | inherits@~2.0.1: 41 | version "2.0.4" 42 | resolved "https://registry.yarnpkg.com/inherits/-/inherits-2.0.4.tgz#0fa2c64f932917c3433a0ded55363aae37416b7c" 43 | integrity sha512-k/vGaX4/Yla3WzyMCvTQOXYeIHvqOKtnqBduzTHpzpQZzAskKMhZ2K+EnBiSM9zGSoIFeMpXKxa4dYeZIQqewQ== 44 | 45 | isarray@~1.0.0: 46 | version "1.0.0" 47 | resolved "https://registry.yarnpkg.com/isarray/-/isarray-1.0.0.tgz#bb935d48582cba168c06834957a54a3e07124f11" 48 | integrity sha1-u5NdSFgsuhaMBoNJV6VKPgcSTxE= 49 | 50 | mongo-db@^1.0.2: 51 | version "1.0.2" 52 | resolved "https://registry.yarnpkg.com/mongo-db/-/mongo-db-1.0.2.tgz#39be12712366756ad3beae9a29384f559ec04dc3" 53 | integrity sha1-Ob4ScSNmdWrTvq6aKThPVZ7ATcM= 54 | dependencies: 55 | bluebird "^3.4.1" 56 | mongodb "^2.1.18" 57 | 58 | mongodb-core@2.1.20: 59 | version "2.1.20" 60 | resolved "https://registry.yarnpkg.com/mongodb-core/-/mongodb-core-2.1.20.tgz#fece8dd76b59ee7d7f2d313b65322c160492d8f1" 61 | integrity sha512-IN57CX5/Q1bhDq6ShAR6gIv4koFsZP7L8WOK1S0lR0pVDQaScffSMV5jxubLsmZ7J+UdqmykKw4r9hG3XQEGgQ== 62 | dependencies: 63 | bson "~1.0.4" 64 | require_optional "~1.0.0" 65 | 66 | mongodb@^2.1.18: 67 | version "2.2.36" 68 | resolved "https://registry.yarnpkg.com/mongodb/-/mongodb-2.2.36.tgz#1c573680b2849fb0f47acbba3dc5fa228de975f5" 69 | integrity sha512-P2SBLQ8Z0PVx71ngoXwo12+FiSfbNfGOClAao03/bant5DgLNkOPAck5IaJcEk4gKlQhDEURzfR3xuBG1/B+IA== 70 | dependencies: 71 | es6-promise "3.2.1" 72 | mongodb-core "2.1.20" 73 | readable-stream "2.2.7" 74 | 75 | process-nextick-args@~1.0.6: 76 | version "1.0.7" 77 | resolved "https://registry.yarnpkg.com/process-nextick-args/-/process-nextick-args-1.0.7.tgz#150e20b756590ad3f91093f25a4f2ad8bff30ba3" 78 | integrity sha1-FQ4gt1ZZCtP5EJPyWk8q2L/zC6M= 79 | 80 | readable-stream@2.2.7: 81 | version "2.2.7" 82 | resolved "https://registry.yarnpkg.com/readable-stream/-/readable-stream-2.2.7.tgz#07057acbe2467b22042d36f98c5ad507054e95b1" 83 | integrity sha1-BwV6y+JGeyIELTb5jFrVBwVOlbE= 84 | dependencies: 85 | buffer-shims "~1.0.0" 86 | core-util-is "~1.0.0" 87 | inherits "~2.0.1" 88 | isarray "~1.0.0" 89 | process-nextick-args "~1.0.6" 90 | string_decoder "~1.0.0" 91 | util-deprecate "~1.0.1" 92 | 93 | require_optional@~1.0.0: 94 | version "1.0.1" 95 | resolved "https://registry.yarnpkg.com/require_optional/-/require_optional-1.0.1.tgz#4cf35a4247f64ca3df8c2ef208cc494b1ca8fc2e" 96 | integrity sha512-qhM/y57enGWHAe3v/NcwML6a3/vfESLe/sGM2dII+gEO0BpKRUkWZow/tyloNqJyN6kXSl3RyyM8Ll5D/sJP8g== 97 | dependencies: 98 | resolve-from "^2.0.0" 99 | semver "^5.1.0" 100 | 101 | resolve-from@^2.0.0: 102 | version "2.0.0" 103 | resolved "https://registry.yarnpkg.com/resolve-from/-/resolve-from-2.0.0.tgz#9480ab20e94ffa1d9e80a804c7ea147611966b57" 104 | integrity sha1-lICrIOlP+h2egKgEx+oUdhGWa1c= 105 | 106 | safe-buffer@~5.1.0: 107 | version "5.1.2" 108 | resolved "https://registry.yarnpkg.com/safe-buffer/-/safe-buffer-5.1.2.tgz#991ec69d296e0313747d59bdfd2b745c35f8828d" 109 | integrity sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g== 110 | 111 | semver@^5.1.0: 112 | version "5.7.1" 113 | resolved "https://registry.yarnpkg.com/semver/-/semver-5.7.1.tgz#a954f931aeba508d307bbf069eff0c01c96116f7" 114 | integrity sha512-sauaDf/PZdVgrLTNYHRtpXa1iRiKcaebiKQ1BJdpQlWH2lCvexQdX55snPFyK7QzpudqbCI0qXFfOasHdyNDGQ== 115 | 116 | string_decoder@~1.0.0: 117 | version "1.0.3" 118 | resolved "https://registry.yarnpkg.com/string_decoder/-/string_decoder-1.0.3.tgz#0fc67d7c141825de94282dd536bec6b9bce860ab" 119 | integrity sha512-4AH6Z5fzNNBcH+6XDMfA/BTt87skxqJlO0lAh3Dker5zThcAxG6mKz+iGu308UKoPPQ8Dcqx/4JhujzltRa+hQ== 120 | dependencies: 121 | safe-buffer "~5.1.0" 122 | 123 | util-deprecate@~1.0.1: 124 | version "1.0.2" 125 | resolved "https://registry.yarnpkg.com/util-deprecate/-/util-deprecate-1.0.2.tgz#450d4dc9fa70de732762fbd2d4a28981419a0ccf" 126 | integrity sha1-RQ1Nyfpw3nMnYvvS1KKJgUGaDM8= 127 | --------------------------------------------------------------------------------