├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── Emakefile ├── LICENSE ├── Makefile ├── README.md ├── beam.mk ├── doc ├── category.md ├── features.md ├── generic.md ├── lens.md ├── monad.md └── typecast.md ├── examples ├── Makefile ├── rebar.config ├── src │ ├── examples.app.src │ ├── examples_generic.erl │ ├── examples_generic_io.erl │ └── examples_lens.erl └── test │ └── tests.config ├── include └── datum.hrl ├── priv └── datum.benchmark ├── rebar.config ├── rebar.config.script ├── src ├── category │ ├── category.erl │ ├── datum_cat.erl │ ├── datum_cat_either.erl │ ├── datum_cat_f.erl │ ├── datum_cat_kleisli.erl │ ├── datum_cat_option.erl │ ├── datum_cat_reader.erl │ └── datum_cat_undefined.erl ├── datum.app.src ├── datum.erl ├── foldable.erl ├── generic.erl ├── lens │ └── lens.erl ├── maplike.erl ├── maplike │ ├── bst.erl │ ├── heap.erl │ ├── htree.erl │ └── rbtree.erl ├── monad │ ├── m_identity.erl │ ├── m_io.erl │ └── m_state.erl ├── partial.erl ├── queue │ ├── deq.erl │ └── q.erl ├── sets │ ├── chord.erl │ ├── ring.erl │ └── sbf.erl ├── stream │ └── stream.erl ├── topological.erl ├── traversable.erl └── typecast.erl └── test ├── category_SUITE.erl ├── category_parse_transform_SUITE.erl ├── foldable_SUITE.erl ├── generic_SUITE.erl ├── lens_SUITE.erl ├── m_SUITE.erl ├── maplike_SUITE.erl ├── q_SUITE.erl ├── ring_tests.erl ├── stream_SUITE.erl ├── tests.config ├── traversable_SUITE.erl ├── tree_SUITE.erl └── typecast_SUITE.erl /.gitignore: -------------------------------------------------------------------------------- 1 | *.*~ 2 | *.log 3 | *.aux 4 | *.beam 5 | *.dump 6 | *.tag.gz 7 | *.tgz 8 | test.* 9 | .eunit/ 10 | tests/ 11 | ebin/ 12 | rebar3 13 | rebar.lock 14 | _build/ 15 | *.sublime-* 16 | t.erl 17 | 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: erlang 2 | dist: trusty 3 | 4 | script: 5 | - make 6 | - make test 7 | - ./rebar3 coveralls send 8 | 9 | otp_release: 10 | - 20.1 11 | - 20.0 12 | - 19.2 13 | - 18.3 14 | 15 | notifications: 16 | webhooks: 17 | urls: 18 | - https://webhooks.gitter.im/e/2f8c131737ec5d25fe9a 19 | on_success: change 20 | on_failure: always 21 | on_start: never 22 | 23 | 24 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | The library uses [semantic versions](http://semver.org) to identify stable releases. 4 | 5 | ## Release 4.6.x 6 | 7 | **Features** 8 | * [#68](https://github.com/fogfish/datum/issues/68): Implements generic representations 9 | * Support product lenses for records (`lens:p/1`). 10 | 11 | 12 | ## Release 4.5.x 13 | 14 | **Features** 15 | * [#54](https://github.com/fogfish/datum/issues/54): Implements pattern matching within do-notation 16 | * Add typecast utility for scalar types. 17 | * Support MFA generator for streams 18 | * implements lens isomorphism (`lens:iso/2`, `lens:iso/4`) and product lens (`lens:p/1`). 19 | 20 | **Improvements** 21 | 22 | * Support lists comprehension at do-notation 23 | 24 | ## Release 4.4.0 25 | 26 | **Features** 27 | * Implements basic lenses: identity (`lens:id/0`), constant (`lens:const/1`) 28 | * Implements binary lenses: head of binary (`lens:hbits/1`), tail of binary (`lens:tbits/`), bit focus (`lens:bits/2`) 29 | 30 | 31 | ## Release 4.3.2 32 | 33 | **Features** 34 | * [#30](https://github.com/fogfish/datum/issues/30) Define a conditional fail (`require`) that conditionally lifts a value either to object or error of category 35 | * [#29](https://github.com/fogfish/datum/issues/29) Support category transformers as part of nested expressions 36 | * Define a generic operators to modify monad context or execute side-effect 37 | 38 | **Improvements** 39 | 40 | * Fix various of compilation errors of function compositions 41 | * Improve test coverage of parse transforms 42 | * Support list comprehensions and list operators as part of function composition 43 | * Export `datum:lens()` data type 44 | 45 | 46 | ## Release 4.3.0 47 | 48 | **Features** 49 | 50 | * [#20](https://github.com/fogfish/datum/issues/20) New category `undefined` 51 | * [#25](https://github.com/fogfish/datum/issues/25) Product lens combinator `lens:p(...)` to spawn multiple fields into abstract view 52 | * [#19](https://github.com/fogfish/datum/issues/19) Macros to pattern match empty data structures (see `datum.hrl`) 53 | * [#22](https://github.com/fogfish/datum/issues/22) Define new lens `lens:require/1`, `lens:defined/0` to support development of unit testing (validate nested structures using lenses) 54 | 55 | **Improvements** 56 | 57 | * Improve interface semantic, introduce `lens:map/3` function instead of `lens:apply/3` 58 | * Re-implement lens isomorphism feature using product lens 59 | * Update documentations and add examples about lenses 60 | * Use `option` data type to warp lens output 61 | 62 | 63 | 64 | ## Release 4.2.x 65 | Data structure isomorphism with lenses 66 | 67 | ## Release 4.1.x 68 | Update interface(s) documentation 69 | 70 | ## Release 4.0.x 71 | Re-implement monads through Kleisli category 72 | 73 | ## Release 3.7.x 74 | Introduce category pattern 75 | 76 | ## Release 3.4.x 77 | Improve monads for usage in production 78 | 79 | ## Release 3.3.x 80 | Van Laahorven lenses and monads 81 | 82 | ## Release 2.7.x 83 | Enhance pure functional data-types with abstract interfaces such Foldable, Collections, etc 84 | 85 | ## Reelase 0.9.x 86 | Implement pure functional data-types: trees, queues, streams, etc 87 | -------------------------------------------------------------------------------- /Emakefile: -------------------------------------------------------------------------------- 1 | {"src/lens/*", [ 2 | report, 3 | verbose, 4 | {i, "include"}, 5 | {outdir, "_build/default/lib/datum/ebin"}, 6 | debug_info 7 | ]}. 8 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | APP = datum 2 | ORG = fogfish 3 | URI = 4 | 5 | include beam.mk 6 | 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # datum : "scrap your boilerplate" for Erlang 2 | 3 | > You could do this with a macro, but... 4 | > the best macro is a macro you don't maintain 5 | 6 | **datum** is a pure functional and generic programming for Erlang. It had its origins in [Purely Functional Data Structures](https://www.cs.cmu.edu/~rwh/theses/okasaki.pdf) by Chris Okasaki, on implementing a various higher rank functional abstractions and patterns, on dealing with [scrap your boilerplate](https://www.microsoft.com/en-us/research/publication/scrap-your-boilerplate-with-class/) and gaining experience from other functional languages primary Scala and Haskell. The library is still testing the limits of functional abstractions in Erlang. 7 | 8 | [![Changelog](https://img.shields.io/badge/changelog-latest-green.svg)](CHANGELOG.md) 9 | [![Build Status](https://secure.travis-ci.org/fogfish/datum.svg?branch=master)](http://travis-ci.org/fogfish/datum) 10 | [![Coverage Status](https://coveralls.io/repos/github/fogfish/datum/badge.svg?branch=master)](https://coveralls.io/github/fogfish/datum?branch=master) 11 | [![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/generic-programming-for-erlang/datum) 12 | [![Hex.pm](https://img.shields.io/hexpm/v/datum.svg)](https://hex.pm/packages/datum) 13 | [![Hex Downloads](https://img.shields.io/hexpm/dt/datum.svg)](https://hex.pm/packages/datum) 14 | 15 | 16 | ## Key features 17 | 18 | The [feature overview](doc/features.md) provides an introduction to datum features, use-cases and reasoning of they existence: 19 | 20 | * `option` and `either` type notations 21 | * a set of generic data types that can be inspected, traversed, and manipulated with common behavior: **foldable**, **traversable** and **map-like**. 22 | * pure functional **data types**: binary search tree, red-black tree, heap, queues, and others 23 | * **streams** or lazy lists are a sequential data structure that contains on demand computed elements. 24 | * resembles concept of getters and setters ([**lens**](doc/lens.md)) for complex algebraic data types. 25 | * mapping of algebraic data types to they [**generic**](doc/generic.md) representation and back 26 | * define a [**category pattern**](doc/category.md), [**monads**](doc/monad.md) and they composition for Erlang applications. You might be familiar with this concept as pipe, flow or function composition. 27 | * generic [**do-notation**](doc/monad.md) with pattern matching. 28 | * [**typecasts**](doc/typecast.md) of primitive data types 29 | * supports **OTP/18.x** or later release 30 | 31 | 32 | ## Getting started 33 | 34 | The latest version of the library is available at its `master` branch. All development, including new features and bug fixes, take place on the `master` branch using forking and pull requests as described in contribution guidelines. 35 | 36 | The stable library release is available via hex packages, add the library as dependency to `rebar.config` 37 | 38 | ```erlang 39 | {deps, [{datum}]}. 40 | ``` 41 | 42 | Please follow the [feature overview](doc/features.md) to start leaning all available features; then continue to library [examples](examples) and to [source code](src). 43 | 44 | 45 | ## How To Contribute 46 | 47 | The library is [Apache 2.0](LICENSE) licensed and accepts contributions via GitHub pull requests: 48 | 49 | 1. Fork it 50 | 2. Create your feature branch (`git checkout -b my-new-feature`) 51 | 3. Commit your changes (`git commit -am 'Added some feature'`) 52 | 4. Push to the branch (`git push origin my-new-feature`) 53 | 5. Create new Pull Request 54 | 55 | The development requires [Erlang/OTP](http://www.erlang.org/downloads) version 19.0 or later and essential build tools. 56 | 57 | **Build** and **run** service in your development console. The following command boots Erlang virtual machine and opens Erlang shell. 58 | 59 | ```bash 60 | git clone https://github.com/fogfish/datum 61 | cd datum 62 | make 63 | make run 64 | ``` 65 | 66 | 67 | ### commit message 68 | 69 | The commit message helps us to write a good release note, speed-up review process. The message should address two question what changed and why. The project follows the template defined by chapter [Contributing to a Project](http://git-scm.com/book/ch5-2.html) of Git book. 70 | 71 | > 72 | > Short (50 chars or less) summary of changes 73 | > 74 | > More detailed explanatory text, if necessary. Wrap it to about 72 characters or so. In some contexts, the first line is treated as the subject of an email and the rest of the text as the body. The blank line separating the summary from the body is critical (unless you omit the body entirely); tools like rebase can get confused if you run the two together. 75 | > 76 | > Further paragraphs come after blank lines. 77 | > 78 | > Bullet points are okay, too 79 | > 80 | > Typically a hyphen or asterisk is used for the bullet, preceded by a single space, with blank lines in between, but conventions vary here 81 | > 82 | > 83 | 84 | ### bugs 85 | 86 | If you experience any issues with the library, please let us know via [GitHub issues](https://github.com/fogfish/datum/issue). We appreciate detailed and accurate reports that help us to identity and replicate the issue. 87 | 88 | * **Specify** the configuration of your environment. Include which operating system you use and the versions of runtime environments. 89 | 90 | * **Attach** logs, screenshots and exceptions, in possible. 91 | 92 | * **Reveal** the steps you took to reproduce the problem, include code snippet or links to your project. 93 | 94 | 95 | 96 | ## License 97 | 98 | [![See LICENSE](https://img.shields.io/github/license/fogfish/datum.svg?style=for-the-badge)](LICENSE) 99 | -------------------------------------------------------------------------------- /beam.mk: -------------------------------------------------------------------------------- 1 | ## 2 | ## Copyright (C) 2012 Dmitry Kolesnikov 3 | ## 4 | ## This Makefile may be modified and distributed under the terms 5 | ## of the MIT license. See the LICENSE file for details. 6 | ## https://github.com/fogfish/makefile 7 | ## 8 | ## @doc 9 | ## This makefile is the wrapper of rebar to build and ship erlang software 10 | ## 11 | ## @version 1.0.12 12 | .PHONY: all compile test unit clean distclean run console mock-up mock-rm benchmark release dist 13 | 14 | APP := $(strip $(APP)) 15 | ORG := $(strip $(ORG)) 16 | URI := $(strip $(URI)) 17 | 18 | ## 19 | ## config 20 | PREFIX ?= /usr/local 21 | APP ?= $(notdir $(CURDIR)) 22 | ARCH = $(shell uname -m) 23 | PLAT ?= $(shell uname -s) 24 | VSN ?= $(shell test -z "`git status --porcelain`" && git describe --tags --long | sed -e 's/-g[0-9a-f]*//' | sed -e 's/-0//' || echo "`git describe --abbrev=0 --tags`-dev") 25 | LATEST ?= latest 26 | REL = ${APP}-${VSN} 27 | PKG = ${REL}+${ARCH}.${PLAT} 28 | TEST ?= tests 29 | COOKIE ?= nocookie 30 | DOCKER ?= fogfish/erlang-alpine 31 | IID = ${URI}${ORG}/${APP} 32 | 33 | ## required tools 34 | ## - rebar version (no spaces at end) 35 | ## - path to basho benchmark 36 | REBAR ?= 3.9.1 37 | BB = ../basho_bench 38 | 39 | 40 | ## erlang runtime configration flags 41 | ROOT = $(shell pwd) 42 | ADDR = localhost.localdomain 43 | EFLAGS = \ 44 | -name ${APP}@${ADDR} \ 45 | -setcookie ${COOKIE} \ 46 | -pa ${ROOT}/_build/default/lib/*/ebin \ 47 | -pa ${ROOT}/_build/default/lib/*/priv \ 48 | -pa ${ROOT}/rel \ 49 | -kernel inet_dist_listen_min 32100 \ 50 | -kernel inet_dist_listen_max 32199 \ 51 | +P 1000000 \ 52 | +K true +A 160 -sbt ts 53 | 54 | 55 | ## erlang common test bootstrap 56 | BOOT_CT = \ 57 | -module(test). \ 58 | -export([run/1]). \ 59 | run(Spec) -> \ 60 | {ok, Test} = file:consult(Spec), \ 61 | case lists:keymember(node, 1, Test) of \ 62 | false -> \ 63 | erlang:halt(element(2, ct:run_test([{spec, Spec}]))); \ 64 | true -> \ 65 | ct_master:run(Spec), \ 66 | erlang:halt(0) \ 67 | end. 68 | 69 | 70 | ## 71 | BUILDER = FROM ${DOCKER}\nARG VERSION=\nRUN mkdir ${APP}\nCOPY . ${APP}/\nRUN cd ${APP} && make VSN=\x24{VERSION} && make release VSN=\x24{VERSION}\n 72 | SPAWNER = FROM ${DOCKER}\nENV VERSION=${VSN}\nRUN mkdir ${APP}\nCOPY . ${APP}/\nRUN cd ${APP} && make VSN=\x24{VERSION} && make release VSN=\x24{VERSION}\nCMD sh -c 'cd ${APP} && make console VSN=\x24{VERSION} RELX_REPLACE_OS_VARS=true ERL_NODE=${APP}'\n 73 | 74 | ## self extracting bundle archive 75 | BUNDLE_INIT = PREFIX=${PREFIX}\nREL=${PREFIX}/${REL}\nAPP=${APP}\nVSN=${VSN}\nLINE=`grep -a -n "BUNDLE:$$" $$0`\nmkdir -p $${REL}\ntail -n +$$(( $${LINE%%%%:*} + 1)) $$0 | gzip -vdc - | tar -C $${REL} -xvf - > /dev/null\n 76 | BUNDLE_FREE = exit\nBUNDLE:\n 77 | 78 | 79 | ##################################################################### 80 | ## 81 | ## build 82 | ## 83 | ##################################################################### 84 | all: rebar3 compile test 85 | 86 | compile: rebar3 87 | @./rebar3 compile 88 | 89 | 90 | ## 91 | ## execute common test and terminate node 92 | test: 93 | # @./rebar3 ct --config test/${TEST}.config --cover --verbose 94 | @./rebar3 ct --cover --verbose 95 | @./rebar3 cover 96 | 97 | # test: _build/test.beam 98 | # @mkdir -p /tmp/test/${APP} 99 | # @erl ${EFLAGS} -noshell -pa _build/ -pa test/ -run test run test/${TEST}.config 100 | # @F=`ls /tmp/test/${APP}/ct_run*/all.coverdata | tail -n 1` ;\ 101 | # cp $$F /tmp/test/${APP}/ct.coverdata 102 | # 103 | # _build/test.beam: _build/test.erl 104 | # @erlc -o _build $< 105 | # 106 | # _build/test.erl: 107 | # @mkdir -p _build && echo "${BOOT_CT}" > $@ 108 | # 109 | 110 | testclean: 111 | @rm -f _build/test.beam 112 | @rm -f _build/test.erl 113 | @rm -f test/*.beam 114 | @rm -rf test.*-temp-data 115 | @rm -rf tests 116 | 117 | ## 118 | ## execute unit test 119 | unit: all 120 | @./rebar3 skip_deps=true eunit 121 | 122 | ## 123 | ## clean 124 | clean: testclean dockerclean 125 | -@./rebar3 clean 126 | @rm -Rf _build/builder 127 | @rm -Rf _build/default/rel 128 | @rm -rf log 129 | @rm -f relx.config 130 | @rm -f *.tar.gz 131 | @rm -f *.bundle 132 | 133 | distclean: clean 134 | -@make mock-rm 135 | -@make dist-rm 136 | -@rm -Rf _build 137 | -@rm rebar3 138 | 139 | ##################################################################### 140 | ## 141 | ## debug 142 | ## 143 | ##################################################################### 144 | run: 145 | @erl ${EFLAGS} 146 | 147 | console: ${PKG}.tar.gz 148 | @_build/default/rel/${APP}/bin/${APP} foreground 149 | 150 | mock-up: test/mock/docker-compose.yml 151 | @docker-compose -f $< up 152 | 153 | mock-rm: test/mock/docker-compose.yml 154 | -@docker-compose -f $< down --rmi all -v --remove-orphans 155 | 156 | dist-up: docker-compose.yml _build/spawner 157 | @docker-compose build 158 | @docker-compose -f $< up 159 | 160 | dist-rm: docker-compose.yml 161 | -@rm -f _build/spawner 162 | -@docker-compose -f $< down --rmi all -v --remove-orphans 163 | 164 | benchmark: 165 | @echo "==> benchmark: ${TEST}" ;\ 166 | $(BB)/basho_bench -N bb@127.0.0.1 -C nocookie priv/${TEST}.benchmark ;\ 167 | $(BB)/priv/summary.r -i tests/current ;\ 168 | open tests/current/summary.png 169 | 170 | ##################################################################### 171 | ## 172 | ## release 173 | ## 174 | ##################################################################### 175 | release: ${PKG}.tar.gz 176 | 177 | ## assemble VM release 178 | ifeq (${PLAT},$(shell uname -s)) 179 | ${PKG}.tar.gz: relx.config 180 | @./rebar3 tar -n ${APP} -v ${VSN} ;\ 181 | mv _build/default/rel/${APP}/${APP}-${VSN}.tar.gz $@ ;\ 182 | echo "==> tarball: $@" 183 | 184 | relx.config: rel/relx.config.src 185 | @cat $< | sed "s/release/release, {'${APP}', \"${VSN}\"}/" > $@ 186 | else 187 | ${PKG}.tar.gz: _build/builder 188 | @docker build --file=$< --force-rm=true --build-arg="VERSION=${VSN}" --tag=build/${APP}:latest . ;\ 189 | I=`docker create build/${APP}:latest` ;\ 190 | docker cp $$I:/${APP}/$@ $@ ;\ 191 | docker rm -f $$I ;\ 192 | docker rmi build/${APP}:latest ;\ 193 | test -f $@ && echo "==> tarball: $@" 194 | 195 | _build/builder: 196 | @mkdir -p _build && echo "${BUILDER}" > $@ 197 | endif 198 | 199 | ## build docker image 200 | docker: Dockerfile 201 | git status --porcelain 202 | test -z "`git status --porcelain`" || exit -1 203 | docker build \ 204 | --build-arg APP=${APP} \ 205 | --build-arg VSN=${VSN} \ 206 | -t ${IID}:${VSN} -f $< . 207 | docker tag ${IID}:${VSN} ${IID}:${LATEST} 208 | 209 | dockerclean: 210 | -@docker rmi -f ${IID}:${LATEST} 211 | -@docker rmi -f ${IID}:${VSN} 212 | 213 | _build/spawner: 214 | @mkdir -p _build && echo "${SPAWNER}" > $@ 215 | 216 | 217 | dist: ${PKG}.tar.gz ${PKG}.bundle 218 | 219 | 220 | ${PKG}.bundle: rel/bootstrap.sh 221 | @printf '${BUNDLE_INIT}' > $@ ;\ 222 | cat $< >> $@ ;\ 223 | printf '${BUNDLE_FREE}' >> $@ ;\ 224 | cat ${PKG}.tar.gz >> $@ ;\ 225 | chmod ugo+x $@ ;\ 226 | echo "==> bundle: $@" 227 | 228 | 229 | ##################################################################### 230 | ## 231 | ## dependencies 232 | ## 233 | ##################################################################### 234 | rebar3: 235 | @echo "==> install rebar (${REBAR})" ;\ 236 | curl -L -O -s https://github.com/erlang/rebar3/releases/download/${REBAR}/rebar3 ;\ 237 | chmod +x $@ 238 | 239 | -------------------------------------------------------------------------------- /doc/features.md: -------------------------------------------------------------------------------- 1 | # Features overview 2 | 3 | * [Option type](#option-type) 4 | * [Either type](#either-type) 5 | * [Foldable](#foldable) 6 | * [Traversable](#traversable) 7 | * [Map-like](#map-like) 8 | * [Pure functional data types](#pure-functional-data-types) 9 | * [Stream](#stream) 10 | * [Lens](#lens) 11 | * [Generic representation](#generic-representation) 12 | * [Category pattern](#category-pattern) 13 | * [Monad](#monad) 14 | 15 | 16 | 17 | 18 | 19 | ## Option type 20 | 21 | > In programming languages (more so functional programming languages) and type theory, an option type or maybe type is a polymorphic type that represents encapsulation of an optional value 22 | 23 | This type is required to represent a results of computation that leads to nondeterministic state (undefined value). In Erlang, the atom `undefined` is frequently used for this purpose. The library adopts this notation to implement *option* type. 24 | 25 | ```erlang 26 | -type option(X) :: undefined | X. 27 | ``` 28 | 29 | The library implements macro and type definition to emphasis the usage of *option* type. However, it only provides a semantical meaning and do not lead to any type safe at compile time. 30 | 31 | ```erlang 32 | -include_lib("datum/include/datum.hrl"). 33 | 34 | -spec f(datum:option(integer())) -> datum:option(integer()). 35 | 36 | f(?None) -> ?None; 37 | f(?Some(X)) -> ?Some(X + 1). 38 | ``` 39 | 40 | **Note**: this definition of *option* type has a drawback if it is used with scalar data types (no issues with algebraic data types). The following example crashes unless developers explicitly match `undefined` atom in they code. Never the less, the given definition is compatible with existed convention in the community. 41 | 42 | ```erlang 43 | f(?Some(X)) -> ?Some(X + 1). 44 | 45 | f(?None). 46 | ``` 47 | 48 | ## Either type 49 | 50 | A typical usage is a representation of either correct -- right value or an error -- left value. Erlang has well established notation to use tagged tuples `{ok, _}` or `{error, _}` for this purpose. The library adopts this notation to implement *either* type. 51 | 52 | ```erlang 53 | -type either(L, R) :: {error, L} | {ok, R}. 54 | ``` 55 | 56 | The library provides a macro to highlight *either* semantic in the code. 57 | 58 | ```erlang 59 | -include_lib("datum/include/datum.hrl"). 60 | 61 | -spec f(datum:either(_, integer())) -> datum:either(_, integer()). 62 | 63 | f(?EitherL(X)) -> ?EitherL(X); 64 | f(?EitherR(X)) -> ?EitherR(X + 1). 65 | ``` 66 | 67 | ## Foldable 68 | 69 | Foldable is a class of data structures that can be folded to a single value. The library defines a [`foldable`](../src/foldable.erl) behaviour and outline a common interface for each data structure that mixes in the behaviour: 70 | 71 | ```erlang 72 | %% 73 | %% Combine elements of a structure using a monoid 74 | %% (with an associative binary operation) 75 | %% 76 | -spec fold(datum:monoid(_), _, datum:foldable(_)) -> _. 77 | 78 | %% 79 | %% The fundamental recursive structure constructor, 80 | %% it applies a function to each previous seed element in turn 81 | %% to determine the next element. 82 | %% 83 | -spec unfold(fun((_) -> _), _) -> datum:foldable(_). 84 | ``` 85 | 86 | The library implements a **foldable** behaviour to *trees*, *heaps*, *queues* and *streams*. For example, you can fold a binary search tree to single value: 87 | 88 | ```erlang 89 | bst:fold( 90 | fun({_, X}, Y) -> X + Y end, 91 | 0, 92 | bst:build([{b, 2}, {a, 1}, {d, 4}, {c, 3}]) 93 | ). 94 | ``` 95 | 96 | ## Traversable 97 | 98 | Traversable is a common interface for all kinds of collections. It defines the [`traversable`](../src/traversable.erl) behaviour common to all collections (See the interface for details). 99 | 100 | As an example, it define a `foreach` method with similar signature to apply a side-effect to each element of collection: 101 | 102 | ```erlang 103 | -spec foreach(datum:effect(_), datum:traversable(_)) -> ok. 104 | ``` 105 | Collection types provide a concrete `foreach` implementation which traverses all the elements contained in the collection. 106 | 107 | The traversable behaviour do not define strictness and orderedness of elements, each type has own properties: 108 | 109 | * *Strict* collections each element is computed before they are used. *Non-strict* collection defer computation before the value is available as a value. 110 | * *Ordered* collections ensures that its elements are always visited in the same order, even for different runs of computation. *Non-ordered* collection will the same order in same run only. 111 | 112 | The library implements a **traversable** behaviour to *trees*, *heaps*, *queues* and *streams*. For example, you can visit each node of binary search tree: 113 | 114 | ```erlang 115 | bst:foreach( 116 | fun(X) -> io:format("=> ~p~n", [X]) end, 117 | bst:build([{b, 2}, {a, 1}, {d, 4}, {c, 3}]) 118 | ). 119 | ``` 120 | 121 | ## Map-like 122 | 123 | Map-like is a common behaviour for all kind of collection that associates keys of type `K` to values of type `V`. See [`maplike`](../src/maplike.erl) for details. The behaviour defines interface to insert, lookup and remove associations from collections. 124 | 125 | The library implements a **map-like** behaviour to *trees* and *heaps*. For example, you can fold a list of pairs to binary search tree using append monoid: 126 | 127 | ```erlang 128 | lists:foldl(fun bst:append/2, bst:new(), [{b, 2}, {a, 1}, {d, 4}, {c, 3}]). 129 | ``` 130 | 131 | ## Pure functional data types 132 | 133 | Library implements a few pure functional data structures using common behvaiours: 134 | 135 | * **Trees**: [binary search tree](../src/maplike/bst.erl), [red-black tree](../src/maplike/rbtree.erl), [hash tree (experemental)](../src/maplike/htree.erl) 136 | * **Heaps**: [leftist heap](../src/maplike/heap.erl) 137 | * **Queues**: [fifo](../src/queue/q.erl), [double ended queue](../src/queue/deq.erl) 138 | 139 | 140 | ## Stream 141 | 142 | [Stream](../src/stream/stream.erl) (lazy list) is a sequential data structure that contains on demand computed elements. The library implements a data structure and stream transformers. 143 | 144 | 145 | ## Lens 146 | 147 | Data access and transformation are common tasks in computing where changes made to the structure are reflected as updates to the original structure. This structure update problem is a classical in imperative languages. 148 | 149 | ``` 150 | user.address.street = "Blumenstraße" 151 | ``` 152 | 153 | This operation is complicated in functional languages. In order to change a value of inner structure, we need to re-assign values of multiple structures along the path. Maintenance and refactoring of this functions becomes very tedious compared to imperative languages 154 | 155 | ```erlang 156 | set_street_name(Value, #user{address = #address{} = Address} = User) -> 157 | User#user{address = Address#address{street = Value}}. 158 | ``` 159 | 160 | Functional languages solve this issue using [lens](lens.md). It resembles concept of getters and setters, which you can compose using functional concepts. 161 | 162 | ```erlang 163 | lens_street_name() -> 164 | lens:c(lens:ti(#user.address), lens:ti(#address.street)). 165 | 166 | lens:get(lens_street_name(), User). 167 | lens:set(lens_street_name(), "Blumenstraße", User). 168 | ``` 169 | 170 | Isomorphism of data structures is another problem solved by lenses. The application often operates with the abstract formats of business objects but communication with clients requires concrete format. We can define a single common format and a collection of lenses that transform each concrete format into this abstract one. 171 | 172 | ```erlang 173 | iso_to_map() -> 174 | lens:iso( 175 | [ 176 | lens:ti(#user.name), 177 | lens:c(lens:ti(#user.address), lens:ti(#address.street)) 178 | ], 179 | [ 180 | lens:at(name), 181 | lens:c(lens:at(address, #{}), lens:at(name)) 182 | ] 183 | ). 184 | 185 | lens:isof(iso_to_map(), #user{name = "Verner", address = #address{street = "Blumenstraße"}}, #{}). 186 | lens:isob(iso_to_map(), #{name => "Verner", address => #{street => "Blumenstraße"}}, #user{}). 187 | ``` 188 | 189 | See details about [lens](lens.md) 190 | 191 | The scalability of lens implementation is another issue, you need to expands lenses with new primitives, support new data types or define custom lenses. The library uses van Laarhoven lens generalisation to solve lens scalability. 192 | 193 | For example, we can define a new lens to focus into binary search tree 194 | 195 | ```erlang 196 | Lens = fun(Key) -> 197 | fun(Fun, Tree) -> 198 | lens:fmap( 199 | fun(X) -> bst:insert(Key, X, Tree) end, 200 | Fun(bst:lookup(Key, Tree)) 201 | ) 202 | end 203 | end. 204 | 205 | lens:get(Lens(a), lens:put(Lens(a), 1, bst:new())). 206 | ``` 207 | 208 | ## Generic representation 209 | 210 | Automatic transformation of algebraic data types to they generic representation solve wide problems of generic programming. Erlang has strong foundation and language primitives on this aspect due to dynamically typed nature. Existence of generic types (lists, maps and tuples) makes a programming task trivial. However, absence of strong types makes it error prone while switching a context from generic algorithms to business domain. Thus usage of algebraic data types (encoded in Erlang records) improves maintainability of domain specific code. 211 | 212 | > The main advantage of using records rather than tuples is that fields in a record are accessed by name, whereas fields in a tuple are accessed by position. 213 | 214 | The library introduces a `generic` parse transform that implements automatic mapping between ADTs and generic representations. 215 | 216 | ```erlang 217 | -compile({parse_transform, generic}). 218 | 219 | -record(person, {name, address, city}). 220 | 221 | example() -> 222 | %% 223 | %% builds a generic representation from #person{} ADT 224 | Gen = generic_of:person(#person{ 225 | name = "Verner Pleishner", 226 | address = "Blumenstrasse 14", 227 | city = "Berne" 228 | }), 229 | 230 | %% 231 | %% builds #person{} ADT from generic representation 232 | generic_to:person(Gen). 233 | ``` 234 | 235 | In facts, a macro magic happens behind to execute transformation without boilerplate. As the result a labeled generic representation is returned. 236 | 237 | See details about [generic patterns](generic.md). 238 | 239 | 240 | ## Category pattern 241 | 242 | The *composition* is a style of development to build a new things from small reusable elements. The category theory formalises principles (laws) that help us to define own abstraction applicable in functional programming through composition. 243 | 244 | See details about [category pattern](category.md). 245 | 246 | 247 | ## Monad 248 | 249 | The library implements rough Haskell's equivalent of **do-notation**, so called monadic binding form. This construction decorates computation pipeline(s) with additional rules implemented by monad, they defines programmable commas. The used syntax expresses various programming concepts in terms of a monad structures: side-effects, variable assignment, error handling, parsing, concurrency, domain specific languages, etc. 250 | 251 | See details about [Kleisli category](category.md) and [do-notation](monad.md). 252 | -------------------------------------------------------------------------------- /doc/generic.md: -------------------------------------------------------------------------------- 1 | # Generic representation 2 | 3 | > Generic programming is a style of computer programming in which algorithms are written in terms of types to-be-specified-later that are then instantiated when needed for specific types provided as parameters. -- said by [Wikipedia](https://en.wikipedia.org/wiki/Generic_programming). 4 | 5 | Erlang permits writing a generic code. It is known to be dynamic, strong typing language, the article [Types (or lack thereof)](https://learnyousomeerlang.com/types-or-lack-thereof) describes it in excellent manner. The in-depth study about type systems have been presented at [Point Of No Local Return: The Continuing Story Of Erlang Type Systems](http://www.erlang-factory.com/static/upload/media/1465548492405302zeeshanlakhanipointofnolocalreturn.pdf). In this section, we would not discuss type systems. Instead we look on other aspect closely related to types. 6 | 7 | Type theory and a functional programming operates with [algebraic data types](https://en.wikipedia.org/wiki/Algebraic_data_type). They are known as a composition of other types. The theory defines two classes of compositions: product types (tuples, records) and co-product types (sum, enumeration or variant types). Product types are strongly expressed by [records](http://erlang.org/doc/reference_manual/records.html) in Erlang; co-products are loosely defined (we skip them at current library release). 8 | 9 | ```erlang 10 | -type fullname() :: binary(). 11 | -type address() :: binary(). 12 | -type city() :: binary(). 13 | 14 | -record(person, { 15 | name :: fullname(), 16 | address :: address(), 17 | city :: city() 18 | }). 19 | ``` 20 | 21 | The beauty of Erlang records (product type) is that they definitions are only available at compile time. The compiler has complete knowledge of defined "algebra" and catches misuse errors. The usage of records in your code benefits to write correct, maintainable code and support refactoring. Use them to define your domain models! 22 | 23 | ```erlang 24 | #person{birthday = "18810509"}. 25 | 26 | %% Compiling src/person.erl failed 27 | %% src/person.erl:18: field birthday undefined in record person 28 | ``` 29 | 30 | There are few other benefits of records over other data types: type testing and pattern matching. These subject has been widely covered at [official documentation](http://erlang.org/doc/programming_examples/records.html): 31 | 32 | ```erlang 33 | %% 34 | %% type testing 35 | myfun(X) when is_record(X, person) -> ... 36 | 37 | %% 38 | %% pattern matching 39 | myfun(#person{name = Name}) -> ... 40 | ``` 41 | 42 | Be aware that type testing of records does not validates types of record fields. It checks only that a tuple of correct size and that its first element corresponds to desired type (e.g. `persion`). Therefore `is_record(#person{name = pleishner}, person)` will return true despite the name field being type annotated as binary. 43 | 44 | ## Generic programming with records 45 | 46 | Erlang offers few features that helps with generic programming: 47 | 48 | 1. record expressions are translated to tuple by compiler, use `element/2` and `setelement/3` for generic access to tuple elements. 49 | 2. functions `tuple_to_list/1` and `list_to_tuple/1` are transformers to an alternative generic representation. 50 | 3. pseudo function `record_info/2` to obtain record structure. 51 | 52 | As an example, a typical macro here to cast record type to the map: 53 | 54 | ```erlang 55 | -define(encode(Type, Struct), 56 | maps:from_list( 57 | [{Key, Value} || 58 | {Key, Value} <- lists:zip( 59 | record_info(fields, Type), 60 | tl(tuple_to_list(Struct)) 61 | ), 62 | Value /= undefined, 63 | Value /= null 64 | ] 65 | ) 66 | ). 67 | ``` 68 | 69 | Unfortunately, usage of records have a couple of disadvantages that makes they usage questionable: 70 | 71 | * external serialization of domain models often requires knowledge of internals about records: types, attributes names, cardinality, etc. This information is not implicitly available unless you import `.hrl` file with records definition. It will be available for you only at compile time. 72 | * record transformations to other record or any external format requires boilerplate code. 73 | * generic programming with records requires macros. 74 | * new built-in data type `map()` obsoletes usage of records for casual use-cases. 75 | 76 | For these reasons, we would like to improve records runtime flexibility through `parse_transform` while keeping its compile-time benefits for domain modeling. 77 | 78 | The latest release of library's generic feature aims on most common tasks in software engineering: representation switching or data transformation. 79 | 80 | 81 | ## Switching representations 82 | 83 | `datum` provides a `parse_transform` called `generic` that allows us to switch back and forth between a concrete records (ADT) and its generic representation without boilerplate. Please not that the generic representation is opaque structure for your code. Please follow examples of generic [here](../examples/src/examples_generic.erl). 84 | 85 | 96 | 97 | 98 | ### Semi-auto derivation 99 | 100 | It is convenient to have just encoder/decoder. Semi-auto codec makes a magic of switching representation between different ADTs. 101 | 102 | ```erlang 103 | -compile({parse_transform, generic}). 104 | 105 | -record(person, {name, age, address}). 106 | 107 | person() -> 108 | #person{ 109 | name = "Verner Pleishner", 110 | age = 64, 111 | address = "Blumenstrasse 14, Berne, 3013" 112 | }. 113 | 114 | semi_auto() -> 115 | Person = person(), 116 | Generic = generic_of:person(Person), 117 | Person = generic_to:person(Generic). 118 | ``` 119 | 120 | The generic representation carries-on instances of records fields and associated metadata, the current implementation uses `map()` but this is subject to change in future release of the library. If two ADTs have the similar representation we can convert back and forth between them using their generics representation: 121 | 122 | ```erlang 123 | -compile({parse_transform, generic}). 124 | 125 | -record(person, {name, age, address}). 126 | -record(employee, {name, age, address}). 127 | 128 | Generic = generic_of:person(#person{ ... }). 129 | Employee = generic_to:employee(Generic). 130 | ``` 131 | 132 | Please note that "similar" representation means -- subset of common fields. 133 | 134 | ```erlang 135 | -compile({parse_transform, generic}). 136 | 137 | -record(person, {name, age, address}). 138 | -record(visitor, {name}). 139 | -record(location, {address}). 140 | 141 | Generic = generic_of:person(#person{ ... }). 142 | Visitor = generic_to:visitor(Generic). 143 | Location = generic_to:location(Generic). 144 | ``` 145 | 146 | Semi-auto derivation works with recursive types but current version supports only lists. 147 | 148 | ```erlang 149 | -spec fetch_list_of_persons() -> [#person{}]. 150 | 151 | Generic = generic_of:person( fetch_list_of_persions() ). 152 | Employee = generic_to:employee(Generic). 153 | ``` 154 | 155 | 156 | ### Assisted derivation 157 | 158 | It is also possible to customize semi-auto encoders/decoders for records. The feature supports morphism if two ADTs do not share similar representation. 159 | 160 | ```erlang 161 | -compile({parse_transform, generic}). 162 | 163 | -record(person, {name, age, address}). 164 | -record(estate, {location, owner}). 165 | 166 | person() -> 167 | #person{ 168 | name = "Verner Pleishner", 169 | age = 64, 170 | address = "Blumenstrasse 14, Berne, 3013" 171 | }. 172 | 173 | assisted_morphism() -> 174 | Person = person(), 175 | Generic = generic_of:person([name, age, address], Person), 176 | Employee = generic_to:estate([address, name], Generic). 177 | ``` 178 | 179 | 180 | ### Partial application 181 | 182 | Partial application is a tool to make a generic processing for your data domain (e.g. generic input/output to database). The generic implements helper utilities that returns encoder/decoder as a function. 183 | 184 | ```erlang 185 | -compile({parse_transform, generic}). 186 | 187 | -record(person, {name, age, address}). 188 | 189 | Encoder = generic:encode(#person{}). 190 | Decoder = generic:decode(#person{}). 191 | ``` 192 | 193 | Use this functions to switch representation of your records at runtime. 194 | 195 | ```erlang 196 | person() -> 197 | #person{ 198 | name = "Verner Pleishner", 199 | age = 64, 200 | address = "Blumenstrasse 14, Berne, 3013" 201 | }. 202 | 203 | Person = person(). 204 | Generic = Encoder(Person). 205 | Person = Decoder(Generic). 206 | ``` 207 | 208 | You can pass these codec functions to any processes named after the records type. Then the implementation of these process needs to deal only with aspects of generic data processing. See its [example](../examples/src/examples_generic_io.erl). 209 | 210 | ```erlang 211 | {ok, _} = examples_generic_io:start_link(person, Encoder, Decoder). 212 | 213 | examples_generic_io:send(Person). 214 | examples_generic_io:recv(#person{}). 215 | ``` 216 | 217 | 218 | ### Custom encoders/decoders 219 | 220 | Only flat data structures are supported at the moment. You still need to deal with custom derivation in complex use-cases. There are few approaches here 221 | 222 | You can write encoder from scratch. In many cases semi-auto and assisted derivation helps you here -- you only writes a custom code for container types but you benefit of derived codec for atomic one. 223 | 224 | ```erlang 225 | -compile({parse_transform, generic}). 226 | 227 | -record(address, {street, city, zipcode}). 228 | -record(person, {name, age, address}). 229 | -record(estate, {location, owner}). 230 | 231 | custom_codec() -> 232 | Person = person(), 233 | Address = address(), 234 | Generic = generic_of:estate(#estate{ 235 | location = generic_of:address(Address), 236 | owner = generic_of:person(Person) 237 | }). 238 | ``` 239 | 240 | The custom decoder requires traversal through generic data structures. This task do not differs from traditional approach, which involves a portion of boilerplate. The library offers a [lens abstraction](lens.md) to solve the problem in a relatively boilerplate-free way. 241 | 242 | ```erlang 243 | 244 | custom_decoder() -> 245 | ... 246 | Lens = generic:lens(#estate{ 247 | location = generic:lens(#address{}), 248 | owner = generic:lens(#person{}) 249 | }), 250 | Estate = lens:get(Lens, Generic). 251 | 252 | ``` 253 | 254 | Please note that lens isomorphism is an alternative abstraction that facilitates variety of transformation use-cases. You can implement custom codec just with lenses but you might observe that your code becomes verbose. 255 | 256 | 257 | ## Conclusion 258 | 259 | Generic programming is widely known technique, which is well supported by Erlang. This effort makes a convenient to convert specific types into generic ones that we can manipulate with common code. The defined technique has been used to implement RESTfull API and AWS DynamoDB serialization logic, while keeping domain model as Erlang records for purpose of maintainability and catches misuse errors at compile time. 260 | -------------------------------------------------------------------------------- /doc/lens.md: -------------------------------------------------------------------------------- 1 | # Lens 2 | 3 | Lenses resembles concept of getters and setters, which you can compose using functional concepts. In other words, this is combinator data transformation for pure functional data structure. This library implements lens using approaches on Haskell lens library, and techniques references by [1]. 4 | 5 | 6 | Lens types are defined as ... They are following the convention of Haskell lens library. 7 | 8 | ```erlang 9 | %% type of object 10 | -type s() :: _. 11 | 12 | %% type of focused element (focus type) 13 | -type a() :: _. 14 | ``` 15 | 16 | 17 | Originally, lenses are defined using `get` and `put` primitives. The third primitive `over` (or `map`) allows to enhance lens behavior using function (e.g. the `put` is `map` using `const` function). 18 | 19 | ```erlang 20 | -type lens() :: 21 | { 22 | fun( (s()) -> a() ), %% get 23 | fun( (fun( (a()) -> a() ), s()) -> s() ) %% map 24 | }. 25 | ``` 26 | 27 | 28 | This naive lens structure is not scalable when you need to expends with new primitives or 29 | support new data types. You either grow it by implementing various flavors of getters and 30 | setters or extend module to support new data types. 31 | 32 | van Laarhoven lens generalization solves the problem, the proposal to use functor to 33 | implement `get`, `put`, `map`, etc. The lens is defined as 34 | 35 | ``` 36 | type Lens s a = Functor f => (a -> f a) -> s -> f s 37 | ``` 38 | 39 | Note: there is a good tutorial about type classes and functors 40 | * http://learnyouahaskell.com/making-our-own-types-and-typeclasses#the-functor-typeclass 41 | * http://scalaz.github.io/scalaz/scalaz-2.9.1-6.0.2/doc.sxr/scalaz/Functor.scala.html 42 | 43 | Functors do not exists in Erlang. This lens module define one with minimal runtime overhead. 44 | 45 | ```erlang 46 | -type f(F) :: [atom()|F]. 47 | -spec fmap( fun((a()) -> _), f(a()) ) -> f(_). 48 | ``` 49 | 50 | Let's skip all details on the design decision about the function definition below. 51 | In the nutshell, various Erlang native containers (tuple, function, etc) are evaluated. 52 | The list shown best performance. There is not any intent to generalize functor concept to Erlang application, it is made to support only lens implementation. Lenses implementation requires two type of functors: identity for `over` (`map`) and const for `get`. 53 | 54 | 55 | We can define van Laarhoven lens type 56 | 57 | ```erlang 58 | -type lens(A, S) :: fun( (fun( (A) -> f(A) ), S) -> f(S) ). 59 | -type lens() :: lens(a(), s()). 60 | ``` 61 | 62 | 63 | ## Interface 64 | 65 | 66 | ### Map 67 | 68 | It is defined as... Given a `lens()` that focuses on `a()` inside of `s()`, and 69 | a function `a() -> a()` and instance of object `s()`. It returns modified `s()` by applying 70 | the function to focus point of the lens 71 | 72 | ```haskell 73 | over :: Lens s a -> (a -> a) -> s -> s 74 | ``` 75 | 76 | ```erlang 77 | -spec map(fun( (a()) -> a() ), lens(), s()) -> s(). 78 | ``` 79 | 80 | 81 | ### Get 82 | 83 | It is defined as... Given a `lens()` that focuses on `a()` inside of `s()`, and 84 | instance of object `s()`. It returns value of focus point `a()`. 85 | 86 | ```haskel 87 | view :: Lens s a -> s -> a 88 | ``` 89 | 90 | ```erlang 91 | -spec get(lens(), s()) -> a(). 92 | ``` 93 | 94 | 95 | ### Put 96 | 97 | It is defined as... Given a `lens()` that focuses on `a()` inside of `s()`, and 98 | value `a()` and instance of object `s()`. It returns modified `s()` by setting 99 | a new value to focus point of the lens. 100 | 101 | 102 | ### Iso 103 | 104 | Isomorphism translates between different data structures. Given a `lens()` that focuses on 105 | multiple `a()` values inside of `s()`. It lifts result (ordered set of `a()`) to abstract view. 106 | Another `lens()` puts abstract view back to another target data structure. 107 | 108 | 109 | ## Lenses 110 | 111 | Generic lens interface above requires actual lens implementation. This library implements a basic set of lenses to focus on Erlang built-in types: lists, maps, records, tuples, keylists. Anyone can implement a custom lens. 112 | 113 | **Lens** is a **function** of `lens()` type. 114 | 115 | in Haskell 116 | 117 | ```haskell 118 | Functor f => (a -> f a) -> s -> f s 119 | ``` 120 | 121 | in Erlang 122 | 123 | ``` 124 | -type lens() :: fun( (fun( (a()) -> f(a()) ), s() ) -> f(s()) ). 125 | ``` 126 | 127 | As an example, Let's define a lens that focuses on head of list `fun lens:hd/2` 128 | 129 | ```erlang 130 | hd() -> 131 | fun(Fun, [H|T]) -> 132 | lens:fmap(fun(X) -> [X|T] end, Fun(H)) 133 | end. 134 | ``` 135 | 136 | 137 | The lens usage is straight forward: 138 | 139 | ```erlang 140 | lens:get(lens:hd(), [1,2]). %% 1 141 | lens:put(lens:hd(), 5, [1, 2]). %% [5, 2] 142 | lens:map(fun(X) -> X + 1 end, lens:hd(), [1, 2]). %% [3, 2] 143 | ``` 144 | 145 | 146 | Well behaving lens satisfies following laws 147 | 148 | **GetPut** if we get focused element `a()` from `s()` and immediately put `a()` with no modifications back into `s()`, we must get back exactly `s()`. 149 | 150 | ```erlang 151 | [a] = lens:put(lens:hd(), lens:get(lens:hd(), [a]), [a]). 152 | ``` 153 | 154 | **PutGet** if putting `a()` inside `s()` yields a new `s()`, then the `a()` obtained from `s()` is exactly `a()`. 155 | 156 | ```erlang 157 | b = lens:get(lens:hd(), lens:put(lens:hd(), b, [a])). 158 | ``` 159 | 160 | **PutPut** A sequence of two puts is just the effect of the second, the first gets completely overwritten. This law is applicable to every well behaving lenses. 161 | 162 | ``` 163 | [c] = lens:put(lens:hd(), c, lens:put(lens:hd(), b, [a])). 164 | ``` 165 | 166 | 167 | ### Ω-lenses 168 | 169 | Lens fails if focus is not exists. Ω-lenses are capable to recover a create a new container `s()` from nothing. The Omega variant(s) is usable for practical application to construct nested data type but they are not well behaving. 170 | 171 | This library implements two variant of lenses that return option type or Ω-variants: 172 | 173 | ``` 174 | undefined = lens:get(lens:hd(), []). 175 | 1 = lens:get(lens:hd(1), []). 176 | ``` 177 | 178 | 179 | 180 | ### Composition 181 | 182 | The lens **composition** is powerful concept to produce complex lenses to deal with deeply nested data structures. The lens composition is a solution to assemble a lenses. 183 | 184 | Let's take an example, there is list of tuple [{1,2,3}], the composition of lens:hd(), fun lens:t2() allows to focus on second element on tuple: 185 | 186 | ```erlang 187 | Lens = lens:c(lens:hd(), lens:t2()). 188 | lens:get(Lens, [{1, 2, 3}]). %% 2 189 | lens:put(Lens, 6, [{1, 2, 3}]). %% [{1, 6, 3}] 190 | ``` 191 | 192 | 193 | The **product lens** composes lenses to spawn multiple fields at once. 194 | 195 | ```erlang 196 | LensA = lens:c(lens:hd(), lens:t2()). 197 | LensB = lens:c(lens:hd(), lens:t3()). 198 | Lens = lens:p(LensA, LensB). 199 | 200 | lens:get(Lens, [{1, 2, 3}]). %% [2, 3]. 201 | lens:put(Lens, [6, 5], [{1, 2, 3}]). %% [{1, 6, 5}] 202 | ``` 203 | 204 | 205 | 206 | ## Refrences 207 | 208 | 1. [Combinators for Bi-Directional Tree Transformations: A Linguistic Approach to the View Update Problem](http://www.cis.upenn.edu/~bcpierce/papers/lenses-toplas-final.pdf) 209 | 1. https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/a-little-lens-starter-tutorial 210 | 1. [Lens tutorial by Jakub Arnold](https://blog.jakuba.net/2014/08/06/lens-tutorial-stab-traversal-part-2.html) 211 | 212 | There are other approaches to implement lens for Erlang 213 | 214 | * https://github.com/jlouis/erl-lenses by Jesper Louis Andersen 215 | * http://www.cs.otago.ac.nz/staffpriv/ok/lens.erl by Richard A. O'Keefe 216 | -------------------------------------------------------------------------------- /doc/monad.md: -------------------------------------------------------------------------------- 1 | # Monad 2 | 3 | The library facilitates a pure functional programming by providing a set of utility functions to work with monads. It also provides the definition of several common monads and defines extension interface using Erlang parse-transform so that users can define their own monads. 4 | 5 | We will skip the monad definitions here. These documents provide excessive explanation of monads: 6 | 7 | * [Monads in functional programming](https://en.wikipedia.org/wiki/Monad_(functional_programming)) 8 | * [A Fistful of Monads](http://learnyouahaskell.com/a-fistful-of-monads) 9 | * [Monads for functional programming](http://homepages.inf.ed.ac.uk/wadler/papers/marktoberdorf/baastad.pdf) 10 | 11 | 12 | ## "do"-notation 13 | 14 | The library implements rough Haskell's equivalent of "do"-notation, so called monadic binding form, using parse-transforms and special form of list comprehension. We used a techniques similar to [erlando](https://github.com/rabbitmq/erlando). This construction decorates computation pipeline(s) with additional rules implemented by monad, they defines programmable commas. 15 | 16 | ```erlang 17 | -compile({parse_transform, category}). 18 | 19 | f() -> 20 | [m_identity || 21 | X <- 10, 22 | Y <- 11, 23 | unit(X + Y) 24 | ]. 25 | ``` 26 | 27 | The used syntax expresses various programming concepts in terms of a monad structures: side-effects, variable assignment, error handling, parsing, concurrency, domain specific languages, etc. 28 | 29 | The library transforms `[ atom() || ... ]` syntax construction to monadic binding using `atom()` as identity of monad module if it starts with **`m_`** prefix (e.g. `m_identity`, `m_state`). List comprehension generators `X <- ...` are transformed into symbol pattern matching rules. For example the following computation produces a list `[1, 2, 100, 101]` 30 | 31 | ```erlang 32 | f() -> 33 | [m_identity || 34 | [X, Y] <- unit([1, 2]), 35 | {A, B} <- unit({100, 101}), 36 | unit([X, Y, A, B]) 37 | ]. 38 | ``` 39 | 40 | Monads are defined in terms of `unit`, `bind` and `fail` operations 41 | 42 | ```erlang 43 | %% 44 | %% return :: a -> m a 45 | -spec unit(A) -> m(A). 46 | 47 | %% 48 | %% (>>=) :: m a -> (a -> m b) -> m b 49 | -spec '>>='(m(A), fun((A) -> m(B))) -> m(B). 50 | 51 | %% 52 | %% fail :: String -> m a 53 | -spec fail(_) -> m(_). 54 | ``` 55 | 56 | Let's show these operation at "do"-notation 57 | 58 | ```erlang 59 | -compile({parse_transform, category}). 60 | f() -> 61 | [m_identity || %% (Monad m) 62 | X <- one(), %% (>>=) :: m a -> (a -> m b) -> m b 63 | Y <- two(), %% (>>=) :: m a -> (a -> m b) -> m b 64 | unit(X + Y) %% return :: (Monad m) => a -> m a 65 | ]. 66 | ``` 67 | 68 | 69 | ### unit 70 | 71 | The operation takes non-monadic value or plain type expression and "lifts" it into container using monadic constructor. The library also implements an operand `=<` as syntax equivalence of `unit` to lift expression into monad. For instance, next computation produces a function that returns `4`. 72 | 73 | ```erlang 74 | f() -> 75 | [m_io || 76 | X <- unit(2), 77 | Y =< X * X, 78 | unit(Y) 79 | ]. 80 | ``` 81 | 82 | 83 | ### fail 84 | 85 | The operation enable failures in a special syntactic construct for monads. The operation is rarely used but allows to escalate failure within computation. The failure is either indicated using `fail` operation from specified monad. 86 | 87 | 88 | ## anonymous variables 89 | 90 | The library defines a special syntax to chain computations and they result through do-notation without explicit definition of binding variables. An anonymous variable `_` hold the result of previous statement. For example, the computation holds the result `15` 91 | 92 | ```erlang 93 | f() -> 94 | [m_identity || 95 | unit(2), %% _ <- 2 96 | unit(_ * 2), %% _ <- 2 * 2 ( 4) 97 | unit(_ + 1), %% _ <- 4 + 1 ( 5) 98 | unit(_ * 3) %% _ <- 5 * 3 (15) 99 | ]. 100 | ``` 101 | 102 | 103 | ## transforms 104 | 105 | Monads provides transforms. These function are defined by the monad class and allows to transform monadic values, executed side effect, etc. The library defines operand `/=` to call utility operation from specified monad. For example, following computation holds result 3 and puts it to state. 106 | 107 | ```erlang 108 | f() -> 109 | [m_state || 110 | A =< 1, 111 | B =< 2, 112 | C =< A + B, 113 | cats:put(lens:t1(), C) 114 | ]. 115 | ``` 116 | 117 | ## References 118 | 119 | 1. http://stenmans.org/happi_blog/?p=181 120 | 2. http://www.rabbitmq.com/blog/2011/05/17/can-you-hear-the-drums-erlando/ 121 | 3. https://github.com/rabbitmq/erlando 122 | 4. https://typelevel.org/blog/2017/05/02/io-monad-for-cats.html 123 | -------------------------------------------------------------------------------- /doc/typecast.md: -------------------------------------------------------------------------------- 1 | # Type cast 2 | 3 | Casts scalar data type to each other or fails: 4 | 5 | * `integer` 6 | * `float` 7 | * `binary` 8 | * `list` 9 | * `atom` 10 | * time stamp triple `{integer(), integer(), integer()}` 11 | 12 | The `typecast` interface re-uses a type field notation of [printf format string](https://en.wikipedia.org/wiki/Printf_format_string) due to historical reasons. 13 | 14 | * `i` - casts to signed decimal number (integer). 15 | * `f` - casts to double in normal (fixed-point) notation 16 | * `x` - casts to hexadecimal number using lower-case letters 17 | * `s` - casts to "string", the library uses binary for string representation 18 | * `ls` - casts to wide "string" 19 | * `c` - casts to list of characters 20 | * `lc` - casts to wide "string" 21 | * `a` - casts to existing atom 22 | * `atom` - casts to atom, create new if do not exists 23 | * `t` - casts to time stamp triple 24 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | APP = examples 2 | 3 | include ../beam.mk 4 | -------------------------------------------------------------------------------- /examples/rebar.config: -------------------------------------------------------------------------------- 1 | {erl_opts, []}. 2 | 3 | {deps, [ 4 | {datum, {path, "../"}} 5 | ]}. 6 | 7 | {plugins, [ 8 | rebar3_path_deps 9 | ]}. 10 | 11 | -------------------------------------------------------------------------------- /examples/src/examples.app.src: -------------------------------------------------------------------------------- 1 | {application, examples, 2 | [ 3 | {description, "examples of datum library"}, 4 | {vsn, "0.0.0"}, 5 | {modules, []}, 6 | {registered, []}, 7 | {applications,[ 8 | kernel, 9 | stdlib, 10 | datum 11 | ]}, 12 | {env, []} 13 | ] 14 | }. -------------------------------------------------------------------------------- /examples/src/examples_generic.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2018, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% Examples of Generic usage in Erlang 19 | -module(examples_generic). 20 | -compile({parse_transform, generic}). 21 | 22 | -compile(export_all). 23 | 24 | -record(address, { 25 | street = undefined :: string(), 26 | city = undefined :: string(), 27 | zipcode = undefined :: string() 28 | }). 29 | 30 | -record(person, { 31 | name = undefined :: string(), 32 | age = undefined :: integer(), 33 | address = undefined :: string() 34 | }). 35 | 36 | -record(employee, { 37 | name = undefined :: string(), 38 | age = undefined :: integer(), 39 | address = undefined :: string() 40 | }). 41 | 42 | -record(estate, { 43 | location = undefined :: string() | #address{}, 44 | owner = undefined :: string() | #person{} 45 | }). 46 | 47 | person() -> 48 | #person{ 49 | name = "Verner Pleishner", 50 | age = 64, 51 | address = "Blumenstrasse 14, Berne, 3013" 52 | }. 53 | 54 | address() -> 55 | #address{ 56 | street = "Blumenstrasse 14", 57 | city = "Berne", 58 | zipcode = "3013" 59 | }. 60 | 61 | %% 62 | %% 63 | semi_auto() -> 64 | Person = person(), 65 | Generic = generic_of:person(Person), 66 | Person = generic_to:person(Generic). 67 | 68 | semi_auto_morphism() -> 69 | Person = person(), 70 | Generic = generic_of:person(Person), 71 | _Employee = generic_to:employee(Generic). 72 | 73 | semi_auto_recursive_type_list() -> 74 | Persons = [person() || _ <- lists:seq(1, 10)], 75 | Generic = generic_of:person(Persons), 76 | _Employees = generic_to:employee(Generic). 77 | 78 | %% 79 | %% 80 | assisted_morphism() -> 81 | Person = person(), 82 | Generic = generic_of:person([name, age, address], Person), 83 | _Employee = generic_to:estate([address, name], Generic). 84 | 85 | %% 86 | %% 87 | partial_application() -> 88 | Encoder = generic:encode(#person{}), 89 | Decoder = generic:decode(#person{}), 90 | 91 | Person = person(), 92 | Generic = Encoder(Person), 93 | Person = Decoder(Generic). 94 | 95 | generic_process() -> 96 | Encoder = generic:encode(#person{}), 97 | Decoder = generic:decode(#person{}), 98 | {ok, _} = examples_generic_io:start_link(person, Encoder, Decoder), 99 | 100 | Person = person(), 101 | ok = examples_generic_io:send(Person), 102 | {ok, Person} = examples_generic_io:recv(#person{}). 103 | 104 | %% 105 | %% 106 | custom_codecs() -> 107 | Person = person(), 108 | Address = address(), 109 | Generic = generic_of:estate(#estate{ 110 | location = generic_of:address(Address), 111 | owner = generic_of:person(Person) 112 | }), 113 | Lens = generic:lens(#estate{ 114 | location = generic:lens(#address{}), 115 | owner = generic:lens(#person{}) 116 | }), 117 | _Estate = lens:get(Lens, Generic). 118 | 119 | -------------------------------------------------------------------------------- /examples/src/examples_generic_io.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2018, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% Examples of Generic usage in Erlang 19 | -module(examples_generic_io). 20 | -behaviour(gen_server). 21 | 22 | -export([ 23 | send/1 24 | , recv/1 25 | , start_link/3 26 | , init/1 27 | , terminate/2 28 | , handle_call/3 29 | , handle_cast/2 30 | , handle_info/2 31 | , code_change/3 32 | ]). 33 | 34 | -record(state, {encoder, decoder, generic}). 35 | 36 | %% 37 | %% 38 | send(Struct) when is_tuple(Struct) -> 39 | gen_server:call(erlang:element(1, Struct), {send, Struct}). 40 | 41 | %% 42 | %% 43 | recv(Struct) when is_tuple(Struct) -> 44 | gen_server:call(erlang:element(1, Struct), {recv, Struct}). 45 | 46 | %% 47 | %% 48 | start_link(Type, Encoder, Decoder) -> 49 | gen_server:start_link({local, Type}, ?MODULE, [Encoder, Decoder], []). 50 | 51 | init([Encoder, Decoder]) -> 52 | {ok, #state{encoder = Encoder, decoder = Decoder}}. 53 | 54 | terminate(_, _) -> 55 | ok. 56 | 57 | handle_call({send, Struct}, _, #state{encoder = Encoder} = State) -> 58 | {reply, ok, 59 | State#state{ 60 | generic = Encoder(Struct) 61 | } 62 | }; 63 | 64 | handle_call({recv, _}, _, #state{decoder = Decoder, generic = Generic} = State) -> 65 | {reply, {ok, Decoder(Generic)}, State}. 66 | 67 | handle_cast(_, State) -> 68 | {noreply, State}. 69 | 70 | handle_info(_, State) -> 71 | {noreply, State}. 72 | 73 | code_change(_, State, _) -> 74 | {ok, State}. 75 | 76 | -------------------------------------------------------------------------------- /examples/src/examples_lens.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2018, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% Examples of Lenses usage in Erlang 19 | -module(examples_lens). 20 | 21 | -compile(export_all). 22 | 23 | %% 24 | %% Ordinary data structures 25 | -record(address, { 26 | street = undefined :: string(), 27 | city = undefined :: string(), 28 | zipcode = undefined :: string() 29 | }). 30 | 31 | -record(person, { 32 | name = undefined :: string(), 33 | age = undefined :: integer(), 34 | address = undefined :: #address{} 35 | }). 36 | 37 | 38 | %% 39 | %% Define lenses over data structures 40 | lens_name() -> lens:ti(#person.name). 41 | lens_age() -> lens:ti(#person.age). 42 | lens_address() -> lens:ti(#person.address). 43 | lens_street() -> lens:c(lens:ti(#person.address), lens:ti(#address.street)). 44 | lens_city() -> lens:c(lens:ti(#person.address), lens:ti(#address.city)). 45 | lens_zipcode() -> lens:c(lens:ti(#person.address), lens:ti(#address.zipcode)). 46 | 47 | 48 | %% 49 | %% A person 50 | person() -> 51 | #person{ 52 | name = "Verner Pleishner", 53 | age = 64, 54 | address = #address{street = "Blumenstrasse", city = "Berne", zipcode = "3013"} 55 | }. 56 | 57 | 58 | %% 59 | %% Use lenses as data setters/getters 60 | read_field() -> 61 | 64 = lens:get(lens_age(), person()). 62 | 63 | update_field() -> 64 | Person = lens:put(lens_age(), 70, person()), 65 | #person{age = 70} = Person. 66 | 67 | transform_field() -> 68 | Person = lens:apply(lens_age(), fun(X) -> X + 1 end, person()), 69 | #person{age = 65} = Person. 70 | 71 | 72 | 73 | %% 74 | %% Use lenses with nested structures 75 | read_nested_field() -> 76 | "Blumenstrasse" = lens:get(lens_street(), person()). 77 | 78 | update_nested_field() -> 79 | Person = lens:put(lens_street(), "Blumenstraße", person()), 80 | #person{address = #address{street = "Blumenstraße"}} = Person. 81 | 82 | transform_nested_field() -> 83 | Person = lens:apply(lens_street(), fun(X) -> X ++ " 14" end, person()), 84 | #person{address = #address{street = "Blumenstrasse 14"}} = Person. 85 | 86 | 87 | 88 | %% 89 | %% Create a product lens, spawning multiple fields 90 | lens_name_age_city() -> 91 | lens:p(lens_name(), lens_age(), lens_city()). 92 | 93 | 94 | read_product_lens() -> 95 | ["Verner Pleishner", 64, "Berne"] = lens:get(lens_name_age_city(), person()). 96 | 97 | update_product_lens() -> 98 | Person = lens:put(lens_name_age_city(), ["Pleishner", 65, "Bern"], person()), 99 | #person{name = "Pleishner", age = 65, address = #address{city = "Bern"}} = Person. 100 | 101 | 102 | %% 103 | %% Create a lens isomorphism, transforming a data to new format 104 | lmap_name_age_city() -> 105 | lens:p(lens:at(name), lens:at(age), lens:at(city)). 106 | 107 | transform_record_to_map() -> 108 | Person = lens:iso(lens_name_age_city(), person(), lmap_name_age_city(), #{}), 109 | #{name := "Verner Pleishner", age := 64, city := "Berne"} = Person. 110 | 111 | 112 | %% 113 | %% Define a custom lens 114 | lens_custom() -> 115 | fun(Fun, Struct) -> 116 | lens:fmap(fun(X) -> lens_custom_put(X, Struct) end, Fun(lens_custom_get(Struct)) ) 117 | end. 118 | 119 | lens_custom_get(#{custom := [H|_]}) -> 120 | H. 121 | lens_custom_put(X, #{custom := [_|T]} = Struct) -> 122 | Struct#{custom => [X|T]}. 123 | 124 | struct() -> 125 | #{custom => [a, b, c]}. 126 | 127 | read_custom_struct() -> 128 | a = lens:get(lens_custom(), struct()). 129 | 130 | update_custom_struct() -> 131 | Struct = lens:put(lens_custom(), 1, struct()), 132 | #{custom := [1, b, c]} = Struct. 133 | 134 | 135 | 136 | run() -> 137 | read_field(), 138 | update_field(), 139 | transform_field(), 140 | 141 | read_nested_field(), 142 | update_nested_field(), 143 | transform_nested_field(), 144 | 145 | read_product_lens(), 146 | update_product_lens(), 147 | 148 | transform_record_to_map(), 149 | 150 | update_custom_struct(), 151 | ok. 152 | 153 | 154 | -------------------------------------------------------------------------------- /examples/test/tests.config: -------------------------------------------------------------------------------- 1 | {suites, ".", all}. 2 | -------------------------------------------------------------------------------- /include/datum.hrl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2012 - 2013 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | 17 | 18 | %% 19 | %% 20 | -define(None, undefined). 21 | -define(Some(X), X). 22 | 23 | %% 24 | %% either category pattern match 25 | -define(EitherR(X), {ok, X}). 26 | -define(Right(X), {ok, X}). 27 | 28 | -define(EitherL(X), {error, X}). 29 | -define(Left(X), {error, X}). 30 | 31 | 32 | %% 33 | %% data types 34 | -record(tree, { 35 | ford = undefined :: datum:compare(_), 36 | tree = undefined :: _ 37 | }). 38 | -define(tree(), #tree{tree = undefined}). 39 | 40 | %% 41 | -record(heap, { 42 | ford = undefined :: datum:compare(_), 43 | heap = undefined :: _ 44 | }). 45 | -define(heap(), #heap{heap = undefined}). 46 | 47 | %% 48 | -record(stream, { 49 | head = undefined :: _, 50 | tail = undefined :: datum:option(fun(() -> _)) 51 | }). 52 | -define(stream(), undefined). 53 | 54 | 55 | %% 56 | -record(queue, { 57 | length = 0 :: integer(), 58 | head = [] :: [_], 59 | tail = [] :: [_] 60 | }). 61 | -define(queue(), #queue{length = 0, head = [], tail = []}). 62 | 63 | -------------------------------------------------------------------------------- /priv/datum.benchmark: -------------------------------------------------------------------------------- 1 | {code_paths, ["./_build/default/lib/datum/ebin"]}. 2 | {log_level, info}. 3 | {report_interval, 1}. 4 | {driver, datum_benchmark}. 5 | 6 | %% 7 | %% workload 8 | {mode, max}. 9 | {duration, 1}. 10 | {concurrent, 1}. 11 | %% 12 | {key_generator, {uniform_int, 1000000}}. 13 | {value_generator, {fixed_bin, 1000}}. 14 | 15 | 16 | %% 17 | %% data structure(s) 18 | 19 | % {struct, stream}. 20 | % {operations, [ 21 | % {head, 1} 22 | % ,{tail, 1} 23 | % ]}. 24 | 25 | % {struct, bst}. 26 | % {operations, [ 27 | % {insert, 1} 28 | % ,{lookup, 1} 29 | % ,{remove, 1} 30 | % ]}. 31 | 32 | % {struct, rbtree}. 33 | % {operations, [ 34 | % {insert, 1} 35 | % ,{lookup, 1} 36 | % ]}. 37 | 38 | % {struct, chord}. 39 | % {operations, [ 40 | % {whereis, 1} 41 | % ,{predecessors, 1} 42 | % ,{successors, 1} 43 | % ]}. 44 | 45 | %{struct, ring}. 46 | %{operations, [ 47 | % % {whereis, 1} 48 | % {predecessors, 1} 49 | % ,{successors, 1} 50 | %]}. 51 | 52 | % {struct, lens}. 53 | % {operations, [ 54 | % {get, 1} 55 | % ,{put, 1} 56 | % ]}. 57 | 58 | % {struct, dict}. 59 | % {operations, [ 60 | % {store, 1} 61 | % ,{find, 1} 62 | % ]}. 63 | 64 | % {struct, gb_trees}. 65 | % {operations, [ 66 | % {enter, 1} 67 | % ,{lookup, 1} 68 | % ]}. 69 | 70 | % {struct, tuple}. 71 | % {operations, [ 72 | % {get, 1} 73 | % ,{put, 1} 74 | % ]}. 75 | 76 | {struct, monad}. 77 | {operations, [ 78 | {m_id, 1} 79 | % ,{m_error, 1} 80 | ,{m_state, 1} 81 | % ,{m_io, 1} 82 | ,{m_native, 1} 83 | ]}. 84 | 85 | -------------------------------------------------------------------------------- /rebar.config: -------------------------------------------------------------------------------- 1 | {erl_opts, [ 2 | warnings_as_errors, 3 | {platform_define, "^17.", 'OTP_17'} 4 | ]}. 5 | 6 | {erl_first_files, [ 7 | "src/category/category.erl" 8 | , "src/category/datum_cat.erl" 9 | , "src/category/datum_cat_f.erl" 10 | , "src/category/datum_cat_option.erl" 11 | , "src/category/datum_cat_undefined.erl" 12 | , "src/category/datum_cat_either.erl" 13 | , "src/category/datum_cat_reader.erl" 14 | , "src/category/datum_cat_kleisli.erl" 15 | 16 | , "src/partial.erl" 17 | 18 | , "src/foldable.erl" 19 | , "src/maplike.erl" 20 | , "src/topological.erl" 21 | , "src/traversable.erl" 22 | 23 | , "src/generic.erl" 24 | ]}. 25 | 26 | %% 27 | %% Exclude parse transform from cover reports 28 | {cover_excl_mods, [ 29 | category 30 | , partial 31 | , generic 32 | ]}. 33 | 34 | %% 35 | %% 36 | {plugins , [coveralls]}. 37 | {cover_enabled , true}. 38 | {cover_export_enabled , true}. 39 | {coveralls_coverdata , "_build/test/cover/ct.coverdata"}. 40 | {coveralls_service_name , "travis-ci"}. 41 | -------------------------------------------------------------------------------- /rebar.config.script: -------------------------------------------------------------------------------- 1 | case os:getenv("TRAVIS") of 2 | "true" -> 3 | JobId = os:getenv("TRAVIS_JOB_ID"), 4 | lists:keystore(coveralls_service_job_id, 1, CONFIG, {coveralls_service_job_id, JobId}); 5 | _ -> 6 | CONFIG 7 | end. 8 | 9 | -------------------------------------------------------------------------------- /src/category/datum_cat.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern / functional composition 3 | %% [ || ... ] 4 | -module(datum_cat). 5 | 6 | -export([is_category/1, category/3, cc_bind_var/2, cc_derive/2, uuid/0]). 7 | 8 | %% 9 | %% 10 | -spec is_category({char, _, _} | _) -> atom() | false. 11 | 12 | is_category({char, _, $.}) -> 13 | {datum_cat_f, datum_cat_f}; 14 | is_category({atom, _, identity}) -> 15 | {datum_cat_f, datum_cat_f}; 16 | is_category({char, _, $?}) -> 17 | {datum_cat_option, datum_cat_option}; 18 | is_category({atom, _, option}) -> 19 | {datum_cat_option, datum_cat_option}; 20 | is_category({atom, _, undefined}) -> 21 | {datum_cat_undefined, datum_cat_undefined}; 22 | is_category({char, _, $^}) -> 23 | {datum_cat_either, datum_cat_either}; 24 | is_category({atom, _, either}) -> 25 | {datum_cat_either, datum_cat_either}; 26 | is_category({atom, _, reader}) -> 27 | {datum_cat_reader, datum_cat_reader}; 28 | is_category({atom, _, Category}) -> 29 | case erlang:atom_to_list(Category) of 30 | "m_" ++ _ -> 31 | {datum_cat_kleisli, Category}; 32 | _ -> 33 | false 34 | end; 35 | is_category(_) -> 36 | false. 37 | 38 | %% 39 | %% check if category expression is partial function 40 | is_partial([Head | _]) -> 41 | is_partial(Head); 42 | 43 | is_partial({generate, _, _, Arrow}) -> 44 | is_partial(Arrow); 45 | 46 | is_partial({op, _, '++', _, _}) -> 47 | false; 48 | 49 | is_partial({op, _, _, _, Arrow}) -> 50 | is_partial(Arrow); 51 | 52 | is_partial({call, _, _, Fa0}) -> 53 | length( erlang:element(2, cc_derive(Fa0, [])) ) > 0; 54 | 55 | is_partial({'fun', _, _}) -> 56 | true; 57 | 58 | is_partial({var, _, _}) -> 59 | true; 60 | 61 | is_partial(_) -> 62 | false. 63 | 64 | 65 | %% 66 | %% 67 | -spec category(atom(), atom(), erl_parse:abstract_expr()) -> erl_parse:abstract_expr(). 68 | 69 | category(Cat, Mod, Expr0) -> 70 | Expr1 = compile(Cat, Mod, Expr0), 71 | Expr2 = join(Mod, fun Cat:'.'/3, Expr1), 72 | cats(is_partial(Expr0), Cat, Expr2). 73 | 74 | cats(false, Cat, Expr) -> 75 | Cat:chain(Expr); 76 | 77 | cats(true, Cat, Expr) -> 78 | Cat:curry(Expr). 79 | 80 | 81 | %% 82 | %% helper function to bind blank variable with expression 83 | %% flat (inject call to the position) 84 | -spec cc_bind_var(erl_parse:abstract_expr(), erl_parse:abstract_expr()) -> erl_parse:abstract_expr(). 85 | 86 | cc_bind_var(Vx, X) 87 | when is_tuple(X) -> 88 | erlang:list_to_tuple( 89 | cc_bind_var(Vx, erlang:tuple_to_list(X)) 90 | ); 91 | 92 | cc_bind_var(Vx, [{lc, _, Type, _} = H | T]) -> 93 | case is_category(Type) of 94 | %% enable variable binding for comprehension 95 | false -> 96 | [erlang:list_to_tuple(cc_bind_var(Vx, erlang:tuple_to_list(H))) | cc_bind_var(Vx, T)]; 97 | 98 | % skip binding for nested category 99 | true -> 100 | [H | cc_bind_var(Vx, T)] 101 | end; 102 | cc_bind_var(Vx, [{var, _, '_'} | T]) -> 103 | [Vx | cc_bind_var(Vx, T)]; 104 | cc_bind_var(Vx, [H | T]) -> 105 | [cc_bind_var(Vx, H) | cc_bind_var(Vx, T)]; 106 | cc_bind_var(_, []) -> 107 | []; 108 | 109 | cc_bind_var(_, X) -> 110 | X. 111 | 112 | %% 113 | %% helper function to derive variables from expression with blank variables 114 | -spec cc_derive(erl_parse:abstract_expr(), [_]) -> {[_], erl_parse:abstract_expr()}. 115 | 116 | cc_derive({lc, _, Type, _} = Expr, Acc) -> 117 | case is_category(Type) of 118 | 119 | %% enable variable binding for comprehension 120 | false -> 121 | {Code, Var} = lists:mapfoldr(fun cc_derive/2, Acc, erlang:tuple_to_list(Expr)), 122 | {erlang:list_to_tuple(Code), Var}; 123 | 124 | %% skip variable binding for nested categories 125 | true -> 126 | {Expr, Acc} 127 | end; 128 | 129 | cc_derive({var, Ln, '_'}, Acc) -> 130 | Uuid = uuid(), 131 | {{var, Ln, Uuid}, [Uuid|Acc]}; 132 | 133 | cc_derive(Expr, Acc) 134 | when is_tuple(Expr) -> 135 | {Code, Var} = lists:mapfoldr(fun cc_derive/2, Acc, erlang:tuple_to_list(Expr)), 136 | {erlang:list_to_tuple(Code), Var}; 137 | 138 | cc_derive(Expr, Acc) 139 | when is_list(Expr) -> 140 | lists:mapfoldr(fun cc_derive/2, Acc, Expr); 141 | 142 | cc_derive(Expr, Acc) -> 143 | {Expr, Acc}. 144 | 145 | %% 146 | %% unique variable 147 | uuid() -> 148 | list_to_atom("_Vx" ++ integer_to_list(unique())). 149 | 150 | -ifdef(OTP_17). 151 | unique() -> 152 | {A, B, C} = erlang:now(), 153 | (A * 1000000 + B) * 1000000 + C. 154 | -else. 155 | unique() -> 156 | erlang:unique_integer([monotonic, positive]). 157 | -endif. 158 | 159 | %%%------------------------------------------------------------------ 160 | %%% 161 | %%% private 162 | %%% 163 | %%%------------------------------------------------------------------ 164 | 165 | %% 166 | %% compile expression to functional composition (f . g . h ...) 167 | compile(Cat, Mod, List) -> 168 | lists:reverse([c(Cat, Mod, X) || X <- List]). 169 | 170 | c(Cat, Mod, {generate, Line, VarS, Arrow}) -> 171 | {generate, Line, VarS, c_cats(Mod, c_arrow(Cat, Arrow))}; 172 | 173 | c(Cat, Mod, Arrow) -> 174 | c_cats(Mod, c_arrow(Cat, Arrow)). 175 | 176 | 177 | %% 178 | %% An arrow is the term used in category theory as an abstract notion of 179 | %% thing that behaves like a function. It represents [A] process that takes as 180 | %% input something of type [B] and outputs something of type [C]. 181 | %% 182 | c_arrow(_Cat, {call, Ln, {atom, _, unit} = Fn, Fa}) -> 183 | {call, Ln, {remote, Ln, {atom, Ln, cats}, Fn}, Fa}; 184 | 185 | c_arrow(_Cat, {call, Ln, {atom, _, fail} = Fn, Fa}) -> 186 | {call, Ln, {remote, Ln, {atom, Ln, cats}, Fn}, Fa}; 187 | 188 | c_arrow(_Cat, {call, _, {remote, _, {atom, _, cats}, {atom, _, unit}}, _} = Expr) -> 189 | Expr; 190 | 191 | c_arrow(_Cat, {call, _, {remote, _, {atom, _, cats}, {atom, _, fail}}, _} = Expr) -> 192 | Expr; 193 | 194 | c_arrow(_Cat, {call, Ln, {remote, _, {atom, _, cats}, {atom, _, tryT}} = TryT, [Expr]}) -> 195 | {call, Ln, TryT, [{'catch', Ln, Expr}]}; 196 | 197 | c_arrow(Cat, {call, Ln, {remote, Ln, {atom, _, cats}, {atom, _, _} = Fn}, Fa}) -> 198 | Cat:'/='({call, Ln, {remote, Ln, {atom, Ln, cats}, Fn}, Fa}); 199 | 200 | c_arrow(_Cat, {call, _, _, _} = H) -> 201 | % explicit call: f(...) 202 | H; 203 | 204 | c_arrow(_Cat, {'fun', Line, {function, Id, _}}) -> 205 | % reference to function: fun f/n 206 | {call, Line, {atom, Line, Id}, [{var, Line, '_'}]}; 207 | 208 | c_arrow(_Cat, {'fun', Line, {function, Mod, Fun, _}}) -> 209 | % reference to function: fun mod:f/n 210 | {call, Line, {remote, Line, Mod, Fun}, [{var, Line, '_'}]}; 211 | 212 | c_arrow(_Cat, {'fun', Line, {clauses, _}} = H) -> 213 | % inline function: fun(_) -> ... end 214 | {call, Line, H, [{var, Line, '_'}]}; 215 | 216 | c_arrow(_Cat, {var, Line, _} = H) -> 217 | % function reference within variable: X = ... 218 | {call, Line, H, [{var, Line, '_'}]}; 219 | 220 | c_arrow(_Cat, {op, Ln, '=<', VarS, Arrow}) -> 221 | {generate, Ln, VarS, 222 | {call, Ln, {remote, Ln, {atom, Ln, cats}, {atom, Ln, unit}}, [Arrow]}}; 223 | 224 | c_arrow(_Cat, {op, Ln, '>', VarS, Arrow}) -> 225 | {generate, Ln, VarS, 226 | {call, Ln, {remote, Ln, {atom, Ln, cats}, {atom, Ln, putT}}, [Arrow]}}; 227 | 228 | c_arrow(_Cat, {op, Ln, '<', VarS, Arrow}) -> 229 | {generate, Ln, VarS, 230 | {call, Ln, {remote, Ln, {atom, Ln, cats}, {atom, Ln, getT}}, [Arrow]}}; 231 | 232 | c_arrow(Cat, {op, Ln, '/=', VarS, {call, Ln, {remote, Ln, {atom, _, cats}, {atom, _, _} = Fn}, Fa}}) -> 233 | {generate, Ln, VarS, Cat:'/='({call, Ln, {remote, Ln, {atom, Ln, cats}, Fn}, Fa})}; 234 | 235 | % 236 | % it would be nice to have a short syntax for transformer 237 | % _ /= x() 238 | % 239 | % but it limits ability for local transformer definition which is essential feature 240 | % 241 | % c_arrow(Cat, Mod, {op, Ln, '/=', VarS, {call, Ln, {atom, _, _} = Fn, Fa}}) -> 242 | % {generate, Ln, VarS, Cat:'/='({call, Ln, {remote, Ln, {atom, Ln, Mod}, Fn}, Fa})}; 243 | % 244 | % c_arrow(Cat, Mod, {op, Ln, '/=', VarS, {atom, _, _} = Fn}) -> 245 | % {generate, Ln, VarS, Cat:'/='({call, Ln, {remote, Ln, {atom, Ln, Mod}, Fn}, []})}; 246 | 247 | c_arrow(Cat, {op, Ln, '/=', VarS, Arrow}) -> 248 | {generate, Ln, VarS, Cat:'/='(Arrow)}; 249 | 250 | c_arrow(_, H) -> 251 | exit( lists:flatten(io_lib:format("Category composition do not support: ~p", [H])) ). 252 | 253 | %% 254 | %% 255 | c_cats(Mod, Expr) 256 | when is_tuple(Expr) -> 257 | erlang:list_to_tuple( 258 | c_cats(Mod, erlang:tuple_to_list(Expr)) 259 | ); 260 | 261 | c_cats(Mod, [{atom, Ln, cats} | T]) -> 262 | [{atom, Ln, Mod} | c_cats(Mod, T)]; 263 | 264 | c_cats(Mod, [H | T]) -> 265 | [c_cats(Mod, H) | c_cats(Mod, T)]; 266 | 267 | c_cats(_, []) -> 268 | []; 269 | 270 | c_cats(_, Expr) -> 271 | Expr. 272 | 273 | 274 | %% 275 | %% join 276 | join(Mod, Fun, [F, G | T]) -> 277 | join(Mod, Fun, [Fun(Mod, F, G)|T]); 278 | join(_, _, [Expr]) -> 279 | Expr. 280 | -------------------------------------------------------------------------------- /src/category/datum_cat_either.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern: either 3 | -module(datum_cat_either). 4 | 5 | %% (/=) 6 | -export(['/='/1]). 7 | 8 | %% (.) operation 9 | -export(['.'/3, chain/1, curry/1]). 10 | 11 | %% category transformers 12 | -export([unit/1, unit/2, fail/1, require/3, sequence/1, flatten/1, optionT/1, optionT/2, eitherT/1, tryT/1]). 13 | 14 | %% 15 | %% 16 | '/='(Arrow) -> 17 | Arrow. 18 | 19 | 20 | %% 21 | %% compose function(s) using AST notation 22 | %% 23 | %% f(_) . g(_) -> case f(_) of {error, _} = Err -> Err ; {ok, X} -> g(X) end 24 | %% 25 | '.'(_, {either, VarX, G}, {call, Ln, Ff0, Fa0}) -> 26 | {Fa1, VarN} = datum_cat:cc_derive(Fa0, []), 27 | Pattern = [{var, Ln, X} || X <- VarX], 28 | Expr = dot_expr(Ln, Pattern, {call, Ln, Ff0, Fa1}, G), 29 | {either, VarN, Expr}; 30 | 31 | '.'(_, {either, _VarX, G}, {generate, Ln, Pattern, F}) -> 32 | {Fa1, VarZ} = datum_cat:cc_derive(F, []), 33 | Expr = dot_expr(Ln, [Pattern], Fa1, G), 34 | {either, VarZ, Expr}; 35 | 36 | '.'(Cat, {call, Ln, Ff0, Fa0}, G) -> 37 | {Fa1, VarN} = datum_cat:cc_derive(Fa0, []), 38 | '.'(Cat, {either, VarN, {call, Ln, Ff0, Fa1}}, G); 39 | 40 | '.'(Cat, {generate, _Ln, _Var, F}, G) -> 41 | %% ignore tail arrow 42 | '.'(Cat, F, G). 43 | 44 | 45 | %% 46 | %% 47 | dot_expr(Ln, [], F, G) -> 48 | Err = datum_cat:uuid(), 49 | {'case', Ln, F, [ 50 | {clause, Ln, 51 | [{match, Ln, {tuple, Ln, [{atom, Ln, error}, {var, Ln, '_'}]}, {var, Ln, Err}}], 52 | [], 53 | [{var, Ln, Err}] 54 | }, 55 | {clause, Ln, 56 | [{var, Ln, '_'}], 57 | [], 58 | [G] 59 | } 60 | ]}; 61 | dot_expr(Ln, Pattern, F, G) -> 62 | Err = datum_cat:uuid(), 63 | {'case', Ln, F, [ 64 | {clause, Ln, 65 | [{tuple, Ln, [{atom, Ln, ok}|Pattern]}], 66 | [], 67 | [G] 68 | }, 69 | {clause, Ln, 70 | [{match, Ln, {tuple, Ln, [{atom, Ln, error}, {var, Ln, '_'}]}, {var, Ln, Err}}], 71 | [], 72 | [{var, Ln, Err}] 73 | } 74 | ]}. 75 | 76 | %% 77 | %% map compose to expression 78 | %% 79 | chain({either, _, Expr}) -> 80 | Expr. 81 | 82 | %% 83 | %% map compose to partial expression 84 | %% 85 | curry({either, VarX, {'case', Ln, _, _} = Expr}) -> 86 | {'fun', Ln, 87 | {clauses, [ 88 | {clause, Ln, 89 | [{var, Ln, X} || X <- VarX], 90 | [], 91 | [Expr] 92 | } 93 | ]} 94 | }. 95 | 96 | 97 | %%%------------------------------------------------------------------ 98 | %%% 99 | %%% transformers 100 | %%% 101 | %%%------------------------------------------------------------------ 102 | 103 | %% 104 | %% lifts a value to object of category 105 | -spec unit(_) -> datum:either(_). 106 | 107 | unit(X) -> 108 | {ok, X}. 109 | 110 | unit(A, X) -> 111 | {ok, A, X}. 112 | 113 | %% 114 | %% lifts a failure to error object of category 115 | -spec fail(_) -> datum:either(_). 116 | 117 | fail(X) -> 118 | {error, X}. 119 | 120 | %% 121 | %% conditionally lifts a value to object or error of category 122 | -spec require(boolean(), _, _) -> datum:either(). 123 | 124 | require(true, X, _) -> 125 | {ok, X}; 126 | require(false, _, X) -> 127 | {error, X}. 128 | 129 | %% 130 | %% transforms sequence of objects into object of category. 131 | -spec sequence([datum:either(_)]) -> datum:either([_]). 132 | 133 | sequence([{ok, Head} | Seq]) -> 134 | case sequence(Seq) of 135 | {ok, Tail} -> 136 | {ok, [Head|Tail]}; 137 | {error, _} = Error -> 138 | Error 139 | end; 140 | 141 | sequence([{error, _} = Error | _]) -> 142 | Error; 143 | 144 | sequence([]) -> 145 | {ok, []}. 146 | 147 | 148 | %% 149 | %% transforms nested objects into object of category 150 | -spec flatten(datum:either(datum:either(_))) -> datum:either(_). 151 | 152 | flatten({ok, {ok, _} = X}) -> 153 | flatten(X); 154 | flatten({ok, {error, _} = X}) -> 155 | flatten(X); 156 | flatten({error, {ok, _} = X}) -> 157 | flatten(X); 158 | flatten({error, {error, _} = X}) -> 159 | flatten(X); 160 | flatten({ok, _} = X) -> 161 | X; 162 | flatten({error, _} = X) -> 163 | X. 164 | 165 | 166 | %% 167 | %% transforms option category to identity 168 | -spec optionT( datum:option() ) -> datum:either(_). 169 | 170 | optionT(undefined) -> 171 | {error, undefined}; 172 | optionT(X) -> 173 | {ok, X}. 174 | 175 | optionT(Reason, undefined) -> 176 | {error, Reason}; 177 | optionT(_, X) -> 178 | {ok, X}. 179 | 180 | %% 181 | %% 182 | -spec eitherT( datum:either(_) ) -> datum:either(_). 183 | 184 | eitherT({ok, _} = X) -> 185 | X; 186 | eitherT({error, _} = X) -> 187 | X. 188 | 189 | %% 190 | %% 191 | -spec tryT( _ ) -> datum:either(_). 192 | 193 | tryT({'EXIT', {Reason, _Stack}}) -> 194 | {error, Reason}; 195 | tryT({'EXIT', Reason}) -> 196 | {error, Reason}; 197 | tryT({ok, _} = Result) -> 198 | Result; 199 | tryT({error, _} = Result) -> 200 | Result; 201 | tryT(Result) -> 202 | {ok, Result}. 203 | -------------------------------------------------------------------------------- /src/category/datum_cat_f.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern: the category of ordinal functions 3 | -module(datum_cat_f). 4 | 5 | %% (/=) 6 | -export(['/='/1]). 7 | 8 | %% (.) operation 9 | -export(['.'/3, chain/1, curry/1]). 10 | 11 | %% category transformers 12 | -export([unit/1, fail/1, require/3, sequence/1, flatten/1, optionT/1, eitherT/1, tryT/1]). 13 | 14 | %% 15 | %% 16 | '/='(Arrow) -> 17 | Arrow. 18 | 19 | %% 20 | %% compose function(s) using AST notation 21 | %% 22 | %% f(_) . g(_) -> g(f(_)) 23 | %% 24 | '.'(_, G, {call, _, _, _} = F) -> 25 | datum_cat:cc_bind_var(F, G); 26 | 27 | '.'(_, G, {generate, Ln, VarS, F}) -> 28 | dot_arrow_state(Ln, VarS, F, G). 29 | 30 | 31 | %% 32 | %% 33 | dot_arrow_state(Ln, VarX, F, G) -> 34 | {'case', Ln, F, [ 35 | {clause, Ln, 36 | [VarX], 37 | [], 38 | [G] 39 | } 40 | ]}. 41 | 42 | %% 43 | %% return dot-composition chain. 44 | chain(Expr) -> 45 | Expr. 46 | 47 | %% 48 | %% curry do-composition chain into partial application 49 | curry({_, Ln, _, _} = Expr) -> 50 | VarX = datum_cat:uuid(), 51 | {'fun', Ln, 52 | {clauses, [ 53 | {clause, Ln, 54 | [{var, Ln, VarX}], 55 | [], 56 | [datum_cat:cc_bind_var({var, Ln, VarX}, Expr)] 57 | } 58 | ]} 59 | }. 60 | 61 | 62 | %%%------------------------------------------------------------------ 63 | %%% 64 | %%% transformers 65 | %%% 66 | %%%------------------------------------------------------------------ 67 | 68 | %% 69 | %% lifts a value to object of category 70 | -spec unit(_) -> _. 71 | 72 | unit(X) -> 73 | X. 74 | 75 | %% 76 | %% lifts a failure to error object of category 77 | -spec fail(_) -> _. 78 | 79 | fail(X) -> 80 | throw(X). 81 | 82 | %% 83 | %% conditionally lifts a value to object or error of category 84 | -spec require(boolean(), _, _) -> _. 85 | 86 | require(true, X, _) -> 87 | X; 88 | require(false, _, X) -> 89 | throw(X). 90 | 91 | %% 92 | %% transforms sequence of objects into object of category. 93 | -spec sequence([_]) -> [_]. 94 | 95 | sequence(Seq) -> 96 | Seq. 97 | 98 | %% 99 | %% transforms nested objects into object of category 100 | -spec flatten(_) -> _. 101 | 102 | flatten(X) -> 103 | X. 104 | 105 | %% 106 | %% transforms option category to identity 107 | -spec optionT( datum:option() ) -> _. 108 | 109 | optionT(X) -> 110 | X. 111 | 112 | %% 113 | %% 114 | -spec eitherT( datum:either(_) ) -> _. 115 | 116 | eitherT({ok, X}) -> 117 | X; 118 | eitherT({error, _}) -> 119 | undefined. 120 | 121 | %% 122 | %% 123 | -spec tryT( _ ) -> _. 124 | 125 | tryT({'EXIT', {Reason, _Stack}}) -> 126 | exit(Reason); 127 | tryT({'EXIT', Reason}) -> 128 | exit(Reason); 129 | tryT(Result) -> 130 | Result. 131 | -------------------------------------------------------------------------------- /src/category/datum_cat_kleisli.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern: the category of monadic functions 3 | -module(datum_cat_kleisli). 4 | 5 | %% (/=) 6 | -export(['/='/1]). 7 | 8 | %% (.) operation 9 | -export(['.'/3, chain/1, curry/1]). 10 | 11 | %% 12 | %% 13 | '/='(Arrow) -> 14 | Arrow. 15 | 16 | 17 | %% 18 | %% compose function(s) using AST notation 19 | %% 20 | %% f(_) . g(_) -> m_state:'>>='(f(), fun(X) -> m_state:'>>='(g(X), ...) end) 21 | '.'(Monad, {monad, VarX, G}, {call, Ln, Ff0, Fa0}) -> 22 | VarN = {var, Ln, datum_cat:uuid()}, 23 | Expr = dot_expr(Monad, Ln, VarX, {call, Ln, Ff0, datum_cat:cc_bind_var(VarN, Fa0)}, G), 24 | {monad, VarN, Expr}; 25 | 26 | '.'(Monad, {monad, VarX, G}, {generate, Ln, Pattern, F}) -> 27 | Expr = dot_expr(Monad, Ln, Pattern, datum_cat:cc_bind_var(VarX, F), G), 28 | {monad, VarX, Expr}; 29 | 30 | '.'(Monad, {call, Ln, _, _} = F, G) -> 31 | VarN = {var, Ln, datum_cat:uuid()}, 32 | Expr = {call, Ln, {remote, Ln, {atom, Ln, Monad}, {atom, Ln, unit}}, [VarN]}, 33 | '.'(Monad, '.'(Monad, {monad, VarN, Expr}, F), G); 34 | 35 | '.'(Cat, {generate, _Ln, _Var, F}, G) -> 36 | %% ignore tail arrow 37 | '.'(Cat, F, G). 38 | 39 | %% 40 | %% 41 | dot_expr(Monad, Ln, Pattern, F, G) -> 42 | {call, Ln, 43 | {remote, Ln, {atom, Ln, Monad}, {atom, Ln, '>>='}}, 44 | [ 45 | F, 46 | {'fun', Ln, 47 | {clauses, 48 | [ 49 | {clause, Ln, [Pattern], [], [G]} 50 | ] 51 | } 52 | } 53 | ] 54 | }. 55 | 56 | 57 | %% 58 | %% return dot-composition chain. 59 | chain({monad, _, Expr}) -> 60 | Expr. 61 | 62 | %% 63 | %% curry do-composition chain into partial application 64 | curry({monad, VarX, {_, Ln, _, _} = Expr}) -> 65 | {'fun', Ln, 66 | {clauses, [ 67 | {clause, Ln, 68 | [VarX], 69 | [], 70 | [Expr] 71 | } 72 | ]} 73 | }. 74 | -------------------------------------------------------------------------------- /src/category/datum_cat_option.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern: option category 3 | -module(datum_cat_option). 4 | 5 | %% (/=) 6 | -export(['/='/1]). 7 | 8 | %% (.) operation 9 | -export(['.'/3, chain/1, curry/1]). 10 | 11 | %% category transformers 12 | -export([unit/1, fail/1, require/3, sequence/1, flatten/1, optionT/1, eitherT/1, tryT/1]). 13 | 14 | %% 15 | %% 16 | '/='(Arrow) -> 17 | Arrow. 18 | 19 | %% 20 | %% compose function(s) using AST notation 21 | %% 22 | %% f(_) . g(_) -> case f(_) of undefined -> undefined ; X -> g(X) end 23 | %% 24 | '.'(_, {option, VarX, G}, {call, Ln, Ff0, Fa0}) -> 25 | VarN = {var, Ln, datum_cat:uuid()}, 26 | Expr = dot_expr(Ln, VarX, {call, Ln, Ff0, datum_cat:cc_bind_var(VarN, Fa0)}, G), 27 | {option, VarN, Expr}; 28 | 29 | '.'(_, {option, VarX, G}, {generate, Ln, Pattern, F}) -> 30 | Expr = dot_expr(Ln, Pattern, datum_cat:cc_bind_var(VarX, F), G), 31 | {option, VarX, Expr}; 32 | 33 | '.'(Cat, {call, Ln, Ff0, Fa0}, G) -> 34 | VarN = {var, Ln, datum_cat:uuid()}, 35 | Expr = {call, Ln, Ff0, datum_cat:cc_bind_var(VarN, Fa0)}, 36 | '.'(Cat, {option, VarN, Expr}, G); 37 | 38 | '.'(Cat, {generate, _Ln, _Var, F}, G) -> 39 | %% ignore tail arrow 40 | '.'(Cat, F, G). 41 | 42 | %% 43 | %% 44 | dot_expr(Ln, Pattern, F, G) -> 45 | {'case', Ln, F, [ 46 | {clause, Ln, 47 | [{atom, Ln, undefined}], 48 | [], 49 | [{atom, Ln, undefined}] 50 | }, 51 | {clause, Ln, 52 | [Pattern], 53 | [], 54 | [G] 55 | } 56 | ]}. 57 | 58 | %% 59 | %% return dot-composition chain. 60 | chain({option, _, Expr}) -> 61 | Expr. 62 | 63 | %% 64 | %% curry do-composition chain into partial application 65 | curry({option, VarX, {'case', Ln, _, _} = Expr}) -> 66 | {'fun', Ln, 67 | {clauses, [ 68 | {clause, Ln, 69 | [VarX], 70 | [], 71 | [Expr] 72 | } 73 | ]} 74 | }. 75 | 76 | 77 | %%%------------------------------------------------------------------ 78 | %%% 79 | %%% transformers 80 | %%% 81 | %%%------------------------------------------------------------------ 82 | 83 | %% 84 | %% lifts a value to object of category 85 | -spec unit(_) -> datum:option(_). 86 | 87 | unit(X) -> 88 | X. 89 | 90 | %% 91 | %% lifts a failure to error object of category 92 | -spec fail(_) -> datum:option(_). 93 | 94 | fail(_) -> 95 | undefined. 96 | 97 | %% 98 | %% conditionally lifts a value to object or error of category 99 | -spec require(boolean(), _, _) -> datum:option(). 100 | 101 | require(true, X, _) -> 102 | X; 103 | require(false, _, _) -> 104 | undefined. 105 | 106 | %% 107 | %% transforms sequence of objects into object of category. 108 | -spec sequence([datum:option(_)]) -> datum:option([_]). 109 | 110 | sequence([undefined | _]) -> 111 | undefined; 112 | 113 | sequence([Head | Seq]) -> 114 | case sequence(Seq) of 115 | undefined -> 116 | undefined; 117 | Tail -> 118 | [Head | Tail] 119 | end; 120 | 121 | sequence([]) -> 122 | []. 123 | 124 | %% 125 | %% transforms nested objects into object of category 126 | -spec flatten(_) -> _. 127 | 128 | flatten(X) -> 129 | X. 130 | 131 | %% 132 | %% transforms option category to identity 133 | -spec optionT( datum:option() ) -> datum:option(_). 134 | 135 | optionT(X) -> 136 | X. 137 | 138 | %% 139 | %% 140 | -spec eitherT( datum:either(_) ) -> datum:option(_). 141 | 142 | eitherT({ok, X}) -> 143 | X; 144 | eitherT({error, _}) -> 145 | undefined. 146 | 147 | %% 148 | %% 149 | -spec tryT( _ ) -> datum:option(_). 150 | 151 | tryT({'EXIT', {_Reason, _Stack}}) -> 152 | undefined; 153 | tryT({'EXIT', _Reason}) -> 154 | undefined; 155 | tryT(Result) -> 156 | Result. 157 | 158 | -------------------------------------------------------------------------------- /src/category/datum_cat_reader.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern: pattern match 3 | -module(datum_cat_reader). 4 | 5 | %% (/=) 6 | -export(['/='/1]). 7 | 8 | %% (.) operation 9 | -export(['.'/3, chain/1, curry/1]). 10 | 11 | %% category transformers 12 | -export([unit/1, fail/1, require/4, sequence/2, flatten/2, optionT/2, optionT/3, eitherT/2, tryT/1]). 13 | 14 | 15 | '/='({call, Ln, Ff0, Fa0}) -> 16 | Fa1 = Fa0 ++ [{var, Ln, '_PatternGlobalEnvironment'}], 17 | {call, Ln, Ff0, Fa1}; 18 | 19 | '/='(Arrow) -> 20 | exit( lists:flatten(io_lib:format("Pattern category composition do not support the arrow of type: ~p", [Arrow])) ). 21 | 22 | %% 23 | %% compose function(s) using AST notation 24 | %% 25 | %% case f(_) of {error, _} = Err -> Err ; {ok, X} -> g(X) end 26 | %% 27 | '.'(_, {either, VarX, G}, {call, Ln, Ff0, Fa0}) -> 28 | {Fa1, VarN} = datum_cat:cc_derive(Fa0, []), 29 | Pattern = [{var, Ln, X} || X <- VarX], 30 | Expr = dot_expr(Ln, Pattern, {call, Ln, Ff0, Fa1}, G), 31 | {either, VarN, Expr}; 32 | 33 | '.'(_, {either, _VarX, G}, {generate, Ln, Pattern, F}) -> 34 | {Fa1, VarZ} = datum_cat:cc_derive(F, []), 35 | Expr = dot_expr(Ln, [Pattern], Fa1, G), 36 | {either, VarZ, Expr}; 37 | 38 | '.'(Cat, {call, Ln, Ff0, Fa0}, G) -> 39 | {Fa1, VarN} = datum_cat:cc_derive(Fa0, []), 40 | '.'(Cat, {either, VarN, {call, Ln, Ff0, Fa1}}, G); 41 | 42 | '.'(Cat, {generate, _Ln, _Var, F}, G) -> 43 | %% ignore tail arrow 44 | '.'(Cat, F, G). 45 | 46 | %% 47 | %% 48 | dot_expr(Ln, [], F, G) -> 49 | Err = datum_cat:uuid(), 50 | {'case', Ln, F, [ 51 | {clause, Ln, 52 | [{match, Ln, {tuple, Ln, [{atom, Ln, error}, {var, Ln, '_'}]}, {var, Ln, Err}}], 53 | [], 54 | [{var, Ln, Err}] 55 | }, 56 | {clause, Ln, 57 | [{var, Ln, '_'}], 58 | [], 59 | [G] 60 | } 61 | ]}; 62 | dot_expr(Ln, Pattern, F, G) -> 63 | Err = datum_cat:uuid(), 64 | {'case', Ln, F, [ 65 | {clause, Ln, 66 | [{tuple, Ln, [{atom, Ln, ok}|Pattern]}], 67 | [], 68 | [G] 69 | }, 70 | {clause, Ln, 71 | [{match, Ln, {tuple, Ln, [{atom, Ln, error}, {var, Ln, '_'}]}, {var, Ln, Err}}], 72 | [], 73 | [{var, Ln, Err}] 74 | } 75 | ]}. 76 | 77 | %% 78 | %% map compose to expression 79 | %% 80 | chain({either, _, {'case', Ln, _, _} = Expr}) -> 81 | {'fun', Ln, 82 | {clauses, [ 83 | {clause, Ln, 84 | [{var, Ln, '_PatternGlobalEnvironment'}], 85 | [], 86 | [Expr] 87 | } 88 | ]} 89 | }. 90 | 91 | %% 92 | %% map compose to partial expression 93 | %% 94 | curry({either, VarX, {'case', Ln, _, _}} = Either) -> 95 | {'fun', Ln, 96 | {clauses, [ 97 | {clause, Ln, 98 | [{var, Ln, X} || X <- VarX], 99 | [], 100 | [chain(Either)] 101 | } 102 | ]} 103 | }. 104 | 105 | %%%------------------------------------------------------------------ 106 | %%% 107 | %%% transformers 108 | %%% 109 | %%%------------------------------------------------------------------ 110 | 111 | %% 112 | %% lifts a value to object of category 113 | -spec unit(_) -> datum:either(_). 114 | 115 | unit(X) -> 116 | {ok, X}. 117 | 118 | 119 | %% 120 | %% lifts a failure to error object of category 121 | -spec fail(_) -> datum:either(_). 122 | 123 | fail(X) -> 124 | {error, X}. 125 | 126 | %% 127 | %% conditionally lifts a value to object or error of category 128 | -spec require(boolean(), _, _, _) -> datum:either(). 129 | 130 | require(true, X, _, _) -> 131 | {ok, X}; 132 | require(false, _, X, _) -> 133 | {error, X}. 134 | 135 | %% 136 | %% transforms sequence of objects into object of category. 137 | -spec sequence([datum:either(_)], _) -> datum:either([_]). 138 | 139 | sequence([{ok, Head} | Seq], Env) -> 140 | case sequence(Seq, Env) of 141 | {ok, Tail} -> 142 | {ok, [Head|Tail]}; 143 | {error, _} = Error -> 144 | Error 145 | end; 146 | 147 | sequence([{error, _} = Error | _], _Env) -> 148 | Error; 149 | 150 | sequence([], _Env) -> 151 | {ok, []}. 152 | 153 | 154 | %% 155 | %% transforms nested objects into object of category 156 | -spec flatten(datum:either(datum:either(_)), _) -> datum:either(_). 157 | 158 | flatten({ok, {ok, _} = X}, Env) -> 159 | flatten(X, Env); 160 | flatten({ok, {error, _} = X}, Env) -> 161 | flatten(X, Env); 162 | flatten({error, {ok, _} = X}, Env) -> 163 | flatten(X, Env); 164 | flatten({error, {error, _} = X}, Env) -> 165 | flatten(X, Env); 166 | flatten({ok, _} = X, _Env) -> 167 | X; 168 | flatten({error, _} = X, _Env) -> 169 | X. 170 | 171 | 172 | %% 173 | %% transforms option category to identity 174 | -spec optionT( datum:option(), _ ) -> datum:either(_). 175 | 176 | optionT(undefined, _) -> 177 | {error, undefined}; 178 | optionT(X, _) -> 179 | {ok, X}. 180 | 181 | optionT(Reason, undefined, _) -> 182 | {error, Reason}; 183 | optionT(_, X, _) -> 184 | {ok, X}. 185 | 186 | %% 187 | %% 188 | -spec eitherT( datum:either(_), _ ) -> datum:either(_). 189 | 190 | eitherT({ok, _} = X, _) -> 191 | X; 192 | eitherT({error, _} = X, _) -> 193 | X. 194 | 195 | %% 196 | %% 197 | -spec tryT( _ ) -> datum:either(_). 198 | 199 | tryT({'EXIT', {Reason, _Stack}}) -> 200 | {error, Reason}; 201 | tryT({'EXIT', Reason}) -> 202 | {error, Reason}; 203 | tryT({ok, _} = Result) -> 204 | Result; 205 | tryT({error, _} = Result) -> 206 | Result; 207 | tryT(Result) -> 208 | {ok, Result}. 209 | 210 | 211 | 212 | -------------------------------------------------------------------------------- /src/category/datum_cat_undefined.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% category pattern: undefined category 3 | -module(datum_cat_undefined). 4 | 5 | %% (/=) 6 | -export(['/='/1]). 7 | 8 | %% (.) operation 9 | -export(['.'/3, chain/1, curry/1]). 10 | 11 | %% category transformers 12 | -export([unit/1, fail/1, require/3, sequence/1, flatten/1, optionT/1, eitherT/1, tryT/1]). 13 | 14 | %% 15 | %% 16 | '/='(Arrow) -> 17 | Arrow. 18 | 19 | %% 20 | %% compose function(s) using AST notation 21 | %% 22 | %% f(_) . g(_) -> case f(_) of X when X =:= undefined -> g(X) ; X -> X end 23 | %% 24 | '.'(_, {undefined, VarX, G}, {call, Ln, Ff0, Fa0}) -> 25 | VarN = datum_cat:uuid(), 26 | Expr = dot_expr(Ln, VarX, {call, Ln, Ff0, datum_cat:cc_bind_var({var, Ln, VarN}, Fa0)}, G), 27 | {undefined, VarN, Expr}; 28 | 29 | '.'(_, {undefined, VarX, G}, {generate, Ln, {var, _, VarN}, F}) -> 30 | Expr = dot_expr(Ln, VarN, datum_cat:cc_bind_var({var, Ln, VarX}, F), G), 31 | {undefined, VarX, Expr}; 32 | 33 | '.'(Cat, {call, Ln, Ff0, Fa0}, G) -> 34 | VarN = datum_cat:uuid(), 35 | Expr = {call, Ln, Ff0, datum_cat:cc_bind_var({var, Ln, VarN}, Fa0)}, 36 | '.'(Cat, {undefined, VarN, Expr}, G); 37 | 38 | '.'(Cat, {generate, _Ln, _Var, F}, G) -> 39 | %% ignore tail arrow 40 | '.'(Cat, F, G). 41 | 42 | %% 43 | %% 44 | dot_expr(Ln, VarX, F, G) -> 45 | {'case', Ln, F, [ 46 | {clause, Ln, 47 | [{var, Ln, VarX}], 48 | [[{op, Ln, '=:=', {var, Ln, VarX}, {atom, Ln, undefined}}]], 49 | [G] 50 | }, 51 | {clause, Ln, 52 | [{var, Ln, VarX}], 53 | [], 54 | [{var, Ln, VarX}] 55 | } 56 | ]}. 57 | 58 | %% 59 | %% return dot-composition chain. 60 | chain({undefined, _, Expr}) -> 61 | Expr. 62 | 63 | %% 64 | %% curry do-composition chain into partial application 65 | curry({undefined, VarX, {'case', Ln, _, _} = Expr}) -> 66 | {'fun', Ln, 67 | {clauses, [ 68 | {clause, Ln, 69 | [{var, Ln, VarX}], 70 | [], 71 | [Expr] 72 | } 73 | ]} 74 | }. 75 | 76 | 77 | %%%------------------------------------------------------------------ 78 | %%% 79 | %%% transformers 80 | %%% 81 | %%%------------------------------------------------------------------ 82 | 83 | %% 84 | %% lifts a value to object of category 85 | -spec unit(_) -> datum:option(_). 86 | 87 | unit(_) -> 88 | undefined. 89 | 90 | %% 91 | %% lifts a failure to error object of category 92 | -spec fail(_) -> datum:option(_). 93 | 94 | fail(X) -> 95 | X. 96 | 97 | %% 98 | %% conditionally lifts a value to object or error of category 99 | -spec require(boolean(), _, _) -> datum:option(). 100 | 101 | require(true, _, _) -> 102 | undefined; 103 | require(false, _, X) -> 104 | X. 105 | 106 | %% 107 | %% transforms sequence of objects into object of category. 108 | -spec sequence([datum:option(_)]) -> datum:option([_]). 109 | 110 | sequence([undefined | _]) -> 111 | undefined; 112 | 113 | sequence([Head | Seq]) -> 114 | case sequence(Seq) of 115 | undefined -> 116 | undefined; 117 | Tail -> 118 | [Head | Tail] 119 | end; 120 | 121 | sequence([]) -> 122 | []. 123 | 124 | %% 125 | %% transforms nested objects into object of category 126 | -spec flatten(_) -> _. 127 | 128 | flatten(X) -> 129 | X. 130 | 131 | %% 132 | %% transforms option category to identity 133 | -spec optionT( datum:option() ) -> datum:option(_). 134 | 135 | optionT(X) -> 136 | X. 137 | 138 | %% 139 | %% 140 | -spec eitherT( datum:either(_) ) -> datum:option(_). 141 | 142 | eitherT({ok, X}) -> 143 | X; 144 | eitherT({error, _}) -> 145 | undefined. 146 | 147 | %% 148 | %% 149 | -spec tryT( _ ) -> datum:option(_). 150 | 151 | tryT({'EXIT', {_Reason, _Stack}}) -> 152 | undefined; 153 | tryT({'EXIT', _Reason}) -> 154 | undefined; 155 | tryT(Result) -> 156 | Result. 157 | 158 | -------------------------------------------------------------------------------- /src/datum.app.src: -------------------------------------------------------------------------------- 1 | {application, datum, 2 | [ 3 | {description, "pure functional and generic programming"}, 4 | {vsn, "git"}, 5 | {modules, []}, 6 | {registered, []}, 7 | {applications,[ 8 | kernel, 9 | stdlib 10 | ]}, 11 | {env, []}, 12 | 13 | {licenses, ["Apache"]}, 14 | {links, [ 15 | {"GitHub", "https://github.com/fogfish/datum"} 16 | ]} 17 | ] 18 | }. 19 | -------------------------------------------------------------------------------- /src/datum.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2012 - 2013 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @description 17 | %% pure functional data structures 18 | -module(datum). 19 | 20 | -include("datum.hrl"). 21 | 22 | -export([ 23 | compare/2 24 | ]). 25 | 26 | %% 27 | %% types 28 | -type option(X) :: undefined | X. 29 | 30 | -type either(L, R) :: {error, L} | {ok, R}. 31 | -type either() :: {error, _} | ok. 32 | -type either(R) :: {error, _} | {ok, R}. 33 | -type either(L, R1, R2) :: {error, L} | {ok, R1, R2}. 34 | 35 | -type foldable(T) :: T. 36 | -type traversable(T) :: T. 37 | -type maplike() :: _. 38 | -type topological() :: _. 39 | 40 | -type tree(T) :: {t, compare(T), _}. 41 | -type heap(T) :: {h, compare(T), _}. 42 | -type stream(T) :: #stream{head :: T, tail :: datum:option(fun(() -> T))}. 43 | -type q(T) :: {q, integer(), [T], [T]}. 44 | 45 | -type ring() :: tuple(). 46 | 47 | -type monoid(T) :: fun((T, T) -> T). 48 | -type predicate(T) :: fun((T) -> true | false). 49 | -type effect(T) :: fun((T) -> ok). 50 | -type compare(T) :: fun((T, T) -> eq | gt | lt). 51 | 52 | -type lens(A, S) :: fun( (fun( (A) -> _ ), S) -> _ ). 53 | -type lens() :: lens(_, _). 54 | 55 | -export_type([ 56 | option/1, 57 | either/0, 58 | either/1, 59 | either/2, 60 | either/3, 61 | 62 | foldable/1, 63 | traversable/1, 64 | maplike/0, 65 | topological/0, 66 | 67 | tree/1, 68 | heap/1, 69 | stream/1, 70 | q/1, 71 | 72 | ring/0, 73 | 74 | monoid/1, 75 | predicate/1, 76 | effect/1, 77 | compare/1, 78 | 79 | lens/2, 80 | lens/0 81 | ]). 82 | 83 | 84 | %% 85 | %% compare two instances, default implementation 86 | -spec compare(_, _) -> eq | gt | lt. 87 | 88 | compare(A, B) when A =:= B -> eq; 89 | compare(A, B) when A > B -> gt; 90 | compare(A, B) when A < B -> lt. 91 | -------------------------------------------------------------------------------- /src/foldable.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% Class of data structures that can be folded to a single value. 3 | -module(foldable). 4 | 5 | -export([behaviour_info/1]). 6 | 7 | behaviour_info(callbacks) -> 8 | [ 9 | %% 10 | %% Combine elements of a structure using a monoid 11 | %% (with an associative binary operation) 12 | %% 13 | %% -spec fold(datum:monoid(_), _, datum:foldable(_)) -> _. 14 | {fold, 3}, 15 | 16 | %% 17 | %% Left-associative fold of a structure 18 | %% 19 | %% -spec foldl(datum:monoid(_), _, datum:foldable(_)) -> _. 20 | {foldl, 3}, 21 | 22 | %% 23 | %% Right-associative fold of a structure 24 | %% 25 | %% -spec foldr(datum:monoid(_), _, datum:foldable(_)) -> _. 26 | {foldr, 3}, 27 | 28 | %% 29 | %% The fundamental recursive structure constructor, 30 | %% it applies a function to each previous seed element in turn 31 | %% to determine the next element. 32 | %% 33 | %% -spec unfold(fun((_) -> _), _) -> datum:foldable(_). 34 | {unfold, 2} 35 | ]; 36 | behaviour_info(_Other) -> 37 | undefined. 38 | -------------------------------------------------------------------------------- /src/maplike.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% map-like collection associates keys of type K to values of type V 3 | -module(maplike). 4 | 5 | -export([behaviour_info/1]). 6 | -export([ 7 | build/2, 8 | build/3, 9 | 10 | keys/2 11 | ]). 12 | 13 | behaviour_info(callbacks) -> 14 | [ 15 | %% 16 | %% append a new key/value pair to collection 17 | %% 18 | %% -spec append({key(_), val(_)}, datum:maplike(_, _)) -> datum:maplike(_, _). 19 | {append, 2}, 20 | 21 | %% 22 | %% insert a new a key/value pair to collection 23 | %% 24 | %% -spec insert(key(_), val(_), datum:maplike(_, _)) -> datum:maplike(_, _). 25 | {insert, 3}, 26 | 27 | %% 28 | %% optionally returns the value associated with key 29 | %% 30 | %% -spec lookup(key(_), datum:maplike(_, _)) -> datum:option( val(_) ). 31 | {lookup, 2}, 32 | 33 | %% 34 | %% remove key/value pair from collection 35 | %% 36 | %% -spec remove(key(_), datum:maplike(_, _)) -> datum:maplike(_, _). 37 | {remove, 2}, 38 | 39 | %% 40 | %% check if the collection has an association 41 | %% 42 | %% -spec has(key(_), datum:maplike(_, _)) -> true | false. 43 | {has, 2}, 44 | 45 | %% 46 | %% collects all keys of this collection to list 47 | %% 48 | %% -spec keys(datum:maplike(_, _)) -> [_]. 49 | {keys, 1}, 50 | 51 | %% 52 | %% optionally apply a function to value associated with key 53 | %% 54 | %% -spec apply(key(_), fun((datum:option(_)) -> _), datum:maplike(_, _)) -> datum:maplike(_, _). 55 | {apply, 3} 56 | ]; 57 | behaviour_info(_Other) -> 58 | undefined. 59 | 60 | 61 | %% 62 | %% build map-like structure from another one 63 | -spec build(atom(), [_]) -> datum:maplike(_, _). 64 | 65 | build(Type, Any) -> 66 | build(Type, fun datum:compare/2, Any). 67 | 68 | 69 | %% 70 | %% build map-like structure from another one 71 | -spec build(atom(), datum:compare(_), [_]) -> datum:maplike(_, _). 72 | 73 | build(Type, Ord, List) 74 | when is_list(List) -> 75 | lists:foldl(fun Type:append/2, Type:new(Ord), List). 76 | 77 | 78 | %% 79 | %% collects all keys of this collection to list 80 | -spec keys(atom(), datum:maplike(_, _)) -> [_]. 81 | 82 | keys(Type, MapLike) -> 83 | Type:foldr(fun({K, _}, Acc) -> [K|Acc] end, [], MapLike). 84 | 85 | -------------------------------------------------------------------------------- /src/maplike/htree.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2012 - 2013 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @description 17 | %% hash tree - functional data structure for large set reconciliation 18 | -module(htree). 19 | 20 | -export([ 21 | new/0, 22 | build/1, 23 | insert/3, 24 | lookup/2, 25 | remove/2, 26 | foldl/3, 27 | foldr/3, 28 | foreach/2, 29 | hash/1, 30 | hash/2, 31 | evict/2, 32 | diff/2, 33 | list/1 34 | ]). 35 | 36 | 37 | %% 38 | %% hash tree configuration 39 | -define(HASH(X), crypto:hash(sha, X)). %% hash function 40 | -define(BITS, 160). %% width of hash function 41 | -define(NULL, nil). %% empty node 42 | 43 | %% 44 | %% width and node capacity impacts on tree performance 45 | %% smaller capacity faster reconciliation due to excessive node eviction 46 | %% but higher demand on memory consumption 47 | -ifndef(CONFIG_HTREE_CAPACITY). 48 | -define(CONFIG_HTREE_CAPACITY, 4). 49 | -endif. 50 | 51 | -ifndef(CONFIG_HTREE_WIDTH). 52 | -define(CONFIG_HTREE_WIDTH, 2). 53 | -endif. 54 | 55 | -export_type([inner/0, tree/0, leaf/0]). 56 | 57 | %% 58 | %% data types 59 | -type(leaf() :: [{key(), val()}]). %% leaf node container 60 | -type(inner() :: [tree()]). %% tree node container 61 | -type(tree() :: {n, hash(), integer(), inner() | leaf()} | ?NULL). 62 | -type(hash() :: binary()). 63 | -type(key() :: any()). 64 | -type(val() :: any()). 65 | -type(sign() :: {hash, integer(), [hash()]}). 66 | 67 | %% tree nodes 68 | -record(n, {hash, uid = 0, nodes = []}). 69 | 70 | %% 71 | %% create new hash tree 72 | -spec new() -> datum:tree(). 73 | 74 | new() -> 75 | {t, ?NULL}. 76 | 77 | %% 78 | %% build tree from data type 79 | -spec build([{key(), val()}]) -> datum:tree(). 80 | 81 | build(List) -> 82 | lists:foldl( 83 | fun({Key, Val}, Acc) -> insert(Key, Val, Acc) end, 84 | new(), 85 | List 86 | ). 87 | 88 | %% 89 | %% insert element to hash tree 90 | -spec insert(key(), val(), datum:tree()) -> datum:tree(). 91 | 92 | insert(K, V, {t, T}) -> 93 | {_, Tx} = ht_insert(fhash(K), V, T), 94 | {t, Tx}. 95 | 96 | ht_insert(H, V, ?NULL) -> 97 | ht_insert(H, V, #n{}); 98 | ht_insert(H, V, T) -> 99 | ht_insert(1, H, V, T). 100 | 101 | ht_insert(_, H, V, ?NULL) -> 102 | %% insert new leaf node 103 | {H, {H, V}}; 104 | ht_insert(_, H, V, {H, _}) -> 105 | %% update existing leaf node 106 | {undefined, {H, V}}; 107 | ht_insert(L, H, V, #n{hash = Hash, nodes = Nodes}=T) -> 108 | {value, N, NN} = ht_select(uid(L, H), H, Nodes), %% peek next child on path 109 | {Hx, Nx} = ht_insert(L + 1, H, V, N), %% insert key/val 110 | {Hx, ht_split(L, T#n{hash = hadd(Hx, Hash), nodes = [Nx | NN]})}. 111 | 112 | %% 113 | %% select node on path 114 | ht_select(_, _, []) -> 115 | {value, ?NULL, []}; 116 | ht_select(I, _, [#n{ } | _]=NN) -> 117 | case lists:keytake(I, #n.uid, NN) of 118 | false -> 119 | {value, #n{uid=I}, NN}; 120 | Value -> 121 | Value 122 | end; 123 | ht_select(_, H, [{_, _} | _]=NN) -> 124 | case lists:keytake(H, 1, NN) of 125 | false -> 126 | {value, ?NULL, NN}; 127 | Value -> 128 | Value 129 | end. 130 | 131 | %% 132 | %% split leaf node 133 | ht_split(L, #n{nodes = [{_, _} | _]=Nodes}=T) 134 | when length(Nodes) > ?CONFIG_HTREE_CAPACITY -> 135 | X = lists:foldr( 136 | fun({H, V}, Acc) -> 137 | I = uid(L, H), 138 | {value, N, NN} = case lists:keytake(I, #n.uid, Acc) of 139 | false -> 140 | {value, #n{uid=I}, Acc}; 141 | Value -> 142 | Value 143 | end, 144 | {_, Nx} = ht_insert(L + 1, H, V, N), 145 | [Nx | NN] 146 | end, 147 | [], 148 | Nodes 149 | ), 150 | T#n{nodes = X}; 151 | ht_split(_, T) -> 152 | T. 153 | 154 | 155 | %% 156 | %% lookup element 157 | -spec lookup(key(), datum:tree()) -> val() | undefined. 158 | 159 | lookup(K, {t, T}) -> 160 | ht_lookup(fhash(K), T). 161 | 162 | ht_lookup(H, T) -> 163 | ht_lookup(1, H, T). 164 | 165 | ht_lookup(_, _, ?NULL) -> 166 | undefined; 167 | ht_lookup(_, H, {H,V}) -> 168 | V; 169 | ht_lookup(L, H, #n{nodes = Nodes}) -> 170 | {value, N, _} = ht_select(uid(L, H), H, Nodes), 171 | ht_lookup(L + 1, H, N). 172 | 173 | %% 174 | %% remove element 175 | -spec remove(key(), datum:tree()) -> datum:tree(). 176 | 177 | remove(K, {t, T}) -> 178 | {_, Tx} = ht_remove(fhash(K), T), 179 | {t, Tx}. 180 | 181 | ht_remove(H, T) -> 182 | ht_remove(1, H, T). 183 | 184 | ht_remove(_, _, ?NULL) -> 185 | {undefined, ?NULL}; 186 | ht_remove(_, H, {H,_}) -> 187 | {H, ?NULL}; 188 | ht_remove(L, H, #n{hash = Hash, nodes = Nodes}=T) -> 189 | {value, N, NN} = ht_select(uid(L, H), H, Nodes), %% peek next child on path 190 | case {ht_remove(L + 1, H, N), NN} of 191 | {{Hx, ?NULL}, []} -> 192 | {Hx, ?NULL}; 193 | {{Hx, ?NULL}, _} -> 194 | {Hx, T#n{hash = hsub(Hx, Hash), nodes = NN}}; 195 | {{Hx, Nx}, _} -> 196 | {Hx, T#n{hash = hsub(Hx, Hash), nodes = [Nx | NN]}} 197 | end. 198 | 199 | %% 200 | %% fold function over tree 201 | -spec foldl(function(), any(), datum:tree()) -> any(). 202 | 203 | foldl(Fun, Acc, {t, T}) -> 204 | ht_foldl(Fun, Acc, T). 205 | 206 | ht_foldl(_Fun, Acc0, ?NULL) -> 207 | Acc0; 208 | ht_foldl(Fun, Acc0, {H,V}) -> 209 | Fun(H, V, Acc0); 210 | ht_foldl(Fun, Acc0, #n{nodes = Nodes}) -> 211 | lists:foldl(fun(X, Acc) -> ht_foldl(Fun, Acc, X) end, Acc0, Nodes). 212 | 213 | %% 214 | %% fold function over tree 215 | -spec foldr(function(), any(), datum:tree()) -> any(). 216 | 217 | foldr(Fun, Acc, {t, T}) -> 218 | ht_foldr(Fun, Acc, T). 219 | 220 | ht_foldr(_Fun, Acc0, ?NULL) -> 221 | Acc0; 222 | ht_foldr(Fun, Acc0, {H,V}) -> 223 | Fun(H, V, Acc0); 224 | ht_foldr(Fun, Acc0, #n{nodes = Nodes}) -> 225 | lists:foldr(fun(X, Acc) -> ht_foldr(Fun, Acc, X) end, Acc0, Nodes). 226 | 227 | %% 228 | %% apply side-effect function to each element 229 | -spec foreach(function(), datum:tree()) -> ok. 230 | 231 | foreach(Fun, {t, T}) -> 232 | ht_foreach(Fun, T). 233 | 234 | ht_foreach(_Fun, ?NULL) -> 235 | ok; 236 | ht_foreach(Fun, {H,V}) -> 237 | Fun(H, V); 238 | ht_foreach(Fun, #n{nodes = Nodes}) -> 239 | lists:foreach(fun(X) -> ht_foreach(Fun, X) end, Nodes). 240 | 241 | 242 | %% 243 | %% return list of signatures at level 244 | -spec hash(datum:tree()) -> sign(). 245 | -spec hash(integer(), datum:tree()) -> sign() | undefined. 246 | 247 | hash(T) -> 248 | {hash, -1, foldl(fun(H, _, Acc) -> gb_sets:add(H, Acc) end, gb_sets:new(), T)}. 249 | 250 | hash(L, {t, T}) -> 251 | Hashes = ht_hash(L, T), 252 | case gb_sets:is_empty(Hashes) of 253 | true -> 254 | undefined; 255 | false -> 256 | {hash, L, Hashes} 257 | end. 258 | 259 | ht_hash(_, ?NULL) -> 260 | gb_sets:new(); 261 | ht_hash(L, T) -> 262 | ht_hash(L, gb_sets:new(), T). 263 | ht_hash(0, Acc, #n{hash = Hash}) -> 264 | gb_sets:add(Hash, Acc); 265 | ht_hash(L, Acc0, #n{nodes = Nodes}) -> 266 | lists:foldl(fun(X, Acc) -> ht_hash(L - 1, Acc, X) end, Acc0, Nodes); 267 | ht_hash(_, Acc0, _) -> 268 | Acc0. 269 | 270 | %% 271 | %% evict subtrees that matches a signature 272 | -spec evict(sign(), datum:tree()) -> datum:tree(). 273 | 274 | evict({hash, L, Hashes}, {t, T}) -> 275 | {t, ht_evict(L, Hashes, T)}. 276 | 277 | ht_evict(_,_Hashes, ?NULL) -> 278 | ?NULL; 279 | ht_evict(0, Hashes, #n{hash = Hash}=T) -> 280 | case gb_sets:is_member(Hash, Hashes) of 281 | true -> 282 | ?NULL; 283 | false -> 284 | T 285 | end; 286 | ht_evict(L, Hashes, {H, _}=T) 287 | when L < 0 -> 288 | case gb_sets:is_member(H, Hashes) of 289 | true -> 290 | ?NULL; 291 | false -> 292 | T 293 | end; 294 | ht_evict(_,_Hashes, {_, _}=T) -> 295 | T; 296 | ht_evict(L, Hashes, #n{nodes = Nodes}=T) -> 297 | case ht_evict_bits(L, Hashes, Nodes) of 298 | [] -> 299 | ?NULL; 300 | X -> 301 | T#n{nodes = X} 302 | end. 303 | 304 | ht_evict_bits(L, Hashes, Nodes) -> 305 | lists:foldl( 306 | fun(Node0, Acc) -> 307 | case ht_evict(L - 1, Hashes, Node0) of 308 | ?NULL -> 309 | Acc; 310 | Node -> 311 | [Node | Acc] 312 | end 313 | end, 314 | [], 315 | Nodes 316 | ). 317 | 318 | 319 | %% 320 | %% calculate difference of signature or tree 321 | -spec diff(sign() | datum:tree(), sign() | datum:tree()) -> sign() | datum:tree(). 322 | 323 | diff({hash, LA, HA}, {hash, LB, HB}) 324 | when LA =:= LB -> 325 | {hash, LA, gb_sets:intersection(HA, HB)}; 326 | diff({hash, LA, _}, {hash, LB, _}) -> 327 | {hash, erlang:min(LA, LB), gb_sets:new()}; 328 | diff({t, _}=A, {t, _}=B) -> 329 | ht_diff(0, A, B). 330 | 331 | ht_diff(_, {t, nil}=A, B) -> 332 | {A, B}; 333 | ht_diff(_, A, {t, nil}=B) -> 334 | {A, B}; 335 | ht_diff(L, A, B) -> 336 | case {hash(L, A), hash(L, B)} of 337 | %% bottom of tree is reached, evict leaves 338 | {undefined, _} -> 339 | I = diff(hash(A), hash(B)), 340 | {evict(I, A), evict(I, B)}; 341 | %% bottom of tree is reached, evict leaves 342 | {_, undefined} -> 343 | I = diff(hash(A), hash(B)), 344 | {evict(I, A), evict(I, B)}; 345 | {HA, HB} -> 346 | I = diff(HA, HB), 347 | ht_diff(L + 1, evict(I, A), evict(I, B)) 348 | end. 349 | 350 | %% 351 | %% 352 | list(T) -> 353 | foldr(fun(_, V, Acc) -> [V|Acc] end, [], T). 354 | 355 | 356 | %%%------------------------------------------------------------------ 357 | %%% 358 | %%% private 359 | %%% 360 | %%%------------------------------------------------------------------ 361 | 362 | %% 363 | %% calculate node identity (offset) at level L 364 | uid(0, _) -> 365 | 0; 366 | uid(L, Hash) -> 367 | Skip = (L - 1) * ?CONFIG_HTREE_WIDTH, 368 | <<_:Skip, Val:?CONFIG_HTREE_WIDTH, _/bitstring>> = Hash, 369 | Val. 370 | 371 | %% 372 | %% hash function 373 | fhash(X) 374 | when is_binary(X) -> 375 | ?HASH(X); 376 | fhash(X) -> 377 | ?HASH(erlang:term_to_binary(X)). 378 | 379 | %% 380 | %% hash add 381 | hadd(undefined, Y) -> 382 | Y; 383 | hadd(X, undefined) -> 384 | X; 385 | hadd(X, Y) -> 386 | <> = X, 387 | <> = Y, 388 | <<(A bxor B):?BITS>>. 389 | 390 | %% 391 | %% hash subtract 392 | hsub(X, Y) -> 393 | hadd(X, Y). 394 | 395 | 396 | 397 | 398 | -------------------------------------------------------------------------------- /src/monad/m_identity.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2016 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @doc 17 | %% identity monad 18 | -module(m_identity). 19 | 20 | -export([unit/1, fail/1, '>>='/2, putT/1, getT/1]). 21 | 22 | -type m(A) :: A. 23 | -type f(A, B) :: fun((A) -> m(B)). 24 | 25 | %% 26 | %% 27 | -spec unit(A) -> m(A). 28 | 29 | unit(X) -> 30 | X. 31 | 32 | %% 33 | %% 34 | -spec fail(_) -> _. 35 | 36 | fail(X) -> 37 | throw(X). 38 | 39 | %% 40 | %% 41 | -spec '>>='(m(A), f(A, B)) -> m(B). 42 | 43 | '>>='(X, Fun) -> 44 | Fun(X). 45 | 46 | %% 47 | %% 48 | -spec putT(_) -> m(_). 49 | 50 | putT(X) -> 51 | X. 52 | 53 | %% 54 | %% 55 | -spec getT(_) -> m(_). 56 | 57 | getT(X) -> 58 | X. 59 | -------------------------------------------------------------------------------- /src/monad/m_io.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2016 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @doc 17 | %% IO monad 18 | -module(m_io). 19 | 20 | -export([unit/1, fail/1, '>>='/2]). 21 | 22 | -type m(A) :: fun(( ) -> A). 23 | -type f(A, B) :: fun((A) -> m(B)). 24 | 25 | %% 26 | %% 27 | -spec unit(A) -> m(A). 28 | 29 | unit(X) -> 30 | fun() -> X end. 31 | 32 | %% 33 | %% 34 | -spec fail(_) -> _. 35 | 36 | fail(X) -> 37 | throw(X). 38 | 39 | %% 40 | %% 41 | -spec '>>='(m(A), f(A, B)) -> m(B). 42 | 43 | '>>='(IO, Fn) -> 44 | join(fmap(Fn, IO)). 45 | 46 | 47 | %% 48 | %% 49 | -spec join( m(m(A)) ) -> m(A). 50 | 51 | join(IO) -> 52 | fun() -> 53 | ( IO() )() 54 | end. 55 | 56 | %% 57 | %% 58 | -spec fmap(fun((A) -> B), m(A)) -> m(B). 59 | 60 | fmap(Fun, IO) -> 61 | fun() -> Fun(IO()) end. 62 | -------------------------------------------------------------------------------- /src/monad/m_state.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2016 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @doc 17 | %% state monad 18 | -module(m_state). 19 | 20 | -export([unit/1, fail/1, '>>='/2]). 21 | -export([put/2, get/1]). 22 | 23 | -type m(A) :: fun((_) -> [A|_]). 24 | -type f(A, B) :: fun((A) -> m(B)). 25 | 26 | %% 27 | %% 28 | -spec unit(A) -> m(A). 29 | 30 | unit(X) -> 31 | fun(State) -> [X|State] end. 32 | 33 | 34 | %% 35 | %% 36 | -spec fail(_) -> _. 37 | 38 | fail(X) -> 39 | throw(X). 40 | 41 | 42 | %% 43 | %% 44 | -spec '>>='(m(A), f(A, B)) -> m(B). 45 | 46 | '>>='(X, Fun) -> 47 | join(fmap(Fun, X)). 48 | 49 | %% 50 | %% 51 | -spec join( m(m(A)) ) -> m(A). 52 | 53 | join(IO) -> 54 | fun(State) -> 55 | [Fun|Y] = IO(State), 56 | Fun(Y) 57 | end. 58 | 59 | %% 60 | %% 61 | -spec fmap(fun((A) -> B), m(A)) -> m(B). 62 | 63 | fmap(Fun, IO) -> 64 | fun(State) -> 65 | [A|Y]=IO(State), 66 | [Fun(A)|Y] 67 | end. 68 | 69 | %% 70 | %% 71 | get(Ln) -> 72 | fun(State) -> 73 | [lens:get(Ln, State)|State] 74 | end. 75 | 76 | %% 77 | %% 78 | put(Ln, X) -> 79 | fun(State) -> 80 | [X|lens:put(Ln, X, State)] 81 | end. 82 | -------------------------------------------------------------------------------- /src/queue/deq.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2012 - 2013 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @description 17 | %% double ended queue 18 | -module(deq). 19 | -behaviour(traversable). 20 | -behaviour(foldable). 21 | 22 | -include("datum.hrl"). 23 | 24 | -export([ 25 | new/0, %% O(1) 26 | build/1, %% O(n) 27 | 28 | %% 29 | %% queue 30 | enq/2, %% O(1) 31 | deq/1, %% O(1) 32 | enqh/2, %% O(1) 33 | deqt/1, %% O(1) 34 | last/1, 35 | liat/1, 36 | 37 | %% 38 | %% traversable 39 | list/1, 40 | head/1, %% O(1) 41 | tail/1, %% O(1) 42 | is_empty/1, %% O(1) 43 | drop/2, %% O(n) 44 | dropwhile/2, %% O(n) 45 | filter/2, %% O(n) 46 | foreach/2, %% O(n) 47 | map/2, %% O(n) 48 | split/2, %% O(n) 49 | splitwhile/2, %% 50 | take/2, 51 | takewhile/2, 52 | 53 | %% 54 | %% foldable 55 | fold/3, 56 | foldl/3, 57 | foldr/3, 58 | unfold/2, 59 | 60 | % utility interface 61 | length/1 62 | ]). 63 | 64 | %% 65 | %% create new empty queue 66 | -spec new() -> datum:q(_). 67 | 68 | new() -> 69 | q:new(). 70 | 71 | %% 72 | %% build tree from another traversable structure 73 | -spec build(_) -> datum:q(_). 74 | 75 | build(List) -> 76 | q:build(List). 77 | 78 | 79 | %% 80 | %% enqueue element to end of queue 81 | -spec enq(_, datum:q(_)) -> datum:q(_). 82 | 83 | enq(E, #queue{} = Queue) -> 84 | q:enq(E, Queue). 85 | 86 | %% 87 | %% dequeue element from head of queue 88 | -spec deq(datum:q(_)) -> {datum:option(_), datum:q(_)}. 89 | 90 | deq(#queue{} = Queue) -> 91 | q:deq(Queue). 92 | 93 | 94 | %% 95 | %% enqueue element to front of the queue 96 | -spec enqh(_, datum:q(_)) -> datum:q(_). 97 | 98 | enqh(E, #queue{length = N, head = [_] = Head, tail = []}) -> 99 | #queue{length = N + 1, head = [E], tail = Head}; 100 | 101 | enqh(E, #queue{length = N, head = Head} = Queue) -> 102 | Queue#queue{length = N + 1, head = [E|Head]}. 103 | 104 | 105 | %% 106 | %% dequeue element from tail of queue 107 | -spec deqt(datum:q(_)) -> {datum:option(_), datum:q(_)}. 108 | 109 | deqt(#queue{tail = [], head = [E]}) -> 110 | {E, new()}; 111 | 112 | deqt(#queue{length = N, tail = [], head = [Head|Tail]}) -> 113 | [E|T] = lists:reverse(Tail), 114 | {E, #queue{length = N - 1, head = [Head], tail = T}}; 115 | 116 | deqt(#queue{length = N, tail = [E], head = Head}) -> 117 | {E, make_deq_head(N - 1, Head)}; 118 | 119 | deqt(#queue{length = N, tail = [E|Tail]} = Queue) -> 120 | {E, Queue#queue{length = N - 1, tail = Tail}}; 121 | 122 | deqt(#queue{tail = [], head = []} = Queue) -> 123 | {?None, Queue}. 124 | 125 | 126 | %% 127 | %% take collection and return last element of collection 128 | %% 129 | -spec last(datum:traversable(_)) -> datum:option(_). 130 | 131 | last(#queue{tail = [Last|_]}) -> 132 | Last; 133 | 134 | last(#queue{head = [Last]}) -> 135 | Last; 136 | 137 | last(#queue{head = [_|Head]}) -> 138 | lists:last(Head); 139 | 140 | last(_) -> 141 | ?None. 142 | 143 | %% 144 | %% take collection and return its prefix (all elements except the last) 145 | %% 146 | -spec liat(datum:traversable(_)) -> datum:traversable(_). 147 | 148 | liat(Queue) -> 149 | erlang:element(2, deqt(Queue)). 150 | 151 | 152 | 153 | %%%------------------------------------------------------------------ 154 | %%% 155 | %%% traversable 156 | %%% 157 | %%%------------------------------------------------------------------ 158 | 159 | %% 160 | %% take collection and return head element of collection 161 | %% 162 | -spec head(datum:traversable(_)) -> datum:option(_). 163 | 164 | head(#queue{} = Queue) -> 165 | q:head(Queue). 166 | 167 | %% 168 | %% take collection and return its suffix (all elements except the first) 169 | %% 170 | -spec tail(datum:traversable(_)) -> datum:traversable(_). 171 | 172 | tail(#queue{} = Queue) -> 173 | q:tail(Queue). 174 | 175 | %% 176 | %% return true if collection is empty 177 | %% 178 | -spec is_empty(datum:traversable(_)) -> true | false. 179 | 180 | is_empty(#queue{} = Queue) -> 181 | q:is_empty(Queue). 182 | 183 | %% 184 | %% return the suffix of collection that starts at the next element after nth. 185 | %% drop first n elements 186 | %% 187 | -spec drop(integer(), datum:traversable(_)) -> datum:traversable(_). 188 | 189 | drop(N, #queue{} = Queue) -> 190 | q:drop(N, Queue). 191 | 192 | %% 193 | %% drops elements from collection while predicate returns true and 194 | %% returns remaining stream suffix. 195 | %% 196 | -spec dropwhile(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 197 | 198 | dropwhile(Pred, #queue{} = Queue) -> 199 | q:dropwhile(Pred, Queue). 200 | 201 | %% 202 | %% returns a newly-allocated collection that contains only those elements of the 203 | %% input collection for which predicate is true. 204 | %% 205 | -spec filter(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 206 | 207 | filter(Pred, #queue{} = Queue) -> 208 | q:filter(Pred, Queue). 209 | 210 | %% 211 | %% applies a function to each collection element for its side-effects; 212 | %% it returns nothing. 213 | %% 214 | -spec foreach(datum:effect(_), datum:traversable(_)) -> ok. 215 | 216 | foreach(Pred, #queue{} = Queue) -> 217 | q:foreach(Pred, Queue). 218 | 219 | %% 220 | %% create a new collection by apply a function to each element of input collection. 221 | %% 222 | -spec map(fun((_) -> _), datum:traversable(_)) -> datum:traversable(_). 223 | 224 | map(Fun, #queue{} = Queue) -> 225 | q:map(Fun, Queue). 226 | 227 | %% 228 | %% partitions collection into two collection. The split behaves as if it is defined as 229 | %% consequent take(N, Seq), drop(N, Seq). 230 | %% 231 | -spec split(integer(), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 232 | 233 | split(N, #queue{} = Queue) -> 234 | q:split(N, Queue). 235 | 236 | %% 237 | %% partitions stream into two streams according to predicate. 238 | %% The splitwith/2 behaves as if it is defined as consequent 239 | %% takewhile(Pred, Seq), dropwhile(Pred, Seq) 240 | %% 241 | -spec splitwhile(datum:predicate(_), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 242 | 243 | splitwhile(Pred, #queue{} = Queue) -> 244 | q:splitwhile(Pred, Queue). 245 | 246 | %% 247 | %% returns a newly-allocated collection containing the first n elements of 248 | %% the input collection. 249 | %% 250 | -spec take(integer(), datum:traversable(_)) -> datum:traversable(_). 251 | 252 | take(N, #queue{} = Queue) -> 253 | q:take(N, Queue). 254 | 255 | %% 256 | %% returns a newly-allocated collection that contains those elements from 257 | %% input collection while predicate returns true. 258 | %% 259 | -spec takewhile(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 260 | 261 | takewhile(Pred, #queue{} = Queue) -> 262 | q:takewhile(Pred, Queue). 263 | 264 | 265 | %%%------------------------------------------------------------------ 266 | %%% 267 | %%% foldable 268 | %%% 269 | %%%------------------------------------------------------------------ 270 | 271 | %% 272 | %% Combine elements of a structure using a monoid 273 | %% (with an associative binary operation) 274 | %% 275 | -spec fold(datum:monoid(_), _, datum:foldable(_)) -> _. 276 | 277 | fold(Fun, Acc, Queue) -> 278 | q:fold(Fun, Acc, Queue). 279 | 280 | %% 281 | %% Left-associative fold of a structure 282 | %% 283 | -spec foldl(datum:monoid(_), _, datum:foldable(_)) -> _. 284 | 285 | foldl(Fun, Acc, Queue) -> 286 | q:foldl(Fun, Acc, Queue). 287 | 288 | %% 289 | %% Right-associative fold of a structure 290 | %% 291 | -spec foldr(datum:monoid(_), _, datum:foldable(_)) -> _. 292 | 293 | foldr(Fun, Acc, Queue) -> 294 | q:foldr(Fun, Acc, Queue). 295 | 296 | %% 297 | %% The fundamental recursive structure constructor, 298 | %% it applies a function to each previous seed element in turn 299 | %% to determine the next element. 300 | %% 301 | -spec unfold(fun((_) -> _), _) -> datum:foldable(_). 302 | 303 | unfold(Fun, Seed) -> 304 | q:unfold(Fun, Seed). 305 | 306 | 307 | %% 308 | %% check length of queue 309 | -spec length(datum:q()) -> boolean(). 310 | 311 | length(#queue{length = N}) -> 312 | N. 313 | 314 | %% 315 | %% 316 | -spec list(datum:q()) -> list(). 317 | 318 | list(#queue{head = Head, tail = Tail}) -> 319 | Head ++ lists:reverse(Tail). 320 | 321 | 322 | %%%------------------------------------------------------------------ 323 | %%% 324 | %%% private 325 | %%% 326 | %%%------------------------------------------------------------------ 327 | 328 | %% 329 | %% make dequeue from list (supplied list is tail) 330 | % make_deq_tail(N, [_]=List) -> 331 | % #queue{length = N, head = List}; 332 | 333 | % make_deq_tail(N, [X,Y]) -> 334 | % #queue{length = N, head = [Y], tail = [X]}; 335 | 336 | % make_deq_tail(N, [X,Y|List]) -> 337 | % #queue{length = N, head = lists:reverse(List), tail = [X, Y]}; 338 | 339 | % make_deq_tail(_, []) -> 340 | % #queue{}. 341 | 342 | %% 343 | %% make dequeue from list (supplied list is head) 344 | make_deq_head(N, [_]=List) -> 345 | #queue{length = N, head = List}; 346 | 347 | make_deq_head(N, [X,Y]) -> 348 | #queue{length = N, head = [X], tail = [Y]}; 349 | 350 | make_deq_head(N, [X,Y|List]) -> 351 | #queue{length = N, head = [X,Y], tail = lists:reverse(List)}; 352 | 353 | make_deq_head(_, []) -> 354 | #queue{}. 355 | -------------------------------------------------------------------------------- /src/queue/q.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2012 - 2013 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @description 17 | %% pure functional queue 18 | -module(q). 19 | -behaviour(traversable). 20 | -behaviour(foldable). 21 | 22 | -include("datum.hrl"). 23 | 24 | -export([ 25 | new/0, %% O(1) 26 | build/1, %% O(n) 27 | 28 | %% 29 | %% queue 30 | enq/2, %% O(1) 31 | deq/1, %% O(1) 32 | 33 | %% 34 | %% traversable 35 | head/1, %% O(1) 36 | tail/1, %% O(1) 37 | is_empty/1, %% O(1) 38 | drop/2, %% O(n) 39 | dropwhile/2, %% O(n) 40 | filter/2, %% O(n) 41 | foreach/2, %% O(n) 42 | map/2, %% O(n) 43 | split/2, %% O(n) 44 | splitwhile/2, %% 45 | take/2, %% 46 | takewhile/2, %% 47 | 48 | %% 49 | %% foldable 50 | fold/3, 51 | foldl/3, 52 | foldr/3, 53 | unfold/2 54 | 55 | % q - interface 56 | % ,head/1 57 | % ,tail/1 58 | 59 | % utility interface 60 | % ,is_empty/1 61 | ,length/1 62 | ,list/1 63 | 64 | ]). 65 | 66 | 67 | %% 68 | %% create new empty queue 69 | -spec new() -> datum:q(_). 70 | 71 | new() -> 72 | #queue{}. 73 | 74 | %% 75 | %% build tree from another traversable structure 76 | -spec build(_) -> datum:q(_). 77 | 78 | build(List) -> 79 | make_deq_head(erlang:length(List), List). 80 | 81 | %% 82 | %% enqueue element 83 | -spec enq(_, datum:q(_)) -> datum:q(_). 84 | 85 | enq(E, #queue{length = N, tail = [_] = Tail, head = []}) -> 86 | #queue{length = N + 1, tail = [E], head = Tail}; 87 | 88 | enq(E, #queue{length = N, tail = Tail} = Queue) -> 89 | Queue#queue{length = N + 1, tail = [E|Tail]}. 90 | 91 | %% 92 | %% dequeue element 93 | -spec deq(datum:q(_)) -> {datum:option(_), datum:q(_)}. 94 | 95 | deq(#queue{tail = [E], head = []}) -> 96 | {E, new()}; 97 | 98 | deq(#queue{length = N, tail = [Last|Tail], head = []}) -> 99 | [E|Head] = lists:reverse(Tail), 100 | {E, #queue{length = N - 1, head = Head, tail = [Last]}}; 101 | 102 | deq(#queue{length = N, tail = Tail, head = [E]}) -> 103 | {E, make_deq_tail(N - 1, Tail)}; 104 | 105 | deq(#queue{length = N, head = [E|Head]} = Queue) -> 106 | {E, Queue#queue{length = N - 1, head = Head}}; 107 | 108 | deq(#queue{tail = [], head = []} = Queue) -> 109 | {?None, Queue}. 110 | 111 | %%%------------------------------------------------------------------ 112 | %%% 113 | %%% traversable 114 | %%% 115 | %%%------------------------------------------------------------------ 116 | 117 | %% 118 | %% take collection and return head element of collection 119 | %% 120 | -spec head(datum:traversable(_)) -> datum:option(_). 121 | 122 | head(#queue{head = [Head| _]}) -> 123 | Head; 124 | head(#queue{tail = [Head]}) -> 125 | Head; 126 | head(#queue{tail = [_|Tail]}) -> 127 | lists:last(Tail); 128 | head(#queue{}) -> 129 | undefined. 130 | 131 | %% 132 | %% take collection and return its suffix (all elements except the first) 133 | %% 134 | -spec tail(datum:traversable(_)) -> datum:traversable(_). 135 | 136 | tail(#queue{} = Queue) -> 137 | erlang:element(2, deq(Queue)). 138 | 139 | 140 | %% 141 | %% return true if collection is empty 142 | %% 143 | -spec is_empty(datum:traversable(_)) -> true | false. 144 | 145 | is_empty(#queue{head = [], tail = []}) -> 146 | true; 147 | is_empty(#queue{}) -> 148 | false. 149 | 150 | 151 | %% 152 | %% return the suffix of collection that starts at the next element after nth. 153 | %% drop first n elements 154 | %% 155 | -spec drop(integer(), datum:traversable(_)) -> datum:traversable(_). 156 | 157 | drop(0, #queue{} = Queue) -> 158 | Queue; 159 | drop(_, #queue{head = [], tail = []} = Queue) -> 160 | Queue; 161 | drop(N, #queue{} = Queue) -> 162 | drop(N - 1, tail(Queue)). 163 | 164 | %% 165 | %% drops elements from collection while predicate returns true and 166 | %% returns remaining stream suffix. 167 | %% 168 | -spec dropwhile(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 169 | 170 | dropwhile(_, #queue{head = [], tail = []} = Queue) -> 171 | Queue; 172 | dropwhile(Pred, #queue{} = Queue) -> 173 | case Pred(head(Queue)) of 174 | true -> 175 | dropwhile(Pred, tail(Queue)); 176 | false -> 177 | Queue 178 | end. 179 | 180 | %% 181 | %% returns a newly-allocated collection that contains only those elements of the 182 | %% input collection for which predicate is true. 183 | %% 184 | -spec filter(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 185 | 186 | filter(Pred, #queue{head = Head0, tail = Tail0}) -> 187 | Head1 = lists:filter(Pred, Head0), 188 | Tail1 = lists:filter(Pred, Tail0), 189 | #queue{length = erlang:length(Head1) + erlang:length(Tail1), head = Head1, tail = Tail1}. 190 | 191 | 192 | %% 193 | %% applies a function to each collection element for its side-effects; 194 | %% it returns nothing. 195 | %% 196 | -spec foreach(datum:effect(_), datum:traversable(_)) -> ok. 197 | 198 | foreach(_, #queue{head = [], tail = []}) -> 199 | ok; 200 | foreach(Fun, #queue{} = Queue) -> 201 | _ = Fun(head(Queue)), 202 | foreach(Fun, tail(Queue)). 203 | 204 | 205 | %% 206 | %% create a new collection by apply a function to each element of input collection. 207 | %% 208 | -spec map(fun((_) -> _), datum:traversable(_)) -> datum:traversable(_). 209 | 210 | map(Fun, #queue{head = Head, tail = Tail} = Queue) -> 211 | Queue#queue{head = lists:map(Fun, Head), tail = lists:map(Fun, Tail)}. 212 | 213 | %% 214 | %% partitions collection into two collection. The split behaves as if it is defined as 215 | %% consequent take(N, Seq), drop(N, Seq). 216 | %% 217 | -spec split(integer(), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 218 | 219 | split(X, #queue{length = N} = Queue) 220 | when X >= N -> 221 | {Queue, new()}; 222 | 223 | split(_, #queue{head = [], tail = []} = Queue) -> 224 | {Queue, Queue}; 225 | 226 | split(N, Queue) -> 227 | split(N, new(), Queue). 228 | 229 | split(0, Acc, Queue) -> 230 | {Acc, Queue}; 231 | split(N, Acc, Queue) -> 232 | {Head, Tail} = deq(Queue), 233 | split(N - 1, enq(Head, Acc), Tail). 234 | 235 | %% 236 | %% partitions stream into two streams according to predicate. 237 | %% The splitwith/2 behaves as if it is defined as consequent 238 | %% takewhile(Pred, Seq), dropwhile(Pred, Seq) 239 | %% 240 | -spec splitwhile(datum:predicate(_), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 241 | 242 | splitwhile(Pred, Queue) -> 243 | splitwhile(Pred, new(), Queue). 244 | 245 | splitwhile(_, Acc, #queue{head = [], tail = []} = Queue) -> 246 | {Acc, Queue}; 247 | splitwhile(Pred, Acc, #queue{} = Queue) -> 248 | Head = head(Queue), 249 | case Pred(Head) of 250 | true -> 251 | splitwhile(Pred, enq(Head, Acc), tail(Queue)); 252 | false -> 253 | {Acc, Queue} 254 | end. 255 | 256 | %% 257 | %% returns a newly-allocated collection containing the first n elements of 258 | %% the input collection. 259 | %% 260 | -spec take(integer(), datum:traversable(_)) -> datum:traversable(_). 261 | 262 | take(X, #queue{length = N} = Queue) 263 | when X >= N -> 264 | Queue; 265 | take(N, Queue) -> 266 | take(N, new(), Queue). 267 | 268 | take(0, Acc, _Queue) -> 269 | Acc; 270 | take(_, Acc, #queue{head = [], tail = []}) -> 271 | Acc; 272 | take(N, Acc, Queue) -> 273 | {Head, Tail} = deq(Queue), 274 | take(N - 1, enq(Head, Acc), Tail). 275 | 276 | 277 | %% 278 | %% returns a newly-allocated collection that contains those elements from 279 | %% input collection while predicate returns true. 280 | %% 281 | -spec takewhile(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 282 | 283 | takewhile(Pred, Queue) -> 284 | takewhile(Pred, new(), Queue). 285 | 286 | takewhile(_, Acc, #queue{head = [], tail = []}) -> 287 | Acc; 288 | takewhile(Pred, Acc, #queue{} = Queue) -> 289 | {Head, Tail} = deq(Queue), 290 | case Pred(Head) of 291 | true -> 292 | takewhile(Pred, enq(Head, Acc), Tail); 293 | false -> 294 | Acc 295 | end. 296 | 297 | %%%------------------------------------------------------------------ 298 | %%% 299 | %%% foldable 300 | %%% 301 | %%%------------------------------------------------------------------ 302 | 303 | %% 304 | %% Combine elements of a structure using a monoid 305 | %% (with an associative binary operation) 306 | %% 307 | -spec fold(datum:monoid(_), _, datum:foldable(_)) -> _. 308 | 309 | fold(Fun, Acc, Queue) -> 310 | foldl(Fun, Acc, Queue). 311 | 312 | %% 313 | %% Left-associative fold of a structure 314 | %% 315 | -spec foldl(datum:monoid(_), _, datum:foldable(_)) -> _. 316 | 317 | foldl(Fun, Acc, #queue{head = Head, tail = Tail}) -> 318 | lists:foldr(Fun, lists:foldl(Fun, Acc, Head), Tail). 319 | 320 | %% 321 | %% Right-associative fold of a structure 322 | %% 323 | -spec foldr(datum:monoid(_), _, datum:foldable(_)) -> _. 324 | 325 | foldr(Fun, Acc, #queue{head = Head, tail = Tail}) -> 326 | lists:foldr(Fun, lists:foldl(Fun, Acc, Tail), Head). 327 | 328 | 329 | %% 330 | %% The fundamental recursive structure constructor, 331 | %% it applies a function to each previous seed element in turn 332 | %% to determine the next element. 333 | %% 334 | -spec unfold(fun((_) -> _), _) -> datum:foldable(_). 335 | 336 | unfold(Fun, Seed) -> 337 | unfold(Fun, Seed, new()). 338 | 339 | unfold(Fun, Seed, Acc) -> 340 | case Fun(Seed) of 341 | {Head, Next} -> 342 | unfold(Fun, Next, enq(Head, Acc)); 343 | _ -> 344 | Acc 345 | end. 346 | 347 | 348 | %% 349 | %% 350 | length(#queue{length = N}) -> 351 | N. 352 | 353 | 354 | %% 355 | %% 356 | -spec list(datum:q()) -> list(). 357 | 358 | list(#queue{head = Head, tail = Tail}) -> 359 | Head ++ lists:reverse(Tail). 360 | 361 | 362 | %%%------------------------------------------------------------------ 363 | %%% 364 | %%% private 365 | %%% 366 | %%%------------------------------------------------------------------ 367 | 368 | %% 369 | %% make dequeue from list (supplied list is tail) 370 | make_deq_tail(N, [_]=List) -> 371 | #queue{length = N, head = List}; 372 | 373 | make_deq_tail(N, [X,Y]) -> 374 | #queue{length = N, head = [Y], tail = [X]}; 375 | 376 | make_deq_tail(N, [X,Y|List]) -> 377 | #queue{length = N, head = lists:reverse(List), tail = [X, Y]}; 378 | 379 | make_deq_tail(_, []) -> 380 | #queue{}. 381 | 382 | %% 383 | %% make dequeue from list (supplied list is head) 384 | make_deq_head(N, [_]=List) -> 385 | #queue{length = N, head = List}; 386 | 387 | make_deq_head(N, [X,Y]) -> 388 | #queue{length = N, head = [X], tail = [Y]}; 389 | 390 | make_deq_head(N, [X,Y|List]) -> 391 | #queue{length = N, head = [X,Y], tail = lists:reverse(List)}; 392 | 393 | make_deq_head(_, []) -> 394 | #queue{}. 395 | 396 | -------------------------------------------------------------------------------- /src/sets/chord.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright 2012 Dmitry Kolesnikov, All Rights Reserved 3 | %% 4 | %% Licensed under the Apache License, Version 2.0 (the "License"); 5 | %% you may not use this file except in compliance with the License. 6 | %% You may obtain a copy of the License at 7 | %% 8 | %% http://www.apache.org/licenses/LICENSE-2.0 9 | %% 10 | %% Unless required by applicable law or agreed to in writing, software 11 | %% distributed under the License is distributed on an "AS IS" BASIS, 12 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | %% See the License for the specific language governing permissions and 14 | %% limitations under the License. 15 | %% 16 | %% @description 17 | %% consistent hashing - chord ring. The node is positioned to the ring. 18 | %% The node address is derived from it's identifier. Node controls all 19 | %% complete shards clockwise from its address (successor shards) 20 | -module(chord). 21 | 22 | -export([ 23 | new/0 24 | ,new/1 25 | ,size/1 26 | ,n/1 27 | ,q/1 28 | ,address/2 29 | ,address/1 30 | ,whereis/2 31 | ,successors/2 32 | ,successors/3 33 | ,predecessors/2 34 | ,predecessors/3 35 | ,members/1 36 | ,stats/1 37 | ,filter/2 38 | ,whois/2 39 | ,join/2 40 | ,leave/2 41 | ]). 42 | 43 | -type(key() :: any()). 44 | -type(val() :: any()). 45 | -type(addr() :: integer()). 46 | 47 | %% 48 | -record(ring, { 49 | m = 8 :: integer() % ring modulo 50 | ,n = 3 :: integer() % number of replica 51 | ,q = 8 :: integer() % number of ranges (shards) 52 | ,hash = md5 :: atom() % hash algorithm 53 | ,size = 0 :: integer() % size of ring 54 | ,keys = [] :: [{addr(), key()}] 55 | }). 56 | 57 | %% 58 | %% create new chord ring 59 | %% 60 | %% Options: 61 | %% {m, integer()} - ring module power of 2 is required 62 | %% {n, integer()} - number of replicas 63 | %% {q, integer()} - number of shard 64 | %% {hash, md5 | sha1} - ring hashing algorithm 65 | -spec new() -> #ring{}. 66 | -spec new(list()) -> #ring{}. 67 | 68 | new() -> 69 | new([]). 70 | new(Opts) -> 71 | init(Opts, #ring{}). 72 | 73 | init([{modulo, X} | Opts], R) -> 74 | init(Opts, R#ring{m=X}); 75 | init([{m, X} | Opts], R) -> 76 | init(Opts, R#ring{m=X}); 77 | 78 | init([{replica, X} | Opts], R) -> 79 | init(Opts, R#ring{n=X}); 80 | init([{n, X} | Opts], R) -> 81 | init(Opts, R#ring{n=X}); 82 | 83 | init([{shard, X} | Opts], R) -> 84 | init(Opts, R#ring{q=X}); 85 | init([{q, X} | Opts], R) -> 86 | init(Opts, R#ring{q=X}); 87 | 88 | init([{hash, X} | Opts], R) -> 89 | init(Opts, R#ring{hash=X}); 90 | init([{_, _} | Opts], R) -> 91 | init(Opts, R); 92 | init([], R) -> 93 | empty(R). 94 | 95 | %% 96 | %% number of replica 97 | -spec n(#ring{}) -> integer(). 98 | 99 | n(#ring{n = N}) -> 100 | N. 101 | 102 | %% 103 | %% number of shards 104 | -spec q(#ring{}) -> integer(). 105 | 106 | q(#ring{q = Q}) -> 107 | Q. 108 | 109 | %% 110 | %% number of hashed nodes 111 | -spec size(#ring{}) -> integer(). 112 | 113 | size(#ring{}=R) -> 114 | length(R#ring.keys). 115 | 116 | %% 117 | %% maps key into address on the ring 118 | -spec address(key() | addr(), #ring{}) -> addr(). 119 | 120 | address(X, #ring{}=R) 121 | when is_integer(X) -> 122 | X rem ringtop(R); 123 | 124 | address({hash, X}, #ring{m=M}) -> 125 | <> = X, 126 | Addr; 127 | 128 | address(X, #ring{}=R) 129 | when is_binary(X) -> 130 | Hash = crypto:hash(R#ring.hash, X), 131 | address({hash, Hash}, R); 132 | 133 | address(X, #ring{}=R) -> 134 | Hash = crypto:hash(R#ring.hash, term_to_binary(X)), 135 | address({hash, Hash}, R). 136 | 137 | %% 138 | %% return complete set of ring addresses 139 | -spec address(#ring{}) -> [addr()]. 140 | 141 | address(#ring{}=R) -> 142 | Top = ringtop(R), 143 | Inc = Top div R#ring.q, 144 | lists:seq(Inc - 1, Top - 1, Inc). 145 | 146 | %% 147 | %% lookup the key position on the ring 148 | -spec whereis(key() | addr(), #ring{}) -> {addr(), key()}. 149 | 150 | whereis(Addr, #ring{}=R) 151 | when is_integer(Addr) -> 152 | {X, Key} = case lists:dropwhile(fun({Shard, _}) -> Shard < Addr end, R#ring.keys) of 153 | [] -> hd(R#ring.keys); 154 | List -> hd(List) 155 | end, 156 | {X, Key}; 157 | whereis(Key, #ring{}=R) -> 158 | whereis(address(Key, R), R). 159 | 160 | %% 161 | %% return list of predecessors 162 | %% [ {X,Y} || {_, X} <- ring:predecessors(3, 0, R), Y <- [ring:get(X, R)] ]. 163 | -spec predecessors(key() | addr(), #ring{}) -> [{addr(), key()}]. 164 | -spec predecessors(integer(), key() | addr(), #ring{}) -> [{addr(), key()}]. 165 | 166 | predecessors(Key, #ring{}=R) -> 167 | predecessors(R#ring.n, Key, R). 168 | 169 | predecessors(_, _Addr, #ring{keys=[]}) -> 170 | []; 171 | predecessors(N, Addr, #ring{}=R) 172 | when is_integer(Addr) -> 173 | %% split tokens to before and after address 174 | {Head, Tail} = lists:splitwith(fun({Shard, _}) -> Shard < Addr end, R#ring.keys), 175 | List = case length(Head) of 176 | L when L >= N -> 177 | element(1, lists:split(N, lists:reverse(Head))); 178 | L when (N - L) =< length(Tail) -> 179 | lists:reverse(Head) ++ element(1, lists:split(N - L, lists:reverse(Tail))); 180 | _ -> 181 | lists:reverse(Head) ++ lists:reverse(Tail) 182 | end, 183 | [{X, Key} || {X, Key} <- List]; 184 | 185 | predecessors(N, Key, Ring) -> 186 | predecessors(N, address(Key, Ring), Ring). 187 | 188 | %% 189 | %% return list of successors 190 | %% [ {X,Y} || {_, X} <- ring:successors(3, 0, R), Y <- [ring:get(X, R)] ]. 191 | -spec successors(key() | addr(), #ring{}) ->[{addr(), key()}]. 192 | -spec successors(integer(), key() | addr(), #ring{}) -> [{addr(), key()}]. 193 | 194 | successors(Key, #ring{}=R) -> 195 | successors(R#ring.n, Key, R). 196 | 197 | successors(_,_Addr, #ring{keys=[]}) -> 198 | []; 199 | successors(N, Addr, #ring{}=R) 200 | when is_integer(Addr) -> 201 | {Head, Tail} = lists:splitwith(fun({Shard, _}) -> Shard < Addr end, R#ring.keys), 202 | List = case length(Tail) of 203 | L when L >= N -> 204 | element(1, lists:split(N, Tail)); 205 | L when (N - L) =< length(Head) -> 206 | Tail ++ element(1, lists:split(N - L, Head)); 207 | _ -> 208 | Tail ++ Head 209 | end, 210 | [{X, Key} || {X, Key} <- List]; 211 | 212 | successors(N, Key, Ring) -> 213 | successors(N, address(Key, Ring), Ring). 214 | 215 | %% 216 | %% return list of ring members 217 | -spec members(#ring{}) -> [{key(), val()}]. 218 | 219 | members(#ring{}=S) -> 220 | [X || {_, X} <- S#ring.keys]. 221 | 222 | %% 223 | %% return list of ring key and ring allocation in percentage 224 | -spec stats(#ring{}) -> [{key(), float()}]. 225 | 226 | stats(#ring{keys=[]}) -> 227 | []; 228 | stats(#ring{keys=[{Addr0, _}|_]=Keys}=Ring) -> 229 | Top = ringtop(Ring), 230 | stats(lists:reverse(Keys), Top + Addr0, Top). 231 | 232 | stats([{Addr, {Key, _}}|Tail], Prev, Top) -> 233 | [{Key, 100 * (Prev - Addr) / Top} | stats(Tail, Addr, Top)]; 234 | stats([], _Prev, _Top) -> 235 | []. 236 | 237 | %% 238 | %% filter 239 | -spec filter(function(), #ring{}) -> #ring{}. 240 | 241 | filter(Fun, #ring{}=R) -> 242 | Keys = lists:filter(fun({_, X}) -> Fun(X) end, R#ring.keys), 243 | R#ring{ 244 | size = length(Keys) 245 | ,keys = Keys 246 | }. 247 | 248 | %% 249 | %% return list of addresses associated with given key 250 | -spec whois(key() | addr(), #ring{}) -> [{addr(), key()}]. 251 | 252 | whois(Key, #ring{}=R) -> 253 | Addr = address(Key, R), 254 | case lists:keyfind(Addr, 1, R#ring.keys) of 255 | false -> 256 | []; 257 | {Addr, Key} -> 258 | [{Addr, Key}] 259 | end. 260 | 261 | %% 262 | %% join key-value to the ring 263 | -spec join(key(), val(), #ring{}) -> #ring{}. 264 | 265 | join(Key, #ring{}=R) -> 266 | join(address(Key, R), Key, R). 267 | 268 | join(Addr, Key, #ring{}=R) -> 269 | R#ring{ 270 | keys = orddict:store(Addr, Key, R#ring.keys) 271 | }. 272 | 273 | %% 274 | %% leave node from ring 275 | -spec leave(key() | addr(), #ring{}) -> #ring{}. 276 | 277 | leave(Addr, #ring{}=R) 278 | when is_integer(Addr) -> 279 | R#ring{ 280 | keys = orddict:erase(Addr, R#ring.keys) 281 | }; 282 | leave(Key, #ring{}=R) -> 283 | leave(address(Key, R), R). 284 | 285 | %%%------------------------------------------------------------------ 286 | %%% 287 | %%% private 288 | %%% 289 | %%%------------------------------------------------------------------ 290 | 291 | %% 292 | %% ring 293 | ringtop(#ring{}=R) -> 294 | trunc(math:pow(2, R#ring.m)). 295 | 296 | %% 297 | %% empties ring 298 | empty(#ring{}=R) -> 299 | R#ring{ 300 | size = 0 301 | ,keys = orddict:new() 302 | }. 303 | 304 | 305 | 306 | -------------------------------------------------------------------------------- /src/sets/sbf.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2012 - 2016, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% scalable bloom filter, based on idea discussed in the paper 19 | %% http://gsd.di.uminho.pt/members/cbm/ps/dbloom.pdf 20 | -module(sbf). 21 | 22 | -export([ 23 | new/1, 24 | new/2, 25 | new/3, 26 | new/4, 27 | add/2, 28 | has/2 29 | ]). 30 | 31 | 32 | %% 33 | %% scalable bloom filter 34 | -record(sbf, { 35 | r :: integer(), 36 | s :: integer(), 37 | size :: integer(), 38 | list :: [_] 39 | }). 40 | 41 | %% 42 | %% bloom filter (bf) 43 | %% partition the M bits on k-slices of size m = M/k bits, 44 | %% each slices per hash function. 45 | -record(bf, { 46 | p :: float(), 47 | k :: integer(), 48 | m :: integer(), 49 | n :: integer(), 50 | size :: integer(), 51 | bits :: [_] 52 | }). 53 | 54 | %% 55 | %% create new scalable bloom filter 56 | %% C - initial capacity 57 | %% P - false positive probability 58 | %% R - tightening ratio of error probability (as defined by paper) 59 | %% S - growth ratio (as defined by paper) 60 | new(C) -> 61 | new(C, 0.001). 62 | 63 | new(C, P) -> 64 | new(C, P, 0.85). 65 | 66 | new(C, P, R) -> 67 | new(C, P, R, 1). 68 | 69 | new(C, P, R, S) -> 70 | %% n ≈ -m ln (1 - p) 71 | P0 = P * (1 - R), 72 | K = bf_k(P0), 73 | Pk = math:pow(P0, 1 / K), 74 | M = 1 + trunc(log2(-C / math:log(1 - Pk))), 75 | #sbf{r = R, s = S, size = 0, list = [bf_new(M, P0)]}. 76 | 77 | %% 78 | %% add element 79 | add(E, #sbf{r = R, s = S, size = Size, list = [H | T]} = State) -> 80 | case has(E, State) of 81 | true -> 82 | State; 83 | false -> 84 | case bf_add(E, H) of 85 | %% filter overflow 86 | #bf{n = N, size = N} = F -> 87 | State#sbf{size = Size + 1, list = [bf_scale(S, R, F), F | T]}; 88 | 89 | F -> 90 | State#sbf{size = Size + 1, list = [F | T]} 91 | end 92 | end. 93 | 94 | %% 95 | %% check membership 96 | has(E, #sbf{list = List}) -> 97 | lists:any(fun(X) -> bf_has(E, X) end, List). 98 | 99 | 100 | %%%------------------------------------------------------------------ 101 | %%% 102 | %%% bloom filter 103 | %%% 104 | %%%------------------------------------------------------------------ 105 | 106 | %% M - segment modulo 107 | %% P - desired error probability 108 | bf_new(M, P) -> 109 | K = bf_k(P), 110 | Pk= math:pow(P, 1 / K), 111 | N = trunc(-(1 bsl M) * math:log(1 - Pk)), 112 | #bf{ 113 | p = P, 114 | k = K, 115 | m = M, 116 | n = N, 117 | size = 0, 118 | bits = [bits_new(1 bsl M) || _ <- lists:seq(1, K)] 119 | }. 120 | 121 | %% number of hash functions with 50% fill rate (optimal rate) 122 | bf_k(P) -> 123 | 1 + erlang:trunc(log2(1 / P)). 124 | 125 | %% 126 | %% insert element to set 127 | bf_add(E, #bf{m = M, k = K, size = Size, bits = Bits0} = State) -> 128 | Mask = 1 bsl M - 1, 129 | Hash = hashes(E, Mask, K), 130 | {Bool, Bits} = lists:unzip([bits_set(H, B) || {H, B} <- lists:zip(Hash, Bits0)]), 131 | case lists:all(fun(X) -> not X end, Bool) of 132 | true -> 133 | State; 134 | false -> 135 | State#bf{size = Size + 1, bits = Bits} 136 | end. 137 | 138 | %% 139 | %% lookup element membership 140 | bf_has(E, #bf{m = M, k = K, bits = Bits0}) -> 141 | Mask = 1 bsl M - 1, 142 | Hash = hashes(E, Mask, K), 143 | Bool = [bits_get(H, B) || {H, B} <- lists:zip(Hash, Bits0)], 144 | lists:all(fun(X) -> X end, Bool). 145 | 146 | 147 | %% The SBF starts with one filter with k0 slices and error probability P0. 148 | %% When this filter gets full, a new one is added with k1 slices and 149 | %% P1 = P0 * r error probability, where r is the tightening ratio with 0 < r < 1. 150 | %% k0 = log2 P0 ^ −1 151 | %% ki = log2 Pi ^ −1 152 | bf_scale(S, R, #bf{p = P, m = M}) -> 153 | bf_new(M + S, P * R). 154 | 155 | %%%------------------------------------------------------------------ 156 | %%% 157 | %%% bits set 158 | %%% 159 | %%%------------------------------------------------------------------ 160 | 161 | -define(WORD, 128). % tuned for space / performance 162 | 163 | bits_new(N) -> 164 | array:new(1 + N div ?WORD, [{default, 0}]). 165 | 166 | bits_set(I, Bits) -> 167 | Cell = I div ?WORD, 168 | Word = array:get(Cell, Bits), 169 | case (Word band (1 bsl (I rem ?WORD))) of 170 | 0 -> 171 | {true, array:set(Cell, (Word bor (1 bsl (I rem ?WORD))), Bits)}; 172 | _ -> 173 | {false, Bits} 174 | end. 175 | 176 | bits_get(I, Bits) -> 177 | Cell = I div ?WORD, 178 | Word = array:get(Cell, Bits), 179 | case (Word band (1 bsl (I rem ?WORD))) of 180 | 0 -> 181 | false; 182 | _ -> 183 | true 184 | end. 185 | 186 | %%%------------------------------------------------------------------ 187 | %%% 188 | %%% private 189 | %%% 190 | %%%------------------------------------------------------------------ 191 | 192 | %% 193 | log2(X) -> 194 | math:log(X) / math:log(2). 195 | 196 | %% 197 | %% calculates K hashes 198 | %% double hashing technique is defined at 199 | %% http://www.eecs.harvard.edu/~kirsch/pubs/bbbf/rsa.pdf 200 | -define(HASH1(X), erlang:phash2([X], 1 bsl 32)). 201 | -define(HASH2(X), erlang:phash2({X}, 1 bsl 32)). 202 | 203 | hashes(X, Mask, K) -> 204 | hashes(?HASH1(X), ?HASH2(X), Mask, K). 205 | 206 | hashes(_, _, _, 0) -> 207 | []; 208 | hashes(A, B, Mask, K) -> 209 | X = (A + B) band Mask, 210 | [ X | hashes(A, X, Mask, K - 1) ]. 211 | -------------------------------------------------------------------------------- /src/topological.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% Class of data structures that maintain a topological relation between actors 3 | -module(topological). 4 | 5 | -export([behaviour_info/1]). 6 | 7 | behaviour_info(callbacks) -> 8 | [ 9 | %% 10 | %% Join an actor to topology and returns a new topology. 11 | %% 12 | %% -spec join(key(), datum:topological(_)) -> datum:topological(). 13 | {join, 2}, 14 | 15 | %% 16 | %% Leave an actor from topology, and returns a new topology. 17 | %% Note, semantic of leave operation do not assume leave due to transitive failures. 18 | %% 19 | %% -spec leave(key(), datum:topological(_)) -> datum:topological(). 20 | {leave, 2}, 21 | 22 | %% 23 | %% Check is an actor exists in topology 24 | %% 25 | %% -spec has(key(), datum:topological(_)) -> true | false. 26 | {has, 2}, 27 | 28 | %% 29 | %% Looks up an topology and returns location of any arbitrary key 30 | %% 31 | %% -spec whereis(key(), datum:topological(_)) -> {address(), key()}. 32 | {whereis, 2}, 33 | 34 | %% 35 | %% Return list of topology members 36 | %% 37 | %% -spec members(datum:topological(_)) -> [key()]. 38 | {members, 1} 39 | ]; 40 | behaviour_info(_Other) -> 41 | undefined. 42 | -------------------------------------------------------------------------------- /src/traversable.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% Class of data structures that can be traversed. 3 | -module(traversable). 4 | 5 | -export([behaviour_info/1]). 6 | 7 | 8 | behaviour_info(callbacks) -> 9 | [ 10 | %% 11 | %% take collection and return head element of collection 12 | %% 13 | %% -spec head(datum:traversable(_)) -> datum:option(_). 14 | {head, 1}, 15 | 16 | %% 17 | %% take collection and return its suffix (all elements except the first) 18 | %% 19 | %% -spec tail(datum:traversable(_)) -> datum:traversable(_). 20 | {tail, 1}, 21 | 22 | %% 23 | %% build a new collection from Erlang list 24 | %% 25 | %% -spec build([_]) -> datum:traversable(_). 26 | {build, 1}, 27 | 28 | %% 29 | %% converts the collection to Erlang list 30 | %% 31 | %% -spec list(datum:traversable(_)) -> [_]. 32 | {list, 1}, 33 | 34 | %% 35 | %% return true if collection is empty 36 | %% 37 | %% -spec is_empty(datum:traversable(_)) -> true | false. 38 | {is_empty, 1}, 39 | 40 | %% 41 | %% length of the collection 42 | %% 43 | %% -spec length(datum:traversable(_)) -> integer(). 44 | % {length, 1}, 45 | 46 | %% 47 | %% return the suffix of collection that starts at the next element after nth. 48 | %% drop first n elements 49 | %% 50 | %% -spec drop(integer(), datum:traversable(_)) -> datum:traversable(_). 51 | {drop, 2}, 52 | 53 | %% 54 | %% drops elements from collection while predicate returns true and 55 | %% returns remaining stream suffix. 56 | %% 57 | %% -spec dropwhile(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 58 | {dropwhile, 2}, 59 | 60 | %% 61 | %% returns a newly-allocated collection that contains only those elements of the 62 | %% input collection for which predicate is true. 63 | %% 64 | %% -spec filter(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 65 | {filter, 2}, 66 | 67 | %% 68 | %% applies a function to each collection element for its side-effects; 69 | %% it returns nothing. 70 | %% 71 | %% -spec foreach(datum:effect(_), datum:traversable(_)) -> ok. 72 | {foreach, 2}, 73 | 74 | %% 75 | %% build a new collection by applying a function to all elements of this collection 76 | %% and flattering resulting collection 77 | %% 78 | %% -spec flatmap(fun((_) -> datum:traversable(_)), datum:traversable(_)) -> datum:traversable(_). 79 | % {flatmap, 2}, 80 | 81 | %% 82 | %% create a new collection by apply a function to each element of input collection. 83 | %% 84 | %% -spec map(fun((_) -> _), datum:traversable(_)) -> datum:traversable(_). 85 | {map, 2}, 86 | 87 | %% 88 | %% partition the collection in two collections according to a predicate 89 | %% 90 | %% -spec partition(datum:predicate(_), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 91 | % {partition, 2}, 92 | 93 | %% 94 | %% partitions collection into two collection. The split behaves as if it is defined as 95 | %% consequent take(N, Seq), drop(N, Seq). 96 | %% 97 | %% -spec split(integer(), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 98 | {split, 2}, 99 | 100 | %% 101 | %% partitions stream into two streams according to predicate. 102 | %% The splitwith/2 behaves as if it is defined as consequent 103 | %% takewhile(Pred, Seq), dropwhile(Pred, Seq) 104 | %% 105 | %% -spec splitwhile(datum:predicate(_), datum:traversable(_)) -> {datum:traversable(_), datum:traversable(_)}. 106 | {splitwhile, 2}, 107 | 108 | %% 109 | %% returns a newly-allocated collection containing the first n elements of 110 | %% the input collection. 111 | %% 112 | %% -spec take(integer(), datum:traversable(_)) -> datum:traversable(_). 113 | {take, 2}, 114 | 115 | %% 116 | %% returns a newly-allocated collection that contains those elements from 117 | %% input collection while predicate returns true. 118 | %% 119 | %% -spec takewhile(datum:predicate(_), datum:traversable(_)) -> datum:traversable(_). 120 | {takewhile, 2} 121 | ]; 122 | behaviour_info(_Other) -> 123 | undefined. 124 | 125 | -------------------------------------------------------------------------------- /src/typecast.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2016, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% type cast utilities 19 | -module(typecast). 20 | 21 | -export([ 22 | i/1, 23 | f/1, 24 | s/1, 25 | ls/1, 26 | c/1, 27 | lc/1, 28 | a/1, 29 | atom/1, 30 | x/1, 31 | t/1 32 | ]). 33 | 34 | -define(TBASE, 1000000). 35 | 36 | %% 37 | %% typecast scalar data type to integer or fails 38 | -spec i(_) -> integer(). 39 | 40 | i(X) when is_binary(X) -> btoi(X); 41 | i(X) when is_atom(X) -> atoi(X); 42 | i(X) when is_list(X) -> ltoi(X); 43 | i(X) when is_integer(X) -> X; 44 | i(X) when is_float(X) -> ftoi(X); 45 | i({A, B, C} = X) when is_integer(A), is_integer(B), is_integer(C) -> ttoi(X). 46 | 47 | btoi(X) -> ltoi(btol(X)). 48 | atoi(X) -> ltoi(atol(X)). 49 | ltoi(X) -> list_to_integer(X). 50 | ftoi(X) -> erlang:trunc(X). 51 | ttoi({A2, A1, A0}) -> A0 + ?TBASE * (A1 + ?TBASE * A2). 52 | 53 | %% 54 | %% typecast scalar data type to double in normal (fixed-point) notation or fails 55 | -spec f(_) -> float(). 56 | 57 | f(X) when is_binary(X) -> btof(X); 58 | f(X) when is_atom(X) -> atof(X); 59 | f(X) when is_list(X) -> ltof(X); 60 | f(X) when is_integer(X) -> itof(X); 61 | f(X) when is_float(X) -> X. 62 | 63 | btof(X) -> ltof(btol(X)). 64 | atof(X) -> ltof(atol(X)). 65 | ltof(X) -> list_to_float(X). 66 | itof(X) -> X + 0.0. 67 | 68 | %% 69 | %% typecast scalar data type to binary string or fails 70 | -spec s(_) -> binary(). 71 | 72 | s(undefined) -> <<>>; 73 | s(X) when is_binary(X) -> btos(X); 74 | s(X) when is_atom(X) -> atos(X); 75 | s(X) when is_list(X) -> ltos(X); 76 | s(X) when is_integer(X) -> itos(X); 77 | s(X) when is_float(X) -> ftos(X). 78 | 79 | btos(X) -> X. 80 | atos(X) -> atom_to_binary(X, utf8). 81 | ltos(X) -> iolist_to_binary(X). 82 | itos(X) -> ltos(itol(X)). 83 | ftos(X) -> ltos(io_lib:format("~.9f", [X])). 84 | 85 | %% 86 | %% typecast scalar data type to Unicode binary or fails 87 | -spec ls(_) -> binary(). 88 | 89 | ls(undefined) -> <<>>; 90 | ls(X) when is_binary(X) -> utob(X); 91 | ls(X) when is_atom(X) -> atos(X); 92 | ls(X) when is_list(X) -> utob(X); 93 | ls(X) when is_integer(X) -> itos(X); 94 | ls(X) when is_float(X) -> ftos(X). 95 | 96 | utob(X) -> 97 | case unicode:characters_to_binary(X) of 98 | {incomplete, _} -> 99 | exit(rought); 100 | {error, _} -> 101 | exit(badarg); 102 | Y -> 103 | Y 104 | end. 105 | 106 | %% 107 | %% typecast scalar data type to character list or fails 108 | -spec c(_) -> list(). 109 | 110 | c(undefined) -> []; 111 | c(X) when is_binary(X) -> btol(X); 112 | c(X) when is_atom(X) -> atol(X); 113 | c(X) when is_list(X) -> X; 114 | c(X) when is_integer(X) -> itol(X); 115 | c(X) when is_float(X) -> ftol(X). 116 | 117 | btol(X) -> binary_to_list(X). 118 | atol(X) -> atom_to_list(X). 119 | itol(X) -> integer_to_list(X). 120 | ftol(X) -> lists:flatten(io_lib:format("~.9f", [X])). 121 | 122 | %% 123 | %% typecast scalar data type to Unicode character list or fails 124 | -spec lc(_) -> list(). 125 | 126 | lc(undefined) -> []; 127 | lc(X) when is_binary(X) -> utoc(X); 128 | lc(X) when is_atom(X) -> atol(X); 129 | lc(X) when is_list(X) -> utoc(X); 130 | lc(X) when is_integer(X) -> itol(X); 131 | lc(X) when is_float(X) -> ftol(X). 132 | 133 | utoc(X) -> 134 | case unicode:characters_to_list(X) of 135 | {incomplete, _} -> 136 | exit(rought); 137 | {error, _} -> 138 | exit(badarg); 139 | Y -> 140 | Y 141 | end. 142 | 143 | %% 144 | %% typecast scalar data type to existing atom or fails 145 | -spec a(_) -> atom(). 146 | 147 | a(X) when is_binary(X) -> btoa(X); 148 | a(X) when is_atom(X) -> X; 149 | a(X) when is_list(X) -> ltoa(X); 150 | a(X) when is_integer(X) -> itoa(X); 151 | a(X) when is_float(X) -> ftoa(X). 152 | 153 | btoa(X) -> binary_to_existing_atom(X, utf8). 154 | ltoa(X) -> list_to_existing_atom(X). 155 | itoa(X) -> ltoa(itol(X)). 156 | ftoa(X) -> ltoa(ftol(X)). 157 | 158 | %% 159 | %% typecast scalar data type to new atom or fails 160 | -spec atom(_) -> atom(). 161 | 162 | atom(X) when is_binary(X) -> btoaa(X); 163 | atom(X) when is_atom(X) -> X; 164 | atom(X) when is_list(X) -> ltoaa(X); 165 | atom(X) when is_integer(X) -> itoaa(X); 166 | atom(X) when is_float(X) -> ftoaa(X). 167 | 168 | btoaa(X) -> binary_to_atom(X, utf8). 169 | ltoaa(X) -> list_to_atom(X). 170 | itoaa(X) -> ltoaa(itol(X)). 171 | ftoaa(X) -> ltoaa(ftol(X)). 172 | 173 | %% 174 | %% typecast scalar data type to hexadecimal or fails 175 | -spec x(_) -> binary(). 176 | 177 | x(X) when is_binary(X) -> btoh(X); 178 | x(X) when is_atom(X) -> btoh(atos(X)); 179 | x(X) when is_list(X) -> btoh(ltos(X)); 180 | x(X) when is_integer(X) -> itoh(X). 181 | 182 | btoh(X) -> 183 | << <<(if A < 10 -> $0 + A; A >= 10 -> $a + (A - 10) end):8>> || <> <= X >>. 184 | 185 | itoh(X) -> 186 | << <<(if A < $A -> A; A > $A -> $a + (A - $A) end):8>> || <> <= erlang:integer_to_binary(X, 16) >>. 187 | 188 | %% 189 | %% typecast scalar data type to timestamp or fails 190 | -spec t(_) -> {integer(), integer(), integer()}. 191 | 192 | t(X) when is_integer(X) -> itot(X). 193 | 194 | itot(X) -> 195 | A0 = X rem ?TBASE, 196 | Y = X div ?TBASE, 197 | A1 = Y rem ?TBASE, 198 | A2 = Y div ?TBASE, 199 | {A2, A1, A0}. 200 | 201 | -------------------------------------------------------------------------------- /test/category_parse_transform_SUITE.erl: -------------------------------------------------------------------------------- 1 | -module(category_parse_transform_SUITE). 2 | -include_lib("common_test/include/ct.hrl"). 3 | 4 | -export([ 5 | all/0, 6 | syntax_composition/1, 7 | syntax_composition_with_state/1, 8 | syntax_composition_with_pattern/1, 9 | syntax_composition_with_transformer/1, 10 | syntax_composition_partial/1, 11 | syntax_nested_list_comprehension/1, 12 | syntax_side_effect_operator/1, 13 | syntax_kleisli_with_list_ops/1, 14 | syntax_composition_parial/1 15 | ]). 16 | 17 | all() -> 18 | [Test || {Test, NAry} <- ?MODULE:module_info(exports), 19 | Test =/= module_info, 20 | Test =/= init_per_suite, 21 | Test =/= end_per_suite, 22 | NAry =:= 1 23 | ]. 24 | 25 | %% 26 | %% 27 | syntax_composition(_) -> 28 | ok = transform("[identity || cats:unit(1), do:this(_), do:that(_)]."), 29 | ok = transform("[$. || cats:unit(1), do:this(_), do:that(_)]."), 30 | ok = transform("[option || cats:unit(1), do:this(_), do:that(_)]."), 31 | ok = transform("[$? || cats:unit(1), do:this(_), do:that(_)]."), 32 | ok = transform("[undefined || cats:unit(1), do:this(_), do:that(_)]."), 33 | ok = transform("[either || cats:unit(1), do:this(_), do:that(_)]."), 34 | ok = transform("[$^ || cats:unit(1), do:this(_), do:that(_)]."), 35 | ok = transform("[reader || cats:unit(1), do:this(_), do:that(_)]."), 36 | ok = transform("[m_identity || cats:unit(1), do:this(_), do:that(_)]."). 37 | 38 | syntax_composition_with_state(_) -> 39 | ok = transform("[identity || A =< 1, B <- do:this(A), do:that(C)]."), 40 | ok = transform("[option || A =< 1, B <- do:this(A), do:that(C)]."), 41 | ok = transform("[undefined || A =< 1, B <- do:this(A), do:that(C)]."), 42 | ok = transform("[either || A =< 1, B <- do:this(A), do:that(C)]."), 43 | ok = transform("[reader || A =< 1, B <- do:this(A), do:that(C)]."), 44 | ok = transform("[m_identity || A =< 1, B <- do:this(A), do:that(C)]."). 45 | 46 | syntax_composition_with_pattern(_) -> 47 | % ok = transform("[identity || #a{a = A} =< 1, #b{b = B} <- do:this(A), do:that(C)]."), 48 | ok = transform("[option || #a{a = A} =< 1, #b{b = B} <- do:this(A), do:that(C)]."), 49 | % ok = transform("[undefined || #a{a = A} =< 1, #b{b = B} <- do:this(A), do:that(C)]."), 50 | ok = transform("[either || #a{a = A} =< 1, #b{b = B} <- do:this(A), do:that(C)]."), 51 | ok = transform("[reader || #a{a = A} =< 1, #b{b = B} <- do:this(A), do:that(C)]."), 52 | ok = transform("[m_identity || #a{a = A} =< 1, #b{b = B} <- do:this(A), do:that(C)]."). 53 | 54 | syntax_composition_with_transformer(_) -> 55 | ok = transform("[identity || cats:unit(1), _/= x(_), _/= cats:this(_), _/= do:that(_)]."), 56 | ok = transform("[option || cats:unit(1), _/= x(_), _/= cats:this(_), _/= do:that(_)]."), 57 | ok = transform("[undefined || cats:unit(1), _/= x(_), _/= cats:this(_), _/= do:that(_)]."), 58 | ok = transform("[either || cats:unit(1), _/= x(_), _/= cats:this(_), _/= do:that(_)]."), 59 | ok = transform("[reader || cats:unit(1), _/= x(_), _/= cats:this(_), _/= do:that(_)]."), 60 | ok = transform("[m_identity || cats:unit(1), _/= x(_), _/= cats:this(_), _/= do:that(_)]."). 61 | 62 | syntax_composition_partial(_) -> 63 | ok = transform("[identity || cats:unit(_), do:this(_), do:that(_)]."), 64 | ok = transform("[option || cats:unit(_), do:this(_), do:that(_)]."), 65 | ok = transform("[undefined || cats:unit(_), do:this(_), do:that(_)]."), 66 | ok = transform("[either || cats:unit(_), do:this(_), do:that(_)]."), 67 | ok = transform("[reader || cats:unit(_), do:this(_), do:that(_)]."), 68 | ok = transform("[m_identity || cats:unit(_), do:this(_), do:that(_)]."). 69 | 70 | syntax_nested_list_comprehension(_) -> 71 | ok = transform("[identity || do:this(1), cats:sequence([X || X <- _]), do:that(_)]."), 72 | ok = transform("[option || do:this(1), cats:sequence([X || X <- _]), do:that(_)]."), 73 | ok = transform("[either || do:this(1), cats:sequence([X || X <- _]), do:that(_)]."). 74 | 75 | syntax_side_effect_operator(_) -> 76 | ok = transform("[m_identity || _ > put, _ < get]."). 77 | 78 | syntax_kleisli_with_list_ops(_) -> 79 | ok = transform("[m_identity || _ > \"a\" ++ X, _ < get]."). 80 | 81 | syntax_composition_parial(_) -> 82 | ok = transform("[identity || fun(X) -> X end, do:that(_)]."), 83 | ok = transform("[identity || X, do:that(_)]."). 84 | 85 | 86 | %%%------------------------------------------------------------------ 87 | %%% 88 | %%% helpers 89 | %%% 90 | %%%------------------------------------------------------------------ 91 | 92 | transform(Code) -> 93 | {ok, Parsed, _} = erl_scan:string(Code), 94 | {ok, Forms} = erl_parse:parse_exprs(Parsed), 95 | Fun = [{function, 1, a, 1, [{clause, 1, [], [], Forms}]}], 96 | [{function, _, _, _, _}] = category:parse_transform(Fun, []), 97 | ok. 98 | -------------------------------------------------------------------------------- /test/foldable_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% 3 | -module(foldable_SUITE). 4 | -include_lib("common_test/include/ct.hrl"). 5 | 6 | %% 7 | %% common test 8 | -export([ 9 | all/0, 10 | groups/0, 11 | init_per_suite/1, 12 | end_per_suite/1, 13 | init_per_group/2, 14 | end_per_group/2 15 | ]). 16 | -export([ 17 | fold/1, 18 | foldl/1, 19 | foldr/1, 20 | unfold/1 21 | ]). 22 | 23 | %%%---------------------------------------------------------------------------- 24 | %%% 25 | %%% suite 26 | %%% 27 | %%%---------------------------------------------------------------------------- 28 | all() -> 29 | [ 30 | {group, stream}, 31 | {group, heap}, 32 | {group, q}, 33 | {group, deq}, 34 | {group, bst}, 35 | {group, rbtree} 36 | ]. 37 | 38 | groups() -> 39 | [ 40 | {stream, [parallel], 41 | [fold, foldl, foldr, unfold]}, 42 | 43 | {heap, [parallel], 44 | [fold, foldl, foldr, unfold]}, 45 | 46 | {q, [parallel], 47 | [fold, foldl, foldr, unfold]}, 48 | 49 | {deq, [parallel], 50 | [fold, foldl, foldr, unfold]}, 51 | 52 | {bst, [parallel], 53 | [fold, foldl, foldr, unfold]}, 54 | 55 | {rbtree, [parallel], 56 | [fold, foldl, foldr, unfold]} 57 | ]. 58 | 59 | 60 | %%%---------------------------------------------------------------------------- 61 | %%% 62 | %%% init 63 | %%% 64 | %%%---------------------------------------------------------------------------- 65 | init_per_suite(Config) -> 66 | Config. 67 | 68 | end_per_suite(_Config) -> 69 | ok. 70 | 71 | %% 72 | %% 73 | init_per_group(Type, Config) -> 74 | [{type, Type}|Config]. 75 | 76 | end_per_group(_, _Config) -> 77 | ok. 78 | 79 | 80 | %%%---------------------------------------------------------------------------- 81 | %%% 82 | %%% unit test 83 | %%% 84 | %%%---------------------------------------------------------------------------- 85 | -define(LENGTH, 100). 86 | 87 | %% 88 | fold(Config) -> 89 | Type = ?config(type, Config), 90 | List = randseq(?LENGTH), 91 | Expect = lists:sum(List), 92 | Expect = Type:fold(fun '+'/2, 0, Type:build(List)). 93 | 94 | %% 95 | foldl(Config) -> 96 | Type = ?config(type, Config), 97 | List = randseq(?LENGTH), 98 | Expect = lists:sum(List), 99 | Expect = Type:foldl(fun '+'/2, 0, Type:build(List)). 100 | 101 | %% 102 | foldr(Config) -> 103 | Type = ?config(type, Config), 104 | List = randseq(?LENGTH), 105 | Expect = lists:sum(List), 106 | Expect = Type:foldr(fun '+'/2, 0, Type:build(List)). 107 | 108 | %% 109 | unfold(Config) -> 110 | Type = ?config(type, Config), 111 | Expect = lists:sum(lists:seq(1, ?LENGTH)), 112 | Struct = Type:unfold(fun int/1, 1), 113 | Expect = Type:fold(fun '+'/2, 0, Struct). 114 | 115 | 116 | %%%---------------------------------------------------------------------------- 117 | %%% 118 | %%% private 119 | %%% 120 | %%%---------------------------------------------------------------------------- 121 | 122 | %% 123 | randseq(0) -> []; 124 | randseq(N) -> [rand:uniform(1 bsl 32) | randseq(N - 1)]. 125 | 126 | %% 127 | % shuffle(List) -> 128 | % [Y || {_, Y} <- lists:keysort(1, [{rand:uniform(), X} || X <- List])]. 129 | 130 | %% 131 | el1({Key, _}) -> 132 | Key; 133 | el1(X) -> 134 | X. 135 | 136 | int(X) 137 | when X =< ?LENGTH -> 138 | {X, X + 1}; 139 | int(_) -> 140 | undefined. 141 | 142 | '+'(X, Acc) -> 143 | el1(X) + Acc. 144 | -------------------------------------------------------------------------------- /test/generic_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2016, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% category pattern test suite 19 | -module(generic_SUITE). 20 | -include_lib("common_test/include/ct.hrl"). 21 | -compile({parse_transform, generic}). 22 | 23 | -export([all/0]). 24 | -export([ 25 | syntax/1 26 | , generic/1 27 | , generic_assisted/1 28 | , generic_partial/1 29 | , generic_partial_assisted/1 30 | , generic_lens/1 31 | , generic_lens_assisted/1 32 | , generic_lens_custom/1 33 | , labelled/1 34 | , labelled_assisted/1 35 | , labelled_partial/1 36 | , labelled_partial_assisted/1 37 | , labelled_lens/1 38 | , labelled_lens_assisted/1 39 | , labelled_lens_custom/1 40 | ]). 41 | 42 | -record(adt, {a, b, c}). 43 | 44 | all() -> 45 | [Test || {Test, NAry} <- ?MODULE:module_info(exports), 46 | Test =/= module_info, 47 | Test =/= init_per_suite, 48 | Test =/= end_per_suite, 49 | NAry =:= 1 50 | ]. 51 | 52 | %% 53 | %% 54 | syntax(_) -> 55 | ok = transform("generic_of:adt(#adt{a = 1})."), 56 | ok = transform("generic_of:adt(X)."), 57 | ok = transform("generic_to:adt(#{a => 1})."), 58 | ok = transform("generic_to:adt(X)."), 59 | ok = transform("generic:encode(#adt{})."), 60 | ok = transform("generic:decode(#adt{})."), 61 | 62 | ok = transform("labelled_of:adt(#adt{a = 1})."), 63 | ok = transform("labelled_of:adt(X)."), 64 | ok = transform("labelled_to:adt(#{a => 1})."), 65 | ok = transform("labelled_to:adt(X)."), 66 | ok = transform("labelled:encode(#adt{})."), 67 | ok = transform("labelled:decode(#adt{})."), 68 | 69 | ok = transform("a:b(X)."). 70 | 71 | %% 72 | %% 73 | generic(_) -> 74 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 75 | Expect = #{a => 1, b => <<"test">>, c => 2.0}, 76 | 77 | Expect = generic_of:adt(Struct), 78 | [Expect] = generic_of:adt([Struct]), 79 | Struct = generic_to:adt(generic_of:adt(Struct)), 80 | [Struct] = generic_to:adt(generic_of:adt([Struct])). 81 | 82 | %% 83 | %% 84 | generic_assisted(_) -> 85 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 86 | Expect = #{x => 1, y => <<"test">>, z => 2.0}, 87 | Spec = [x, y, z], 88 | 89 | Expect = generic_of:adt(Spec, Struct), 90 | [Expect] = generic_of:adt(Spec, [Struct]), 91 | Struct = generic_to:adt(Spec, generic_of:adt(Spec, Struct)), 92 | [Struct] = generic_to:adt(Spec, generic_of:adt(Spec, [Struct])). 93 | 94 | %% 95 | %% 96 | generic_partial(_) -> 97 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 98 | Expect = #{a => 1, b => <<"test">>, c => 2.0}, 99 | 100 | Encode = generic:encode(#adt{}), 101 | Decode = generic:decode(#adt{}), 102 | 103 | Expect = Encode(Struct), 104 | [Expect] = Encode([Struct]), 105 | 106 | Struct = Decode(Encode(Struct)), 107 | [Struct] = Decode(Encode([Struct])). 108 | 109 | %% 110 | %% 111 | generic_partial_assisted(_) -> 112 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 113 | Expect = #{x => 1, y => <<"test">>, z => 2.0}, 114 | Spec = [x, y, z], 115 | 116 | Encode = generic:encode(Spec, #adt{}), 117 | Decode = generic:decode(Spec, #adt{}), 118 | 119 | Expect = Encode(Struct), 120 | [Expect] = Encode([Struct]), 121 | 122 | Struct = Decode(Encode(Struct)), 123 | [Struct] = Decode(Encode([Struct])). 124 | 125 | %% 126 | %% 127 | generic_lens(_) -> 128 | Struct = #{a => 1, b => <<"test">>, c => 2.0}, 129 | Expect = #adt{a = 1, b = <<"test">>, c = 2.0}, 130 | 131 | Lens = generic:lens(#adt{}), 132 | 133 | Expect = lens:get(Lens, Struct), 134 | [Expect] = lens:get(lens:c(lens:traverse(), Lens), [Struct]). 135 | 136 | %% 137 | %% 138 | generic_lens_assisted(_) -> 139 | Struct = #{x => 1, y => <<"test">>, z => 2.0}, 140 | Expect = #adt{a = 1, b = <<"test">>, c = 2.0}, 141 | Spec = [x, y, z], 142 | 143 | Lens = generic:lens(Spec, #adt{}), 144 | 145 | Expect = lens:get(Lens, Struct), 146 | [Expect] = lens:get(lens:c(lens:traverse(), Lens), [Struct]). 147 | 148 | %% 149 | %% 150 | generic_lens_custom(_) -> 151 | Struct = #{a => <<"1">>, b => <<"test">>, c => 2.0}, 152 | Expect = #adt{a = 1, b = <<"test">>, c = 2.0}, 153 | 154 | Lens = generic:lens(#adt{a = int()}), 155 | 156 | Expect = lens:get(Lens, Struct), 157 | [Expect] = lens:get(lens:c(lens:traverse(), Lens), [Struct]). 158 | 159 | %% 160 | %% 161 | labelled(_) -> 162 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 163 | Expect = #{<<"a">> => 1, <<"b">> => <<"test">>, <<"c">> => 2.0}, 164 | 165 | Expect = labelled_of:adt(Struct), 166 | [Expect] = labelled_of:adt([Struct]), 167 | Struct = labelled_to:adt(labelled_of:adt(Struct)), 168 | [Struct] = labelled_to:adt(labelled_of:adt([Struct])). 169 | 170 | %% 171 | %% 172 | labelled_assisted(_) -> 173 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 174 | Expect = #{<<"x">> => 1, <<"y">> => <<"test">>, <<"z">> => 2.0}, 175 | Spec = [x, y, z], 176 | 177 | Expect = labelled_of:adt(Spec, Struct), 178 | [Expect] = labelled_of:adt(Spec, [Struct]), 179 | Struct = labelled_to:adt(Spec, labelled_of:adt(Spec, Struct)), 180 | [Struct] = labelled_to:adt(Spec, labelled_of:adt(Spec, [Struct])). 181 | 182 | %% 183 | %% 184 | labelled_partial(_) -> 185 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 186 | Expect = #{<<"a">> => 1, <<"b">> => <<"test">>, <<"c">> => 2.0}, 187 | 188 | Encode = labelled:encode(#adt{}), 189 | Decode = labelled:decode(#adt{}), 190 | 191 | Expect = Encode(Struct), 192 | [Expect] = Encode([Struct]), 193 | 194 | Struct = Decode(Encode(Struct)), 195 | [Struct] = Decode(Encode([Struct])). 196 | 197 | %% 198 | %% 199 | labelled_partial_assisted(_) -> 200 | Struct = #adt{a = 1, b = <<"test">>, c = 2.0}, 201 | Expect = #{<<"x">> => 1, <<"y">> => <<"test">>, <<"z">> => 2.0}, 202 | Spec = [x, y, z], 203 | 204 | Encode = labelled:encode(Spec, #adt{}), 205 | Decode = labelled:decode(Spec, #adt{}), 206 | 207 | Expect = Encode(Struct), 208 | [Expect] = Encode([Struct]), 209 | 210 | Struct = Decode(Encode(Struct)), 211 | [Struct] = Decode(Encode([Struct])). 212 | 213 | %% 214 | %% 215 | labelled_lens(_) -> 216 | Struct = #{<<"a">> => 1, <<"b">> => <<"test">>, <<"c">> => 2.0}, 217 | Expect = #adt{a = 1, b = <<"test">>, c = 2.0}, 218 | 219 | Lens = labelled:lens(#adt{}), 220 | 221 | Expect = lens:get(Lens, Struct), 222 | [Expect] = lens:get(lens:c(lens:traverse(), Lens), [Struct]). 223 | 224 | %% 225 | %% 226 | labelled_lens_assisted(_) -> 227 | Struct = #{<<"x">> => 1, <<"y">> => <<"test">>, <<"z">> => 2.0}, 228 | Expect = #adt{a = 1, b = <<"test">>, c = 2.0}, 229 | Spec = [x, y, z], 230 | 231 | Lens = labelled:lens(Spec, #adt{}), 232 | 233 | Expect = lens:get(Lens, Struct), 234 | [Expect] = lens:get(lens:c(lens:traverse(), Lens), [Struct]). 235 | 236 | %% 237 | %% 238 | labelled_lens_custom(_) -> 239 | Struct = #{<<"a">> => <<"1">>, <<"b">> => <<"test">>, <<"c">> => 2.0}, 240 | Expect = #adt{a = 1, b = <<"test">>, c = 2.0}, 241 | 242 | Lens = labelled:lens(#adt{a = int()}), 243 | 244 | Expect = lens:get(Lens, Struct), 245 | [Expect] = lens:get(lens:c(lens:traverse(), Lens), [Struct]). 246 | %%%------------------------------------------------------------------ 247 | %%% 248 | %%% helpers 249 | %%% 250 | %%%------------------------------------------------------------------ 251 | 252 | transform(Code) -> 253 | {ok, Parsed, _} = erl_scan:string(Code), 254 | {ok, Forms} = erl_parse:parse_exprs(Parsed), 255 | Fun = [{function, 1, a, 1, [{clause, 1, [], [], Forms}]}], 256 | [{function, _, _, _, _}] = generic:parse_transform(Fun, []), 257 | ok. 258 | 259 | int() -> 260 | fun(Fun, Value) -> 261 | lens:fmap(fun(X) -> X end, Fun(typecast:i(Value))) 262 | end. -------------------------------------------------------------------------------- /test/m_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2015, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% 19 | -module(m_SUITE). 20 | -include_lib("common_test/include/ct.hrl"). 21 | -compile({parse_transform, category}). 22 | 23 | %% 24 | %% common test 25 | -export([ 26 | all/0 27 | ,groups/0 28 | ,init_per_suite/1 29 | ,end_per_suite/1 30 | ,init_per_group/2 31 | ,end_per_group/2 32 | ]). 33 | 34 | -export([ 35 | syntax_identity_expr/1, 36 | syntax_identity_unit/1, 37 | syntax_identity_fail/1, 38 | syntax_identity_state/1, 39 | syntax_identity_transformer/1, 40 | syntax_identity_partial/1, 41 | 42 | syntax_io_expr/1, 43 | syntax_io_unit/1, 44 | syntax_io_fail/1, 45 | syntax_io_state/1, 46 | syntax_io_transformer/1, 47 | syntax_io_partial/1, 48 | 49 | syntax_state_expr/1, 50 | syntax_state_unit/1, 51 | syntax_state_fail/1, 52 | syntax_state_state/1, 53 | syntax_state_transformer/1, 54 | syntax_state_partial/1, 55 | syntax_state_lenses/1 56 | ]). 57 | 58 | 59 | 60 | %%%---------------------------------------------------------------------------- 61 | %%% 62 | %%% suite 63 | %%% 64 | %%%---------------------------------------------------------------------------- 65 | all() -> 66 | [ 67 | {group, syntax} 68 | ]. 69 | 70 | groups() -> 71 | [ 72 | {syntax, [parallel], [ 73 | syntax_identity_expr, 74 | syntax_identity_unit, 75 | syntax_identity_fail, 76 | syntax_identity_state, 77 | syntax_identity_transformer, 78 | syntax_identity_partial, 79 | 80 | syntax_io_expr, 81 | syntax_io_unit, 82 | syntax_io_fail, 83 | syntax_io_state, 84 | syntax_io_transformer, 85 | syntax_io_partial, 86 | 87 | syntax_state_expr, 88 | syntax_state_unit, 89 | syntax_state_fail, 90 | syntax_state_state, 91 | syntax_state_transformer, 92 | syntax_state_partial, 93 | syntax_state_lenses 94 | ]} 95 | ]. 96 | 97 | %%%---------------------------------------------------------------------------- 98 | %%% 99 | %%% init 100 | %%% 101 | %%%---------------------------------------------------------------------------- 102 | init_per_suite(Config) -> 103 | Config. 104 | 105 | end_per_suite(_Config) -> 106 | ok. 107 | 108 | %% 109 | %% 110 | init_per_group(_, Config) -> 111 | Config. 112 | 113 | end_per_group(_, _Config) -> 114 | ok. 115 | 116 | 117 | %%%---------------------------------------------------------------------------- 118 | %%% 119 | %%% unit(s) : syntax 120 | %%% 121 | %%%---------------------------------------------------------------------------- 122 | 123 | x(X) -> X. 124 | 125 | a(m_identity, X) -> X; 126 | a(m_io, X) -> fun( ) -> X end; 127 | a(m_state, X) -> fun(S) -> [X|S] end. 128 | 129 | b(m_identity, X) -> X + 2; 130 | b(m_io, X) -> fun( ) -> X + 2 end; 131 | b(m_state, X) -> fun(S) -> [X + 2|S] end. 132 | 133 | c(m_identity, X) -> X + 3; 134 | c(m_io, X) -> fun( ) -> X + 3 end; 135 | c(m_state, X) -> fun(S) -> [X + 3|S] end. 136 | 137 | d(m_identity, X, Y, Z) -> X * Y * Z; 138 | d(m_io, X, Y, Z) -> fun( ) -> X * Y * Z end; 139 | d(m_state, X, Y, Z) -> fun(S) -> [X * Y * Z|S] end. 140 | 141 | t(m_identity, X) -> X + 2; 142 | t(m_io, X) -> fun( ) -> X + 2 end; 143 | t(m_state, X) -> fun(S) -> [X + 2|S] end. 144 | 145 | 146 | %% eq 6. 147 | -define(cat_compose_expr(Type), 148 | [Type || 149 | a(Type, 1), %% 1 150 | b(Type, _), %% 3 151 | c(Type, _) %% 6 152 | ] 153 | ). 154 | 155 | %% eq 6. 156 | -define(cat_compose_unit(Type), 157 | [Type || 158 | A =< x(1), 159 | unit(A + 0), %% 1 160 | unit(_ + 2), %% 3 161 | unit(_ + 3) %% 6 162 | ] 163 | ). 164 | 165 | %% eq error 166 | -define(cat_compose_fail(Type), 167 | [Type || 168 | a(Type, 1), 169 | fail(_ + 2), 170 | c(Type, _) 171 | ] 172 | ). 173 | 174 | %% eq 12. 175 | -define(cat_compose_state(Type), 176 | [Type || 177 | A <- a(Type, 1), %% 1 178 | b(Type, A), 179 | B <- c(Type, _), %% 6 180 | C <- a(Type, 2), %% 2 181 | d(Type, A, B, C) %% 12 182 | ] 183 | ). 184 | 185 | %% eq 24. 186 | -define(cat_compose_transformer(Type), 187 | [Type || 188 | A <- a(Type, 1), %% 1 189 | b(Type, A), 190 | B <- c(Type, _), %% 6 191 | a(Type, 2), %% 2 192 | cats:unit(_), 193 | C /= t(Type, _), %% 4 194 | d(Type, A, B, C) %% 24 195 | ] 196 | ). 197 | 198 | -define(cat_compose_partial(Type), 199 | [Type || 200 | a(Type, _), 201 | b(Type, _), 202 | c(Type, _) 203 | ] 204 | ). 205 | 206 | 207 | 208 | %% 209 | syntax_identity_expr(_) -> 210 | 6 = ?cat_compose_expr(m_identity). 211 | 212 | syntax_identity_unit(_) -> 213 | 6 = ?cat_compose_unit(m_identity). 214 | 215 | syntax_identity_fail(_) -> 216 | 3 = (catch ?cat_compose_fail(m_identity)). 217 | 218 | syntax_identity_state(_) -> 219 | 12 = ?cat_compose_state(m_identity). 220 | 221 | syntax_identity_transformer(_) -> 222 | 24 = ?cat_compose_transformer(m_identity). 223 | 224 | syntax_identity_partial(_) -> 225 | 6 = (?cat_compose_partial(m_identity))(1). 226 | 227 | 228 | %% 229 | syntax_io_expr(_) -> 230 | 6 = (?cat_compose_expr(m_io))(). 231 | 232 | syntax_io_unit(_) -> 233 | 6 = (?cat_compose_unit(m_io))(). 234 | 235 | syntax_io_fail(_) -> 236 | 3 = (catch (?cat_compose_fail(m_io))()). 237 | 238 | syntax_io_state(_) -> 239 | 12 = (?cat_compose_state(m_io))(). 240 | 241 | syntax_io_transformer(_) -> 242 | 24 = (?cat_compose_transformer(m_io))(). 243 | 244 | syntax_io_partial(_) -> 245 | 6 = ((?cat_compose_partial(m_io))(1))(). 246 | 247 | 248 | %% 249 | syntax_state_expr(_) -> 250 | [6|state] = (?cat_compose_expr(m_state))(state). 251 | 252 | syntax_state_unit(_) -> 253 | [6|state] = (?cat_compose_unit(m_state))(state). 254 | 255 | syntax_state_fail(_) -> 256 | 3 = (catch (?cat_compose_fail(m_state))(state)). 257 | 258 | syntax_state_state(_) -> 259 | [12|state] = (?cat_compose_state(m_state))(state). 260 | 261 | syntax_state_transformer(_) -> 262 | [24|state] = (?cat_compose_transformer(m_state))(state). 263 | 264 | syntax_state_partial(_) -> 265 | [6|state] = ((?cat_compose_partial(m_state))(1))(state). 266 | 267 | 268 | syntax_state_lenses(_) -> 269 | Expr = [m_state || 270 | X /= cats:get(lens:at(a)), 271 | unit(X + 10), 272 | cats:put(lens:at(b), _) 273 | ], 274 | 275 | [11|#{a := 1, b := 11}] = Expr(#{a => 1, b => 0}). 276 | 277 | -------------------------------------------------------------------------------- /test/maplike_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% 3 | -module(maplike_SUITE). 4 | -include_lib("common_test/include/ct.hrl"). 5 | 6 | %% 7 | %% common test 8 | -export([ 9 | all/0, 10 | groups/0, 11 | init_per_suite/1, 12 | end_per_suite/1, 13 | init_per_group/2, 14 | end_per_group/2 15 | ]). 16 | -export([ 17 | append/1, 18 | append1/1, 19 | insert/1, 20 | insert1/1, 21 | lookup/1, 22 | remove/1, 23 | has/1, 24 | keys/1, 25 | apply/1 26 | ]). 27 | 28 | %%%---------------------------------------------------------------------------- 29 | %%% 30 | %%% suite 31 | %%% 32 | %%%---------------------------------------------------------------------------- 33 | all() -> 34 | [ 35 | {group, bst}, 36 | {group, rbtree}, 37 | {group, heap} 38 | ]. 39 | 40 | groups() -> 41 | [ 42 | {bst, [parallel], 43 | [append, insert, lookup, remove, has, keys, apply]}, 44 | 45 | {rbtree, [parallel], 46 | [append, insert, lookup, remove, has, keys, apply]}, 47 | 48 | {heap, [parallel], 49 | [append1, insert1, keys]} 50 | ]. 51 | 52 | %%%---------------------------------------------------------------------------- 53 | %%% 54 | %%% init 55 | %%% 56 | %%%---------------------------------------------------------------------------- 57 | init_per_suite(Config) -> 58 | Config. 59 | 60 | end_per_suite(_Config) -> 61 | ok. 62 | 63 | %% 64 | %% 65 | init_per_group(Type, Config) -> 66 | [{type, Type}|Config]. 67 | 68 | end_per_group(_, _Config) -> 69 | ok. 70 | 71 | 72 | %%%---------------------------------------------------------------------------- 73 | %%% 74 | %%% unit test 75 | %%% 76 | %%%---------------------------------------------------------------------------- 77 | -define(LENGTH, 100). 78 | 79 | %% 80 | append(Config) -> 81 | Type = ?config(type, Config), 82 | List = randseq(?LENGTH), 83 | Keys = [Key || {Key, _} <- List], 84 | LMap0 = lists:foldl(fun Type:append/2, Type:new(), List), 85 | LMap0 = lists:foldl(fun Type:append/2, LMap0, shuffle(List)), 86 | 87 | LMap1 = lists:foldl(fun Type:append/2, Type:new(), Keys), 88 | LMap1 = lists:foldl(fun Type:append/2, LMap1, shuffle(Keys)). 89 | 90 | %% 91 | append1(Config) -> 92 | Type = ?config(type, Config), 93 | List = randseq(?LENGTH), 94 | Keys = [Key || {Key, _} <- List], 95 | lists:foldl(fun Type:append/2, Type:new(), List), 96 | lists:foldl(fun Type:append/2, Type:new(), Keys). 97 | 98 | %% 99 | insert(Config) -> 100 | Type = ?config(type, Config), 101 | List = randseq(?LENGTH), 102 | Lens = fun({Key, Val}, Acc) -> Type:insert(Key, Val, Acc) end, 103 | LMap = lists:foldl(Lens, Type:new(), List), 104 | LMap = lists:foldl(Lens, LMap, shuffle(List)). 105 | 106 | %% 107 | insert1(Config) -> 108 | Type = ?config(type, Config), 109 | List = randseq(?LENGTH), 110 | Lens = fun({Key, Val}, Acc) -> Type:insert(Key, Val, Acc) end, 111 | lists:foldl(Lens, Type:new(), List). 112 | 113 | 114 | %% 115 | lookup(Config) -> 116 | Type = ?config(type, Config), 117 | List = randseq(?LENGTH), 118 | LMap = Type:build(List), 119 | undefined = Type:lookup(any, LMap), 120 | lists:foreach( 121 | fun({Key, Val}) -> 122 | Val = Type:lookup(Key, LMap) 123 | end, 124 | shuffle(List) 125 | ). 126 | 127 | %% 128 | remove(Config) -> 129 | Type = ?config(type, Config), 130 | List = randseq(?LENGTH), 131 | LMap = Type:build(List), 132 | LMap = Type:remove(any, LMap), 133 | Empty= Type:new(), 134 | Empty= lists:foldl( 135 | fun({Key, _}, Acc) -> 136 | Type:remove(Key, Acc) 137 | end, 138 | LMap, 139 | shuffle(List) 140 | ). 141 | 142 | 143 | %% 144 | has(Config) -> 145 | Type = ?config(type, Config), 146 | List = randseq(?LENGTH), 147 | LMap = Type:build(List), 148 | false = Type:has(any, LMap), 149 | lists:foreach( 150 | fun({Key, _}) -> 151 | true = Type:has(Key, LMap) 152 | end, 153 | shuffle(List) 154 | ). 155 | 156 | 157 | %% 158 | keys(Config) -> 159 | Type = ?config(type, Config), 160 | List = randseq(?LENGTH), 161 | LMap = Type:build(List), 162 | Keys = lists:sort([Key || {Key, _} <- List]), 163 | Keys = lists:sort(Type:keys(LMap)). 164 | 165 | 166 | %% 167 | apply(Config) -> 168 | Type = ?config(type, Config), 169 | List = randseq(?LENGTH), 170 | LMap0 = Type:build(List), 171 | LMap1 = lists:foldl( 172 | fun({Key, _}, Acc) -> 173 | Type:apply(Key, fun '+'/1, Acc) 174 | end, 175 | LMap0, 176 | shuffle(List) 177 | ), 178 | LMap0 = lists:foldl( 179 | fun({Key, _}, Acc) -> 180 | Type:apply(Key, fun '-'/1, Acc) 181 | end, 182 | LMap1, 183 | shuffle(List) 184 | ), 185 | Type:apply(any, fun '+'/1, LMap0). 186 | 187 | 188 | %%%---------------------------------------------------------------------------- 189 | %%% 190 | %%% private 191 | %%% 192 | %%%---------------------------------------------------------------------------- 193 | 194 | %% 195 | %% 196 | randseq(0) -> []; 197 | randseq(N) -> [{rand:uniform(1 bsl 32), rand:uniform(1 bsl 32)} | randseq(N - 1)]. 198 | 199 | %% 200 | %% 201 | shuffle(List) -> 202 | [Y || {_, Y} <- lists:keysort(1, [{rand:uniform(), X} || X <- List])]. 203 | 204 | 205 | 206 | %% 207 | %% 208 | '+'(undefined) -> 209 | undefined; 210 | '+'(X) -> 211 | X + 1. 212 | 213 | '-'(undefined) -> 214 | undefined; 215 | '-'(X) -> 216 | X - 1. 217 | -------------------------------------------------------------------------------- /test/q_SUITE.erl: -------------------------------------------------------------------------------- 1 | -module(q_SUITE). 2 | -include_lib("common_test/include/ct.hrl"). 3 | -include_lib("datum/include/datum.hrl"). 4 | 5 | %% 6 | %% common test 7 | -export([ 8 | all/0 9 | ,groups/0 10 | ,init_per_suite/1 11 | ,end_per_suite/1 12 | ,init_per_group/2 13 | ,end_per_group/2 14 | ]). 15 | 16 | -export([ 17 | queue/1, 18 | empty/1, 19 | deq_option/1, 20 | dequeue/1, 21 | deqt_option/1, 22 | last/1, 23 | liat/1 24 | ]). 25 | 26 | %%%---------------------------------------------------------------------------- 27 | %%% 28 | %%% suite 29 | %%% 30 | %%%---------------------------------------------------------------------------- 31 | all() -> 32 | [ 33 | {group, q}, 34 | {group, deq} 35 | ]. 36 | 37 | groups() -> 38 | [ 39 | {q, [parallel], 40 | [queue, empty, deq_option]}, 41 | 42 | {deq, [parallel], 43 | [queue, deq_option, dequeue, deqt_option, last, liat]} 44 | ]. 45 | 46 | %%%---------------------------------------------------------------------------- 47 | %%% 48 | %%% init 49 | %%% 50 | %%%---------------------------------------------------------------------------- 51 | init_per_suite(Config) -> 52 | Config. 53 | 54 | end_per_suite(_Config) -> 55 | ok. 56 | 57 | %% 58 | %% 59 | init_per_group(Type, Config) -> 60 | [{type, Type}|Config]. 61 | 62 | end_per_group(_, _Config) -> 63 | ok. 64 | 65 | %%%---------------------------------------------------------------------------- 66 | %%% 67 | %%% unit test 68 | %%% 69 | %%%---------------------------------------------------------------------------- 70 | 71 | queue(Config) -> 72 | Type = ?config(type, Config), 73 | Seq = lists:seq(1, 5), 74 | Queue0 = lists:foldl(fun Type:enq/2, Type:new(), Seq), 75 | {1, Queue1} = Type:deq(Queue0), 76 | false = Type:is_empty(Queue1), 77 | 78 | {2, Queue2} = Type:deq(Queue1), 79 | false = Type:is_empty(Queue2), 80 | 81 | {3, Queue3} = Type:deq(Queue2), 82 | false = Type:is_empty(Queue3), 83 | 84 | {4, Queue4} = Type:deq(Queue3), 85 | false = Type:is_empty(Queue4), 86 | 87 | {5, Queue5} = Type:deq(Queue4), 88 | true = Type:is_empty(Queue5). 89 | 90 | empty(Config) -> 91 | Type = ?config(type, Config), 92 | ?queue() = Type:new(). 93 | 94 | deq_option(Config) -> 95 | Type = ?config(type, Config), 96 | Empty = Type:new(), 97 | {undefined, Empty} = Type:deq(Empty). 98 | 99 | 100 | dequeue(Config) -> 101 | Type = ?config(type, Config), 102 | Seq = lists:seq(1, 5), 103 | Queue0 = lists:foldl(fun Type:enqh/2, Type:new(), Seq), 104 | {1, Queue1} = Type:deqt(Queue0), 105 | false = Type:is_empty(Queue1), 106 | 107 | {2, Queue2} = Type:deqt(Queue1), 108 | false = Type:is_empty(Queue2), 109 | 110 | {3, Queue3} = Type:deqt(Queue2), 111 | false = Type:is_empty(Queue3), 112 | 113 | {4, Queue4} = Type:deqt(Queue3), 114 | false = Type:is_empty(Queue4), 115 | 116 | {5, Queue5} = Type:deqt(Queue4), 117 | true = Type:is_empty(Queue5). 118 | 119 | deqt_option(Config) -> 120 | Type = ?config(type, Config), 121 | Empty = Type:new(), 122 | {undefined, Empty} = Type:deqt(Empty). 123 | 124 | 125 | last(Config) -> 126 | Type = ?config(type, Config), 127 | Queue = Type:build([1, 2, 3, 4]), 128 | 4 = Type:last(Queue). 129 | 130 | liat(Config) -> 131 | Type = ?config(type, Config), 132 | Queue = Type:build([1, 2, 3, 4]), 133 | Queue = Type:liat(Type:enq(x, Queue)). 134 | 135 | -------------------------------------------------------------------------------- /test/ring_tests.erl: -------------------------------------------------------------------------------- 1 | -module(ring_tests). 2 | % -include_lib("eunit/include/eunit.hrl"). 3 | 4 | % -define(HASH, sha). 5 | % -define(M, 8). 6 | % -define(N, 3). 7 | % -define(Q, 16). 8 | % -define(KEYS, [ 9 | % {<<"deadbeef">>, self()} 10 | % ,{<<"beeff00d">>, self()} 11 | % ,{<<"f001cafe">>, self()} 12 | % ,{atom, self()} 13 | % ,{list, self()} 14 | % ,{hash, self()} 15 | % ,{30, self()} 16 | % ,{128, self()} 17 | % ,{150, self()} 18 | % ]). 19 | 20 | % chord_test_() -> 21 | % {foreach, 22 | % fun chord/0, 23 | % fun free/1, 24 | % [ 25 | % fun size/1 26 | % ,fun addresses/1 27 | % ,fun address_addr/1 28 | % ,fun address_hash/1 29 | % ,fun address_binary/1 30 | % ,fun address_term/1 31 | % ,fun whereis/1 32 | % ,fun predecessors/1 33 | % ,fun successors/1 34 | % ,fun whois/1 35 | % ] 36 | % }. 37 | 38 | % rint_test_() -> 39 | % {foreach, 40 | % fun ring/0, 41 | % fun free/1, 42 | % [ 43 | % fun size/1 44 | % ,fun addresses/1 45 | % ,fun address_addr/1 46 | % ,fun address_hash/1 47 | % ,fun address_binary/1 48 | % ,fun address_term/1 49 | % ,fun whereis/1 50 | % ,fun predecessors/1 51 | % ,fun successors/1 52 | % ,fun whois/1 53 | % ,fun consistency/1 54 | % ] 55 | % }. 56 | 57 | 58 | % chord() -> 59 | % {chord, 60 | % lists:foldl( 61 | % fun({Key, Val}, Acc) -> chord:join(Key, Val, Acc) end, 62 | % chord:new([{hash, ?HASH}, {m, ?M}, {n, ?N}, {q, ?Q}]), 63 | % ?KEYS 64 | % ) 65 | % }. 66 | 67 | % ring() -> 68 | % {ring, 69 | % lists:foldl( 70 | % fun({Key, Val}, Acc) -> ring:join(Key, Val, Acc) end, 71 | % ring:new([{hash, ?HASH}, {m, ?M}, {n, ?N}, {q, ?Q}]), 72 | % ?KEYS 73 | % ) 74 | % }. 75 | 76 | % free(_) -> 77 | % ok. 78 | 79 | % %% 80 | % %% 81 | % size({Mod, Ring}) -> 82 | % ?_assertEqual(length(?KEYS), Mod:size(Ring)). 83 | 84 | % %% 85 | % %% 86 | % addresses({Mod, Ring}) -> 87 | % Top = trunc(math:pow(2, ?M)), 88 | % Inc = Top div ?Q, 89 | % Set = lists:seq(Inc - 1, Top - 1, Inc), 90 | % ?_assertEqual(Set, Mod:address(Ring)). 91 | 92 | % %% 93 | % %% 94 | % address_addr({Mod, Ring}) -> 95 | % Top = trunc(math:pow(2, ?M)), 96 | % Addr = random:uniform(10 * Top), 97 | % ?_assertEqual(Addr rem Top, Mod:address(Addr, Ring)). 98 | 99 | % address_hash({Mod, Ring}) -> 100 | % <> = Key = crypto:hash(?HASH, <<"qazwsxedc">>), 101 | % ?_assertEqual(Addr, Mod:address({hash, Key}, Ring)). 102 | 103 | % address_binary({Mod, Ring}) -> 104 | % Key = <<"qazwsxedc">>, 105 | % <> = crypto:hash(?HASH, Key), 106 | % ?_assertEqual(Addr, Mod:address(Key, Ring)). 107 | 108 | % address_term({Mod, Ring}) -> 109 | % Key = {<<"qaz">>, <<"wsx">>, <<"edc">>}, 110 | % <> = crypto:hash(?HASH, erlang:term_to_binary(Key)), 111 | % ?_assertEqual(Addr, Mod:address(Key, Ring)). 112 | 113 | % %% 114 | % %% 115 | % whereis({Mod, Ring}) -> 116 | % Key = <<"qazwsxedc">>, 117 | % Addr = Mod:address(Key, Ring), 118 | % ?_assert(Addr < erlang:element(1, Mod:whereis(Key, Ring))). 119 | 120 | % %% 121 | % %% 122 | % predecessors({Mod, Ring}) -> 123 | % Key = <<"qazwsxedc">>, 124 | % {Addr, _} = Mod:whereis(Key, Ring), 125 | % {Head, Tail} = lists:splitwith( 126 | % fun({X, _}) -> X =/= Addr end, 127 | % Mod:successors(?Q, 0, Ring) %% return shards 128 | % ), 129 | % ?_assert( 130 | % lists:prefix(Mod:predecessors(Key, Ring), lists:reverse(Head) ++ lists:reverse(Tail)) 131 | % ); 132 | % predecessors(_) -> 133 | % []. 134 | 135 | % %% 136 | % %% 137 | % successors({Mod, Ring}) -> 138 | % Key = <<"qazwsxedc">>, 139 | % {Addr, _} = Mod:whereis(Key, Ring), 140 | % {Head, Tail} = lists:splitwith( 141 | % fun({X, _}) -> X =/= Addr end, 142 | % Mod:successors(?Q, 0, Ring) %% return shards 143 | % ), 144 | % ?_assert( 145 | % lists:prefix(Mod:successors(Key, Ring), Tail ++ Head) 146 | % ); 147 | % successors(_) -> 148 | % []. 149 | 150 | % %% 151 | % %% 152 | % whois({Mod, Ring}) -> 153 | % {Key, Pid} = lists:nth(random:uniform(length(?KEYS)), ?KEYS), 154 | % List = lists:filter( 155 | % fun({_, X}) -> X =:= Key end, 156 | % Mod:successors(?Q, 0, Ring) 157 | % ), 158 | % ?_assertEqual(List, Mod:whois(Key, Ring)); 159 | % whois(_) -> 160 | % []. 161 | 162 | % %% 163 | % %% 164 | % consistency({Mod, Ring}) -> 165 | % random:seed(os:timestamp()), 166 | % {Key, Pid} = lists:nth(random:uniform(length(?KEYS)), ?KEYS), 167 | % ?_assertEqual(Ring, Mod:join(Key, Pid, Mod:leave(Key, Ring))). 168 | 169 | 170 | 171 | 172 | -------------------------------------------------------------------------------- /test/tests.config: -------------------------------------------------------------------------------- 1 | %% 2 | %% suites 3 | {suites, ".", all}. 4 | -------------------------------------------------------------------------------- /test/traversable_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% @doc 2 | %% 3 | -module(traversable_SUITE). 4 | -include_lib("common_test/include/ct.hrl"). 5 | 6 | %% 7 | %% common test 8 | -export([ 9 | all/0 10 | ,groups/0 11 | ,init_per_suite/1 12 | ,end_per_suite/1 13 | ,init_per_group/2 14 | ,end_per_group/2 15 | ]). 16 | -export([ 17 | iterate/1, 18 | drop/1, 19 | dropwhile/1, 20 | filter/1, 21 | foreach/1, 22 | map/1, 23 | split/1, 24 | splitwhile/1, 25 | take/1, 26 | takewhile/1 27 | ]). 28 | 29 | 30 | %%%---------------------------------------------------------------------------- 31 | %%% 32 | %%% suite 33 | %%% 34 | %%%---------------------------------------------------------------------------- 35 | all() -> 36 | [ 37 | {group, stream}, 38 | {group, heap}, 39 | {group, q}, 40 | {group, deq}, 41 | {group, bst}, 42 | {group, rbtree} 43 | ]. 44 | 45 | groups() -> 46 | [ 47 | {stream, [parallel], 48 | [iterate, drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile]}, 49 | 50 | {heap, [parallel], 51 | [iterate, drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile]}, 52 | 53 | {q, [parallel], 54 | [iterate, drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile]}, 55 | 56 | {deq, [parallel], 57 | [iterate, drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile]}, 58 | 59 | {bst, [parallel], 60 | [drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile]}, 61 | 62 | {rbtree, [parallel], 63 | [drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile]} 64 | ]. 65 | 66 | %%%---------------------------------------------------------------------------- 67 | %%% 68 | %%% init 69 | %%% 70 | %%%---------------------------------------------------------------------------- 71 | init_per_suite(Config) -> 72 | Config. 73 | 74 | end_per_suite(_Config) -> 75 | ok. 76 | 77 | %% 78 | %% 79 | init_per_group(Type, Config) -> 80 | [{type, Type}|Config]. 81 | 82 | end_per_group(_, _Config) -> 83 | ok. 84 | 85 | 86 | %%%---------------------------------------------------------------------------- 87 | %%% 88 | %%% unit test 89 | %%% 90 | %%%---------------------------------------------------------------------------- 91 | -define(LENGTH, 100). 92 | 93 | %% 94 | iterate(Config) -> 95 | Type = ?config(type, Config), 96 | List = randseq(?LENGTH), 97 | Tail = Type:build(List), 98 | false = Type:is_empty(Tail), 99 | iterate(Type:head(Tail), Type:tail(Tail), Type, List). 100 | 101 | iterate(undefined, Tail, Type, _List) -> 102 | true = Type:is_empty(Tail); 103 | 104 | iterate(Head, Tail, Type, List) -> 105 | true = lists:member(el1(Head), List), 106 | iterate(Type:head(Tail), Type:tail(Tail), Type, List). 107 | 108 | 109 | %% 110 | drop(Config) -> 111 | Type = ?config(type, Config), 112 | List = randseq(?LENGTH), 113 | Empty = Type:new(), 114 | Empty = Type:drop(?LENGTH, Type:build(List)). 115 | 116 | %% 117 | dropwhile(Config) -> 118 | Type = ?config(type, Config), 119 | List = randseq(?LENGTH), 120 | Empty = Type:new(), 121 | Empty = lists:foldl( 122 | fun(Key, Acc) -> 123 | Type:dropwhile(fun(X) -> el1(X) =/= Key end, Acc) 124 | end, 125 | Type:build(List), 126 | shuffle(List) 127 | ). 128 | 129 | %% 130 | filter(Config) -> 131 | Type = ?config(type, Config), 132 | List = randseq(?LENGTH), 133 | Empty = Type:new(), 134 | Empty = lists:foldl( 135 | fun(Key, Acc) -> 136 | Type:filter(fun(X) -> el1(X) =/= Key end, Acc) 137 | end, 138 | Type:build(List), 139 | shuffle(List) 140 | ). 141 | 142 | %% 143 | foreach(Config) -> 144 | Type = ?config(type, Config), 145 | List = randseq(?LENGTH), 146 | ok = Type:foreach(fun(X) -> X end, Type:build(List)). 147 | 148 | 149 | %% 150 | map(Config) -> 151 | Type = ?config(type, Config), 152 | List = randseq(?LENGTH), 153 | Empty = Type:new(), 154 | Empty = Type:filter( 155 | fun(X) -> not el2(X) end, 156 | Type:map(fun(X) -> lists:member(el1(X), List) end, Type:build(List)) 157 | ). 158 | 159 | %% 160 | split(Config) -> 161 | Type = ?config(type, Config), 162 | List = randseq(?LENGTH), 163 | Empty = Type:new(), 164 | Struct = Type:build(List), 165 | {_, Empty} = Type:split(?LENGTH, Struct), 166 | {Empty, _} = Type:split(0, Struct). 167 | 168 | %% 169 | splitwhile(Config) -> 170 | Type = ?config(type, Config), 171 | List = randseq(?LENGTH), 172 | Empty = Type:new(), 173 | Struct = Type:build(List), 174 | {_, Empty} = Type:splitwhile(fun(_) -> true end, Struct), 175 | {Empty, _} = Type:splitwhile(fun(_) -> false end, Struct). 176 | 177 | %% 178 | take(Config) -> 179 | Type = ?config(type, Config), 180 | List = randseq(?LENGTH), 181 | Struct = Type:build(List), 182 | Type:take(?LENGTH, Struct). 183 | 184 | 185 | %% 186 | takewhile(Config) -> 187 | Type = ?config(type, Config), 188 | List = randseq(?LENGTH), 189 | Struct = Type:build(List), 190 | Type:takewhile(fun(_) -> true end, Struct). 191 | 192 | 193 | %%%---------------------------------------------------------------------------- 194 | %%% 195 | %%% private 196 | %%% 197 | %%%---------------------------------------------------------------------------- 198 | 199 | %% 200 | randseq(0) -> []; 201 | randseq(N) -> [rand:uniform(1 bsl 32) | randseq(N - 1)]. 202 | 203 | %% 204 | shuffle(List) -> 205 | [Y || {_, Y} <- lists:keysort(1, [{rand:uniform(), X} || X <- List])]. 206 | 207 | %% 208 | el1({Key, _}) -> 209 | Key; 210 | el1(X) -> 211 | X. 212 | 213 | %% 214 | el2({_, Val}) -> 215 | Val; 216 | el2(X) -> 217 | X. 218 | 219 | -------------------------------------------------------------------------------- /test/tree_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2017, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | -module(tree_SUITE). 18 | -include_lib("common_test/include/ct.hrl"). 19 | -include_lib("datum/include/datum.hrl"). 20 | 21 | 22 | -compile({parse_transform, category}). 23 | -compile({no_auto_import,[apply/2]}). 24 | 25 | %% 26 | %% common test 27 | -export([ 28 | all/0 29 | ,groups/0 30 | ,init_per_suite/1 31 | ,end_per_suite/1 32 | ,init_per_group/2 33 | ,end_per_group/2 34 | ]). 35 | 36 | -export([ 37 | new/1, 38 | empty/1, 39 | 40 | append/1, 41 | insert/1, 42 | lookup/1, 43 | remove/1, 44 | has/1, 45 | keys/1, 46 | apply/1, 47 | 48 | build/1, 49 | drop/1, 50 | dropwhile/1, 51 | filter/1, 52 | foreach/1, 53 | map/1, 54 | split/1, 55 | splitwhile/1, 56 | take/1, 57 | takewhile/1, 58 | 59 | % fold/1, 60 | % foldl/1, 61 | % foldr/1, 62 | % unfold/1, 63 | 64 | min/1, 65 | max/1 66 | ]). 67 | 68 | %%%---------------------------------------------------------------------------- 69 | %%% 70 | %%% suite 71 | %%% 72 | %%%---------------------------------------------------------------------------- 73 | all() -> 74 | [ 75 | {group, bst}, 76 | {group, rbtree} 77 | ]. 78 | 79 | groups() -> 80 | [ 81 | {bst, [parallel], 82 | [new, empty, 83 | append, insert, lookup, remove, has, keys, apply, 84 | build, drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile, 85 | % fold, foldl, foldr, unfold, min, max]}, 86 | min, max]}, 87 | 88 | {rbtree, [parallel], 89 | [new, empty, 90 | append, insert, lookup, remove, has, keys, apply, 91 | build, drop, dropwhile, filter, foreach, map, split, splitwhile, take, takewhile, 92 | % fold, foldl, foldr, unfold, min, max]} 93 | min, max]} 94 | ]. 95 | 96 | %%%---------------------------------------------------------------------------- 97 | %%% 98 | %%% init 99 | %%% 100 | %%%---------------------------------------------------------------------------- 101 | init_per_suite(Config) -> 102 | Config. 103 | 104 | end_per_suite(_Config) -> 105 | ok. 106 | 107 | %% 108 | %% 109 | init_per_group(Type, Config) -> 110 | [{type, Type}|Config]. 111 | 112 | end_per_group(_, _Config) -> 113 | ok. 114 | 115 | %%%---------------------------------------------------------------------------- 116 | %%% 117 | %%% tree primitives 118 | %%% 119 | %%%---------------------------------------------------------------------------- 120 | -define(LENGTH, 100). 121 | 122 | new(Config) -> 123 | Type = ?config(type, Config), 124 | tree = erlang:element(1, Type:new()). 125 | 126 | empty(Config) -> 127 | Type = ?config(type, Config), 128 | ?tree() = Type:new(). 129 | 130 | 131 | append(Config) -> 132 | Type = ?config(type, Config), 133 | [{1,1}] = Type:list(Type:append({1,1}, Type:new())). 134 | 135 | insert(Config) -> 136 | Type = ?config(type, Config), 137 | List = randseq(?LENGTH), 138 | Lens = fun({Key, Val}, Acc) -> Type:insert(Key, Val, Acc) end, 139 | Tree = lists:foldl(Lens, Type:new(), List), 140 | lists:foreach( 141 | fun({Key, Val}) -> 142 | Val = Type:lookup(Key, Tree) 143 | end, 144 | shuffle(List) 145 | ). 146 | 147 | lookup(Config) -> 148 | Type = ?config(type, Config), 149 | List = randseq(?LENGTH), 150 | Tree = Type:build(List), 151 | undefined = Type:lookup(any, Tree), 152 | lists:foreach( 153 | fun({Key, Val}) -> 154 | Val = Type:lookup(Key, Tree) 155 | end, 156 | shuffle(List) 157 | ). 158 | 159 | remove(Config) -> 160 | Type = ?config(type, Config), 161 | List = randseq(?LENGTH), 162 | Tree = Type:build(List), 163 | Tree = Type:remove(any, Tree), 164 | Empty= Type:new(), 165 | Empty= lists:foldl( 166 | fun({Key, _}, Acc) -> 167 | Type:remove(Key, Acc) 168 | end, 169 | Tree, 170 | shuffle(List) 171 | ). 172 | 173 | has(Config) -> 174 | Type = ?config(type, Config), 175 | List = randseq(?LENGTH), 176 | Tree = Type:build(List), 177 | undefined = Type:lookup(any, Tree), 178 | lists:foreach( 179 | fun({Key, _}) -> 180 | true = Type:has(Key, Tree) 181 | end, 182 | shuffle(List) 183 | ). 184 | 185 | keys(Config) -> 186 | Type = ?config(type, Config), 187 | List = randseq(?LENGTH), 188 | Tree = Type:build(List), 189 | Keys = lists:sort([Key || {Key, _} <- List]), 190 | Keys = Type:keys(Tree). 191 | 192 | apply(Config) -> 193 | Type = ?config(type, Config), 194 | List = randseq(?LENGTH), 195 | Tree0= Type:build(List), 196 | Tree1= lists:foldl( 197 | fun({Key, Val}, Acc) -> 198 | Type:apply(Key, fun(X) -> X - Val end, Acc) 199 | end, 200 | Tree0, 201 | shuffle(List) 202 | ), 203 | 0 = Type:foldl(fun({_, X}, Acc) -> Acc + X end, 0, Tree1). 204 | 205 | 206 | build(Config) -> 207 | Type = ?config(type, Config), 208 | Tree = Type:build([{2, b}, {1, a}, {3, c}]), 209 | [{1, a}, {2, b}, {3, c}] = Type:list(Tree). 210 | 211 | 212 | drop(Config) -> 213 | Type = ?config(type, Config), 214 | List = shuffle(seq(?LENGTH)), 215 | N = rand:uniform(?LENGTH), 216 | Tree = Type:drop(N, Type:build(List)), 217 | Keys = lists:seq(N + 1, ?LENGTH), 218 | Keys = Type:keys(Tree). 219 | 220 | dropwhile(Config) -> 221 | Type = ?config(type, Config), 222 | List = shuffle(seq(?LENGTH)), 223 | N = rand:uniform(?LENGTH), 224 | Tree = Type:dropwhile(fun({Key, _}) -> Key =< N end, Type:build(List)), 225 | Keys = lists:seq(N + 1, ?LENGTH), 226 | Keys = Type:keys(Tree). 227 | 228 | filter(Config) -> 229 | Type = ?config(type, Config), 230 | List = shuffle(seq(?LENGTH)), 231 | N = rand:uniform(?LENGTH), 232 | Tree = Type:filter(fun({Key, _}) -> Key =< N end, Type:build(List)), 233 | Keys = lists:seq(1, N), 234 | Keys = Type:keys(Tree). 235 | 236 | %% 237 | foreach(Config) -> 238 | Type = ?config(type, Config), 239 | List = randseq(?LENGTH), 240 | ok = Type:foreach(fun(X) -> X end, Type:build(List)). 241 | 242 | %% 243 | map(Config) -> 244 | Type = ?config(type, Config), 245 | List = randseq(?LENGTH), 246 | Tree = Type:map(fun({_, _}) -> 0 end, Type:build(List)), 247 | 0 = Type:foldl(fun({_, X}, Acc) -> Acc + X end, 0, Tree). 248 | 249 | %% 250 | split(Config) -> 251 | Type = ?config(type, Config), 252 | List = shuffle(seq(?LENGTH)), 253 | N = rand:uniform(?LENGTH), 254 | {TreeA, TreeB} = Type:split(N, Type:build(List)), 255 | KeyA = lists:seq(1, N), 256 | KeyA = Type:keys(TreeA), 257 | 258 | KeyB = lists:seq(N + 1, ?LENGTH), 259 | KeyB = Type:keys(TreeB). 260 | 261 | %% 262 | splitwhile(Config) -> 263 | Type = ?config(type, Config), 264 | List = shuffle(seq(?LENGTH)), 265 | N = rand:uniform(?LENGTH), 266 | {TreeA, TreeB} = Type:splitwhile(fun({Key, _}) -> Key =< N end, Type:build(List)), 267 | KeyA = lists:seq(1, N), 268 | KeyA = Type:keys(TreeA), 269 | 270 | KeyB = lists:seq(N + 1, ?LENGTH), 271 | KeyB = Type:keys(TreeB). 272 | 273 | %% 274 | take(Config) -> 275 | Type = ?config(type, Config), 276 | List = shuffle(seq(?LENGTH)), 277 | N = rand:uniform(?LENGTH), 278 | Tree = Type:take(N, Type:build(List)), 279 | Keys = lists:seq(1, N), 280 | Keys = Type:keys(Tree). 281 | 282 | %% 283 | takewhile(Config) -> 284 | Type = ?config(type, Config), 285 | List = shuffle(seq(?LENGTH)), 286 | N = rand:uniform(?LENGTH), 287 | Tree = Type:takewhile(fun({Key, _}) -> Key =< N end, Type:build(List)), 288 | Keys = lists:seq(1, N), 289 | Keys = Type:keys(Tree). 290 | 291 | %% 292 | min(Config) -> 293 | Type = ?config(type, Config), 294 | List = shuffle(seq(?LENGTH)), 295 | Tree = Type:build(List), 296 | Min = lists:min(List), 297 | Min = Type:min(Tree). 298 | 299 | %% 300 | max(Config) -> 301 | Type = ?config(type, Config), 302 | List = shuffle(seq(?LENGTH)), 303 | Tree = Type:build(List), 304 | Max = lists:max(List), 305 | Max = Type:max(Tree). 306 | 307 | 308 | %%%---------------------------------------------------------------------------- 309 | %%% 310 | %%% private 311 | %%% 312 | %%%---------------------------------------------------------------------------- 313 | 314 | %% 315 | randseq(0) -> 316 | []; 317 | randseq(N) -> 318 | [{rand:uniform(1 bsl 32), N} | randseq(N - 1)]. 319 | 320 | seq(0) -> 321 | []; 322 | seq(N) -> 323 | [{N, N} | seq(N - 1)]. 324 | 325 | %% 326 | shuffle(List) -> 327 | [Y || {_, Y} <- lists:keysort(1, [{rand:uniform(), X} || X <- List])]. 328 | 329 | 330 | 331 | -------------------------------------------------------------------------------- /test/typecast_SUITE.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% Copyright (c) 2016, Dmitry Kolesnikov 3 | %% All Rights Reserved. 4 | %% 5 | %% Licensed under the Apache License, Version 2.0 (the "License"); 6 | %% you may not use this file except in compliance with the License. 7 | %% You may obtain a copy of the License at 8 | %% 9 | %% http://www.apache.org/licenses/LICENSE-2.0 10 | %% 11 | %% Unless required by applicable law or agreed to in writing, software 12 | %% distributed under the License is distributed on an "AS IS" BASIS, 13 | %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | %% See the License for the specific language governing permissions and 15 | %% limitations under the License. 16 | %% 17 | %% @doc 18 | %% 19 | -module(typecast_SUITE). 20 | 21 | -export([all/0]). 22 | -export([ 23 | cast_int/1, 24 | cast_float/1, 25 | cast_string/1, 26 | cast_unicode_string/1, 27 | cast_characters/1, 28 | cast_unicode_characters/1, 29 | cast_atom/1, 30 | cast_new_atom/1, 31 | cast_hexdec/1, 32 | cast_timestamp/1 33 | ]). 34 | 35 | 36 | all() -> 37 | [Test || {Test, NAry} <- ?MODULE:module_info(exports), 38 | Test =/= module_info, 39 | Test =/= init_per_suite, 40 | Test =/= end_per_suite, 41 | NAry =:= 1 42 | ]. 43 | 44 | cast_int(_) -> 45 | 1 = typecast:i(<<"1">>), 46 | 1 = typecast:i('1'), 47 | 1 = typecast:i("1"), 48 | 1 = typecast:i(1), 49 | 1 = typecast:i(1.0), 50 | 1539713652691476 = typecast:i({1539,713652,691476}), 51 | undefined = try typecast:i({1}) catch _:_ -> undefined end. 52 | 53 | cast_float(_) -> 54 | 1.0 = typecast:f(<<"1.0">>), 55 | 1.0 = typecast:f('1.0'), 56 | 1.0 = typecast:f("1.0"), 57 | 1.0 = typecast:f(1), 58 | 1.0 = typecast:f(1.0), 59 | undefined = try typecast:f({1.0}) catch _:_ -> undefined end. 60 | 61 | cast_string(_) -> 62 | <<>> = typecast:s(undefined), 63 | <<"1">> = typecast:s(<<"1">>), 64 | <<"1">> = typecast:s('1'), 65 | <<"1">> = typecast:s("1"), 66 | <<"1">> = typecast:s(1), 67 | <<"1.000000000">> = typecast:s(1.0), 68 | undefined = try typecast:s({<<"1">>}) catch _:_ -> undefined end. 69 | 70 | cast_unicode_string(_) -> 71 | <<>> = typecast:ls(undefined), 72 | <<"тест"/utf8>> = typecast:ls(<<"тест"/utf8>>), 73 | % <<"тест"/utf8>> = typecast:ls('тест'), 74 | <<"тест"/utf8>> = typecast:ls("тест"), 75 | <<"1">> = typecast:ls(1), 76 | <<"1.000000000">> = typecast:ls(1.0), 77 | undefined = try typecast:s({<<"тест"/utf8>>}) catch _:_ -> undefined end. 78 | 79 | cast_characters(_) -> 80 | [] = typecast:c(undefined), 81 | "1" = typecast:c(<<"1">>), 82 | "1" = typecast:c('1'), 83 | "1" = typecast:c("1"), 84 | "1" = typecast:c(1), 85 | "1.000000000" = typecast:c(1.0), 86 | undefined = try typecast:c({"1"}) catch _:_ -> undefined end. 87 | 88 | cast_unicode_characters(_) -> 89 | [] = typecast:lc(undefined), 90 | "тест" = typecast:lc(<<"тест"/utf8>>), 91 | % "тест" = typecast:lc('тест'), 92 | "тест" = typecast:lc("тест"), 93 | "1" = typecast:lc(1), 94 | "1.000000000" = typecast:lc(1.0), 95 | undefined = try typecast:lc({"тест"}) catch _:_ -> undefined end. 96 | 97 | cast_atom(_) -> 98 | '1' = typecast:a(<<"1">>), 99 | '1' = typecast:a('1'), 100 | '1' = typecast:a("1"), 101 | '1' = typecast:a(1), 102 | '1.000000000' = typecast:a(1.0), 103 | undefined = try typecast:a({'1'}) catch _:_ -> undefined end. 104 | 105 | cast_new_atom(_) -> 106 | _ = typecast:atom(<<"10">>), 107 | _ = typecast:atom('11'), 108 | _ = typecast:atom("12"), 109 | _ = typecast:atom(13), 110 | _ = typecast:atom(14.0), 111 | undefined = try typecast:atom({'15.0'}) catch _:_ -> undefined end. 112 | 113 | cast_hexdec(_) -> 114 | <<"000f">> = typecast:x(<<0,15>>), 115 | <<"6162">> = typecast:x('ab'), 116 | <<"000f">> = typecast:x([0,15]), 117 | <<"f">> = typecast:x(15), 118 | undefined = try typecast:x({15}) catch _:_ -> undefined end. 119 | 120 | cast_timestamp(_) -> 121 | {1539,713652,691476} = typecast:t(typecast:i({1539,713652,691476})), 122 | {1539,713652,691476} = typecast:t(1539713652691476). 123 | 124 | --------------------------------------------------------------------------------