diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml new file mode 100644 index 0000000..9611b10 --- /dev/null +++ b/.github/workflows/main.yml @@ -0,0 +1,31 @@ +name: Integration tests + +on: + pull_request: + branches: + - 'master' + push: + branches: + - 'master' + +jobs: + build: + name: OTP ${{ matrix.otp_version }} on ${{ matrix.os }} + runs-on: ${{ matrix.os }} + container: + image: erlang:${{matrix.otp_version}} + + strategy: + matrix: + otp_version: ['27', '25', '23'] + os: [ubuntu-latest] + + steps: + - uses: actions/checkout@v4 + + - name: Compile + run: rebar3 compile + - name: Dialyzer + run: rebar3 as test dialyzer + - name: EUnit + run: TERM=xterm rebar3 eunit diff --git a/.gitignore b/.gitignore index 55a8799..d306af0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,18 @@ +.erlware_commons_plt +.eunit/* +deps/* +doc/*.html +doc/*.css +doc/edoc-info +doc/erlang.png +ebin/* +.* +!.github _build erl_crash.dump *.pyc +*~ +TEST-*.xml +/foo + +src/ec_semver_parser.peg diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md new file mode 100644 index 0000000..cca6505 --- /dev/null +++ b/CONTRIBUTING.md @@ -0,0 +1,139 @@ +Contributing +============ + +Introduction +------------ + +This document describes the usages and rules to follow when contributing +to this project. + +It uses the uppercase keywords SHOULD for optional but highly recommended +conditions and MUST for required conditions. + +`git` is a distributed source code versioning system. This document refers +to three different repositories hosting the source code of the project. +`Your local copy` refers to the copy of the repository that you have on +your computer. The remote repository `origin` refers to your fork of the +project's repository that you can find in your GitHub account. The remote +repository `upstream` refers to the official repository for this project. + +Reporting bugs +-------------- + +Upon identifying a bug you SHOULD submit a ticket, regardless of your +plan for fixing it. If you plan to fix the bug, you SHOULD discuss your +plans to avoid having your work rejected. + +Before implementing a new feature, you SHOULD submit a ticket for discussion +on your plans. The feature might have been rejected already, or the +implementation might already be decided. + +Cloning +------- + +You MUST fork the project's repository to your GitHub account by clicking +on the `Fork` button. + +Then, from your fork's page, copy the `Git Read-Only` URL to your clipboard. +You MUST perform the following commands in the folder you choose, replacing +`$URL` by the URL you just copied, `$UPSTREAM_URL` by the `Git Read-Only` +project of the official repository, and `$PROJECT` by the name of this project. + +``` bash +$ git clone "$URL" +$ cd $PROJECT +$ git remote add upstream $UPSTREAM_URL +``` + +Branching +--------- + +Before starting working on the code, you MUST update to `upstream`. The +project is always evolving, and as such you SHOULD always strive to keep +up to date when submitting patches to make sure they can be merged without +conflicts. + +To update the current branch to `upstream`, you can use the following commands. + +``` bash +$ git fetch upstream +$ git rebase upstream/master +``` + +It may ask you to stash your changes, in which case you stash with: + +``` bash +$ git stash +``` + +And put your changes back in with: + +``` bash +$ git stash pop +``` + +You SHOULD use these commands both before working on your patch and before +submitting the pull request. If conflicts arise it is your responsibility +to deal with them. + +You MUST create a new branch for your work. First make sure you have +'fetched' `master` + +``` bash +$ git checkout -b $BRANCH upstream/master +``` + +You MUST use a an insightful branch name. + +If you later need to switch back to an existing branch `$BRANCH`, you can use: + +``` bash +$ git checkout $BRANCH +``` + +Source editing +-------------- + +The following rules MUST be followed: + * Indentation uses 4 horizontal spaces + * Tabs should not be used + * Do NOT align code; only indentation is allowed + + +The following rules SHOULD be followed: + * Write small functions whenever possible + * Avoid having too many clauses containing clauses containing clauses + * Lines SHOULD NOT span more than 80 columns + +When in doubt indentation as performed in the Erlang Emacs Mode is +correct. + +Committing +---------- + +You MUST ensure that all commits pass all tests and do not have extra +Dialyzer warnings. + +You MUST put all the related work in a single commit. Fixing a bug is one +commit, adding a feature is one commit, adding two features is two commits. + +You MUST write a proper commit title and message. The commit title MUST be +at most 72 characters; it is the first line of the commit text. The second +line of the commit text MUST be left blank. The third line and beyond is the +commit message. You SHOULD write a commit message. If you do, you MUST make +all lines smaller than 80 characters. You SHOULD explain what the commit +does, what references you used and any other information that helps +understanding your work. + +Submitting the pull request +--------------------------- + +You MUST push your branch `$BRANCH` to GitHub, using the following command: + +``` bash +$ git push origin $BRANCH +``` + +You MUST then submit the pull request by using the GitHub interface to +the `master` branch. You SHOULD provide an explanatory message and refer +to any previous ticket related to this patch. diff --git a/README.md b/README.md new file mode 100644 index 0000000..3e9f193 --- /dev/null +++ b/README.md @@ -0,0 +1,143 @@ +Erlware Commons +=============== + +Current Status +-------------- + +[![Hex.pm](https://img.shields.io/hexpm/v/erlware_commons)](https://hex.pm/packages/erlware_commons) +[![Tests](https://github.com/erlware/erlware_commons/workflows/EUnit/badge.svg)](https://github.com/erlware/erlware_commons/actions) + +Introduction +------------ + +Erlware commons can best be described as an extension to the stdlib +application that is distributed with Erlang. These are things that we +at Erlware have found useful for production applications but are not +included with the distribution. We hope that as things in this library +prove themselves useful, they will make their way into the main Erlang +distribution. However, whether they do or not, we hope that this +application will prove generally useful. + +Goals for the project +--------------------- + +* Generally Useful Code +* High Quality +* Well Documented +* Well Tested + +Licenses +-------- + +This project contains elements licensed with Apache License, Version 2.0, +as well as elements licensed with The MIT License. + +You'll find license-related information in the header of specific files, +where warranted. + +In cases where no such information is present refer to +[COPYING](COPYING). + +Currently Available Modules/Systems +------------------------------------ + +### [ec_date](https://github.com/erlware/erlware_commons/blob/master/src/ec_date.erl) + +This module formats erlang dates in the form {{Year, Month, Day}, +{Hour, Minute, Second}} to printable strings, using (almost) +equivalent formatting rules as http://uk.php.net/date, US vs European +dates are disambiguated in the same way as +http://uk.php.net/manual/en/function.strtotime.php That is, Dates in +the m/d/y or d-m-y formats are disambiguated by looking at the +separator between the various components: if the separator is a slash +(/), then the American m/d/y is assumed; whereas if the separator is a +dash (-) or a dot (.), then the European d-m-y format is assumed. To +avoid potential ambiguity, it's best to use ISO 8601 (YYYY-MM-DD) +dates. + +erlang has no concept of timezone so the following formats are not +implemented: B e I O P T Z formats c and r will also differ slightly + +### [ec_file](https://github.com/erlware/erlware_commons/blob/master/src/ec_file.erl) + +A set of commonly defined helper functions for files that are not +included in stdlib. + +### [ec_plists](https://github.com/erlware/erlware_commons/blob/master/src/ec_plists.erl) + +plists is a drop-in replacement for module lists, making most +list operations parallel. It can operate on each element in parallel, +for IO-bound operations, on sublists in parallel, for taking advantage +of multi-core machines with CPU-bound operations, and across erlang +nodes, for parallelizing inside a cluster. It handles errors and node +failures. It can be configured, tuned, and tweaked to get optimal +performance while minimizing overhead. + +Almost all the functions are identical to equivalent functions in +lists, returning exactly the same result, and having both a form with +an identical syntax that operates on each element in parallel and a +form which takes an optional "malt", a specification for how to +parallelize the operation. + +fold is the one exception, parallel fold is different from linear +fold. This module also include a simple mapreduce implementation, and +the function runmany. All the other functions are implemented with +runmany, which is as a generalization of parallel list operations. + +### [ec_semver](https://github.com/erlware/erlware_commons/blob/master/src/ec_semver.erl) + +A complete parser for the [semver](http://semver.org/) +standard. Including a complete set of conforming comparison functions. + +### [ec_lists](https://github.com/erlware/erlware_commons/blob/master/src/ec_lists.erl) + +A set of additional list manipulation functions designed to supliment +the `lists` module in stdlib. + +### [ec_talk](https://github.com/erlware/erlware_commons/blob/master/src/ec_talk.erl) + +A set of simple utility functions to facilitate command line +communication with a user. + +Signatures +----------- + +Other languages, have built in support for **Interface** or +**signature** functionality. Java has Interfaces, SML has +Signatures. Erlang, though, doesn't currently support this model, at +least not directly. There are a few ways you can approximate it. We +have defined a mechanism called *signatures* and several modules that +to serve as examples and provide a good set of *dictionary* +signatures. More information about signatures can be found at +[signature](https://github.com/erlware/erlware_commons/blob/master/doc/signatures.md). + + +### [ec_dictionary](https://github.com/erlware/erlware_commons/blob/master/src/ec_dictionary.erl) + +A signature that supports association of keys to values. A map cannot +contain duplicate keys; each key can map to at most one value. + +### [ec_dict](https://github.com/erlware/erlware_commons/blob/master/src/ec_dict.erl) + +This provides an implementation of the ec_dictionary signature using +erlang's dicts as a base. The function documentation for ec_dictionary +applies here as well. + +### [ec_gb_trees](https://github.com/erlware/erlware_commons/blob/master/src/ec_gb_trees.erl) + +This provides an implementation of the ec_dictionary signature using +erlang's gb_trees as a base. The function documentation for +ec_dictionary applies here as well. + +### [ec_orddict](https://github.com/erlware/erlware_commons/blob/master/src/ec_orddict.erl) + +This provides an implementation of the ec_dictionary signature using +erlang's orddict as a base. The function documentation for +ec_dictionary applies here as well. + +### [ec_rbdict](https://github.com/erlware/erlware_commons/blob/master/src/ec_rbdict.erl) + +This provides an implementation of the ec_dictionary signature using +Robert Virding's rbdict module as a base. The function documentation +for ec_dictionary applies here as well. diff --git a/doc/signatures.md b/doc/signatures.md new file mode 100644 index 0000000..cc5fd32 --- /dev/null +++ b/doc/signatures.md @@ -0,0 +1,479 @@ +Signatures +========== + +It often occurs in coding that we need a library, a set of +functionalities. Often there are several algorithms that could provide +each of these functionalities. However, the code that uses it, either doesn't +care about the individual algorithm or wishes to delegate choosing +that algorithm to some higher level. Let's take the concrete example of +dictionaries. A dictionary provides the ability to access a value via +a key (other things as well but primarily this). There are may ways to +implement a dictionary. Just a few are: + +* [Associative Arrays](http://en.wikipedia.org/wiki/Associative_array) +* [Binary Trees](http://en.wikipedia.org/wiki/Binary_tree) +* [Hash Tables](http://en.wikipedia.org/wiki/Hash_table#Performance_analysis) +* [Skip Lists](http://en.wikipedia.org/wiki/Skip_list) +* Many, many more .... + +Each of these approaches has their own performance characteristics, +memory footprints, etc. For example, a table of size $n$ with open +addressing has no collisions and holds up to $n$ elements, with a single +comparison for successful lookup, and a table of size $n$ with chaining +and $k$ keys has the minimum $\max(0, k-n)$ collisions and $\mathcal{O}(1 + k/n)$ +comparisons for lookup. While for skip lists the performance +characteristics are about as good as that of randomly-built binary +search trees - namely $\mathcal{O}(\log n)$. So the choice of which to select +depends very much on memory available, insert/read characteristics, +etc. So delegating the choice to a single point in your code is a very +good idea. Unfortunately, in Erlang that's so easy to do at the moment. + +Other languages, have built in support for this +functionality. [Java](http://en.wikipedia.org/wiki/Java_(programming_language)) +has +[Interfaces](http://download.oracle.com/javase/tutorial/java/IandI/createinterface.html), +[SML](http://en.wikipedia.org/wiki/Standard_ML) has +[Signatures](http://en.wikipedia.org/wiki/Standard_ML#Module_system). +Erlang, though, doesn't currently support this model, at least not +directly. There are a few ways you can approximate it. One way is to +pass the Module name to the calling functions along with the data that +it is going to be called on. + +```erlang +add(ModuleToUse, Key, Value, DictData) -> + ModuleToUse:add(Key, Value, DictData). +``` + +This works, and you can vary how you want to pass the data. For +example, you could easily use a tuple to contain the data. That is, +you could pass in `{ModuleToUse, DictData}` and that would make it a +bit cleaner. + +```erlang +add(Key, Value, {ModuleToUse, DictData}) -> + ModuleToUse:add(Key, Value, DictData). +``` + +Either way, there are a few problems with this approach. One of the +biggest is that you lose code locality, by looking at this bit of code +you don't know what `ModuleToUse` is at all. You would need to follow +the call chain up to figure out what it is. Also it may not be obvious +what is actually happening. The fact that `ModuleToUse` is a variable +name obscures the code making it harder to understand. The other big +problem is that the tools provided with Erlang can't help find +mistakes that you might have made. Tools like +[Xref](http://www.erlang.org/doc/man/xref.html) and +[Dialyzer](http://www.erlang.org/doc/man/dialyzer.html) have just as +hard a time figuring out the what `ModuleToUse` is pointing to as you +do. So they can't give you warnings about potential problems. In fact +someone could inadvertently pass an unexpected function name as +`ModuleToUse` and you would never get any warnings, just an exception +at run time. + +Fortunately, Erlang is a pretty flexible language so we can use a +similar approach with a few adjustments to give us the best of both +worlds. Both the flexibility of ignoring a specific implementation +and keeping all the nice locality we get by using an explicit module +name. + +So what we actually want to do is something mole like this: + +```erlang +add(Key, Value, DictData) -> + dictionary:add(Key, Value, DictData). +``` + +Doing this we retain the locality. We can easily look up the +`dictionary` Module. We immediately have a good idea what a +`dictionary` actually is and we know what functions we are +calling. Also, all the tools know what a `dictionary` is as well and +how to check that your code is calling it correctly. For all of these +reasons, this is a much better approach to the problem. This is what +*Signatures* are all about. + +Signatures +---------- + +How do we actually do this in Erlang now that Erlang is missing what Java, SML and friends have built in? + +The first thing we need to do is to define +a [Behaviour](http://metajack.im/2008/10/29/custom-behaviors-in-erlang/) +for our functionality. To continue our example we will define a +Behaviour for dictionaries. That Behaviour looks like this: + +```erlang +-module(ec_dictionary). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{new, 0}, + {has_key, 2}, + {get, 2}, + {add, 3}, + {remove, 2}, + {has_value, 2}, + {size, 1}, + {to_list, 1}, + {from_list, 1}, + {keys, 1}]; +behaviour_info(_) -> + undefined. +``` + + +So we have our Behaviour now. Unfortunately, this doesn't give us much +yet. It will make sure that any dictionaries we write will have all +the functions they need to have, but it won't help us actually use the +dictionaries in an abstract way in our code. To do that we need to add +a bit of functionality. We do that by actually implementing our own +behaviour, starting with `new/1`. + +```erlang +%% @doc create a new dictionary object from the specified module. The +%% module should implement the dictionary behaviour. +%% +%% @param ModuleName The module name. +-spec new(module()) -> dictionary(_K, _V). +new(ModuleName) when is_atom(ModuleName) -> + #dict_t{callback = ModuleName, data = ModuleName:new()}. +``` + +This code creates a new dictionary for us. Or to be more specific it +actually creates a new dictionary Signature record, that will be used +subsequently in other calls. This might look a bit familiar from our +previous less optimal approach. We have both the module name and the +data in the record. We call the module name named in +`ModuleName` to create the initial data. We then construct the record +and return that record to the caller and we have a new +dictionary. What about the other functions, the ones that don't create +a dictionary but make use of it. Let's take a look at the +implementations of two kinds of functions, one that updates the +dictionary and another that just retrieves data. + +The first we will look at is the one that updates the dictionary by +adding a value. + +```erlang +%% @doc add a new value to the existing dictionary. Return a new +%% dictionary containing the value. +%% +%% @param Dict the dictionary object to add too +%% @param Key the key to add +%% @param Value the value to add +-spec add(key(K), value(V), dictionary(K, V)) -> dictionary(K, V). +add(Key, Value, #dict_t{callback = Mod, data = Data} = Dict) -> + Dict#dict_t{data = Mod:add(Key, Value, Data)}. +``` + +There are two key things here. + +1. The dictionary is deconstructed so we can get access to the data +and the callback module. +1. We modify the dictionary record we the new data and return that +modified record. + +This is the same approach that you will use for any Signature that +updates data. As a side note, notice that we are calling the concrete +implementation to do the work itself. + +Now lets do a data retrieval function. In this case, the `get` function +of the dictionary Signature. + +```erlang +%% @doc given a key return that key from the dictionary. If the key is +%% not found throw a 'not_found' exception. +%% +%% @param Dict The dictionary object to return the value from +%% @param Key The key requested +%% @throws not_found when the key does not exist +-spec get(key(K), dictionary(K, V)) -> value(V). +get(Key, #dict_t{callback = Mod, data = Data}) -> + Mod:get(Key, Data). +``` + +In this case, you can see a very similar approach to deconstructing +the dict record. We still need to pull out the callback module and the +data itself and call the concrete implementation of the algorithm. In +this case, we return the data returned from the call, not the record +itself. + +That is really all you need to define a Signature. There is a complete +implementation in +[erlware_commons/ec_dictionary](https://github.com/ericbmerritt/erlware_commons/blob/types/src/ec_dictionary.erl). + +Using Signatures +---------------- + +It's a good idea to work through an example so we have a bit better +idea of how to use these Signatures. If you are like me, you probably +have some questions about what kind of performance burden this places +on the code. At the very least we have an additional function call +along with the record deconstruction. This must add some overhead. So +lets write a little timing test, so we can get a good idea of how much +this is all costing us. + +In general, there are two kinds of concrete implementations for +Signatures. The first is a native implementation, the second is a +wrapper. + +### Native Signature Implementations + +A Native Signature Implementation is just that, a module that +implements the Behaviour defined by a Signature directly. For most +user defined Signatures this is going to be the norm. In our current +example, the +[erlware_commons/ec_rbdict](https://github.com/ericbmerritt/erlware_commons/blob/types/src/ec_rbdict.erl) +module is the best example of a Native Signature Implementation. It +implements the ec_dictionary module directly. + +### Signature Wrappers + +A Signature Wrapper is a module that wraps another module. Its +purpose is to help a preexisting module implement the Behaviour +defined by a Signature. A good example of this in our current example +is the +[erlware_commons/ec_dict](https://github.com/ericbmerritt/erlware_commons/blob/types/src/ec_dict.erl) +module. It implements the `ec_dictionary` Behaviour, but all the +functionality is provided by the +[stdlib/dict](http://www.erlang.org/doc/man/dict.html) module +itself. Let's take a look at one example to see how this is done. + +We will take a look at one of the functions we have already seen. The +`get` function in `ec_dictionary` doesn't have quite the same +semantics as any of the functions in the `dict` module. So a bit of +translation needs to be done. We do that in the `ec_dict:get/2` function. + +```erlang +-spec get(ec_dictionary:key(K), Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, Data) -> + case dict:find(Key, Data) of + {ok, Value} -> + Value; + error -> + throw(not_found) + end. +``` + +So the `ec_dict` module's purpose for existence is to help the +preexisting `dict` module implement the Behaviour defined by the +Signature. + + +Why do we bring this up here? Because we are going to be looking at +timings, and Signature Wrappers add an extra level of indirection to +the mix and that adds a bit of additional overhead. + +### Creating the Timing Module + +We are going to be creating timings for both Native Signature +Implementations and Signature Wrappers. + +Let's get started by looking at some helper functions. We want +dictionaries to have a bit of data in them. So to that end we will +create a couple of functions that create dictionaries for each type we +want to test. The first we want to time is the Signature Wrapper, so +`dict` vs `ec_dict` called as a Signature. + +```erlang +create_dict() -> + lists:foldl(fun(El, Dict) -> + dict:store(El, El, Dict) + end, dict:new(), + lists:seq(1,100)). +``` + +The only thing we do here is create a sequence of numbers 1 to 100, +and then add each of those to the `dict` as an entry. We aren't too +worried about replicating real data in the dictionary. We care about +timing the function call overhead of Signatures, not the performance +of the dictionaries themselves. + +We need to create a similar function for our Signature based +dictionary `ec_dict`. + +```erlang +create_dictionary(Type) -> + lists:foldl(fun(El, Dict) -> + ec_dictionary:add(El, El, Dict) + end, + ec_dictionary:new(Type), + lists:seq(1,100)). +``` + +Here we actually create everything using the Signature. So we don't +need one function for each type. We can have one function that can +create anything that implements the Signature. That is the magic of +Signatures. Otherwise, this does the exact same thing as the dictionary +given by `create_dict/0`. + +We are going to use two function calls in our timing. One that updates +data and one that returns data, just to get good coverage. For our +dictionaries we are going to use the `size` function as well as +the `add` function. + +```erlang +time_direct_vs_signature_dict() -> + io:format("Timing dict~n"), + Dict = create_dict(), + test_avg(fun() -> + dict:size(dict:store(some_key, some_value, Dict)) + end, + 1000000), + io:format("Timing ec_dict implementation of ec_dictionary~n"), + time_dict_type(ec_dict). +``` + +The `test_avg` function runs the provided function the number of times +specified in the second argument and collects timing information. We +are going to run these one million times to get a good average (it's +fast so it doesn't take long). You can see in the anonymous +function that we directly call `dict:size/1` and `dict:store/3` to perform +the test. However, because we are in the wonderful world of Signatures +we don't have to hard code the calls for the Signature +implementations. Lets take a look at the `time_dict_type` function. + + +```erlang +time_dict_type(Type) -> + io:format("Testing ~p~n", [Type]), + Dict = create_dictionary(Type), + test_avg(fun() -> + ec_dictionary:size(ec_dictionary:add(some_key, some_value, Dict)) + end, + 1000000). +``` + +As you can see we take the type as an argument (we need it for `dict` +creation) and call our create function. Then we run the same timings +that we did for `ec_dict`. In this case though, the type of dictionary +is never specified, we only ever call ec_dictionary, so this test will +work for anything that implements that Signature. + +#### `dict` vs `ec_dict` Results + +So we have our tests, what was the result. Well on my laptop this is +what it looked like. + +```sh +Erlang R14B01 (erts-5.8.2) [source] [64-bit] [smp:4:4] [rq:4] [async-threads:0] [hipe] [kernel-poll:false] + +Eshell V5.8.2 (abort with ^G) + +1> ec_timing:time_direct_vs_signature_dict(). +Timing dict +Range: 2 - 5621 mics +Median: 3 mics +Average: 3 mics +Timing ec_dict implementation of ec_dictionary +Testing ec_dict +Range: 3 - 6097 mics +Median: 3 mics +Average: 4 mics +2> +``` + +So for the direct `dict` call, we average about 3 mics per call, while +for the Signature Wrapper we average around 4. That's a 25% cost for +Signature Wrappers in this example, for a very small number of +calls. Depending on what you are doing that is going to be greater or +lesser. In any case, we can see that there is some cost associated +with the Signature Wrapper Implementations. + +What about native Signatures though? Lets take a look at +`ec_rbdict`. The `ec_rbdict` also implements the `ec_dictionary` +Signature, but it is not a Signature Wrapper. It is a native +implementation of the Signature. To use `ec_rbdict` directly we have +to create a creation helper just like we did for dict. + +```erlang +create_rbdict() -> + lists:foldl(fun(El, Dict) -> + ec_rbdict:add(El, El, Dict) + end, ec_rbdict:new(), + lists:seq(1,100)). +``` + +This is exactly the same as `create_dict` with the exception that dict +is replaced by `ec_rbdict`. + +The timing function itself looks very similar as well. Again notice +that we have to hard code the concrete name for the concrete +implementation, but we don't for the `ec_dictionary` test. + +```erlang +time_direct_vs_signature_rbdict() -> + io:format("Timing rbdict~n"), + Dict = create_rbdict(), + test_avg(fun() -> + ec_rbdict:size(ec_rbdict:add(some_key, some_value, Dict)) + end, + 1000000), + io:format("Timing ec_dict implementation of ec_dictionary~n"), + time_dict_type(ec_rbdict). +``` + +And there we have our test. What do the results look like? + +#### `ec_rbdict` vs `ec_rbdict` as an `ec_dictionary` Results + +The main thing we are timing here is the additional cost of the +dictionary Signature itself. Keep that in mind as we look at the +results. + +```sh +Erlang R14B01 (erts-5.8.2) [source] [64-bit] [smp:4:4] [rq:4] [async-threads:0] [hipe] [kernel-poll:false] + +Eshell V5.8.2 (abort with ^G) + +1> ec_timing:time_direct_vs_signature_rbdict(). +Timing rbdict +Range: 6 - 15070 mics +Median: 7 mics +Average: 7 mics +Timing ec_dict implementation of ec_dictionary +Testing ec_rbdict +Range: 6 - 6013 mics +Median: 7 mics +Average: 7 mics +2> +``` + +So no difference it time. Well the reality is that there is a +difference in timing, there must be, but we don't have enough +resolution in the timing system to be able to figure out what that +difference is. Essentially that means it's really, really small - or small +enough not to worry about at the very least. + +Conclusion +---------- + +Signatures are a viable, useful approach to the problem of interfaces +in Erlang. They have little or no overhead depending on the type of +implementation, and greatly increase the flexibility of the a library +while retaining testability and locality. + +### Terminology + +Behaviour +: A normal Erlang Behaviour that defines a contract + +Signature +: A combination of an Behaviour and functionality to make the + functions callable in a concrete way + +Native Signature Implementation +: A module that implements a signature directly + +Signature Wrapper +: A module that does translation between a preexisting module and a + Signature, allowing the preexisting module to be used as a Signature + Implementation. + +### Code Referenced + +* [ec_dictionary Implementation](https://github.com/ericbmerritt/erlware_commons/blob/types/src/ec_dictionary.erl) +* [ec_dict Signature Wrapper](https://github.com/ericbmerritt/erlware_commons/blob/types/src/ec_dict.erl) +* [ec_rbdict Native Signature Implementation](https://github.com/ericbmerritt/erlware_commons/blob/types/src/ec_rbdict.erl) +* [ec_timing Signature Use Example and Timing Collector](https://github.com/ericbmerritt/erlware_commons/blob/types/examples/ec_timing.erl) diff --git a/ebin/erlware_commons.app b/ebin/erlware_commons.app deleted file mode 100644 index 792980a..0000000 --- a/ebin/erlware_commons.app +++ /dev/null @@ -1,14 +0,0 @@ -%% -*- mode: Erlang; fill-column: 75; comment-column: 50; -*- -{application, erlware_commons, - [{description, "Additional standard library for Erlang"}, - {vsn, "0.5.0"}, - {modules, [ - ec_lists, - ec_plists, - ec_file, - ec_string, - ec_semver, - ec_talk - ]}, - {registered, []}, - {applications, [kernel, stdlib]}]}. diff --git a/include/ec_cmd_log.hrl b/include/ec_cmd_log.hrl new file mode 100644 index 0000000..170d399 --- /dev/null +++ b/include/ec_cmd_log.hrl @@ -0,0 +1,24 @@ +%% -*- erlang-indent-level: 4; indent-tabs-mode: nil; fill-column: 80 -*- +%%% Copyright 2012 Erlware, LLC. All Rights Reserved. +%%% +%%% This file is provided to you under the Apache License, +%%% Version 2.0 (the "License"); you may not use this file +%%% except in compliance with the License. You may obtain +%%% a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, +%%% software distributed under the License is distributed on an +%%% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +%%% KIND, either express or implied. See the License for the +%%% specific language governing permissions and limitations +%%% under the License. +%%%--------------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright (C) 2012 Erlware, LLC. + +-define(EC_ERROR, 0). +-define(EC_WARN, 1). +-define(EC_INFO, 2). +-define(EC_DEBUG, 3). diff --git a/priv/ec_semver_parser.peg b/priv/ec_semver_parser.peg new file mode 100644 index 0000000..d0444a6 --- /dev/null +++ b/priv/ec_semver_parser.peg @@ -0,0 +1,9 @@ +semver <- major_minor_patch_min_patch ("-" alpha_part ("." alpha_part)*)? ("+" alpha_part ("." alpha_part)*)? !. + ` ec_semver:internal_parse_version(Node) ` ; + +major_minor_patch_min_patch <- ("v"? numeric_part / alpha_part) ("." version_part)? ("." version_part)? ("." version_part)? ; + +version_part <- numeric_part / alpha_part ; + +numeric_part <- [0-9]+ `erlang:list_to_integer(erlang:binary_to_list(erlang:iolist_to_binary(Node)))` ; +alpha_part <- [A-Za-z0-9]+ `erlang:iolist_to_binary(Node)` ; diff --git a/rebar.config b/rebar.config new file mode 100644 index 0000000..017e3fe --- /dev/null +++ b/rebar.config @@ -0,0 +1,24 @@ +%% -*- mode: Erlang; fill-column: 80; comment-column: 75; -*- + +%% Dependencies ================================================================ +{deps, [ + {cf, "~>0.3"} +]}. + +{erl_first_files, ["ec_dictionary", "ec_vsn"]}. + +%% Compiler Options ============================================================ +{erl_opts, [debug_info, warnings_as_errors]}. + +%% EUnit ======================================================================= +{eunit_opts, [verbose, + {report, {eunit_surefire, [{dir, "."}]}}]}. + +{cover_enabled, true}. +{cover_print_enabled, true}. + +%% Profiles ==================================================================== +{profiles, [{dev, [{deps, + [{neotoma, "", + {git, "https://github.com/seancribbs/neotoma.git", {branch, master}}}]}]} + ]}. diff --git a/rebar.config.script b/rebar.config.script new file mode 100644 index 0000000..cc054a8 --- /dev/null +++ b/rebar.config.script @@ -0,0 +1,7 @@ +NoDialWarns = {dialyzer, [{warnings, [no_unknown]}]}, +OTPRelease = erlang:list_to_integer(erlang:system_info(otp_release)), + +case OTPRelease<26 of + true -> CONFIG; + false -> lists:keystore(dialyzer, 1, CONFIG, NoDialWarns) +end. diff --git a/rebar.lock b/rebar.lock new file mode 100644 index 0000000..7873d25 --- /dev/null +++ b/rebar.lock @@ -0,0 +1,8 @@ +{"1.2.0", +[{<<"cf">>,{pkg,<<"cf">>,<<"0.3.1">>},0}]}. +[ +{pkg_hash,[ + {<<"cf">>, <<"5CB902239476E141EA70A740340233782D363A31EEA8AD37049561542E6CD641">>}]}, +{pkg_hash_ext,[ + {<<"cf">>, <<"315E8D447D3A4B02BCDBFA397AD03BBB988A6E0AA6F44D3ADD0F4E3C3BF97672">>}]} +]. diff --git a/rebar3 b/rebar3 new file mode 100755 index 0000000..a5f263e Binary files /dev/null and b/rebar3 differ diff --git a/src/ec_assoc_list.erl b/src/ec_assoc_list.erl new file mode 100644 index 0000000..9921f55 --- /dev/null +++ b/src/ec_assoc_list.erl @@ -0,0 +1,106 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2011 Erlware, LLC. +%%% @doc +%%% provides an implementation of ec_dictionary using an association +%%% list as a basy +%%% see ec_dictionary +%%% @end +%%%------------------------------------------------------------------- +-module(ec_assoc_list). + +-behaviour(ec_dictionary). + +%% API +-export([new/0, + has_key/2, + get/2, + get/3, + add/3, + remove/2, + has_value/2, + size/1, + to_list/1, + from_list/1, + keys/1]). + +-export_type([dictionary/2]). + +%%%=================================================================== +%%% Types +%%%=================================================================== +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type dictionary(K, V) :: {ec_assoc_list, + [{ec_dictionary:key(K), ec_dictionary:value(V)}]}. + +%%%=================================================================== +%%% API +%%%=================================================================== + +-spec new() -> dictionary(_K, _V). +new() -> + {ec_assoc_list, []}. + +-spec has_key(ec_dictionary:key(K), Object::dictionary(K, _V)) -> boolean(). +has_key(Key, {ec_assoc_list, Data}) -> + lists:keymember(Key, 1, Data). + +-spec get(ec_dictionary:key(K), Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, {ec_assoc_list, Data}) -> + case lists:keyfind(Key, 1, Data) of + {Key, Value} -> + Value; + false -> + throw(not_found) + end. + +-spec get(ec_dictionary:key(K), + ec_dictionary:value(V), + Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, Default, {ec_assoc_list, Data}) -> + case lists:keyfind(Key, 1, Data) of + {Key, Value} -> + Value; + false -> + Default + end. + +-spec add(ec_dictionary:key(K), ec_dictionary:value(V), + Object::dictionary(K, V)) -> + dictionary(K, V). +add(Key, Value, {ec_assoc_list, _Data}=Dict) -> + {ec_assoc_list, Rest} = remove(Key,Dict), + {ec_assoc_list, [{Key, Value} | Rest ]}. + +-spec remove(ec_dictionary:key(K), Object::dictionary(K, _V)) -> + dictionary(K, _V). +remove(Key, {ec_assoc_list, Data}) -> + {ec_assoc_list, lists:keydelete(Key, 1, Data)}. + +-spec has_value(ec_dictionary:value(V), Object::dictionary(_K, V)) -> boolean(). +has_value(Value, {ec_assoc_list, Data}) -> + lists:keymember(Value, 2, Data). + +-spec size(Object::dictionary(_K, _V)) -> non_neg_integer(). +size({ec_assoc_list, Data}) -> + length(Data). + +-spec to_list(dictionary(K, V)) -> [{ec_dictionary:key(K), + ec_dictionary:value(V)}]. +to_list({ec_assoc_list, Data}) -> + Data. + +-spec from_list([{ec_dictionary:key(K), ec_dictionary:value(V)}]) -> + dictionary(K, V). +from_list(List) when is_list(List) -> + {ec_assoc_list, List}. + +-spec keys(dictionary(K, _V)) -> [ec_dictionary:key(K)]. +keys({ec_assoc_list, Data}) -> + lists:map(fun({Key, _Value}) -> + Key + end, Data). diff --git a/src/ec_cmd_log.erl b/src/ec_cmd_log.erl new file mode 100644 index 0000000..a1f2713 --- /dev/null +++ b/src/ec_cmd_log.erl @@ -0,0 +1,257 @@ +%% -*- erlang-indent-level: 4; indent-tabs-mode: nil; fill-column: 80 -*- +%%% Copyright 2012 Erlware, LLC. All Rights Reserved. +%%% +%%% This file is provided to you under the Apache License, +%%% Version 2.0 (the "License"); you may not use this file +%%% except in compliance with the License. You may obtain +%%% a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, +%%% software distributed under the License is distributed on an +%%% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +%%% KIND, either express or implied. See the License for the +%%% specific language governing permissions and limitations +%%% under the License. +%%%--------------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright (C) 2012 Erlware, LLC. +%%% +%%% @doc This provides simple output functions for command line apps. You should +%%% use this to talk to the users if you are writing code for the system +-module(ec_cmd_log). + +%% Avoid clashing with `error/3` BIF added in Erlang/OTP 24 +-compile({no_auto_import,[error/3]}). + +-export([new/1, + new/2, + new/3, + log/4, + should/2, + debug/2, + debug/3, + info/2, + info/3, + error/2, + error/3, + warn/2, + warn/3, + log_level/1, + atom_log_level/1, + colorize/4, + format/1]). + +-include("include/ec_cmd_log.hrl"). +-include("src/ec_cmd_log.hrl"). + +-define(PREFIX, "===> "). + +-record(state_t, {log_level=0 :: int_log_level(), + caller=api :: caller(), + intensity=low :: intensity()}). + +%%============================================================================ +%% types +%%============================================================================ +-export_type([t/0, + int_log_level/0, + atom_log_level/0, + log_level/0, + caller/0, + log_fun/0]). + +-type caller() :: api | command_line. + +-type log_level() :: int_log_level() | atom_log_level(). + +-type int_log_level() :: 0..3. + +-type atom_log_level() :: error | warn | info | debug. + +-type intensity() :: none | low | high. + +-type log_fun() :: fun(() -> iolist()). + +-type color() :: char(). + +-opaque t() :: #state_t{}. + +%%============================================================================ +%% API +%%============================================================================ +%% @doc Create a new 'log level' for the system +-spec new(log_level()) -> t(). +new(LogLevel) -> + new(LogLevel, api). + +-spec new(log_level(), caller()) -> t(). +new(LogLevel, Caller) -> + new(LogLevel, Caller, high). + + +-spec new(log_level(), caller(), intensity()) -> t(). +new(LogLevel, Caller, Intensity) when (Intensity =:= none orelse + Intensity =:= low orelse + Intensity =:= high), + LogLevel >= 0, LogLevel =< 3 -> + #state_t{log_level=LogLevel, caller=Caller, + intensity=Intensity}; +new(AtomLogLevel, Caller, Intensity) + when AtomLogLevel =:= error; + AtomLogLevel =:= warn; + AtomLogLevel =:= info; + AtomLogLevel =:= debug -> + LogLevel = case AtomLogLevel of + error -> 0; + warn -> 1; + info -> 2; + debug -> 3 + end, + new(LogLevel, Caller, Intensity). + + +%% @doc log at the debug level given the current log state with a string or +%% function that returns a string +-spec debug(t(), string() | log_fun()) -> ok. +debug(LogState, Fun) + when erlang:is_function(Fun) -> + log(LogState, ?EC_DEBUG, fun() -> + colorize(LogState, ?CYAN, false, Fun()) + end); +debug(LogState, String) -> + debug(LogState, "~ts~n", [String]). + +%% @doc log at the debug level given the current log state with a format string +%% and arguments @see io:format/2 +-spec debug(t(), string(), [any()]) -> ok. +debug(LogState, FormatString, Args) -> + log(LogState, ?EC_DEBUG, colorize(LogState, ?CYAN, false, FormatString), Args). + +%% @doc log at the info level given the current log state with a string or +%% function that returns a string +-spec info(t(), string() | log_fun()) -> ok. +info(LogState, Fun) + when erlang:is_function(Fun) -> + log(LogState, ?EC_INFO, fun() -> + colorize(LogState, ?GREEN, false, Fun()) + end); +info(LogState, String) -> + info(LogState, "~ts~n", [String]). + +%% @doc log at the info level given the current log state with a format string +%% and arguments @see io:format/2 +-spec info(t(), string(), [any()]) -> ok. +info(LogState, FormatString, Args) -> + log(LogState, ?EC_INFO, colorize(LogState, ?GREEN, false, FormatString), Args). + +%% @doc log at the error level given the current log state with a string or +%% format string that returns a function +-spec error(t(), string() | log_fun()) -> ok. +error(LogState, Fun) + when erlang:is_function(Fun) -> + log(LogState, ?EC_ERROR, fun() -> + colorize(LogState, ?RED, false, Fun()) + end); +error(LogState, String) -> + error(LogState, "~ts~n", [String]). + +%% @doc log at the error level given the current log state with a format string +%% and arguments @see io:format/2 +-spec error(t(), string(), [any()]) -> ok. +error(LogState, FormatString, Args) -> + log(LogState, ?EC_ERROR, colorize(LogState, ?RED, false, FormatString), Args). + +%% @doc log at the warn level given the current log state with a string or +%% format string that returns a function +-spec warn(t(), string() | log_fun()) -> ok. +warn(LogState, Fun) + when erlang:is_function(Fun) -> + log(LogState, ?EC_WARN, fun() -> colorize(LogState, ?MAGENTA, false, Fun()) end); +warn(LogState, String) -> + warn(LogState, "~ts~n", [String]). + +%% @doc log at the warn level given the current log state with a format string +%% and arguments @see io:format/2 +-spec warn(t(), string(), [any()]) -> ok. +warn(LogState, FormatString, Args) -> + log(LogState, ?EC_WARN, colorize(LogState, ?MAGENTA, false, FormatString), Args). + +%% @doc Execute the fun passed in if log level is as expected. +-spec log(t(), int_log_level(), log_fun()) -> ok. +log(#state_t{log_level=DetailLogLevel}, LogLevel, Fun) + when DetailLogLevel >= LogLevel -> + io:format("~ts~n", [Fun()]); +log(_, _, _) -> + ok. + +%% @doc when the module log level is less then or equal to the log level for the +%% call then write the log info out. When its not then ignore the call. +-spec log(t(), int_log_level(), string(), [any()]) -> ok. +log(#state_t{log_level=DetailLogLevel}, LogLevel, FormatString, Args) + when DetailLogLevel >= LogLevel, + erlang:is_list(Args) -> + io:format(FormatString, Args); +log(_, _, _, _) -> + ok. + +%% @doc return a boolean indicating if the system should log for the specified +%% levelg +-spec should(t(), int_log_level() | any()) -> boolean(). +should(#state_t{log_level=DetailLogLevel}, LogLevel) + when DetailLogLevel >= LogLevel -> + true; +should(_, _) -> + false. + +%% @doc get the current log level as an integer +-spec log_level(t()) -> int_log_level(). +log_level(#state_t{log_level=DetailLogLevel}) -> + DetailLogLevel. + +%% @doc get the current log level as an atom +-spec atom_log_level(t()) -> atom_log_level(). +atom_log_level(#state_t{log_level=?EC_ERROR}) -> + error; +atom_log_level(#state_t{log_level=?EC_WARN}) -> + warn; +atom_log_level(#state_t{log_level=?EC_INFO}) -> + info; +atom_log_level(#state_t{log_level=?EC_DEBUG}) -> + debug. + +-spec format(t()) -> iolist(). +format(Log) -> + [<<"(">>, + ec_cnv:to_binary(log_level(Log)), <<":">>, + ec_cnv:to_binary(atom_log_level(Log)), + <<")">>]. + +-spec colorize(t(), color(), boolean(), string()) -> string(). + +-define(VALID_COLOR(C), + C =:= $r orelse C =:= $g orelse C =:= $y orelse + C =:= $b orelse C =:= $m orelse C =:= $c orelse + C =:= $R orelse C =:= $G orelse C =:= $Y orelse + C =:= $B orelse C =:= $M orelse C =:= $C). + +colorize(#state_t{intensity=none}, _, _, Msg) -> + Msg; +%% When it is supposed to be bold and we already have a uppercase +%% (bold color) we don't need to modify the color +colorize(State, Color, true, Msg) when ?VALID_COLOR(Color), + Color >= $A, Color =< $Z -> + colorize(State, Color, false, Msg); +%% We're sneaky we can subtract 32 to get the uppercase character if we want +%% bold but have a non bold color. +colorize(State, Color, true, Msg) when ?VALID_COLOR(Color) -> + colorize(State, Color - 32, false, Msg); +colorize(#state_t{caller=command_line, intensity = high}, + Color, false, Msg) when ?VALID_COLOR(Color) -> + lists:flatten(cf:format("~!" ++ [Color] ++"~ts~ts", [?PREFIX, Msg])); +colorize(#state_t{caller=command_line, intensity = low}, + Color, false, Msg) when ?VALID_COLOR(Color) -> + lists:flatten(cf:format("~!" ++ [Color] ++"~ts~!!~ts", [?PREFIX, Msg])); +colorize(_LogState, _Color, _Bold, Msg) -> + Msg. diff --git a/src/ec_cmd_log.hrl b/src/ec_cmd_log.hrl new file mode 100644 index 0000000..428fd74 --- /dev/null +++ b/src/ec_cmd_log.hrl @@ -0,0 +1,7 @@ +%%% @copyright 2024 Erlware, LLC. +-define(RED, $r). +-define(GREEN, $g). +-define(YELLOW, $y). +-define(BLUE, $b). +-define(MAGENTA, $m). +-define(CYAN, $c). diff --git a/src/ec_cnv.erl b/src/ec_cnv.erl new file mode 100644 index 0000000..bc3b3f3 --- /dev/null +++ b/src/ec_cnv.erl @@ -0,0 +1,214 @@ +%% -*- erlang-indent-level: 4; indent-tabs-mode: nil; fill-column: 80 -*- +%%% Copyright 2012 Erlware, LLC. All Rights Reserved. +%%% +%%% This file is provided to you under the Apache License, +%%% Version 2.0 (the "License"); you may not use this file +%%% except in compliance with the License. You may obtain +%%% a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, +%%% software distributed under the License is distributed on an +%%% "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +%%% KIND, either express or implied. See the License for the +%%% specific language governing permissions and limitations +%%% under the License. +%%%--------------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright (C) 2012 Erlware, LLC. +%%% +-module(ec_cnv). + +%% API +-export([to_integer/1, + to_integer/2, + to_float/1, + to_float/2, + to_number/1, + to_list/1, + to_binary/1, + to_atom/1, + to_boolean/1, + is_true/1, + is_false/1]). + +%%%=================================================================== +%%% API +%%%=================================================================== + +%% @doc +%% Automatic conversion of a term into integer type. The conversion +%% will round a float value if nonstrict is specified otherwise badarg +-spec to_integer(string() | binary() | integer() | float()) -> + integer(). +to_integer(X)-> + to_integer(X, nonstrict). + +-spec to_integer(string() | binary() | integer() | float(), + strict | nonstrict) -> + integer(). +to_integer(X, strict) + when erlang:is_float(X) -> + erlang:error(badarg); +to_integer(X, nonstrict) + when erlang:is_float(X) -> + erlang:round(X); +to_integer(X, S) + when erlang:is_binary(X) -> + to_integer(erlang:binary_to_list(X), S); +to_integer(X, S) + when erlang:is_list(X) -> + try erlang:list_to_integer(X) of + Result -> + Result + catch + error:badarg when S =:= nonstrict -> + erlang:round(erlang:list_to_float(X)) + end; +to_integer(X, _) + when erlang:is_integer(X) -> + X. + +%% @doc +%% Automatic conversion of a term into float type. badarg if strict +%% is defined and an integer value is passed. +-spec to_float(string() | binary() | integer() | float()) -> + float(). +to_float(X) -> + to_float(X, nonstrict). + +-spec to_float(string() | binary() | integer() | float(), + strict | nonstrict) -> + float(). +to_float(X, S) when is_binary(X) -> + to_float(erlang:binary_to_list(X), S); +to_float(X, S) + when erlang:is_list(X) -> + try erlang:list_to_float(X) of + Result -> + Result + catch + error:badarg when S =:= nonstrict -> + erlang:list_to_integer(X) * 1.0 + end; +to_float(X, strict) when + erlang:is_integer(X) -> + erlang:error(badarg); +to_float(X, nonstrict) + when erlang:is_integer(X) -> + X * 1.0; +to_float(X, _) when erlang:is_float(X) -> + X. + +%% @doc +%% Automatic conversion of a term into number type. +-spec to_number(binary() | string() | number()) -> + number(). +to_number(X) + when erlang:is_number(X) -> + X; +to_number(X) + when erlang:is_binary(X) -> + to_number(to_list(X)); +to_number(X) + when erlang:is_list(X) -> + try list_to_integer(X) of + Int -> Int + catch + error:badarg -> + list_to_float(X) + end. + +%% @doc +%% Automatic conversion of a term into Erlang list +-spec to_list(atom() | list() | binary() | integer() | float()) -> + list(). +to_list(X) + when erlang:is_float(X) -> + erlang:float_to_list(X); +to_list(X) + when erlang:is_integer(X) -> + erlang:integer_to_list(X); +to_list(X) + when erlang:is_binary(X) -> + erlang:binary_to_list(X); +to_list(X) + when erlang:is_atom(X) -> + erlang:atom_to_list(X); +to_list(X) + when erlang:is_list(X) -> + X. + +%% @doc +%% Known limitations: +%% Converting [256 | _], lists with integers > 255 +-spec to_binary(atom() | string() | binary() | integer() | float()) -> + binary(). +to_binary(X) + when erlang:is_float(X) -> + to_binary(to_list(X)); +to_binary(X) + when erlang:is_integer(X) -> + erlang:iolist_to_binary(integer_to_list(X)); +to_binary(X) + when erlang:is_atom(X) -> + erlang:list_to_binary(erlang:atom_to_list(X)); +to_binary(X) + when erlang:is_list(X) -> + erlang:iolist_to_binary(X); +to_binary(X) + when erlang:is_binary(X) -> + X. + +-spec to_boolean(binary() | string() | atom()) -> + boolean(). +to_boolean(<<"true">>) -> + true; +to_boolean("true") -> + true; +to_boolean(true) -> + true; +to_boolean(<<"false">>) -> + false; +to_boolean("false") -> + false; +to_boolean(false) -> + false. + +-spec is_true(binary() | string() | atom()) -> + boolean(). +is_true(<<"true">>) -> + true; +is_true("true") -> + true; +is_true(true) -> + true; +is_true(_) -> + false. + +-spec is_false(binary() | string() | atom()) -> + boolean(). +is_false(<<"false">>) -> + true; +is_false("false") -> + true; +is_false(false) -> + true; +is_false(_) -> + false. + +%% @doc +%% Automation conversion a term to an existing atom. badarg is +%% returned if the atom doesn't exist. the safer version, won't let +%% you leak atoms +-spec to_atom(atom() | list() | binary() | integer() | float()) -> + atom(). +to_atom(X) + when erlang:is_atom(X) -> + X; +to_atom(X) + when erlang:is_list(X) -> + erlang:list_to_existing_atom(X); +to_atom(X) -> + to_atom(to_list(X)). diff --git a/src/ec_compile.erl b/src/ec_compile.erl new file mode 100644 index 0000000..7199610 --- /dev/null +++ b/src/ec_compile.erl @@ -0,0 +1,131 @@ +%%%------------------------------------------------------------------- +%%% @author Eric Merritt <> +%%% @copyright (C) 2011, Erlware, LLC. +%%% @doc +%%% These are various utility functions to help with compiling and +%%% decompiling erlang source. They are mostly useful to the +%%% language/parse transform implementor. +%%% @end +%%%------------------------------------------------------------------- +-module(ec_compile). + +-export([beam_to_erl_source/2, + erl_source_to_core_ast/1, + erl_source_to_erl_ast/1, + erl_source_to_asm/1, + erl_source_to_erl_syntax/1, + erl_string_to_core_ast/1, + erl_string_to_erl_ast/1, + erl_string_to_asm/1, + erl_string_to_erl_syntax/1]). + +%%%=================================================================== +%%% API +%%%=================================================================== + +%% @doc decompile a beam file that has been compiled with +debug_info +%% into a erlang source file +%% +%% @param BeamFName the name of the beamfile +%% @param ErlFName the name of the erlang file where the generated +%% source file will be output. This should *not* be the same as the +%% source file that created the beamfile unless you want to overwrite +%% it. +-spec beam_to_erl_source(string(), string()) -> ok | term(). +beam_to_erl_source(BeamFName, ErlFName) -> + case beam_lib:chunks(BeamFName, [abstract_code]) of + {ok, {_, [{abstract_code, {raw_abstract_v1,Forms}}]}} -> + Src = + erl_prettypr:format(erl_syntax:form_list(tl(Forms))), + {ok, Fd} = file:open(ErlFName, [write]), + io:fwrite(Fd, "~ts~n", [Src]), + file:close(Fd); + Error -> + Error + end. + +%% @doc compile an erlang source file into a Core Erlang AST +%% +%% @param Path - The path to the erlang source file +-spec erl_source_to_core_ast(file:filename()) -> CoreAst::term(). +erl_source_to_core_ast(Path) -> + {ok, Contents} = file:read_file(Path), + erl_string_to_core_ast(binary_to_list(Contents)). + +%% @doc compile an erlang source file into an Erlang AST +%% +%% @param Path - The path to the erlang source file +-spec erl_source_to_erl_ast(file:filename()) -> ErlangAst::term(). +erl_source_to_erl_ast(Path) -> + {ok, Contents} = file:read_file(Path), + erl_string_to_erl_ast(binary_to_list(Contents)). + +%% @doc compile an erlang source file into erlang terms that represent +%% the relevant ASM +%% +%% @param Path - The path to the erlang source file +-spec erl_source_to_asm(file:filename()) -> ErlangAsm::term(). +erl_source_to_asm(Path) -> + {ok, Contents} = file:read_file(Path), + erl_string_to_asm(binary_to_list(Contents)). + +%% @doc compile an erlang source file to a string that displays the +%% 'erl_syntax1 calls needed to reproduce those terms. +%% +%% @param Path - The path to the erlang source file +-spec erl_source_to_erl_syntax(file:filename()) -> string(). +erl_source_to_erl_syntax(Path) -> + {ok, Contents} = file:read_file(Path), + erl_string_to_erl_syntax(Contents). + +%% @doc compile a string representing an erlang expression into an +%% Erlang AST +%% +%% @param StringExpr - The path to the erlang source file +-spec erl_string_to_erl_ast(string()) -> ErlangAst::term(). +erl_string_to_erl_ast(StringExpr) -> + Forms0 = + lists:foldl(fun(<<>>, Acc) -> + Acc; + (<<"\n\n">>, Acc) -> + Acc; + (El, Acc) -> + {ok, Tokens, _} = + erl_scan:string(binary_to_list(El) + ++ "."), + [Tokens | Acc] + end, [], re:split(StringExpr, "\\.\n")), + %% No need to reverse. This will rereverse for us + lists:foldl(fun(Form, Forms) -> + {ok, ErlAST} = erl_parse:parse_form(Form), + [ErlAST | Forms] + end, [], Forms0). + +%% @doc compile a string representing an erlang expression into a +%% Core Erlang AST +%% +%% @param StringExpr - The path to the erlang source file +-spec erl_string_to_core_ast(string()) -> CoreAst::term(). +erl_string_to_core_ast(StringExpr) -> + compile:forms(erl_string_to_erl_ast(StringExpr), [to_core]). + +%% @doc compile a string representing an erlang expression into a term +%% that represents the ASM +%% +%% @param StringExpr - The path to the erlang source file +-spec erl_string_to_asm(string()) -> ErlangAsm::term(). +erl_string_to_asm(StringExpr) -> + compile:forms(erl_string_to_erl_ast(StringExpr), ['S']). + +%% @doc compile an erlang source file to a string that displays the +%% 'erl_syntax1 calls needed to reproduce those terms. +%% +%% @param StringExpr - The string representing the erlang code. +-spec erl_string_to_erl_syntax(string() | binary()) -> string(). +erl_string_to_erl_syntax(BinaryExpr) + when erlang:is_binary(BinaryExpr) -> + erlang:binary_to_list(BinaryExpr); +erl_string_to_erl_syntax(StringExpr) -> + {ok, Tokens, _} = erl_scan:string(StringExpr), + {ok, ErlAST} = erl_parse:parse_form(Tokens), + io:format(erl_prettypr:format(erl_syntax:meta(ErlAST))). diff --git a/src/ec_date.erl b/src/ec_date.erl new file mode 100644 index 0000000..747b246 --- /dev/null +++ b/src/ec_date.erl @@ -0,0 +1,1082 @@ +%% vi:ts=4 sw=4 et +%% @copyright Dale Harvey +%% @doc Format dates in erlang +%% +%% Licensed under the MIT license +%% +%% This module formats erlang dates in the form {{Year, Month, Day}, +%% {Hour, Minute, Second}} to printable strings, using (almost) +%% equivalent formatting rules as http://uk.php.net/date, US vs +%% European dates are disambiguated in the same way as +%% http://uk.php.net/manual/en/function.strtotime.php That is, Dates +%% in the m/d/y or d-m-y formats are disambiguated by looking at the +%% separator between the various components: if the separator is a +%% slash (/), then the American m/d/y is assumed; whereas if the +%% separator is a dash (-) or a dot (.), then the European d-m-y +%% format is assumed. To avoid potential ambiguity, it's best to use +%% ISO 8601 (YYYY-MM-DD) dates. +%% +%% erlang has no concept of timezone so the following +%% formats are not implemented: B e I O P T Z +%% formats c and r will also differ slightly +%% +%% See tests at bottom for examples +-module(ec_date). +-author("Dale Harvey "). + +-export([format/1, format/2]). +-export([format_iso8601/1]). +-export([parse/1, parse/2]). +-export([nparse/1]). +-export([tokenise/2]). + +%% These are used exclusively as guards and so the function like +%% defines make sense +-define( is_num(X), (X >= $0 andalso X =< $9) ). +-define( is_meridian(X), (X==[] orelse X==[am] orelse X==[pm]) ). +-define( is_us_sep(X), ( X==$/) ). +-define( is_world_sep(X), ( X==$-) ). + +-define( MONTH_TAG, month ). +-define( is_year(X), (is_integer(X) andalso X > 31) ). +-define( is_day(X), (is_integer(X) andalso X =< 31) ). +-define( is_hinted_month(X), (is_tuple(X) andalso size(X)=:=2 andalso element(1,X)=:=?MONTH_TAG) ). +-define( is_month(X), ( (is_integer(X) andalso X =< 12) orelse ?is_hinted_month(X) ) ). +-define( is_tz_offset(H1,H2,M1,M2), (?is_num(H1) andalso ?is_num(H2) andalso ?is_num(M1) andalso ?is_num(M2)) ). + +-define(GREGORIAN_SECONDS_1970, 62_167_219_200). +-define(ISO_8601_DATETIME_FORMAT, "Y-m-dTH:i:sZ"). +-define(ISO_8601_DATETIME_WITH_MS_FORMAT, "Y-m-dTH:i:s.fZ"). + +-type year() :: non_neg_integer(). +-type month() :: 1..12 | {?MONTH_TAG, 1..12}. +-type day() :: 1..31. +-type hour() :: 0..23. +-type minute() :: 0..59. +-type second() :: 0..59. +-type microsecond() :: 0..999_999. + +-type daynum() :: 1..7. +-type date() :: {year(),month(),day()}. +-type time() :: {hour(),minute(),second()} | {hour(),minute(),second(),microsecond()}. +-type datetime() :: {date(),time()}. +-type now() :: {integer(),integer(),integer()}. + +%% +%% EXPORTS +%% + +-spec format(string()) -> string(). +%% @doc format current local time as Format +format(Format) -> + format(Format, calendar:universal_time(),[]). + +-spec format(string(),datetime() | now()) -> string(). +%% @doc format Date as Format +format(Format, {_,_,Ms}=Now) -> + {Date,{H,M,S}} = calendar:now_to_datetime(Now), + format(Format, {Date, {H,M,S,Ms}}, []); +format(Format, Date) -> + format(Format, Date, []). + +-spec format_iso8601(datetime()) -> string(). +%% @doc format date in the ISO8601 format +%% This always puts 'Z' as time zone, since we have no notion of timezone +format_iso8601({{_, _, _}, {_, _, _}} = Date) -> + format(?ISO_8601_DATETIME_FORMAT, Date); +format_iso8601({{_, _, _}, {_, _, _, _}} = Date) -> + format(?ISO_8601_DATETIME_WITH_MS_FORMAT, Date). + +-spec parse(string()) -> datetime(). +%% @doc parses the datetime from a string +parse(Date) -> + do_parse(Date, calendar:universal_time(),[]). + +-spec parse(string(),datetime() | now()) -> datetime(). + +%% @doc parses the datetime from a string +parse(Date, {_,_,_}=Now) -> + do_parse(Date, calendar:now_to_datetime(Now), []); +parse(Date, Now) -> + do_parse(Date, Now, []). + +do_parse(Date, Now, Opts) -> + case filter_hints(parse(tokenise(string:uppercase(Date), []), Now, Opts)) of + {error, bad_date} -> + erlang:throw({?MODULE, {bad_date, Date}}); + {D1, T1} = {{Y, M, D}, {H, M1, S}} + when is_number(Y), is_number(M), + is_number(D), is_number(H), + is_number(M1), is_number(S) -> + case calendar:valid_date(D1) of + true -> {D1, T1}; + false -> erlang:throw({?MODULE, {bad_date, Date}}) + end; + {D1, _T1, {Ms}} = {{Y, M, D}, {H, M1, S}, {Ms}} + when is_number(Y), is_number(M), + is_number(D), is_number(H), + is_number(M1), is_number(S), + is_number(Ms) -> + case calendar:valid_date(D1) of + true -> {D1, {H,M1,S,Ms}}; + false -> erlang:throw({?MODULE, {bad_date, Date}}) + end; + Unknown -> erlang:throw({?MODULE, {bad_date, Date, Unknown }}) + end. + +filter_hints({{Y, {?MONTH_TAG, M}, D}, {H, M1, S}}) -> + filter_hints({{Y, M, D}, {H, M1, S}}); +filter_hints({{Y, {?MONTH_TAG, M}, D}, {H, M1, S}, {Ms}}) -> + filter_hints({{Y, M, D}, {H, M1, S}, {Ms}}); +filter_hints(Other) -> + Other. + +-spec nparse(string()) -> now(). +%% @doc parses the datetime from a string into 'now' format +nparse(Date) -> + case parse(Date) of + {DateS, {H, M, S, Ms} } -> + GSeconds = calendar:datetime_to_gregorian_seconds({DateS, {H, M, S} }), + ESeconds = GSeconds - ?GREGORIAN_SECONDS_1970, + {ESeconds div 1_000_000, ESeconds rem 1_000_000, Ms}; + DateTime -> + GSeconds = calendar:datetime_to_gregorian_seconds(DateTime), + ESeconds = GSeconds - ?GREGORIAN_SECONDS_1970, + {ESeconds div 1_000_000, ESeconds rem 1_000_000, 0} + end. + +%% +%% LOCAL FUNCTIONS +%% + +parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $., Micros, $Z ], _Now, _Opts) + when ?is_world_sep(X) + andalso (Micros >= 0 andalso Micros < 1_000_000) + andalso Year > 31 -> + {{Year, Month, Day}, {hour(Hour, []), Min, Sec}, {Micros}}; + +parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $Z ], _Now, _Opts) + when (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso Year > 31 -> + {{Year, Month, Day}, {hour(Hour, []), Min, Sec}}; + +parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $., Micros, $+, Off | _Rest ], _Now, _Opts) + when (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso (Micros >= 0 andalso Micros < 1_000_000) + andalso Year > 31 -> + {{Year, Month, Day}, {hour(Hour, []) - Off, Min, Sec}, {Micros}}; + +parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $+, Off | _Rest ], _Now, _Opts) + when (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso Year > 31 -> + {{Year, Month, Day}, {hour(Hour, []) - Off, Min, Sec}, {0}}; + +parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $., Micros, $-, Off | _Rest ], _Now, _Opts) + when (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso (Micros >= 0 andalso Micros < 1_000_000) + andalso Year > 31 -> + {{Year, Month, Day}, {hour(Hour, []) + Off, Min, Sec}, {Micros}}; + +parse([Year, X, Month, X, Day, Hour, $:, Min, $:, Sec, $-, Off | _Rest ], _Now, _Opts) + when (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso Year > 31 -> + {{Year, Month, Day}, {hour(Hour, []) + Off, Min, Sec}, {0}}; + +%% Date/Times 22 Aug 2008 6:35.0001 PM +parse([Year,X,Month,X,Day,Hour,$:,Min,$:,Sec,$., Ms | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso + (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}, {Ms}}; +parse([Month,X,Day,X,Year,Hour,$:,Min,$:,Sec,$., Ms | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_us_sep(X) + andalso ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}, {Ms}}; +parse([Day,X,Month,X,Year,Hour,$:,Min,$:,Sec,$., Ms | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_world_sep(X) + andalso ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}, {Ms}}; + +%% Date/Times Dec 1st, 2012 6:25 PM +parse([Month,Day,Year,Hour,$:,Min,$:,Sec | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_hinted_month(Month) andalso ?is_day(Day) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}}; +parse([Month,Day,Year,Hour,$:,Min | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_hinted_month(Month) andalso ?is_day(Day) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, 0}}; +parse([Month,Day,Year,Hour | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_hinted_month(Month) andalso ?is_day(Day) -> + {{Year, Month, Day}, {hour(Hour, PAM), 0, 0}}; + +%% Date/Times Fri Nov 21 14:55:26 +0000 2014 (Twitter format) +parse([Month, Day, Hour,$:,Min,$:,Sec, Year], _Now, _Opts) + when ?is_hinted_month(Month), ?is_day(Day), ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, []), Min, Sec}}; + +%% Times - 21:45, 13:45:54, 13:15PM etc +parse([Hour,$:,Min,$:,Sec | PAM], {Date, _Time}, _O) when ?is_meridian(PAM) -> + {Date, {hour(Hour, PAM), Min, Sec}}; +parse([Hour,$:,Min | PAM], {Date, _Time}, _Opts) when ?is_meridian(PAM) -> + {Date, {hour(Hour, PAM), Min, 0}}; +parse([Hour | PAM],{Date,_Time}, _Opts) when ?is_meridian(PAM) -> + {Date, {hour(Hour,PAM), 0, 0}}; + +%% Dates (Any combination with word month "aug 8th, 2008", "8 aug 2008", "2008 aug 21" "2008 5 aug" ) +%% Will work because of the "Hinted month" +parse([Day,Month,Year], {_Date, Time}, _Opts) + when ?is_day(Day) andalso ?is_hinted_month(Month) andalso ?is_year(Year) -> + {{Year, Month, Day}, Time}; +parse([Month,Day,Year], {_Date, Time}, _Opts) + when ?is_day(Day) andalso ?is_hinted_month(Month) andalso ?is_year(Year) -> + {{Year, Month, Day}, Time}; +parse([Year,Day,Month], {_Date, Time}, _Opts) + when ?is_day(Day) andalso ?is_hinted_month(Month) andalso ?is_year(Year) -> + {{Year, Month, Day}, Time}; +parse([Year,Month,Day], {_Date, Time}, _Opts) + when ?is_day(Day) andalso ?is_hinted_month(Month) andalso ?is_year(Year) -> + {{Year, Month, Day}, Time}; + +%% Dates 23/april/1963 +parse([Day,Month,Year], {_Date, Time}, _Opts) -> + {{Year, Month, Day}, Time}; +parse([Year,X,Month,X,Day], {_Date, Time}, _Opts) + when (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso ?is_year(Year) -> + {{Year, Month, Day}, Time}; +parse([Month,X,Day,X,Year], {_Date, Time}, _Opts) when ?is_us_sep(X) -> + {{Year, Month, Day}, Time}; +parse([Day,X,Month,X,Year], {_Date, Time}, _Opts) when ?is_world_sep(X) -> + {{Year, Month, Day}, Time}; + +%% Date/Times 22 Aug 2008 6:35 PM +%% Time is "7 PM" +parse([Year,X,Month,X,Day,Hour | PAM], _Date, _Opts) + when ?is_meridian(PAM) andalso + (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, PAM), 0, 0}}; +parse([Day,X,Month,X,Year,Hour | PAM], _Date, _Opts) + when ?is_meridian(PAM) andalso ?is_world_sep(X) -> + {{Year, Month, Day}, {hour(Hour, PAM), 0, 0}}; +parse([Month,X,Day,X,Year,Hour | PAM], _Date, _Opts) + when ?is_meridian(PAM) andalso ?is_us_sep(X) -> + {{Year, Month, Day}, {hour(Hour, PAM), 0, 0}}; + + +%% Time is "6:35 PM" ms return +parse([Year,X,Month,X,Day,Hour,$:,Min | PAM], _Date, _Opts) + when ?is_meridian(PAM) andalso + (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, 0}}; +parse([Day,X,Month,X,Year,Hour,$:,Min | PAM], _Date, _Opts) + when ?is_meridian(PAM) andalso ?is_world_sep(X) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, 0}}; +parse([Month,X,Day,X,Year,Hour,$:,Min | PAM], _Date, _Opts) + when ?is_meridian(PAM) andalso ?is_us_sep(X) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, 0}}; + +%% Time is "6:35:15 PM" +parse([Year,X,Month,X,Day,Hour,$:,Min,$:,Sec | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso + (?is_us_sep(X) orelse ?is_world_sep(X)) + andalso ?is_year(Year) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}}; +parse([Month,X,Day,X,Year,Hour,$:,Min,$:,Sec | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_us_sep(X) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}}; +parse([Day,X,Month,X,Year,Hour,$:,Min,$:,Sec | PAM], _Now, _Opts) + when ?is_meridian(PAM) andalso ?is_world_sep(X) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}}; + +parse([Day,Month,Year,Hour | PAM], _Now, _Opts) + when ?is_meridian(PAM) -> + {{Year, Month, Day}, {hour(Hour, PAM), 0, 0}}; +parse([Day,Month,Year,Hour,$:,Min | PAM], _Now, _Opts) + when ?is_meridian(PAM) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, 0}}; +parse([Day,Month,Year,Hour,$:,Min,$:,Sec | PAM], _Now, _Opts) + when ?is_meridian(PAM) -> + {{Year, Month, Day}, {hour(Hour, PAM), Min, Sec}}; + +parse(_Tokens, _Now, _Opts) -> + {error, bad_date}. + +tokenise([], Acc) -> + lists:reverse(Acc); + +%% ISO 8601 fractions of a second +tokenise([$., N1, N2, N3, N4, N5, N6 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4), ?is_num(N5), ?is_num(N6) -> + tokenise(Rest, [ ltoi([N1, N2, N3, N4, N5, N6]), $. | Acc]); +tokenise([$., N1, N2, N3, N4, N5 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4), ?is_num(N5) -> + tokenise(Rest, [ ltoi([N1, N2, N3, N4, N5]) * 10, $. | Acc]); +tokenise([$., N1, N2, N3, N4 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4) -> + tokenise(Rest, [ ltoi([N1, N2, N3, N4]) * 100, $. | Acc]); +tokenise([$., N1, N2, N3 | Rest], Acc) when ?is_num(N1), ?is_num(N2), ?is_num(N3) -> + tokenise(Rest, [ ltoi([N1, N2, N3]) * 1_000, $. | Acc]); +tokenise([$., N1, N2 | Rest], Acc) when ?is_num(N1), ?is_num(N2) -> + tokenise(Rest, [ ltoi([N1, N2]) * 10_000, $. | Acc]); +tokenise([$., N1 | Rest], Acc) when ?is_num(N1) -> + tokenise(Rest, [ ltoi([N1]) * 100_000, $. | Acc]); + +tokenise([N1, N2, N3, N4, N5, N6 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4), ?is_num(N5), ?is_num(N6) -> + tokenise(Rest, [ ltoi([N1, N2, N3, N4, N5, N6]) | Acc]); +tokenise([N1, N2, N3, N4, N5 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4), ?is_num(N5) -> + tokenise(Rest, [ ltoi([N1, N2, N3, N4, N5]) | Acc]); +tokenise([N1, N2, N3, N4 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3), ?is_num(N4) -> + tokenise(Rest, [ ltoi([N1, N2, N3, N4]) | Acc]); +tokenise([N1, N2, N3 | Rest], Acc) + when ?is_num(N1), ?is_num(N2), ?is_num(N3) -> + tokenise(Rest, [ ltoi([N1, N2, N3]) | Acc]); +tokenise([N1, N2 | Rest], Acc) + when ?is_num(N1), ?is_num(N2) -> + tokenise(Rest, [ ltoi([N1, N2]) | Acc]); +tokenise([N1 | Rest], Acc) + when ?is_num(N1) -> + tokenise(Rest, [ ltoi([N1]) | Acc]); + + +%% Worded Months get tagged with ?MONTH_TAG to let the parser know that these +%% are unambiguously declared to be months. This was there's no confusion +%% between, for example: "Aug 12" and "12 Aug" +%% These hint tags are filtered in filter_hints/1 above. +tokenise("JANUARY"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,1} | Acc]); +tokenise("JAN"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,1} | Acc]); +tokenise("FEBRUARY"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,2} | Acc]); +tokenise("FEB"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,2} | Acc]); +tokenise("MARCH"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,3} | Acc]); +tokenise("MAR"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,3} | Acc]); +tokenise("APRIL"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,4} | Acc]); +tokenise("APR"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,4} | Acc]); +tokenise("MAY"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,5} | Acc]); +tokenise("JUNE"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,6} | Acc]); +tokenise("JUN"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,6} | Acc]); +tokenise("JULY"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,7} | Acc]); +tokenise("JUL"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,7} | Acc]); +tokenise("AUGUST"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,8} | Acc]); +tokenise("AUG"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,8} | Acc]); +tokenise("SEPTEMBER"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,9} | Acc]); +tokenise("SEPT"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,9} | Acc]); +tokenise("SEP"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,9} | Acc]); +tokenise("OCTOBER"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,10} | Acc]); +tokenise("OCT"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,10} | Acc]); +tokenise("NOVEMBER"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,11} | Acc]); +tokenise("NOVEM"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,11} | Acc]); +tokenise("NOV"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,11} | Acc]); +tokenise("DECEMBER"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,12} | Acc]); +tokenise("DECEM"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,12} | Acc]); +tokenise("DEC"++Rest, Acc) -> tokenise(Rest, [{?MONTH_TAG,12} | Acc]); + +tokenise([$: | Rest], Acc) -> tokenise(Rest, [ $: | Acc]); +tokenise([$/ | Rest], Acc) -> tokenise(Rest, [ $/ | Acc]); +tokenise([$- | Rest], Acc) -> tokenise(Rest, [ $- | Acc]); +tokenise("AM"++Rest, Acc) -> tokenise(Rest, [am | Acc]); +tokenise("PM"++Rest, Acc) -> tokenise(Rest, [pm | Acc]); +tokenise("A"++Rest, Acc) -> tokenise(Rest, [am | Acc]); +tokenise("P"++Rest, Acc) -> tokenise(Rest, [pm | Acc]); + +%% Postel's Law +%% +%% be conservative in what you do, +%% be liberal in what you accept from others. +%% +%% See RFC 793 Section 2.10 http://tools.ietf.org/html/rfc793 +%% +%% Mebbies folk want to include Saturday etc in a date, nae borra +tokenise("MONDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("MON"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("TUESDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("TUES"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("TUE"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("WEDNESDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("WEDS"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("WED"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("THURSDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("THURS"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("THUR"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("THU"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("FRIDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("FRI"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("SATURDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("SAT"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("SUNDAY"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("SUN"++Rest, Acc) -> tokenise(Rest, Acc); + +%% Hmm Excel reports GMT in times so nuke that too +tokenise("GMT"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("UTC"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("DST"++Rest, Acc) -> tokenise(Rest, Acc); % daylight saving time + +tokenise([$, | Rest], Acc) -> tokenise(Rest, Acc); +tokenise([32 | Rest], Acc) -> tokenise(Rest, Acc); % Spaces +tokenise("TH"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("ND"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("ST"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("OF"++Rest, Acc) -> tokenise(Rest, Acc); +tokenise("T"++Rest, Acc) -> tokenise(Rest, Acc); % 2012-12-12T12:12:12 ISO formatting. +tokenise([$Z | Rest], Acc) -> tokenise(Rest, [$Z | Acc]); % 2012-12-12T12:12:12Zulu +tokenise([$+, H1,H2,M1,M2| Rest], Acc) when ?is_tz_offset(H1,H2,M1,M2) -> tokenise(Rest, Acc); % Tue Nov 11 15:03:18 +0000 2014 Twitter format +tokenise([$+| Rest], Acc) -> tokenise(Rest, [$+ | Acc]); % 2012-12-12T12:12:12.xxxx+ ISO formatting. + +tokenise([Else | Rest], Acc) -> + tokenise(Rest, [{bad_token, Else} | Acc]). + +hour(Hour, []) -> Hour; +hour(12, [am]) -> 0; +hour(Hour, [am]) -> Hour; +hour(12, [pm]) -> 12; +hour(Hour, [pm]) -> Hour+12. + +-spec format(string(),datetime(),list()) -> string(). +%% Finished, return +format([], _Date, Acc) -> + lists:flatten(lists:reverse(Acc)); + +%% Escape backslashes +format([$\\,H|T], Dt, Acc) -> + format(T,Dt,[H|Acc]); + +%% Year Formats +format([$Y|T], {{Y,_,_},_}=Dt, Acc) -> + format(T, Dt, [itol(Y)|Acc]); +format([$y|T], {{Y,_,_},_}=Dt, Acc) -> + [_, _, Y3, Y4] = itol(Y), + format(T, Dt, [[Y3,Y4]|Acc]); +format([$L|T], {{Y,_,_},_}=Dt, Acc) -> + format(T, Dt, [itol(is_leap(Y))|Acc]); +format([$o|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [itol(iso_year(Date))|Acc]); + +%% Month Formats +format([$n|T], {{_,M,_},_}=Dt, Acc) -> + format(T, Dt, [itol(M)|Acc]); +format([$m|T], {{_,M,_},_}=Dt, Acc) -> + format(T, Dt, [pad2(M)|Acc]); +format([$M|T], {{_,M,_},_}=Dt, Acc) -> + format(T, Dt, [smonth(M)|Acc]); +format([$F|T], {{_,M,_},_}=Dt, Acc) -> + format(T, Dt, [month(M)|Acc]); +format([$t|T], {{Y,M,_},_}=Dt, Acc) -> + format(T, Dt, [itol(calendar:last_day_of_the_month(Y,M))|Acc]); + +%% Week Formats +format([$W|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [pad2(iso_week(Date))|Acc]); + +%% Day Formats +format([$j|T], {{_,_,D},_}=Dt, Acc) -> + format(T, Dt, [itol(D)|Acc]); +format([$S|T], {{_,_,D},_}=Dt, Acc) -> + format(T, Dt,[suffix(D)| Acc]); +format([$d|T], {{_,_,D},_}=Dt, Acc) -> + format(T, Dt, [pad2(D)|Acc]); +format([$D|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [sdayd(Date)|Acc]); +format([$l|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [day(calendar:day_of_the_week(Date))|Acc]); +format([$N|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [itol(calendar:day_of_the_week(Date))|Acc]); +format([$w|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [itol(to_w(calendar:day_of_the_week(Date)))|Acc]); +format([$z|T], {Date,_}=Dt, Acc) -> + format(T, Dt, [itol(days_in_year(Date))|Acc]); + +%% Time Formats +format([$a|T], Dt={_,{H,_,_}}, Acc) when H >= 12 -> + format(T, Dt, ["pm"|Acc]); +format([$a|T], Dt={_,{_,_,_}}, Acc) -> + format(T, Dt, ["am"|Acc]); +format([$A|T], {_,{H,_,_}}=Dt, Acc) when H >= 12 -> + format(T, Dt, ["PM"|Acc]); +format([$A|T], Dt={_,{_,_,_}}, Acc) -> + format(T, Dt, ["AM"|Acc]); +format([$g|T], {_,{H,_,_}}=Dt, Acc) when H == 12; H == 0 -> + format(T, Dt, ["12"|Acc]); +format([$g|T], {_,{H,_,_}}=Dt, Acc) when H > 12 -> + format(T, Dt, [itol(H-12)|Acc]); +format([$g|T], {_,{H,_,_}}=Dt, Acc) -> + format(T, Dt, [itol(H)|Acc]); +format([$G|T], {_,{H,_,_}}=Dt, Acc) -> + format(T, Dt, [itol(H)|Acc]); +format([$h|T], {_,{H,_,_}}=Dt, Acc) when H > 12 -> + format(T, Dt, [pad2(H-12)|Acc]); +format([$h|T], {_,{H,_,_}}=Dt, Acc) -> + format(T, Dt, [pad2(H)|Acc]); +format([$H|T], {_,{H,_,_}}=Dt, Acc) -> + format(T, Dt, [pad2(H)|Acc]); +format([$i|T], {_,{_,M,_}}=Dt, Acc) -> + format(T, Dt, [pad2(M)|Acc]); +format([$s|T], {_,{_,_,S}}=Dt, Acc) -> + format(T, Dt, [pad2(S)|Acc]); +format([$f|T], {_,{_,_,_}}=Dt, Acc) -> + format(T, Dt, [itol(0)|Acc]); + +%% Time Formats ms +format([$a|T], Dt={_,{H,_,_,_}}, Acc) when H > 12 -> + format(T, Dt, ["pm"|Acc]); +format([$a|T], Dt={_,{_,_,_,_}}, Acc) -> + format(T, Dt, ["am"|Acc]); +format([$A|T], {_,{H,_,_,_}}=Dt, Acc) when H > 12 -> + format(T, Dt, ["PM"|Acc]); +format([$A|T], Dt={_,{_,_,_,_}}, Acc) -> + format(T, Dt, ["AM"|Acc]); +format([$g|T], {_,{H,_,_,_}}=Dt, Acc) when H == 12; H == 0 -> + format(T, Dt, ["12"|Acc]); +format([$g|T], {_,{H,_,_,_}}=Dt, Acc) when H > 12 -> + format(T, Dt, [itol(H-12)|Acc]); +format([$g|T], {_,{H,_,_,_}}=Dt, Acc) -> + format(T, Dt, [itol(H)|Acc]); +format([$G|T], {_,{H,_,_,_}}=Dt, Acc) -> + format(T, Dt, [pad2(H)|Acc]); +format([$h|T], {_,{H,_,_,_}}=Dt, Acc) when H > 12 -> + format(T, Dt, [pad2(H-12)|Acc]); +format([$h|T], {_,{H,_,_,_}}=Dt, Acc) -> + format(T, Dt, [pad2(H)|Acc]); +format([$H|T], {_,{H,_,_,_}}=Dt, Acc) -> + format(T, Dt, [pad2(H)|Acc]); +format([$i|T], {_,{_,M,_,_}}=Dt, Acc) -> + format(T, Dt, [pad2(M)|Acc]); +format([$s|T], {_,{_,_,S,_}}=Dt, Acc) -> + format(T, Dt, [pad2(S)|Acc]); +format([$f|T], {_,{_,_,_,Ms}}=Dt, Acc) -> + format(T, Dt, [pad6(Ms)|Acc]); + +%% Whole Dates +format([$c|T], {{Y,M,D},{H,Min,S}}=Dt, Acc) -> + Format = "~4.10.0B-~2.10.0B-~2.10.0B" + ++" ~2.10.0B:~2.10.0B:~2.10.0B", + Date = io_lib:format(Format, [Y, M, D, H, Min, S]), + format(T, Dt, [Date|Acc]); +format([$r|T], {{Y,M,D},{H,Min,S}}=Dt, Acc) -> + Format = "~s, ~p ~s ~p ~2.10.0B:~2.10.0B:~2.10.0B", + Args = [sdayd({Y,M,D}), D, smonth(M), Y, H, Min, S], + format(T, Dt, [io_lib:format(Format, Args)|Acc]); +format([$U|T], Dt, Acc) -> + Epoch = {{1970,1,1},{0,0,0}}, + Time = calendar:datetime_to_gregorian_seconds(Dt) - + calendar:datetime_to_gregorian_seconds(Epoch), + format(T, Dt, [itol(Time)|Acc]); + +%% Unrecognised, print as is +format([H|T], Date, Acc) -> + format(T, Date, [H|Acc]). + + +%% @doc days in year +-spec days_in_year(date()) -> integer(). +days_in_year({Y,_,_}=Date) -> + calendar:date_to_gregorian_days(Date) - + calendar:date_to_gregorian_days({Y,1,1}). + +%% @doc is a leap year +-spec is_leap(year()) -> 1|0. +is_leap(Y) -> + case calendar:is_leap_year(Y) of + true -> 1; + false -> 0 + end. + +%% @doc Made up numeric day of the week +%% (0 Sunday -> 6 Saturday) +-spec to_w(daynum()) -> integer(). +to_w(7) -> 0; +to_w(X) -> X. + +-spec suffix(day()) -> string(). +%% @doc English ordinal suffix for the day of the +%% month, 2 characters +suffix(1) -> "st"; +suffix(2) -> "nd"; +suffix(3) -> "rd"; +suffix(21) -> "st"; +suffix(22) -> "nd"; +suffix(23) -> "rd"; +suffix(31) -> "st"; +suffix(_) -> "th". + +-spec sdayd(date()) -> string(). +%% @doc A textual representation of a day, three letters +sdayd({Y,M,D}) -> + sday(calendar:day_of_the_week({Y,M,D})). + +-spec sday(daynum()) -> string(). +%% @doc A textual representation of a day, three letters +sday(1) -> "Mon"; +sday(2) -> "Tue"; +sday(3) -> "Wed"; +sday(4) -> "Thu"; +sday(5) -> "Fri"; +sday(6) -> "Sat"; +sday(7) -> "Sun". + +-spec day(daynum()) -> string(). +%% @doc A full textual representation of a day +day(1) -> "Monday"; +day(2) -> "Tuesday"; +day(3) -> "Wednesday"; +day(4) -> "Thursday"; +day(5) -> "Friday"; +day(6) -> "Saturday"; +day(7) -> "Sunday". + +-spec smonth(month()) -> string(). +%% @doc A short textual representation of a +%% month, three letters +smonth(1) -> "Jan"; +smonth(2) -> "Feb"; +smonth(3) -> "Mar"; +smonth(4) -> "Apr"; +smonth(5) -> "May"; +smonth(6) -> "Jun"; +smonth(7) -> "Jul"; +smonth(8) -> "Aug"; +smonth(9) -> "Sep"; +smonth(10) -> "Oct"; +smonth(11) -> "Nov"; +smonth(12) -> "Dec". + +-spec month(month()) -> string(). +%% @doc A full textual representation of a month +month(1) -> "January"; +month(2) -> "February"; +month(3) -> "March"; +month(4) -> "April"; +month(5) -> "May"; +month(6) -> "June"; +month(7) -> "July"; +month(8) -> "August"; +month(9) -> "September"; +month(10) -> "October"; +month(11) -> "November"; +month(12) -> "December". + +-spec iso_week(date()) -> integer(). +%% @doc The week of the years as defined in ISO 8601 +%% http://en.wikipedia.org/wiki/ISO_week_date +iso_week(Date) -> + Week = iso_week_one(iso_year(Date)), + Days = calendar:date_to_gregorian_days(Date) - + calendar:date_to_gregorian_days(Week), + trunc((Days / 7) + 1). + +-spec iso_year(date()) -> integer(). +%% @doc The year number as defined in ISO 8601 +%% http://en.wikipedia.org/wiki/ISO_week_date +iso_year({Y, _M, _D}=Dt) -> + case Dt >= {Y, 12, 29} of + true -> + case Dt < iso_week_one(Y+1) of + true -> Y; + false -> Y+1 + end; + false -> + case Dt < iso_week_one(Y) of + true -> Y-1; + false -> Y + end + end. + +-spec iso_week_one(year()) -> date(). +%% @doc The date of the the first day of the first week +%% in the ISO calendar +iso_week_one(Y) -> + Day1 = calendar:day_of_the_week({Y,1,4}), + Days = calendar:date_to_gregorian_days({Y,1,4}) + (1-Day1), + calendar:gregorian_days_to_date(Days). + +-spec itol(integer()) -> list(). +%% @doc short hand +itol(X) -> + integer_to_list(X). + +-spec pad2(integer() | float()) -> list(). +%% @doc int padded with 0 to make sure its 2 chars +pad2(X) when is_integer(X) -> + io_lib:format("~2.10.0B",[X]); +pad2(X) when is_float(X) -> + io_lib:format("~2.10.0B",[trunc(X)]). + +-spec pad6(integer()) -> list(). +pad6(X) when is_integer(X) -> + io_lib:format("~6.10.0B",[X]). + +ltoi(X) -> + list_to_integer(X). + +%%%=================================================================== +%%% Tests +%%%=================================================================== + +-ifdef(TEST). +-include_lib("eunit/include/eunit.hrl"). + + +-define(DATE, {{2001,3,10},{17,16,17}}). +-define(DATEMS, {{2001,3,10},{17,16,17,123_456}}). +-define(DATE_NOON, {{2001,3,10},{12,0,0}}). +-define(DATE_MIDNIGHT, {{2001,3,10},{0,0,0}}). +-define(ISO, "o \\WW"). + +basic_format_test_() -> + [ + ?_assertEqual(format("F j, Y, g:i a",?DATE), "March 10, 2001, 5:16 pm"), + ?_assertEqual(format("F jS, Y, g:i a",?DATE), "March 10th, 2001, 5:16 pm"), + ?_assertEqual(format("F jS",{{2011,3,21},{0,0,0}}), "March 21st"), + ?_assertEqual(format("F jS",{{2011,3,22},{0,0,0}}), "March 22nd"), + ?_assertEqual(format("F jS",{{2011,3,23},{0,0,0}}), "March 23rd"), + ?_assertEqual(format("F jS",{{2011,3,31},{0,0,0}}), "March 31st"), + ?_assertEqual(format("m.d.y",?DATE), "03.10.01"), + ?_assertEqual(format("j, n, Y",?DATE), "10, 3, 2001"), + ?_assertEqual(format("Ymd",?DATE), "20010310"), + ?_assertEqual(format("H:i:s",?DATE), "17:16:17"), + ?_assertEqual(format("z",?DATE), "68"), + ?_assertEqual(format("D M j G:i:s Y",?DATE), "Sat Mar 10 17:16:17 2001"), + ?_assertEqual(format("D M j G:i:s Y", {{2001,3,10},{5,16,17}}), "Sat Mar 10 5:16:17 2001"), + ?_assertEqual(format("D M j H:i:s Y", {{2001,3,10},{5,16,17}}), "Sat Mar 10 05:16:17 2001"), + ?_assertEqual(format("ga",?DATE_NOON), "12pm"), + ?_assertEqual(format("gA",?DATE_NOON), "12PM"), + ?_assertEqual(format("ga",?DATE_MIDNIGHT), "12am"), + ?_assertEqual(format("gA",?DATE_MIDNIGHT), "12AM"), + + ?_assertEqual(format("h-i-s, j-m-y, it is w Day",?DATE), + "05-16-17, 10-03-01, 1631 1617 6 Satpm01"), + ?_assertEqual(format("\\i\\t \\i\\s \\t\\h\\e\\ jS \\d\\a\\y.",?DATE), + "it is the 10th day."), + ?_assertEqual(format("H:m:s \\m \\i\\s \\m\\o\\n\\t\\h",?DATE), + "17:03:17 m is month") + ]. + +basic_parse_test_() -> + [ + ?_assertEqual({{2008,8,22}, {17,16,17}}, + parse("22nd of August 2008", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("22-Aug-2008 6 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("22-Aug-2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,12}}, + parse("22-Aug-2008 6:35:12 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("August/22/2008 6 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("August/22/2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("22 August 2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("22 Aug 2008 6AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("22 Aug 2008 6:35AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("22 Aug 2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("22 Aug 2008 6", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("22 Aug 2008 6:35", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,35,0}}, + parse("22 Aug 2008 6:35 PM", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,0,0}}, + parse("22 Aug 2008 6 PM", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,0,0}}, + parse("Aug 22, 2008 6 PM", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,0,0}}, + parse("August 22nd, 2008 6:00 PM", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,15,15}}, + parse("August 22nd 2008, 6:15:15pm", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,15,15}}, + parse("August 22nd, 2008, 6:15:15pm", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,15,0}}, + parse("Aug 22nd 2008, 18:15", ?DATE)), + ?_assertEqual({{2008,8,2}, {17,16,17}}, + parse("2nd of August 2008", ?DATE)), + ?_assertEqual({{2008,8,2}, {17,16,17}}, + parse("August 2nd, 2008", ?DATE)), + ?_assertEqual({{2008,8,2}, {17,16,17}}, + parse("2nd August, 2008", ?DATE)), + ?_assertEqual({{2008,8,2}, {17,16,17}}, + parse("2008 August 2nd", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,0,0}}, + parse("2-Aug-2008 6 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,0}}, + parse("2-Aug-2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,12}}, + parse("2-Aug-2008 6:35:12 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,0,0}}, + parse("August/2/2008 6 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,0}}, + parse("August/2/2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,0}}, + parse("2 August 2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,0,0}}, + parse("2 Aug 2008 6AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,0}}, + parse("2 Aug 2008 6:35AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,0}}, + parse("2 Aug 2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,0,0}}, + parse("2 Aug 2008 6", ?DATE)), + ?_assertEqual({{2008,8,2}, {6,35,0}}, + parse("2 Aug 2008 6:35", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,35,0}}, + parse("2 Aug 2008 6:35 PM", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,0,0}}, + parse("2 Aug 2008 6 PM", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,0,0}}, + parse("Aug 2, 2008 6 PM", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,0,0}}, + parse("August 2nd, 2008 6:00 PM", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,15,15}}, + parse("August 2nd 2008, 6:15:15pm", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,15,15}}, + parse("August 2nd, 2008, 6:15:15pm", ?DATE)), + ?_assertEqual({{2008,8,2}, {18,15,0}}, + parse("Aug 2nd 2008, 18:15", ?DATE)), + ?_assertEqual({{2012,12,10}, {0,0,0}}, + parse("Dec 10th, 2012, 12:00 AM", ?DATE)), + ?_assertEqual({{2012,12,10}, {0,0,0}}, + parse("10 Dec 2012 12:00 AM", ?DATE)), + ?_assertEqual({{2001,3,10}, {11,15,0}}, + parse("11:15", ?DATE)), + ?_assertEqual({{2001,3,10}, {1,15,0}}, + parse("1:15", ?DATE)), + ?_assertEqual({{2001,3,10}, {1,15,0}}, + parse("1:15 am", ?DATE)), + ?_assertEqual({{2001,3,10}, {0,15,0}}, + parse("12:15 am", ?DATE)), + ?_assertEqual({{2001,3,10}, {12,15,0}}, + parse("12:15 pm", ?DATE)), + ?_assertEqual({{2001,3,10}, {3,45,39}}, + parse("3:45:39", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("23-4-1963", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("23-april-1963", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("23-apr-1963", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("4/23/1963", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("april/23/1963", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("apr/23/1963", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("1963/4/23", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("1963/april/23", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("1963/apr/23", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("1963-4-23", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("1963-4-23", ?DATE)), + ?_assertEqual({{1963,4,23}, {17,16,17}}, + parse("1963-apr-23", ?DATE)), + ?_assertThrow({?MODULE, {bad_date, "23/ap/195"}}, + parse("23/ap/195", ?DATE)), + ?_assertEqual({{2001,3,10}, {6,45,0}}, + parse("6:45 am", ?DATE)), + ?_assertEqual({{2001,3,10}, {18,45,0}}, + parse("6:45 PM", ?DATE)), + ?_assertEqual({{2001,3,10}, {18,45,0}}, + parse("6:45 PM ", ?DATE)) + ]. + +parse_with_days_test_() -> + [ + ?_assertEqual({{2008,8,22}, {17,16,17}}, + parse("Sat 22nd of August 2008", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("Sat, 22-Aug-2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,12}}, + parse("Sunday 22-Aug-2008 6:35:12 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("Sun 22-Aug-2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("THURSDAY, 22-August-2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,0,0}}, + parse("THURSDAY, 22-August-2008 6 pM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("THU 22 August 2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("FRi 22 Aug 2008 6:35AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("FRi 22 Aug 2008 6AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("Wednesday 22 Aug 2008 6:35 AM", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,35,0}}, + parse("Monday 22 Aug 2008 6:35", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("Monday 22 Aug 2008 6", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,0,0}}, + parse("Monday 22 Aug 2008 6p", ?DATE)), + ?_assertEqual({{2008,8,22}, {6,0,0}}, + parse("Monday 22 Aug 2008 6a", ?DATE)), + ?_assertEqual({{2008,8,22}, {18,35,0}}, + parse("Mon, 22 Aug 2008 6:35 PM", ?DATE)), + % Twitter style + ?_assertEqual({{2008,8,22}, {06,35,04}}, + parse("Mon Aug 22 06:35:04 +0000 2008", ?DATE)), + ?_assertEqual({{2008,8,22}, {06,35,04}}, + parse("Mon Aug 22 06:35:04 +0500 2008", ?DATE)) + ]. + +parse_with_TZ_test_() -> + [ + ?_assertEqual({{2008,8,22}, {17,16,17}}, + parse("Sat 22nd of August 2008 GMT", ?DATE)), + ?_assertEqual({{2008,8,22}, {17,16,17}}, + parse("Sat 22nd of August 2008 UTC", ?DATE)), + ?_assertEqual({{2008,8,22}, {17,16,17}}, + parse("Sat 22nd of August 2008 DST", ?DATE)) + ]. + +iso_test_() -> + [ + ?_assertEqual("2004 W53",format(?ISO,{{2005,1,1}, {1,1,1}})), + ?_assertEqual("2004 W53",format(?ISO,{{2005,1,2}, {1,1,1}})), + ?_assertEqual("2005 W52",format(?ISO,{{2005,12,31},{1,1,1}})), + ?_assertEqual("2007 W01",format(?ISO,{{2007,1,1}, {1,1,1}})), + ?_assertEqual("2007 W52",format(?ISO,{{2007,12,30},{1,1,1}})), + ?_assertEqual("2008 W01",format(?ISO,{{2007,12,31},{1,1,1}})), + ?_assertEqual("2008 W01",format(?ISO,{{2008,1,1}, {1,1,1}})), + ?_assertEqual("2009 W01",format(?ISO,{{2008,12,29},{1,1,1}})), + ?_assertEqual("2009 W01",format(?ISO,{{2008,12,31},{1,1,1}})), + ?_assertEqual("2009 W01",format(?ISO,{{2009,1,1}, {1,1,1}})), + ?_assertEqual("2009 W53",format(?ISO,{{2009,12,31},{1,1,1}})), + ?_assertEqual("2009 W53",format(?ISO,{{2010,1,3}, {1,1,1}})) + ]. + +ms_test_() -> + Now=os:timestamp(), + [ + ?_assertEqual({{2012,12,12}, {12,12,12,1234}}, parse("2012-12-12T12:12:12.001234")), + ?_assertEqual({{2012,12,12}, {12,12,12,123_000}}, parse("2012-12-12T12:12:12.123")), + ?_assertEqual(format("H:m:s.f \\m \\i\\s \\m\\o\\n\\t\\h",?DATEMS), + "17:03:17.123456 m is month"), + ?_assertEqual(format("Y-m-d\\TH:i:s.f",?DATEMS), + "2001-03-10T17:16:17.123456"), + ?_assertEqual(format("Y-m-d\\TH:i:s.f",nparse("2001-03-10T05:16:17.123456")), + "2001-03-10T05:16:17.123456"), + ?_assertEqual(format("Y-m-d\\TH:i:s.f",nparse("2001-03-10T05:16:17.123456")), + "2001-03-10T05:16:17.123456"), + ?_assertEqual(format("Y-m-d\\TH:i:s.f",nparse("2001-03-10T15:16:17.123456")), + "2001-03-10T15:16:17.123456"), + ?_assertEqual(format("Y-m-d\\TH:i:s.f",nparse("2001-03-10T15:16:17.000123")), + "2001-03-10T15:16:17.000123"), + ?_assertEqual(Now, nparse(format("Y-m-d\\TH:i:s.f", Now))) + ]. + +zulu_test_() -> + [ + ?_assertEqual(format("Y-m-d\\TH:i:sZ",nparse("2001-03-10T15:16:17.123456")), + "2001-03-10T15:16:17Z"), + ?_assertEqual(format("Y-m-d\\TH:i:s",nparse("2001-03-10T15:16:17Z")), + "2001-03-10T15:16:17"), + ?_assertEqual(format("Y-m-d\\TH:i:s",nparse("2001-03-10T15:16:17+04")), + "2001-03-10T11:16:17"), + ?_assertEqual(format("Y-m-d\\TH:i:s",nparse("2001-03-10T15:16:17+04:00")), + "2001-03-10T11:16:17"), + ?_assertEqual(format("Y-m-d\\TH:i:s",nparse("2001-03-10T15:16:17-04")), + "2001-03-10T19:16:17"), + ?_assertEqual(format("Y-m-d\\TH:i:s",nparse("2001-03-10T15:16:17-04:00")), + "2001-03-10T19:16:17") + ]. + +format_iso8601_test_() -> + [ + ?_assertEqual("2001-03-10T17:16:17Z", + format_iso8601({{2001,3,10},{17,16,17}})), + ?_assertEqual("2001-03-10T17:16:17.000000Z", + format_iso8601({{2001,3,10},{17,16,17,0}})), + ?_assertEqual("2001-03-10T17:16:17.100000Z", + format_iso8601({{2001,3,10},{17,16,17,100_000}})), + ?_assertEqual("2001-03-10T17:16:17.120000Z", + format_iso8601({{2001,3,10},{17,16,17,120_000}})), + ?_assertEqual("2001-03-10T17:16:17.123000Z", + format_iso8601({{2001,3,10},{17,16,17,123_000}})), + ?_assertEqual("2001-03-10T17:16:17.123400Z", + format_iso8601({{2001,3,10},{17,16,17,123_400}})), + ?_assertEqual("2001-03-10T17:16:17.123450Z", + format_iso8601({{2001,3,10},{17,16,17,123_450}})), + ?_assertEqual("2001-03-10T17:16:17.123456Z", + format_iso8601({{2001,3,10},{17,16,17,123_456}})), + ?_assertEqual("2001-03-10T17:16:17.023456Z", + format_iso8601({{2001,3,10},{17,16,17,23_456}})), + ?_assertEqual("2001-03-10T17:16:17.003456Z", + format_iso8601({{2001,3,10},{17,16,17,3_456}})), + ?_assertEqual("2001-03-10T17:16:17.000456Z", + format_iso8601({{2001,3,10},{17,16,17,456}})), + ?_assertEqual("2001-03-10T17:16:17.000056Z", + format_iso8601({{2001,3,10},{17,16,17,56}})), + ?_assertEqual("2001-03-10T17:16:17.000006Z", + format_iso8601({{2001,3,10},{17,16,17,6}})), + ?_assertEqual("2001-03-10T07:16:17Z", + format_iso8601({{2001,3,10},{07,16,17}})), + ?_assertEqual("2001-03-10T07:16:17.000000Z", + format_iso8601({{2001,3,10},{07,16,17,0}})), + ?_assertEqual("2001-03-10T07:16:17.100000Z", + format_iso8601({{2001,3,10},{07,16,17,100_000}})), + ?_assertEqual("2001-03-10T07:16:17.120000Z", + format_iso8601({{2001,3,10},{07,16,17,120_000}})), + ?_assertEqual("2001-03-10T07:16:17.123000Z", + format_iso8601({{2001,3,10},{07,16,17,123_000}})), + ?_assertEqual("2001-03-10T07:16:17.123400Z", + format_iso8601({{2001,3,10},{07,16,17,123_400}})), + ?_assertEqual("2001-03-10T07:16:17.123450Z", + format_iso8601({{2001,3,10},{07,16,17,123_450}})), + ?_assertEqual("2001-03-10T07:16:17.123456Z", + format_iso8601({{2001,3,10},{07,16,17,123_456}})), + ?_assertEqual("2001-03-10T07:16:17.023456Z", + format_iso8601({{2001,3,10},{07,16,17,23_456}})), + ?_assertEqual("2001-03-10T07:16:17.003456Z", + format_iso8601({{2001,3,10},{07,16,17,3_456}})), + ?_assertEqual("2001-03-10T07:16:17.000456Z", + format_iso8601({{2001,3,10},{07,16,17,456}})), + ?_assertEqual("2001-03-10T07:16:17.000056Z", + format_iso8601({{2001,3,10},{07,16,17,56}})), + ?_assertEqual("2001-03-10T07:16:17.000006Z", + format_iso8601({{2001,3,10},{07,16,17,6}})) + ]. + +parse_iso8601_test_() -> + [ + ?_assertEqual({{2001,3,10},{17,16,17}}, + parse("2001-03-10T17:16:17Z")), + ?_assertEqual({{2001,3,10},{17,16,17,0}}, + parse("2001-03-10T17:16:17.000Z")), + ?_assertEqual({{2001,3,10},{17,16,17,0}}, + parse("2001-03-10T17:16:17.000000Z")), + ?_assertEqual({{2001,3,10},{17,16,17,100_000}}, + parse("2001-03-10T17:16:17.1Z")), + ?_assertEqual({{2001,3,10},{17,16,17,120_000}}, + parse("2001-03-10T17:16:17.12Z")), + ?_assertEqual({{2001,3,10},{17,16,17,123_000}}, + parse("2001-03-10T17:16:17.123Z")), + ?_assertEqual({{2001,3,10},{17,16,17,123_400}}, + parse("2001-03-10T17:16:17.1234Z")), + ?_assertEqual({{2001,3,10},{17,16,17,123_450}}, + parse("2001-03-10T17:16:17.12345Z")), + ?_assertEqual({{2001,3,10},{17,16,17,123_456}}, + parse("2001-03-10T17:16:17.123456Z")), + + ?_assertEqual({{2001,3,10},{15,16,17,100_000}}, + parse("2001-03-10T16:16:17.1+01:00")), + ?_assertEqual({{2001,3,10},{15,16,17,123_456}}, + parse("2001-03-10T16:16:17.123456+01:00")), + ?_assertEqual({{2001,3,10},{17,16,17,100_000}}, + parse("2001-03-10T16:16:17.1-01:00")), + ?_assertEqual({{2001,3,10},{17,16,17,123_456}}, + parse("2001-03-10T16:16:17.123456-01:00")), + + ?_assertEqual({{2001,3,10},{17,16,17,456}}, + parse("2001-03-10T17:16:17.000456Z")), + ?_assertEqual({{2001,3,10},{17,16,17,123_000}}, + parse("2001-03-10T17:16:17.123000Z")) + ]. + +-endif. diff --git a/src/ec_dict.erl b/src/ec_dict.erl new file mode 100644 index 0000000..3e9418e --- /dev/null +++ b/src/ec_dict.erl @@ -0,0 +1,110 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2011 Erlware, LLC. +%%% @doc +%%% This provides an implementation of the ec_dictionary type using +%%% erlang dicts as a base. The function documentation for +%%% ec_dictionary applies here as well. +%%% see ec_dictionary +%%% see dict +%%% @end +%%%------------------------------------------------------------------- +-module(ec_dict). + +-behaviour(ec_dictionary). + +%% API +-export([new/0, + has_key/2, + get/2, + get/3, + add/3, + remove/2, + has_value/2, + size/1, + to_list/1, + from_list/1, + keys/1]). + +-export_type([dictionary/2]). + +%%%=================================================================== +%%% Types +%%%=================================================================== +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type dictionary(_K, _V) :: dict:dict(). + +%%%=================================================================== +%%% API +%%%=================================================================== + +-spec new() -> dictionary(_K, _V). +new() -> + dict:new(). + +-spec has_key(ec_dictionary:key(K), Object::dictionary(K, _V)) -> boolean(). +has_key(Key, Data) -> + dict:is_key(Key, Data). + +-spec get(ec_dictionary:key(K), Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, Data) -> + case dict:find(Key, Data) of + {ok, Value} -> + Value; + error -> + throw(not_found) + end. + +-spec get(ec_dictionary:key(K), + ec_dictionary:value(V), + Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, Default, Data) -> + case dict:find(Key, Data) of + {ok, Value} -> + Value; + error -> + Default + end. + +-spec add(ec_dictionary:key(K), ec_dictionary:value(V), + Object::dictionary(K, V)) -> + dictionary(K, V). +add(Key, Value, Data) -> + dict:store(Key, Value, Data). + +-spec remove(ec_dictionary:key(K), Object::dictionary(K, V)) -> + dictionary(K, V). +remove(Key, Data) -> + dict:erase(Key, Data). + +-spec has_value(ec_dictionary:value(V), Object::dictionary(_K, V)) -> boolean(). +has_value(Value, Data) -> + dict:fold(fun(_, NValue, _) when NValue == Value -> + true; + (_, _, Acc) -> + Acc + end, + false, + Data). + +-spec size(Object::dictionary(_K, _V)) -> non_neg_integer(). +size(Data) -> + dict:size(Data). + +-spec to_list(dictionary(K, V)) -> [{ec_dictionary:key(K), + ec_dictionary:value(V)}]. +to_list(Data) -> + dict:to_list(Data). + +-spec from_list([{ec_dictionary:key(K), ec_dictionary:value(V)}]) -> + dictionary(K, V). +from_list(List) when is_list(List) -> + dict:from_list(List). + +-spec keys(dictionary(K, _V)) -> [ec_dictionary:key(K)]. +keys(Dict) -> + dict:fetch_keys(Dict). diff --git a/src/ec_dictionary.erl b/src/ec_dictionary.erl new file mode 100644 index 0000000..ea7fdc9 --- /dev/null +++ b/src/ec_dictionary.erl @@ -0,0 +1,153 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2011 Erlware, LLC. +%%% @doc +%%% A module that supports association of keys to values. A map cannot +%%% contain duplicate keys; each key can map to at most one value. +%%% +%%% This interface is a member of the Erlware Commons Library. +%%% @end +%%%------------------------------------------------------------------- +-module(ec_dictionary). + +%% API +-export([new/1, + has_key/2, + get/2, + get/3, + add/3, + remove/2, + has_value/2, + size/1, + to_list/1, + from_list/2, + keys/1]). + +-export_type([dictionary/2, + key/1, + value/1]). + +%%%=================================================================== +%%% Types +%%%=================================================================== + +-record(dict_t, + {callback, + data}). + +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type dictionary(_K, _V) :: #dict_t{}. +-type key(T) :: T. +-type value(T) :: T. + +-callback new() -> any(). +-callback has_key(key(any()), any()) -> boolean(). +-callback get(key(any()), any()) -> any(). +-callback add(key(any()), value(any()), T) -> T. +-callback remove(key(any()), T) -> T. +-callback has_value(value(any()), any()) -> boolean(). +-callback size(any()) -> non_neg_integer(). +-callback to_list(any()) -> [{key(any()), value(any())}]. +-callback from_list([{key(any()), value(any())}]) -> any(). +-callback keys(any()) -> [key(any())]. + +%%%=================================================================== +%%% API +%%%=================================================================== + +%% @doc create a new dictionary object from the specified module. The +%% module should implement the dictionary behaviour. +%% +%% @param ModuleName The module name. +-spec new(module()) -> dictionary(_K, _V). +new(ModuleName) when is_atom(ModuleName) -> + #dict_t{callback = ModuleName, data = ModuleName:new()}. + +%% @doc check to see if the dictionary provided has the specified key. +%% +%% @param Dict The dictory object to check +%% @param Key The key to check the dictionary for +-spec has_key(key(K), dictionary(K, _V)) -> boolean(). +has_key(Key, #dict_t{callback = Mod, data = Data}) -> + Mod:has_key(Key, Data). + +%% @doc given a key return that key from the dictionary. If the key is +%% not found throw a 'not_found' exception. +%% +%% @param Dict The dictionary object to return the value from +%% @param Key The key requested +%% when the key does not exist @throws not_found +-spec get(key(K), dictionary(K, V)) -> value(V). +get(Key, #dict_t{callback = Mod, data = Data}) -> + Mod:get(Key, Data). + +%% @doc given a key return that key from the dictionary. If the key is +%% not found then the default value is returned. +%% +%% @param Dict The dictionary object to return the value from +%% @param Key The key requested +%% @param Default The value that will be returned if no value is found +%% in the database. +-spec get(key(K), value(V), dictionary(K, V)) -> value(V). +get(Key, Default, #dict_t{callback = Mod, data = Data}) -> + Mod:get(Key, Default, Data). + +%% @doc add a new value to the existing dictionary. Return a new +%% dictionary containing the value. +%% +%% @param Dict the dictionary object to add too +%% @param Key the key to add +%% @param Value the value to add +-spec add(key(K), value(V), dictionary(K, V)) -> dictionary(K, V). +add(Key, Value, #dict_t{callback = Mod, data = Data} = Dict) -> + Dict#dict_t{data = Mod:add(Key, Value, Data)}. + +%% @doc Remove a value from the dictionary returning a new dictionary +%% with the value removed. +%% +%% @param Dict the dictionary object to remove the value from +%% @param Key the key of the key/value pair to remove +-spec remove(key(K), dictionary(K, V)) -> dictionary(K, V). +remove(Key, #dict_t{callback = Mod, data = Data} = Dict) -> + Dict#dict_t{data = Mod:remove(Key, Data)}. + +%% @doc Check to see if the value exists in the dictionary +%% +%% @param Dict the dictionary object to check +%% @param Value The value to check if exists +-spec has_value(value(V), dictionary(_K, V)) -> boolean(). +has_value(Value, #dict_t{callback = Mod, data = Data}) -> + Mod:has_value(Value, Data). + +%% @doc return the current number of key value pairs in the dictionary +%% +%% @param Dict the object return the size for. +-spec size(dictionary(_K, _V)) -> integer(). +size(#dict_t{callback = Mod, data = Data}) -> + Mod:size(Data). + +%% @doc Return the contents of this dictionary as a list of key value +%% pairs. +%% +%% @param Dict the base dictionary to make use of. +-spec to_list(Dict::dictionary(K, V)) -> [{key(K), value(V)}]. +to_list(#dict_t{callback = Mod, data = Data}) -> + Mod:to_list(Data). + +%% @doc Create a new dictionary, of the specified implementation using +%% the list provided as the starting contents. +%% +%% @param ModuleName the type to create the dictionary from +%% @param List The list of key value pairs to start with +-spec from_list(module(), [{key(K), value(V)}]) -> dictionary(K, V). +from_list(ModuleName, List) when is_list(List) -> + #dict_t{callback = ModuleName, data = ModuleName:from_list(List)}. + +%% @doc Return the keys of this dictionary as a list +%% +%% @param Dict the base dictionary to make use of. +-spec keys(Dict::dictionary(K, _V)) -> [key(K)]. +keys(#dict_t{callback = Mod, data = Data}) -> + Mod:keys(Data). diff --git a/src/ec_file.erl b/src/ec_file.erl index 15f9f54..ddbee40 100644 --- a/src/ec_file.erl +++ b/src/ec_file.erl @@ -1,3 +1,4 @@ +%%% vi:ts=4 sw=4 et %%%------------------------------------------------------------------- %%% @copyright (C) 2011, Erlware LLC %%% @doc @@ -7,95 +8,171 @@ -module(ec_file). -export([ + exists/1, copy/2, copy/3, - mkdtemp/0, + copy_file_info/3, + insecure_mkdtemp/0, mkdir_path/1, + mkdir_p/1, find/2, is_symlink/1, + is_dir/1, + type/1, + real_dir_path/1, remove/1, remove/2, md5sum/1, + sha1sum/1, read/1, write/2, - write_term/2, - consult/1 + write_term/2 ]). -export_type([ - path/0, option/0 ]). -include_lib("kernel/include/file.hrl"). -%% User friendly exception message (remove line and module info once we -%% get them in stack traces) --define(UEX(Exception, UMSG, UVARS), - {uex, {?MODULE, - ?LINE, - Exception, - lists:flatten(io_lib:fwrite(UMSG, UVARS))}}). - -define(CHECK_PERMS_MSG, "Try checking that you have the correct permissions and try again~n"). %%============================================================================ %% Types %%============================================================================ --type path() :: string(). --type option() :: [atom()]. +-type file_info() :: mode | time | owner | group. +-type option() :: recursive | {file_info, [file_info()]}. %%%=================================================================== %%% API %%%=================================================================== +-spec exists(file:filename()) -> boolean(). +exists(Filename) -> + case file:read_file_info(Filename) of + {ok, _} -> + true; + {error, _Reason} -> + false + end. + %% @doc copy an entire directory to another location. --spec copy(path(), path(), Options::[option()]) -> ok. +-spec copy(file:name(), file:name(), Options::[option()]) -> ok | {error, Reason::term()}. copy(From, To, []) -> - copy(From, To); -copy(From, To, [recursive] = Options) -> - case filelib:is_dir(From) of - false -> - copy(From, To); + copy_(From, To, []); +copy(From, To, Options) -> + case proplists:get_value(recursive, Options, false) of true -> - make_dir_if_dir(To), - copy_subfiles(From, To, Options) + case is_dir(From) of + false -> + copy_(From, To, Options); + true -> + make_dir_if_dir(To), + copy_subfiles(From, To, Options) + end; + false -> + copy_(From, To, Options) end. %% @doc copy a file including timestamps,ownership and mode etc. --spec copy(From::string(), To::string()) -> ok. +-spec copy(From::file:filename(), To::file:filename()) -> ok | {error, Reason::term()}. copy(From, To) -> - try - ec_file_copy(From, To) - catch - _C:E -> throw(?UEX({copy_failed, E}, ?CHECK_PERMS_MSG, [])) + copy_(From, To, [{file_info, [mode, time, owner, group]}]). + +copy_(From, To, Options) -> + Linked + = case file:read_link(From) of + {ok, Linked0} -> Linked0; + {error, _} -> undefined + end, + case Linked =/= undefined orelse file:copy(From, To) of + true -> + file:make_symlink(Linked, To); + {ok, _} -> + copy_file_info(To, From, proplists:get_value(file_info, Options, [])); + {error, Error} -> + {error, {copy_failed, Error}} end. -%% @doc return an md5 checksum string or a binary. Same as unix utility of -%% same name. +copy_file_info(To, From, FileInfoToKeep) -> + case file:read_file_info(From) of + {ok, FileInfo} -> + case write_file_info(To, FileInfo, FileInfoToKeep) of + [] -> + ok; + Errors -> + {error, {write_file_info_failed_for, Errors}} + end; + {error, RFError} -> + {error, {read_file_info_failed, RFError}} + end. + +write_file_info(To, FileInfo, FileInfoToKeep) -> + WriteInfoFuns = [{mode, fun try_write_mode/2}, + {time, fun try_write_time/2}, + {group, fun try_write_group/2}, + {owner, fun try_write_owner/2}], + lists:foldl(fun(Info, Acc) -> + case proplists:get_value(Info, WriteInfoFuns, undefined) of + undefined -> + Acc; + F -> + case F(To, FileInfo) of + ok -> + Acc; + {error, Reason} -> + [{Info, Reason} | Acc] + end + end + end, [], FileInfoToKeep). + + +try_write_mode(To, #file_info{mode=Mode}) -> + file:write_file_info(To, #file_info{mode=Mode}). + +try_write_time(To, #file_info{atime=Atime, mtime=Mtime}) -> + file:write_file_info(To, #file_info{atime=Atime, mtime=Mtime}). + +try_write_owner(To, #file_info{uid=OwnerId}) -> + file:write_file_info(To, #file_info{uid=OwnerId}). + +try_write_group(To, #file_info{gid=OwnerId}) -> + file:write_file_info(To, #file_info{gid=OwnerId}). + +%% @doc return the MD5 digest of a string or a binary, +%% named after the UNIX utility. -spec md5sum(string() | binary()) -> string(). md5sum(Value) -> - hex(binary_to_list(erlang:md5(Value))). + bin_to_hex(crypto:hash(md5, Value)). + +%% @doc return the SHA-1 digest of a string or a binary, +%% named after the UNIX utility. +-spec sha1sum(string() | binary()) -> string(). +sha1sum(Value) -> + bin_to_hex(crypto:hash(sha, Value)). + +bin_to_hex(Bin) -> + hex(binary_to_list(Bin)). %% @doc delete a file. Use the recursive option for directories. %%
 %% Example: remove("./tmp_dir", [recursive]).
 %% 
--spec remove(path(), Options::[option()]) -> ok | {error, Reason::term()}. +-spec remove(file:name(), Options::[option()]) -> ok | {error, Reason::term()}. remove(Path, Options) -> - try - ok = ec_file_remove(Path, Options) - catch - _C:E -> throw(?UEX({remove_failed, E}, ?CHECK_PERMS_MSG, [])) + case lists:member(recursive, Options) of + false -> file:delete(Path); + true -> remove_recursive(Path, Options) end. + %% @doc delete a file. --spec remove(path()) -> ok | {error, Reason::term()}. +-spec remove(file:name()) -> ok | {error, Reason::term()}. remove(Path) -> remove(Path, []). -%% @doc indicates witha boolean if the path supplied refers to symlink. --spec is_symlink(path()) -> boolean(). +%% @doc indicates with a boolean if the path supplied refers to symlink. +-spec is_symlink(file:name()) -> boolean(). is_symlink(Path) -> case file:read_link_info(Path) of {ok, #file_info{type = symlink}} -> @@ -104,93 +181,103 @@ is_symlink(Path) -> false end. +is_dir(Path) -> + case file:read_file_info(Path) of + {ok, #file_info{type = directory}} -> + true; + _ -> + false + end. -%% @doc make a unique temorory directory. Similar function to BSD stdlib +%% @doc returns the type of the file. +-spec type(file:name()) -> file | symlink | directory | undefined. +type(Path) -> + case filelib:is_regular(Path) of + true -> + file; + false -> + case is_symlink(Path) of + true -> + symlink; + false -> + case is_dir(Path) of + true -> directory; + false -> undefined + end + end + + end. +%% @doc gets the real path of a directory. This is mostly useful for +%% resolving symlinks. Be aware that this temporarily changes the +%% current working directory to figure out what the actual path +%% is. That means that it can be quite slow. +-spec real_dir_path(file:name()) -> file:name(). +real_dir_path(Path) -> + {ok, CurCwd} = file:get_cwd(), + ok = file:set_cwd(Path), + {ok, RealPath} = file:get_cwd(), + ok = file:set_cwd(CurCwd), + filename:absname(RealPath). + +%% @doc make a unique temporary directory. Similar function to BSD stdlib %% function of the same name. --spec mkdtemp() -> TmpDirPath::path(). -mkdtemp() -> - UniqueNumber = integer_to_list(element(3, now())), +-spec insecure_mkdtemp() -> TmpDirPath::file:name() | {error, term()}. +insecure_mkdtemp() -> + UniqueNumber = erlang:integer_to_list(erlang:trunc(rand:uniform() * 1_000_000_000_000)), TmpDirPath = filename:join([tmp(), lists:flatten([".tmp_dir", UniqueNumber])]), - try - ok = mkdir_path(TmpDirPath), - TmpDirPath - catch - _C:E -> throw(?UEX({mkdtemp_failed, E}, ?CHECK_PERMS_MSG, [])) + + case mkdir_path(TmpDirPath) of + ok -> TmpDirPath; + Error -> Error end. +%% @doc Makes a directory including parent dirs if they are missing. +-spec mkdir_p(file:name()) -> ok | {error, Reason::term()}. +mkdir_p(Path) -> + %% We are exploiting a feature of ensuredir that that creates all + %% directories up to the last element in the filename, then ignores + %% that last element. This way we ensure that the dir is created + %% and not have any worries about path names + DirName = filename:join([filename:absname(Path), "tmp"]), + filelib:ensure_dir(DirName). + %% @doc Makes a directory including parent dirs if they are missing. --spec mkdir_path(path()) -> ok. +-spec mkdir_path(file:name()) -> ok | {error, Reason::term()}. mkdir_path(Path) -> - % We are exploiting a feature of ensuredir that that creates all - % directories up to the last element in the filename, then ignores - % that last element. This way we ensure that the dir is created - % and not have any worries about path names - DirName = filename:join([filename:absname(Path), "tmp"]), - try - ok = filelib:ensure_dir(DirName) - catch - _C:E -> throw(?UEX({mkdir_path_failed, E}, ?CHECK_PERMS_MSG, [])) - end. + mkdir_p(Path). -%% @doc consult an erlang term file from the file system. -%% Provide user readible exeption on failure. --spec consult(FilePath::path()) -> term(). -consult(FilePath) -> - case file:consult(FilePath) of - {ok, [Term]} -> - Term; - {error, Error} -> - Msg = "The file at ~p~n" ++ - "is either not a valid Erlang term, does not to exist~n" ++ - "or you lack the permissions to read it. Please check~n" ++ - "to see if the file exists and that it has the correct~n" ++ - "permissions~n", - throw(?UEX({failed_to_consult_file, {FilePath, Error}}, - Msg, [FilePath])) - end. - -%% @doc read a file from the file system. Provide UEX exeption on failure. --spec read(FilePath::string()) -> binary(). +%% @doc read a file from the file system. Provide UEX exception on failure. +-spec read(FilePath::file:filename()) -> {ok, binary()} | {error, Reason::term()}. read(FilePath) -> - try - {ok, FileBin} = file:read_file(FilePath), - FileBin - catch - _C:E -> throw(?UEX({read_failed, {FilePath, E}}, - "Read failed for the file ~p with ~p~n" ++ - ?CHECK_PERMS_MSG, - [FilePath, E])) - end. + %% Now that we are moving away from exceptions again this becomes + %% a bit redundant but we want to be backwards compatible as much + %% as possible in the api. + file:read_file(FilePath). -%% @doc write a file to the file system. Provide UEX exeption on failure. --spec write(FileName::string(), Contents::string()) -> ok. + +%% @doc write a file to the file system. Provide UEX exception on failure. +-spec write(FileName::file:filename(), Contents::string()) -> ok | {error, Reason::term()}. write(FileName, Contents) -> - case file:write_file(FileName, Contents) of - ok -> - ok; - {error, Reason} -> - Msg = "Writing the file ~s to disk failed with reason ~p.~n" ++ - ?CHECK_PERMS_MSG, - throw(?UEX({write_file_failure, {FileName, Reason}}, - Msg, - [FileName, Reason])) - end. + %% Now that we are moving away from exceptions again this becomes + %% a bit redundant but we want to be backwards compatible as much + %% as possible in the api. + file:write_file(FileName, Contents). %% @doc write a term out to a file so that it can be consulted later. --spec write_term(string(), term()) -> ok. +-spec write_term(file:filename(), term()) -> ok | {error, Reason::term()}. write_term(FileName, Term) -> write(FileName, lists:flatten(io_lib:fwrite("~p. ", [Term]))). %% @doc Finds files and directories that match the regexp supplied in %% the TargetPattern regexp. --spec find(FromDir::path(), TargetPattern::string()) -> [path()]. +-spec find(FromDir::file:name(), TargetPattern::string()) -> [file:name()]. find([], _) -> []; find(FromDir, TargetPattern) -> - case filelib:is_dir(FromDir) of + case is_dir(FromDir) of false -> case re:run(FromDir, TargetPattern) of {match, _} -> [FromDir]; @@ -207,7 +294,7 @@ find(FromDir, TargetPattern) -> %%%=================================================================== %%% Internal Functions %%%=================================================================== --spec find_in_subdirs(path(), string()) -> [path()]. +-spec find_in_subdirs(file:name(), string()) -> [file:name()]. find_in_subdirs(FromDir, TargetPattern) -> lists:foldl(fun(CheckFromDir, Acc) when CheckFromDir == FromDir -> @@ -219,57 +306,52 @@ find_in_subdirs(FromDir, TargetPattern) -> end end, [], - filelib:wildcard(filename:join(FromDir, "*"))). + sub_files(FromDir)). --spec ec_file_remove(path(), [{atom(), any()}]) -> ok. -ec_file_remove(Path, Options) -> - case lists:member(recursive, Options) of - false -> file:delete(Path); - true -> remove_recursive(Path, Options) - end. --spec remove_recursive(path(), Options::list()) -> ok. + +-spec remove_recursive(file:name(), Options::list()) -> ok | {error, Reason::term()}. remove_recursive(Path, Options) -> - case filelib:is_dir(Path) of + case is_dir(Path) of false -> file:delete(Path); true -> lists:foreach(fun(ChildPath) -> remove_recursive(ChildPath, Options) - end, filelib:wildcard(filename:join(Path, "*"))), - ok = file:del_dir(Path) + end, sub_files(Path)), + file:del_dir(Path) end. --spec tmp() -> path(). +-spec tmp() -> file:name(). tmp() -> case erlang:system_info(system_architecture) of "win32" -> - "./tmp"; + case os:getenv("TEMP") of + false -> "./tmp"; + Val -> Val + end; _SysArch -> - "/tmp" + case os:getenv("TMPDIR") of + false -> "/tmp"; + Val -> Val + end end. %% Copy the subfiles of the From directory to the to directory. --spec copy_subfiles(path(), path(), [option()]) -> ok. +-spec copy_subfiles(file:name(), file:name(), [option()]) -> {error, Reason::term()} | ok. copy_subfiles(From, To, Options) -> Fun = fun(ChildFrom) -> ChildTo = filename:join([To, filename:basename(ChildFrom)]), copy(ChildFrom, ChildTo, Options) end, - lists:foreach(Fun, filelib:wildcard(filename:join(From, "*"))). + lists:foreach(Fun, sub_files(From)). --spec ec_file_copy(path(), path()) -> ok. -ec_file_copy(From, To) -> - {ok, _} = file:copy(From, To), - {ok, FileInfo} = file:read_file_info(From), - ok = file:write_file_info(To, FileInfo). - --spec make_dir_if_dir(path()) -> ok. +-spec make_dir_if_dir(file:name()) -> ok | {error, Reason::term()}. make_dir_if_dir(File) -> - case filelib:is_dir(File) of + case is_dir(File) of true -> ok; - false -> ok = mkdir_path(File) + false -> mkdir_path(File) end. %% @doc convert a list of integers into hex. @@ -289,72 +371,7 @@ hex0(14) -> $e; hex0(15) -> $f; hex0(I) -> $0 + I. -%%%=================================================================== -%%% Test Functions -%%%=================================================================== --ifndef(NOTEST). --include_lib("eunit/include/eunit.hrl"). - -setup_test() -> - case filelib:is_dir("/tmp/ec_file") of - true -> - remove("/tmp/ec_file", [recursive]); - false -> - ok - end, - mkdir_path("/tmp/ec_file/dir"), - ?assertMatch(false, is_symlink("/tmp/ec_file/dir")), - ?assertMatch(true, filelib:is_dir("/tmp/ec_file/dir")). - - -md5sum_test() -> - ?assertMatch("cfcd208495d565ef66e7dff9f98764da", md5sum("0")). - -file_test() -> - TermFile = "/tmp/ec_file/dir/file.term", - TermFileCopy = "/tmp/ec_file/dircopy/file.term", - write_term(TermFile, "term"), - ?assertMatch("term", consult(TermFile)), - ?assertMatch(<<"\"term\". ">>, read(TermFile)), - copy(filename:dirname(TermFile), - filename:dirname(TermFileCopy), - [recursive]), - ?assertMatch("term", consult(TermFileCopy)). - -teardown_test() -> - remove("/tmp/ec_file", [recursive]), - ?assertMatch(false, filelib:is_dir("/tmp/ec_file")). - -setup_base_and_target() -> - {ok, BaseDir} = ewl_file:create_tmp_dir("/tmp"), - DummyContents = <<"This should be deleted">>, - SourceDir = filename:join([BaseDir, "source"]), - ok = file:make_dir(SourceDir), - Name1 = filename:join([SourceDir, "fileone"]), - Name2 = filename:join([SourceDir, "filetwo"]), - Name3 = filename:join([SourceDir, "filethree"]), - NoName = filename:join([SourceDir, "noname"]), - - ok = file:write_file(Name1, DummyContents), - ok = file:write_file(Name2, DummyContents), - ok = file:write_file(Name3, DummyContents), - ok = file:write_file(NoName, DummyContents), - {BaseDir, SourceDir, {Name1, Name2, Name3, NoName}}. - -find_test() -> - % Create a directory in /tmp for the test. Clean everything afterwards - - {setup, - fun setup_base_and_target/0, - fun ({BaseDir, _, _}) -> - ewl_file:delete_dir(BaseDir) - end, - fun ({BaseDir, _, {Name1, Name2, Name3, _}}) -> - ?assertMatch([Name2, - Name3, - Name1], - ewl_file:find(BaseDir, "file[a-z]+\$")) - end}. - --endif. +sub_files(From) -> + {ok, SubFiles} = file:list_dir(From), + [filename:join(From, SubFile) || SubFile <- SubFiles]. diff --git a/src/ec_gb_trees.erl b/src/ec_gb_trees.erl new file mode 100644 index 0000000..cde3f1b --- /dev/null +++ b/src/ec_gb_trees.erl @@ -0,0 +1,137 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2011 Erlware, LLC. +%%% @doc +%%% This provides an implementation of the type ec_dictionary using +%%% gb_trees as a backin +%%% see ec_dictionary +%%% see gb_trees +%%% @end +%%%------------------------------------------------------------------- +-module(ec_gb_trees). + +-behaviour(ec_dictionary). + +%% API +-export([new/0, + has_key/2, + get/2, + get/3, + add/3, + remove/2, + has_value/2, + size/1, + to_list/1, + from_list/1, + keys/1]). + +%%%=================================================================== +%%% API +%%%=================================================================== + +%% @doc create a new dictionary object from the specified module. The +%% module should implement the dictionary behaviour. In the clause +%% where an existing object is passed in new empty dictionary of the +%% same implementation is created and returned. +%% +%% @param ModuleName|Object The module name or existing dictionary object. +-spec new() -> gb_trees:tree(_K, _V). +new() -> + gb_trees:empty(). + +%% @doc check to see if the dictionary provided has the specified key. +%% +%% @param Object The dictory object to check +%% @param Key The key to check the dictionary for +-spec has_key(ec_dictionary:key(K), Object::gb_trees:tree(K, _V)) -> boolean(). +has_key(Key, Data) -> + case gb_trees:lookup(Key, Data) of + {value, _Val} -> + true; + none -> + false + end. + +%% @doc given a key return that key from the dictionary. If the key is +%% not found throw a 'not_found' exception. +%% +%% @param Object The dictionary object to return the value from +%% @param Key The key requested +%% when the key does not exist @throws not_found +-spec get(ec_dictionary:key(K), Object::gb_trees:tree(K, V)) -> + ec_dictionary:value(V). +get(Key, Data) -> + case gb_trees:lookup(Key, Data) of + {value, Value} -> + Value; + none -> + throw(not_found) + end. + +-spec get(ec_dictionary:key(K), + ec_dictionary:value(V), + Object::gb_trees:tree(K, V)) -> + ec_dictionary:value(V). +get(Key, Default, Data) -> + case gb_trees:lookup(Key, Data) of + {value, Value} -> + Value; + none -> + Default + end. + +%% @doc add a new value to the existing dictionary. Return a new +%% dictionary containing the value. +%% +%% @param Object the dictionary object to add too +%% @param Key the key to add +%% @param Value the value to add +-spec add(ec_dictionary:key(K), ec_dictionary:value(V), + Object::gb_trees:tree(K, V)) -> + gb_trees:tree(K, V). +add(Key, Value, Data) -> + gb_trees:enter(Key, Value, Data). + +%% @doc Remove a value from the dictionary returning a new dictionary +%% with the value removed. +%% +%% @param Object the dictionary object to remove the value from +%% @param Key the key of the key/value pair to remove +-spec remove(ec_dictionary:key(K), Object::gb_trees:tree(K, V)) -> + gb_trees:tree(K, V). +remove(Key, Data) -> + gb_trees:delete_any(Key, Data). + +%% @doc Check to see if the value exists in the dictionary +%% +%% @param Object the dictionary object to check +%% @param Value The value to check if exists +-spec has_value(ec_dictionary:value(V), Object::gb_trees:tree(_K, V)) -> boolean(). +has_value(Value, Data) -> + lists:member(Value, gb_trees:values(Data)). + +%% @doc return the current number of key value pairs in the dictionary +%% +%% @param Object the object return the size for. +-spec size(Object::gb_trees:tree(_K, _V)) -> non_neg_integer(). +size(Data) -> + gb_trees:size(Data). + +-spec to_list(gb_trees:tree(K, V)) -> [{ec_dictionary:key(K), + ec_dictionary:value(V)}]. +to_list(Data) -> + gb_trees:to_list(Data). + +-spec from_list([{ec_dictionary:key(K), ec_dictionary:value(V)}]) -> + gb_trees:tree(K, V). +from_list(List) when is_list(List) -> + lists:foldl(fun({Key, Value}, Dict) -> + gb_trees:enter(Key, Value, Dict) + end, + gb_trees:empty(), + List). + +-spec keys(gb_trees:tree(K,_V)) -> [ec_dictionary:key(K)]. +keys(Data) -> + gb_trees:keys(Data). diff --git a/src/ec_git_vsn.erl b/src/ec_git_vsn.erl new file mode 100644 index 0000000..e67d8e4 --- /dev/null +++ b/src/ec_git_vsn.erl @@ -0,0 +1,107 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2011 Erlware, LLC. +%%% @doc +%%% This provides an implementation of the ec_vsn for git. That is +%%% it is capable of returning a semver for a git repository +%%% see ec_vsn +%%% see ec_semver +%%% @end +%%%------------------------------------------------------------------- +-module(ec_git_vsn). + +-behaviour(ec_vsn). + +%% API +-export([new/0, + vsn/1]). + +-ifdef(TEST). +-export([parse_tags/1, + get_patch_count/1, + collect_default_refcount/1 + ]). +-endif. + +-export_type([t/0]). + +%%%=================================================================== +%%% Types +%%%=================================================================== +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type t() :: {}. + +%%%=================================================================== +%%% API +%%%=================================================================== + +-spec new() -> t(). +new() -> + {}. + +-spec vsn(t()|string()) -> {ok, string()} | {error, Reason::any()}. +vsn(Data) -> + {Vsn, RawRef, RawCount} = collect_default_refcount(Data), + {ok, build_vsn_string(Vsn, RawRef, RawCount)}. + +%%%=================================================================== +%%% Internal Functions +%%%=================================================================== + +collect_default_refcount(Data) -> + %% Get the tag timestamp and minimal ref from the system. The + %% timestamp is really important from an ordering perspective. + RawRef = os:cmd("git log -n 1 --pretty=format:'%h\n' "), + + {Tag, TagVsn} = parse_tags(Data), + RawCount = + case Tag of + undefined -> + os:cmd("git rev-list --count HEAD"); + _ -> + get_patch_count(Tag) + end, + {TagVsn, RawRef, RawCount}. + +build_vsn_string(Vsn, RawRef, RawCount) -> + %% Cleanup the tag and the Ref information. Basically leading 'v's and + %% whitespace needs to go away. + RefTag = [".ref", re:replace(RawRef, "\\s", "", [global])], + Count = erlang:iolist_to_binary(re:replace(RawCount, "\\s", "", [global])), + + %% Create the valid [semver](http://semver.org) version from the tag + case Count of + <<"0">> -> + erlang:binary_to_list(erlang:iolist_to_binary(Vsn)); + _ -> + erlang:binary_to_list(erlang:iolist_to_binary([Vsn, "+build.", + Count, RefTag])) + end. + +get_patch_count(RawRef) -> + Ref = re:replace(RawRef, "\\s", "", [global]), + Cmd = io_lib:format("git rev-list --count ~ts..HEAD", + [Ref]), + case os:cmd(Cmd) of + "fatal: " ++ _ -> + 0; + Count -> + Count + end. + +-spec parse_tags(t()|string()) -> {string()|undefined, ec_semver:version_string()}. +parse_tags({}) -> + parse_tags(""); +parse_tags(Pattern) -> + Cmd = io_lib:format("git describe --abbrev=0 --tags --match \"~ts*\"", [Pattern]), + Tag = os:cmd(Cmd), + case Tag of + "fatal: " ++ _ -> + {undefined, ""}; + _ -> + Vsn = string:slice(Tag, string:length(Pattern)), + Vsn1 = string:trim(string:trim(Vsn, leading, "v"), trailing, "\n"), + {Tag, Vsn1} + end. diff --git a/src/ec_lists.erl b/src/ec_lists.erl index 1545eeb..fed76d0 100644 --- a/src/ec_lists.erl +++ b/src/ec_lists.erl @@ -1,3 +1,4 @@ +%%% vi:ts=4 sw=4 et %%%------------------------------------------------------------------- %%% @copyright (C) 2011, Erlware LLC %%% @doc @@ -23,7 +24,7 @@ %% the third value is the element passed to the function. The purpose %% of this is to allow a list to be searched where some internal state %% is important while the input element is not. --spec search(fun(), list()) -> {ok, Result::term(), Element::term()}. +-spec search(fun(), list()) -> {ok, Result::term(), Element::term()} | not_found. search(Fun, [H|T]) -> case Fun(H) of {ok, Value} -> @@ -51,7 +52,7 @@ find(_Fun, []) -> error. %% @doc Fetch a value from the list. If the function returns true the -%% value is returend. If processing reaches the end of the list and +%% value is returned. If processing reaches the end of the list and %% the function has never returned true an exception not_found is %% thrown. -spec fetch(fun(), list()) -> term(). @@ -62,184 +63,3 @@ fetch(Fun, List) when is_list(List), is_function(Fun) -> error -> throw(not_found) end. - -%%%=================================================================== -%%% Test Functions -%%%=================================================================== - --ifndef(NOTEST). --include_lib("eunit/include/eunit.hrl"). - -find1_test() -> - TestData = [1, 2, 3, 4, 5, 6], - Result = find(fun(5) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch({ok, 5}, Result), - - Result2 = find(fun(37) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch(error, Result2). - -find2_test() -> - TestData = ["one", "two", "three", "four", "five", "six"], - Result = find(fun("five") -> - true; - (_) -> - false - end, - TestData), - ?assertMatch({ok, "five"}, Result), - - Result2 = find(fun(super_duper) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch(error, Result2). - - - -find3_test() -> - TestData = [{"one", 1}, {"two", 2}, {"three", 3}, {"four", 5}, {"five", 5}, - {"six", 6}], - Result = find(fun({"one", 1}) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch({ok, {"one", 1}}, Result), - - Result2 = find(fun([fo, bar, baz]) -> - true; - ({"onehundred", 100}) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch(error, Result2). - - - -fetch1_test() -> - TestData = [1, 2, 3, 4, 5, 6], - Result = fetch(fun(5) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch(5, Result), - - ?assertThrow(not_found, - fetch(fun(37) -> - true; - (_) -> - false - end, - TestData)). - -fetch2_test() -> - TestData = ["one", "two", "three", "four", "five", "six"], - Result = fetch(fun("five") -> - true; - (_) -> - false - end, - TestData), - ?assertMatch("five", Result), - - ?assertThrow(not_found, - fetch(fun(super_duper) -> - true; - (_) -> - false - end, - TestData)). - -fetch3_test() -> - TestData = [{"one", 1}, {"two", 2}, {"three", 3}, {"four", 5}, {"five", 5}, - {"six", 6}], - Result = fetch(fun({"one", 1}) -> - true; - (_) -> - false - end, - TestData), - ?assertMatch({"one", 1}, Result), - - ?assertThrow(not_found, - fetch(fun([fo, bar, baz]) -> - true; - ({"onehundred", 100}) -> - true; - (_) -> - false - end, - TestData)). - -search1_test() -> - TestData = [1, 2, 3, 4, 5, 6], - Result = search(fun(5) -> - {ok, 5}; - (_) -> - not_found - end, - TestData), - ?assertMatch({ok, 5, 5}, Result), - - Result2 = search(fun(37) -> - {ok, 37}; - (_) -> - not_found - end, - TestData), - ?assertMatch(not_found, Result2). - -search2_test() -> - TestData = [1, 2, 3, 4, 5, 6], - Result = search(fun(1) -> - {ok, 10}; - (_) -> - not_found - end, - TestData), - ?assertMatch({ok, 10, 1}, Result), - - Result2 = search(fun(6) -> - {ok, 37}; - (_) -> - not_found - end, - TestData), - ?assertMatch({ok, 37, 6}, Result2). - -search3_test() -> - TestData = [1, 2, 3, 4, 5, 6], - Result = search(fun(10) -> - {ok, 10}; - (_) -> - not_found - end, - TestData), - ?assertMatch(not_found, Result), - - Result2 = search(fun(-1) -> - {ok, 37}; - (_) -> - not_found - end, - TestData), - ?assertMatch(not_found, Result2). - --endif. diff --git a/src/ec_orddict.erl b/src/ec_orddict.erl new file mode 100644 index 0000000..90418f5 --- /dev/null +++ b/src/ec_orddict.erl @@ -0,0 +1,110 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2011 Erlware, LLC. +%%% @doc +%%% This provides an implementation of the ec_dictionary type using +%%% erlang orddicts as a base. The function documentation for +%%% ec_dictionary applies here as well. +%%% see ec_dictionary +%%% see orddict +%%% @end +%%%------------------------------------------------------------------- +-module(ec_orddict). + +-behaviour(ec_dictionary). + +%% API +-export([new/0, + has_key/2, + get/2, + get/3, + add/3, + remove/2, + has_value/2, + size/1, + to_list/1, + from_list/1, + keys/1]). + +-export_type([dictionary/2]). + +%%%=================================================================== +%%% Types +%%%=================================================================== +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type dictionary(K, V) :: [{K, V}]. + +%%%=================================================================== +%%% API +%%%=================================================================== + +-spec new() -> dictionary(_K, _V). +new() -> + orddict:new(). + +-spec has_key(ec_dictionary:key(K), Object::dictionary(K, _V)) -> boolean(). +has_key(Key, Data) -> + orddict:is_key(Key, Data). + +-spec get(ec_dictionary:key(K), Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, Data) -> + case orddict:find(Key, Data) of + {ok, Value} -> + Value; + error -> + throw(not_found) + end. + +-spec get(ec_dictionary:key(K), + Default::ec_dictionary:value(V), + Object::dictionary(K, V)) -> + ec_dictionary:value(V). +get(Key, Default, Data) -> + case orddict:find(Key, Data) of + {ok, Value} -> + Value; + error -> + Default + end. + +-spec add(ec_dictionary:key(K), ec_dictionary:value(V), + Object::dictionary(K, V)) -> + dictionary(K, V). +add(Key, Value, Data) -> + orddict:store(Key, Value, Data). + +-spec remove(ec_dictionary:key(K), Object::dictionary(K, V)) -> + dictionary(K, V). +remove(Key, Data) -> + orddict:erase(Key, Data). + +-spec has_value(ec_dictionary:value(V), Object::dictionary(_K, V)) -> boolean(). +has_value(Value, Data) -> + orddict:fold(fun(_, NValue, _) when NValue == Value -> + true; + (_, _, Acc) -> + Acc + end, + false, + Data). + +-spec size(Object::dictionary(_K, _V)) -> non_neg_integer(). +size(Data) -> + orddict:size(Data). + +-spec to_list(dictionary(K, V)) -> + [{ec_dictionary:key(K), ec_dictionary:value(V)}]. +to_list(Data) -> + orddict:to_list(Data). + +-spec from_list([{ec_dictionary:key(K), ec_dictionary:value(V)}]) -> + dictionary(K, V). +from_list(List) when is_list(List) -> + orddict:from_list(List). + +-spec keys(dictionary(K, _V)) -> [ec_dictionary:key(K)]. +keys(Dict) -> + orddict:fetch_keys(Dict). diff --git a/src/ec_plists.erl b/src/ec_plists.erl index b7b9260..221075b 100644 --- a/src/ec_plists.erl +++ b/src/ec_plists.erl @@ -1,257 +1,945 @@ -%%%------------------------------------------------------------------- +%%% -*- mode: Erlang; fill-column: 80; comment-column: 75; -*- +%%% vi:ts=4 sw=4 et +%%% The MIT License +%%% +%%% Copyright (c) 2007 Stephen Marsh +%%% +%%% Permission is hereby granted, free of charge, to any person obtaining a copy +%%% of this software and associated documentation files (the "Software"), to deal +%%% in the Software without restriction, including without limitation the rights +%%% to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +%%% copies of the Software, and to permit persons to whom the Software is +%%% furnished to do so, subject to the following conditions: +%%% +%%% The above copyright notice and this permission notice shall be included in +%%% all copies or substantial portions of the Software. +%%% +%%% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +%%% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +%%% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +%%% AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +%%% LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +%%% OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +%%% THE SOFTWARE. +%%%--------------------------------------------------------------------------- +%%% @author Stephen Marsh +%%% @copyright 2007 Stephen Marsh freeyourmind ++ [$@|gmail.com] %%% @doc -%%% simple parrallel map. Originally provided by Joe Armstrong -%%% on the erlang questions mailing list. -%%% @end -%%%------------------------------------------------------------------- +%%% plists is a drop-in replacement for module lists, making +%%% most list operations parallel. It can operate on each element in +%%% parallel, for IO-bound operations, on sublists in parallel, for +%%% taking advantage of multi-core machines with CPU-bound operations, +%%% and across erlang nodes, for parallelizing inside a cluster. It +%%% handles errors and node failures. It can be configured, tuned, and +%%% tweaked to get optimal performance while minimizing overhead. +%%% +%%% Almost all the functions are identical to equivalent functions in +%%% lists, returning exactly the same result, and having both a form +%%% with an identical syntax that operates on each element in parallel +%%% and a form which takes an optional "malt", a specification for how +%%% to parallelize the operation. +%%% +%%% fold is the one exception, parallel fold is different from linear +%%% fold. This module also include a simple mapreduce implementation, +%%% and the function runmany. All the other functions are implemented +%%% with runmany, which is as a generalization of parallel list +%%% operations. +%%% +%%% Malts +%%% ===== +%%% +%%% A malt specifies how to break a list into sublists, and can optionally +%%% specify a timeout, which nodes to run on, and how many processes to start +%%% per node. +%%% +%%% Malt = MaltComponent | [MaltComponent] +%%% MaltComponent = SubListSize::integer() | {processes, integer()} | +%%% {processes, schedulers} | +%%% {timeout, Milliseconds::integer()} | {nodes, [NodeSpec]}
+%%% +%%% NodeSpec = Node::atom() | {Node::atom(), NumProcesses::integer()} | +%%% {Node::atom(), schedulers} +%%% +%%% An integer can be given to specify the exact size for sublists. 1 +%%% is a good choice for IO-bound operations and when the operation on +%%% each list element is expensive. Larger numbers minimize overhead +%%% and are faster for cheap operations. +%%% +%%% If the integer is omitted, and you have specified a `{processes, +%%% X}`, the list is split into X sublists. This is only useful when +%%% the time to process each element is close to identical and you +%%% know exactly how many lines of execution are available to you. +%%% +%%% If neither of the above applies, the sublist size defaults to 1. +%%% +%%% You can use `{processes, X}` to have the list processed by `X` +%%% processes on the local machine. A good choice for `X` is the +%%% number of lines of execution (cores) the machine provides. This +%%% can be done automatically with {processes, schedulers}, which sets +%%% the number of processes to the number of schedulers in the erlang +%%% virtual machine (probably equal to the number of cores). +%%% +%%% `{timeout, Milliseconds}` specifies a timeout. This is a timeout +%%% for the entire operation, both operating on the sublists and +%%% combining the results. exit(timeout) is evaluated if the timeout +%%% is exceeded. +%%% +%%% `{nodes, NodeList}` specifies that the operation should be done +%%% across nodes. Every element of NodeList is of the form +%%% `{NodeName, NumProcesses}` or NodeName, which means the same as +%%% `{NodeName, 1}`. plists runs NumProcesses processes on NodeName +%%% concurrently. A good choice for NumProcesses is the number of +%%% lines of execution (cores) a node provides plus one. This ensures +%%% the node is completely busy even when fetching a new sublist. This +%%% can be done automatically with `{NodeName, schedulers}`, in which +%%% case plists uses a cached value if it has one, and otherwise finds +%%% the number of schedulers in the remote node and adds one. This +%%% will ensure at least one busy process per core (assuming the node +%%% has a scheduler for each core). +%%% +%%% plists is able to recover if a node goes down. If all nodes go +%%% down, exit(allnodescrashed) is evaluated. +%%% +%%% Any of the above may be used as a malt, or may be combined into a +%%% list. `{nodes, NodeList}` and {processes, X} may not be combined. +%%% +%%% Examples +%%% ======== +%%% +%%% %%start a process for each element (1-element sublists)< +%%% 1 +%%% +%%% %% start a process for each ten elements (10-element sublists) +%%% 10 +%%% +%%% %% split the list into two sublists and process in two processes +%%% {processes, 2} +%%% +%%% %% split the list into X sublists and process in X processes, +%%% %% where X is the number of cores in the machine +%%% {processes, schedulers} +%%% +%%% %% split the list into 10-element sublists and process in two processes +%%% [10, {processes, 2}] +%%% +%%% %% timeout after one second. Assumes that a process should be started +%%% %% for each element.
+%%% {timeout, 1000} +%%% +%%% %% Runs 3 processes at a time on apple@desktop, and 2 on orange@laptop +%%% %% This is the best way to utilize all the CPU-power of a dual-core
+%%% %% desktop and a single-core laptop. Assumes that the list should be
+%%% %% split into 1-element sublists.
+%%% {nodes, [{apple@desktop, 3}, {orange@laptop, 2}]} +%%% +%%% %% Like above, but makes plists figure out how many processes to use. +%%% {nodes, [{apple@desktop, schedulers}, {orange@laptop, schedulers}]} +%%% +%%% %% Gives apple and orange three seconds to process the list as
+%%% %% 100-element sublists.
+%%% [100, {timeout, 3000}, {nodes, [{apple@desktop, 3}, {orange@laptop, 2}]}] +%%% +%%% Aside: Why Malt? +%%% ================ +%%% +%%% I needed a word for this concept, so maybe my subconsciousness +%%% gave me one by making me misspell multiply. Maybe it is an acronym +%%% for Malt is A List Tearing Specification. Maybe it is a beer +%%% metaphor, suggesting that code only runs in parallel if bribed +%%% with spirits. It's jargon, learn it or you can't be part of the +%%% in-group. +%%% +%%% Messages and Errors +%%% =================== +%%% +%%% plists assures that no extraneous messages are left in or will +%%% later enter the message queue. This is guaranteed even in the +%%% event of an error. +%%% +%%% Errors in spawned processes are caught and propagated to the +%%% calling process. If you invoke +%%% +%%% plists:map(fun (X) -> 1/X end, [1, 2, 3, 0]). +%%% +%%% you get a badarith error, exactly like when you use lists:map. +%%% +%%% plists uses monitors to watch the processes it spawns. It is not a +%%% good idea to invoke plists when you are already monitoring +%%% processes. If one of them does a non-normal exit, plists receives +%%% the 'DOWN' message believing it to be from one of its own +%%% processes. The error propagation system goes into effect, which +%%% results in the error occurring in the calling process. +%%% -module(ec_plists). --export([map/2, - map/3, - ftmap/2, - ftmap/3, - filter/2, - filter/3]). +-export([all/2, all/3, + any/2, any/3, + filter/2, filter/3, + fold/3, fold/4, fold/5, + foreach/2, foreach/3, + map/2, map/3, + ftmap/2, ftmap/3, + partition/2, partition/3, + sort/1, sort/2, sort/3, + usort/1, usort/2, usort/3, + mapreduce/2, mapreduce/3, mapreduce/5, + runmany/3, runmany/4]). -%%============================================================================= -%% Public API -%%============================================================================= +-export_type([malt/0, malt_component/0, node_spec/0, fuse/0, fuse_fun/0]). -%% @doc Takes a function and produces a list of the result of the function -%% applied to each element of the argument list. A timeout is optional. -%% In the event of a timeout or an exception the entire map will fail -%% with an excption with class throw. --spec map(fun(), [any()]) -> [any()]. -map(Fun, List) -> - map(Fun, List, infinity). +%%============================================================================ +%% types +%%============================================================================ --spec map(fun(), [any()], non_neg_integer()) -> [any()]. -map(Fun, List, Timeout) -> - run_list_fun_in_parallel(map, Fun, List, Timeout). +-type malt() :: malt_component() | [malt_component()]. -%% @doc Takes a function and produces a list of the result of the function -%% applied to each element of the argument list. A timeout is optional. -%% This function differes from regular map in that it is fault tolerant. -%% If a timeout or an exception occurs while processing an element in -%% the input list the ftmap operation will continue to function. Timeouts -%% and exceptions will be reflected in the output of this function. -%% All application level results are wrapped in a tuple with the tag -%% 'value'. Exceptions will come through as they are and timeouts will -%% return as the atom timeout. -%% This is useful when the ftmap is being used for side effects. -%%
-%% 2> ftmap(fun(N) -> factorial(N) end, [1, 2, 1000000, "not num"], 100)
-%% [{value, 1}, {value, 2}, timeout, {badmatch, ...}]
-%% 
--spec ftmap(fun(), [any()]) -> [{value, any()} | any()]. -ftmap(Fun, List) -> - ftmap(Fun, List, infinity). +-type malt_component() :: SubListSize::integer() + | {processes, integer()} + | {processes, schedulers} + | {timeout, Milliseconds::integer()} + | {nodes, [node_spec()]}. --spec ftmap(fun(), [any()], non_neg_integer()) -> [{value, any()} | any()]. -ftmap(Fun, List, Timeout) -> - run_list_fun_in_parallel(ftmap, Fun, List, Timeout). +-type node_spec() :: Node::atom() + | {Node::atom(), NumProcesses::integer()} + | {Node::atom(), schedulers}. -%% @doc Returns a list of the elements in the supplied list which -%% the function Fun returns true. A timeout is optional. In the -%% event of a timeout the filter operation fails. --spec filter(fun(), [any()]) -> [any()]. -filter(Fun, List) -> - filter(Fun, List, infinity). +-type fuse_fun() :: fun((term(), term()) -> term()). +-type fuse() :: fuse_fun() | {recursive, fuse_fun()} | {reverse, fuse_fun()}. +-type el_fun() :: fun((term()) -> term()). --spec filter(fun(), [any()], integer()) -> [any()]. -filter(Fun, List, Timeout) -> - run_list_fun_in_parallel(filter, Fun, List, Timeout). +%%============================================================================ +%% API +%%============================================================================ -%%============================================================================= -%% Internal API -%%============================================================================= --spec run_list_fun_in_parallel(atom(), fun(), [any()], integer()) -> [any()]. -run_list_fun_in_parallel(ListFun, Fun, List, Timeout) -> - LocalPid = self(), - Pids = - lists:map(fun(E) -> - Pid = - proc_lib:spawn(fun() -> - wait(LocalPid, Fun, - E, Timeout) - end), - {Pid, E} - end, List), - gather(ListFun, Pids). +%% Everything here is defined in terms of runmany. +%% The following methods are convient interfaces to runmany. --spec wait(pid(), fun(), any(), integer()) -> any(). -wait(Parent, Fun, E, Timeout) -> - WaitPid = self(), - Child = spawn(fun() -> - do_f(WaitPid, Fun, E) - end), +%% @doc Same semantics as in module +%% lists. +-spec all(el_fun(), list()) -> boolean(). +all(Fun, List) -> + all(Fun, List, 1). - wait(Parent, Child, Timeout). - --spec wait(pid(), pid(), integer()) -> any(). -wait(Parent, Child, Timeout) -> - receive - {Child, Ret} -> - Parent ! {self(), Ret} - after Timeout -> - exit(Child, timeout), - Parent ! {self(), timeout} - end. - --spec gather(atom(), [any()]) -> [any()]. -gather(map, PidElementList) -> - map_gather(PidElementList); -gather(ftmap, PidElementList) -> - ftmap_gather(PidElementList); -gather(filter, PidElementList) -> - filter_gather(PidElementList). - --spec map_gather([pid()]) -> [any()]. -map_gather([{Pid, _E} | Rest]) -> - receive - {Pid, {value, Ret}} -> - [Ret|map_gather(Rest)]; - % timeouts fall here too. Should timeouts be a return value - % or an exception? I lean toward return value, but the code - % is easier with the exception. Thoughts? - {Pid, Exception} -> - killall(Rest), - throw(Exception) - end; -map_gather([]) -> - []. - --spec ftmap_gather([pid()]) -> [any()]. -ftmap_gather([{Pid, _E} | Rest]) -> - receive - {Pid, Value} -> [Value|ftmap_gather(Rest)] - end; -ftmap_gather([]) -> - []. - --spec filter_gather([pid()]) -> [any()]. -filter_gather([{Pid, E} | Rest]) -> - receive - {Pid, {value, false}} -> - filter_gather(Rest); - {Pid, {value, true}} -> - [E|filter_gather(Rest)]; - {Pid, {value, NotBool}} -> - killall(Rest), - throw({bad_return_value, NotBool}); - {Pid, Exception} -> - killall(Rest), - throw(Exception) - end; -filter_gather([]) -> - []. - --spec do_f(pid(), fun(), any()) -> no_return(). -do_f(Parent, F, E) -> +%% @doc Same semantics as in module +%% lists. +-spec all(el_fun(), list(), malt()) -> boolean(). +all(Fun, List, Malt) -> try - Result = F(E), - Parent ! {self(), {value, Result}} + runmany(fun (L) -> + B = lists:all(Fun, L), + if + B -> + nil; + true -> + erlang:throw(notall) + end + end, + fun (_A1, _A2) -> + nil + end, + List, Malt), + true catch - _Class:Exception -> - % Losing class info here, but since throw does not accept - % that arg anyhow and forces a class of throw it does not - % matter. - Parent ! {self(), Exception} + throw:notall -> + false end. --spec killall([pid()]) -> ok. -killall([{Pid, _E}|T]) -> - exit(Pid, kill), - killall(T); -killall([]) -> - ok. +%% @doc Same semantics as in module +%% lists. +-spec any(fun(), list()) -> boolean(). +any(Fun, List) -> + any(Fun, List, 1). -%%============================================================================= -%% Tests -%%============================================================================= - --ifndef(NOTEST). --include_lib("eunit/include/eunit.hrl"). - -map_good_test() -> - Results = map(fun(_) -> - ok - end, - lists:seq(1, 5), infinity), - ?assertMatch([ok, ok, ok, ok, ok], - Results). - -ftmap_good_test() -> - Results = ftmap(fun(_) -> - ok - end, - lists:seq(1, 3), infinity), - ?assertMatch([{value, ok}, {value, ok}, {value, ok}], - Results). - -filter_good_test() -> - Results = filter(fun(X) -> - X == show - end, - [show, show, remove], infinity), - ?assertMatch([show, show], - Results). - -map_timeout_test() -> - Results = - try - map(fun(T) -> - timer:sleep(T), - T +%% @doc Same semantics as in module +%% lists. +-spec any(fun(), list(), malt()) -> boolean(). +any(Fun, List, Malt) -> + try + runmany(fun (L) -> + B = lists:any(Fun, L), + if B -> + erlang:throw(any); + true -> + nil + end end, - [1, 100], 10) - catch - C:E -> {C, E} - end, - ?assertMatch({throw, timeout}, Results). + fun (_A1, _A2) -> + nil + end, + List, Malt) of + _ -> + false + catch throw:any -> + true + end. -ftmap_timeout_test() -> - Results = ftmap(fun(X) -> - timer:sleep(X), - true - end, - [100, 1], 10), - ?assertMatch([timeout, {value, true}], Results). +%% @doc Same semantics as in module +%% lists. +-spec filter(fun(), list()) -> list(). +filter(Fun, List) -> + filter(Fun, List, 1). -filter_timeout_test() -> - Results = - try - filter(fun(T) -> - timer:sleep(T), - T == 1 +%% @doc Same semantics as in module +%% lists. +-spec filter(fun(), list(), malt()) -> list(). +filter(Fun, List, Malt) -> + runmany(fun (L) -> + lists:filter(Fun, L) + end, + {reverse, fun (A1, A2) -> + A1 ++ A2 + end}, + List, Malt). + +%% Note that with parallel fold there is not foldl and foldr, +%% instead just one fold that can fuse Accumlators. + +%% @doc Like below, but assumes 1 as the Malt. This function is almost useless, +%% and is intended only to aid converting code from using lists to plists. +-spec fold(fun(), InitAcc::term(), list()) -> term(). +fold(Fun, InitAcc, List) -> + fold(Fun, Fun, InitAcc, List, 1). + +%% @doc Like below, but uses the Fun as the Fuse by default. +-spec fold(fun(), InitAcc::term(), list(), malt()) -> term(). +fold(Fun, InitAcc, List, Malt) -> + fold(Fun, Fun, InitAcc, List, Malt). + +%% @doc fold is more complex when made parallel. There is no foldl and +%% foldr, accumulators aren't passed in any defined order. The list +%% is split into sublists which are folded together. Fun is identical +%% to the function passed to lists:fold[lr], it takes (an element, and +%% the accumulator) and returns -> a new accumulator. It is used for +%% the initial stage of folding sublists. Fuse fuses together the +%% results, it takes (Results1, Result2) and returns -> a new result. +%% By default sublists are fused left to right, each result of a fuse +%% being fed into the first element of the next fuse. The result of +%% the last fuse is the result. +%% +%% Fusing may also run in parallel using a recursive algorithm, +%% by specifying the fuse as {recursive, Fuse}. See +%% the discussion in {@link runmany/4}. +%% +%% Malt is the malt for the initial folding of sublists, and for the +%% possible recursive fuse. +-spec fold(fun(), fuse(), InitAcc::term(), list(), malt()) -> term(). +fold(Fun, Fuse, InitAcc, List, Malt) -> + Fun2 = fun (L) -> + lists:foldl(Fun, InitAcc, L) + end, + runmany(Fun2, Fuse, List, Malt). + +%% @doc Similar to foreach in module +%% lists +%% except it makes no guarantee about the order it processes list elements. +-spec foreach(fun(), list()) -> ok. +foreach(Fun, List) -> + foreach(Fun, List, 1). + +%% @doc Similar to foreach in module +%% lists +%% except it makes no guarantee about the order it processes list elements. +-spec foreach(fun(), list(), malt()) -> ok. +foreach(Fun, List, Malt) -> + runmany(fun (L) -> + lists:foreach(Fun, L) + end, + fun (_A1, _A2) -> + ok + end, + List, Malt). + +%% @doc Same semantics as in module +%% lists. +-spec map(fun(), list()) -> list(). +map(Fun, List) -> + map(Fun, List, 1). + +%% @doc Same semantics as in module +%% lists. +-spec map(fun(), list(), malt()) -> list(). +map(Fun, List, Malt) -> + runmany(fun (L) -> + lists:map(Fun, L) + end, + {reverse, fun (A1, A2) -> + A1 ++ A2 + end}, + List, Malt). + +%% @doc values are returned as {value, term()}. +-spec ftmap(fun(), list()) -> list(). +ftmap(Fun, List) -> + map(fun(L) -> + try + {value, Fun(L)} + catch + Class:Type -> + {error, {Class, Type}} + end + end, List). + +%% @doc values are returned as {value, term()}. +-spec ftmap(fun(), list(), malt()) -> list(). +ftmap(Fun, List, Malt) -> + map(fun(L) -> + try + {value, Fun(L)} + catch + Class:Type -> + {error, {Class, Type}} + end + end, List, Malt). + +%% @doc Same semantics as in module +%% lists. +-spec partition(fun(), list()) -> {list(), list()}. +partition(Fun, List) -> + partition(Fun, List, 1). + +%% @doc Same semantics as in module +%% lists. +-spec partition(fun(), list(), malt()) -> {list(), list()}. +partition(Fun, List, Malt) -> + runmany(fun (L) -> + lists:partition(Fun, L) + end, + {reverse, fun ({True1, False1}, {True2, False2}) -> + {True1 ++ True2, False1 ++ False2} + end}, + List, Malt). + +%% SORTMALT needs to be tuned +-define(SORTMALT, 100). + +%% @doc Same semantics as in module +%% lists. +-spec sort(list()) -> list(). +sort(List) -> + sort(fun (A, B) -> + A =< B + end, + List). + +%% @doc Same semantics as in module +%% lists. +-spec sort(fun(), list()) -> list(). +sort(Fun, List) -> + sort(Fun, List, ?SORTMALT). + +%% @doc This version lets you specify your own malt for sort. +%% +%% sort splits the list into sublists and sorts them, and it merges the +%% sorted lists together. These are done in parallel. Each sublist is +%% sorted in a separate process, and each merging of results is done in a +%% separate process. Malt defaults to 100, causing the list to be split into +%% 100-element sublists. +-spec sort(fun(), list(), malt()) -> list(). +sort(Fun, List, Malt) -> + Fun2 = fun (L) -> + lists:sort(Fun, L) + end, + Fuse = fun (A1, A2) -> + lists:merge(Fun, A1, A2) + end, + runmany(Fun2, {recursive, Fuse}, List, Malt). + +%% @doc Same semantics as in module +%% lists. +-spec usort(list()) -> list(). +usort(List) -> + usort(fun (A, B) -> + A =< B + end, + List). + +%% @doc Same semantics as in module +%% lists. +-spec usort(fun(), list()) -> list(). +usort(Fun, List) -> + usort(Fun, List, ?SORTMALT). + +%% @doc This version lets you specify your own malt for usort. +%% +%% usort splits the list into sublists and sorts them, and it merges the +%% sorted lists together. These are done in parallel. Each sublist is +%% sorted in a separate process, and each merging of results is done in a +%% separate process. Malt defaults to 100, causing the list to be split into +%% 100-element sublists. +%% +%% usort removes duplicate elements while it sorts. +-spec usort(fun(), list(), malt()) -> list(). +usort(Fun, List, Malt) -> + Fun2 = fun (L) -> + lists:usort(Fun, L) + end, + Fuse = fun (A1, A2) -> + lists:umerge(Fun, A1, A2) + end, + runmany(Fun2, {recursive, Fuse}, List, Malt). + +%% @doc Like below, assumes default MapMalt of 1. +-spec mapreduce(MapFunc, list()) -> dict:dict() when + MapFunc :: fun((term()) -> DeepListOfKeyValuePairs), + DeepListOfKeyValuePairs :: [DeepListOfKeyValuePairs] | {Key::term(), Value::term()}. + +mapreduce(MapFunc, List) -> + mapreduce(MapFunc, List, 1). + +%% Like below, but uses a default reducer that collects all +%% {Key, Value} pairs into a +%% dict, +%% with values {Key, [Value1, Value2...]}. +%% This dict is returned as the result. +mapreduce(MapFunc, List, MapMalt) -> + mapreduce(MapFunc, List, dict:new(), fun add_key/3, MapMalt). + +%% @doc This is a very basic mapreduce. You won't write a +%% Google-rivaling search engine with it. It has no equivalent in +%% lists. Each element in the list is run through the MapFunc, which +%% produces either a {Key, Value} pair, or a lists of key value pairs, +%% or a list of lists of key value pairs...etc. A reducer process runs +%% in parallel with the mapping processes, collecting the key value +%% pairs. It starts with a state given by InitState, and for each +%% {Key, Value} pair that it receives it invokes ReduceFunc(OldState, +%% Key, Value) to compute its new state. mapreduce returns the +%% reducer's final state. +%% +%% MapMalt is the malt for the mapping operation, with a default value of 1, +%% meaning each element of the list is mapped by a separate process. +%% +%% mapreduce requires OTP R11B, or it may leave monitoring messages in the +%% message queue. +-spec mapreduce(MapFunc, list(), InitState::term(), ReduceFunc, malt()) -> dict:dict() when + MapFunc :: fun((term()) -> DeepListOfKeyValuePairs), + DeepListOfKeyValuePairs :: [DeepListOfKeyValuePairs] | {Key::term(), Value::term()}, + ReduceFunc :: fun((OldState::term(), Key::term(), Value::term()) -> NewState::term()). +mapreduce(MapFunc, List, InitState, ReduceFunc, MapMalt) -> + Parent = self(), + {Reducer, ReducerRef} = + erlang:spawn_monitor(fun () -> + reducer(Parent, 0, InitState, ReduceFunc) + end), + MapFunc2 = fun (L) -> + Reducer ! lists:map(MapFunc, L), + 1 + end, + SentMessages = try + runmany(MapFunc2, fun (A, B) -> A+B end, List, MapMalt) + catch + exit:Reason -> + erlang:demonitor(ReducerRef, [flush]), + Reducer ! die, + exit(Reason) end, - [1, 100], 10) - catch - C:E -> {C, E} - end, - ?assertMatch({throw, timeout}, Results). - -map_bad_test() -> - Results = - try - map(fun(_) -> - throw(test_exception) - end, - lists:seq(1, 5), infinity) - catch - C:E -> {C, E} - end, - ?assertMatch({throw, test_exception}, Results). - -ftmap_bad_test() -> - Results = - ftmap(fun(2) -> - throw(test_exception); - (N) -> - N + Reducer ! {mappers, done, SentMessages}, + Results = receive + {Reducer, Results2} -> + Results2; + {'DOWN', _, _, Reducer, Reason2} -> + exit(Reason2) end, - lists:seq(1, 5), infinity), - ?assertMatch([{value, 1}, test_exception, {value, 3}, - {value, 4}, {value, 5}] , Results). + receive + {'DOWN', _, _, Reducer, normal} -> + nil + end, + Results. --endif. +reducer(Parent, NumReceived, State, Func) -> + receive + die -> + nil; + {mappers, done, NumReceived} -> + Parent ! {self (), State}; + Keys -> + reducer(Parent, NumReceived + 1, each_key(State, Func, Keys), Func) + end. + +each_key(State, Func, {Key, Value}) -> + Func(State, Key, Value); +each_key(State, Func, [List|Keys]) -> + each_key(each_key(State, Func, List), Func, Keys); +each_key(State, _, []) -> + State. + +add_key(Dict, Key, Value) -> + case dict:is_key(Key, Dict) of + true -> + dict:append(Key, Value, Dict); + false -> + dict:store(Key, [Value], Dict) + end. + +%% @doc Like below, but assumes a Malt of 1, +%% meaning each element of the list is processed by a separate process. +-spec runmany(fun(), fuse(), list()) -> term(). +runmany(Fun, Fuse, List) -> + runmany(Fun, Fuse, List, 1). + +%% Begin internal stuff (though runmany/4 is exported). + +%% @doc All of the other functions are implemented with runmany. runmany +%% takes a List, splits it into sublists, and starts processes to operate on +%% each sublist, all done according to Malt. Each process passes its sublist +%% into Fun and sends the result back. +%% +%% The results are then fused together to get the final result. There are two +%% ways this can operate, lineraly and recursively. If Fuse is a function, +%% a fuse is done linearly left-to-right on the sublists, the results +%% of processing the first and second sublists being passed to Fuse, then +%% the result of the first fuse and processing the third sublits, and so on. If +%% Fuse is {reverse, FuseFunc}, then a fuse is done right-to-left, the results +%% of processing the second-to-last and last sublists being passed to FuseFunc, +%% then the results of processing the third-to-last sublist and +%% the results of the first fuse, and and so forth. +%% Both methods preserve the original order of the lists elements. +%% +%% To do a recursive fuse, pass Fuse as {recursive, FuseFunc}. +%% The recursive fuse makes no guarantee about the order the results of +%% sublists, or the results of fuses are passed to FuseFunc. It +%% continues fusing pairs of results until it is down to one. +%% +%% Recursive fuse is down in parallel with processing the sublists, and a +%% process is spawned to fuse each pair of results. It is a parallelized +%% algorithm. Linear fuse is done after all results of processing sublists +%% have been collected, and can only run in a single process. +%% +%% Even if you pass {recursive, FuseFunc}, a recursive fuse is only done if +%% the malt contains {nodes, NodeList} or {processes, X}. If this is not the +%% case, a linear fuse is done. +-spec runmany(fun(([term()]) -> term()), fuse(), list(), malt()) -> term(). +runmany(Fun, Fuse, List, Malt) + when erlang:is_list(Malt) -> + runmany(Fun, Fuse, List, local, no_split, Malt); +runmany(Fun, Fuse, List, Malt) -> + runmany(Fun, Fuse, List, [Malt]). + +runmany(Fun, Fuse, List, Nodes, no_split, [MaltTerm|Malt]) + when erlang:is_integer(MaltTerm) -> + runmany(Fun, Fuse, List, Nodes, MaltTerm, Malt); +runmany(Fun, Fuse, List, local, Split, [{processes, schedulers}|Malt]) -> + %% run a process for each scheduler + S = erlang:system_info(schedulers), + runmany(Fun, Fuse, List, local, Split, [{processes, S}|Malt]); +runmany(Fun, Fuse, List, local, no_split, [{processes, X}|_]=Malt) -> + %% Split the list into X sublists, where X is the number of processes + L = erlang:length(List), + case (L rem X) of + 0 -> + runmany(Fun, Fuse, List, local, (L / X), Malt); + _ -> + runmany(Fun, Fuse, List, local, (L / X) + 1, Malt) + end; +runmany(Fun, Fuse, List, local, Split, [{processes, X}|Malt]) -> + %% run X process on local machine + Nodes = lists:duplicate(X, node()), + runmany(Fun, Fuse, List, Nodes, Split, Malt); +runmany(Fun, Fuse, List, Nodes, Split, [{timeout, X}|Malt]) -> + Parent = erlang:self(), + Timer = proc_lib:spawn(fun () -> + receive + stoptimer -> + Parent ! {timerstopped, erlang:self()} + after X -> + Parent ! {timerrang, erlang:self()}, + receive + stoptimer -> + Parent ! {timerstopped, erlang:self()} + end + end + end), + Ans = try + runmany(Fun, Fuse, List, Nodes, Split, Malt) + catch + %% we really just want the after block, the syntax + %% makes this catch necessary. + willneverhappen -> + nil + after + Timer ! stoptimer, + cleanup_timer(Timer) + end, + Ans; +runmany(Fun, Fuse, List, local, Split, [{nodes, NodeList}|Malt]) -> + Nodes = lists:foldl(fun ({Node, schedulers}, A) -> + X = schedulers_on_node(Node) + 1, + lists:reverse(lists:duplicate(X, Node), A); + ({Node, X}, A) -> + lists:reverse(lists:duplicate(X, Node), A); + (Node, A) -> + [Node|A] + end, + [], NodeList), + runmany(Fun, Fuse, List, Nodes, Split, Malt); +runmany(Fun, {recursive, Fuse}, List, local, Split, []) -> + %% local recursive fuse, for when we weren't invoked with {processes, X} + %% or {nodes, NodeList}. Degenerates recursive fuse into linear fuse. + runmany(Fun, Fuse, List, local, Split, []); +runmany(Fun, Fuse, List, Nodes, no_split, []) -> + %% by default, operate on each element separately + runmany(Fun, Fuse, List, Nodes, 1, []); +runmany(Fun, Fuse, List, local, Split, []) -> + List2 = splitmany(List, Split), + local_runmany(Fun, Fuse, List2); +runmany(Fun, Fuse, List, Nodes, Split, []) -> + List2 = splitmany(List, Split), + cluster_runmany(Fun, Fuse, List2, Nodes). + +cleanup_timer(Timer) -> + receive + {timerrang, Timer} -> + cleanup_timer(Timer); + {timerstopped, Timer} -> + nil + end. + +schedulers_on_node(Node) -> + case erlang:get(ec_plists_schedulers_on_nodes) of + undefined -> + X = determine_schedulers(Node), + erlang:put(ec_plists_schedulers_on_nodes, + dict:store(Node, X, dict:new())), + X; + Dict -> + case dict:is_key(Node, Dict) of + true -> + dict:fetch(Node, Dict); + false -> + X = determine_schedulers(Node), + erlang:put(ec_plists_schedulers_on_nodes, + dict:store(Node, X, Dict)), + X + end + end. + +determine_schedulers(Node) -> + Parent = erlang:self(), + Child = proc_lib:spawn(Node, fun () -> + Parent ! {self(), erlang:system_info(schedulers)} + end), + erlang:monitor(process, Child), + receive + {Child, X} -> + receive + {'DOWN', _, _, Child, _Reason} -> + nil + end, + X; + {'DOWN', _, _, Child, Reason} when Reason =/= normal -> + 0 + end. + +%% @doc local runmany, for when we weren't invoked with {processes, X} +%% or {nodes, NodeList}. Every sublist is processed in parallel. +local_runmany(Fun, Fuse, List) -> + Parent = self (), + Pids = lists:map(fun (L) -> + F = fun () -> + Parent ! {self (), Fun(L)} + end, + {Pid, _} = erlang:spawn_monitor(F), + Pid + end, + List), + Answers = try + lists:map(fun receivefrom/1, Pids) + catch + throw:Message -> + {BadPid, Reason} = Message, + handle_error(BadPid, Reason, Pids) + end, + lists:foreach(fun (Pid) -> + normal_cleanup(Pid) + end, Pids), + fuse(Fuse, Answers). + +receivefrom(Pid) -> + receive + {Pid, R} -> + R; + {'DOWN', _, _, Pid, Reason} when Reason =/= normal -> + erlang:throw({Pid, Reason}); + {timerrang, _} -> + erlang:throw({nil, timeout}) + end. + +%% Convert List into [{Number, Sublist}] +cluster_runmany(Fun, Fuse, List, Nodes) -> + {List2, _} = lists:foldl(fun (X, {L, Count}) -> + {[{Count, X}|L], Count+1} + end, + {[], 0}, List), + cluster_runmany(Fun, Fuse, List2, Nodes, [], []). + +%% @doc Add a pair of results into the TaskList as a fusing task +cluster_runmany(Fun, {recursive, Fuse}, [], Nodes, Running, + [{_, R1}, {_, R2}|Results]) -> + cluster_runmany(Fun, {recursive, Fuse}, [{fuse, R1, R2}], Nodes, + Running, Results); +cluster_runmany(_, {recursive, _Fuse}, [], _Nodes, [], [{_, Result}]) -> + %% recursive fuse done, return result + Result; +cluster_runmany(_, {recursive, _Fuse}, [], _Nodes, [], []) -> + %% edge case where we are asked to do nothing + []; +cluster_runmany(_, Fuse, [], _Nodes, [], Results) -> + %% We're done, now we just have to [linear] fuse the results + fuse(Fuse, lists:map(fun ({_, R}) -> + R + end, + lists:sort(fun ({A, _}, {B, _}) -> + A =< B + end, + lists:reverse(Results)))); +cluster_runmany(Fun, Fuse, [Task|TaskList], [N|Nodes], Running, Results) -> +%% We have a ready node and a sublist or fuse to be processed, so we start +%% a new process + + Parent = erlang:self(), + case Task of + {Num, L2} -> + Fun2 = fun () -> + Parent ! {erlang:self(), Num, Fun(L2)} + end; + {fuse, R1, R2} -> + {recursive, FuseFunc} = Fuse, + Fun2 = fun () -> + Parent ! {erlang:self(), fuse, FuseFunc(R1, R2)} + end + end, + Fun3 = fun() -> runmany_wrap(Fun2, Parent) end, + Pid = proc_lib:spawn(N, Fun3), + erlang:monitor(process, Pid), + cluster_runmany(Fun, Fuse, TaskList, Nodes, [{Pid, N, Task}|Running], Results); +cluster_runmany(Fun, Fuse, TaskList, Nodes, Running, Results) when length(Running) > 0 -> + %% We can't start a new process, but can watch over already running ones + receive + {_Pid, error, Reason} -> + RunningPids = lists:map(fun ({Pid, _, _}) -> + Pid + end, + Running), + handle_error(junkvalue, Reason, RunningPids); + {Pid, Num, Result} -> + %% throw out the exit message, Reason should be + %% normal, noproc, or noconnection + receive + {'DOWN', _, _, Pid, _Reason} -> + nil + end, + {Running2, FinishedNode, _} = delete_running(Pid, Running, []), + cluster_runmany(Fun, Fuse, TaskList, + [FinishedNode|Nodes], Running2, [{Num, Result}|Results]); + {timerrang, _} -> + RunningPids = lists:map(fun ({Pid, _, _}) -> + Pid + end, + Running), + handle_error(nil, timeout, RunningPids); + %% node failure + {'DOWN', _, _, Pid, noconnection} -> + {Running2, _DeadNode, Task} = delete_running(Pid, Running, []), + cluster_runmany(Fun, Fuse, [Task|TaskList], Nodes, + Running2, Results); + %% could a noproc exit message come before the message from + %% the process? we are assuming it can't. + %% this clause is unlikely to get invoked due to cluster_runmany's + %% spawned processes. It will still catch errors in mapreduce's + %% reduce process, however. + {'DOWN', _, _, BadPid, Reason} when Reason =/= normal -> + RunningPids = lists:map(fun ({Pid, _, _}) -> + Pid + end, + Running), + handle_error(BadPid, Reason, RunningPids) + end; +cluster_runmany(_, _, [_Non|_Empty], []=_Nodes, []=_Running, _) -> +%% We have data, but no nodes either available or occupied + erlang:exit(allnodescrashed). + +runmany_wrap(Fun, Parent) -> + try + Fun() + catch + exit:siblingdied -> + ok; + exit:Reason -> + Parent ! {erlang:self(), error, Reason}; + error:R:Stacktrace -> + Parent ! {erlang:self(), error, {R, Stacktrace}}; + throw:R:Stacktrace -> + Parent ! {erlang:self(), error, {{nocatch, R}, Stacktrace}} + end. + +delete_running(Pid, [{Pid, Node, List}|Running], Acc) -> + {Running ++ Acc, Node, List}; +delete_running(Pid, [R|Running], Acc) -> + delete_running(Pid, Running, [R|Acc]). + +handle_error(BadPid, Reason, Pids) -> + lists:foreach(fun (Pid) -> + erlang:exit(Pid, siblingdied) + end, Pids), + lists:foreach(fun (Pid) -> + error_cleanup(Pid, BadPid) + end, Pids), + erlang:exit(Reason). + +error_cleanup(BadPid, BadPid) -> + ok; +error_cleanup(Pid, BadPid) -> + receive + {Pid, _} -> + error_cleanup(Pid, BadPid); + {Pid, _, _} -> + error_cleanup(Pid, BadPid); + {'DOWN', _, _, Pid, _Reason} -> + ok + end. + +normal_cleanup(Pid) -> + receive + {'DOWN', _, _, Pid, _Reason} -> + ok + end. + +%% edge case +fuse(_, []) -> + []; +fuse({reverse, _}=Fuse, Results) -> + [RL|ResultsR] = lists:reverse(Results), + fuse(Fuse, ResultsR, RL); +fuse(Fuse, [R1|Results]) -> + fuse(Fuse, Results, R1). + +fuse({reverse, FuseFunc}=Fuse, [R2|Results], R1) -> + fuse(Fuse, Results, FuseFunc(R2, R1)); +fuse(Fuse, [R2|Results], R1) -> + fuse(Fuse, Results, Fuse(R1, R2)); +fuse(_, [], R) -> + R. + +%% @doc Splits a list into a list of sublists, each of size Size, +%% except for the last element which is less if the original list +%% could not be evenly divided into Size-sized lists. +splitmany(List, Size) -> + splitmany(List, [], Size). + +splitmany([], Acc, _) -> + lists:reverse(Acc); +splitmany(List, Acc, Size) -> + {Top, NList} = split(Size, List), + splitmany(NList, [Top|Acc], Size). + +%% @doc Like lists:split, except it splits a list smaller than its first +%% parameter +split(Size, List) -> + split(Size, List, []). + +split(0, List, Acc) -> + {lists:reverse(Acc), List}; +split(Size, [H|List], Acc) -> + split(Size - 1, List, [H|Acc]); +split(_, [], Acc) -> + {lists:reverse(Acc), []}. diff --git a/src/ec_rbdict.erl b/src/ec_rbdict.erl new file mode 100644 index 0000000..9f3b617 --- /dev/null +++ b/src/ec_rbdict.erl @@ -0,0 +1,322 @@ +%%% vi:ts=4 sw=4 et +%%% Copyright (c) 2008 Robert Virding. All rights reserved. +%%% +%%% Redistribution and use in source and binary forms, with or without +%%% modification, are permitted provided that the following conditions +%%% are met: +%%% +%%% 1. Redistributions of source code must retain the above copyright +%%% notice, this list of conditions and the following disclaimer. +%%% 2. Redistributions in binary form must reproduce the above copyright +%%% notice, this list of conditions and the following disclaimer in the +%%% documentation and/or other materials provided with the distribution. +%%% +%%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +%%% "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +%%% LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS +%%% FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +%%% COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, +%%% INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, +%%% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +%%% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +%%% LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +%%% ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%%% POSSIBILITY OF SUCH DAMAGE. +%%%------------------------------------------------------------------- +%%% @copyright 2008 Robert Verding +%%% +%%% @doc +%%% +%%% Rbdict implements a Key - Value dictionary. An rbdict is a +%%% representation of a dictionary, where a red-black tree is used to +%%% store the keys and values. +%%% +%%% This module implements exactly the same interface as the module +%%% ec_dictionary but with a defined representation. One difference is +%%% that while dict considers two keys as different if they do not +%%% match (=:=), this module considers two keys as different if and +%%% only if they do not compare equal (==). +%%% +%%% The algorithms here are taken directly from Okasaki and Rbset +%%% in ML/Scheme. The interface is compatible with the standard dict +%%% interface. +%%% +%%% The following structures are used to build the the RB-dict: +%%% +%%% {r,Left,Key,Val,Right} +%%% {b,Left,Key,Val,Right} +%%% empty +%%% +%%% It is interesting to note that expanding out the first argument of +%%% l/rbalance, the colour, in store etc. is actually slower than not +%%% doing it. Measured. +%%% +%%% see ec_dictionary +%%% @end +%%%------------------------------------------------------------------- +-module(ec_rbdict). + +-behaviour(ec_dictionary). + +%% Standard interface. +-export([add/3, from_list/1, get/2, get/3, has_key/2, + has_value/2, new/0, remove/2, size/1, to_list/1, + keys/1]). + +-export_type([dictionary/2]). + +%%%=================================================================== +%%% Types +%%%=================================================================== +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type dictionary(K, V) :: empty | {color(), + dictionary(K, V), + ec_dictionary:key(K), + ec_dictionary:value(V), + dictionary(K, V)}. + +-type color() :: r | b. + +%%%=================================================================== +%%% API +%%%=================================================================== + +-spec new() -> dictionary(_K, _V). +new() -> empty. + +-spec has_key(ec_dictionary:key(K), dictionary(K, _V)) -> boolean(). +has_key(_, empty) -> + false; +has_key(K, {_, Left, K1, _, _}) when K < K1 -> + has_key(K, Left); +has_key(K, {_, _, K1, _, Right}) when K > K1 -> + has_key(K, Right); +has_key(_, {_, _, _, _, _}) -> + true. + +-spec get(ec_dictionary:key(K), dictionary(K, V)) -> ec_dictionary:value(V). +get(_, empty) -> + throw(not_found); +get(K, {_, Left, K1, _, _}) when K < K1 -> + get(K, Left); +get(K, {_, _, K1, _, Right}) when K > K1 -> + get(K, Right); +get(_, {_, _, _, Val, _}) -> + Val. + +-spec get(ec_dictionary:key(K), + ec_dictionary:value(V), + dictionary(K, V)) -> ec_dictionary:value(V). +get(_, Default, empty) -> + Default; +get(K, Default, {_, Left, K1, _, _}) when K < K1 -> + get(K, Default, Left); +get(K, Default, {_, _, K1, _, Right}) when K > K1 -> + get(K, Default, Right); +get(_, _, {_, _, _, Val, _}) -> + Val. + +-spec add(ec_dictionary:key(K), ec_dictionary:value(V), + dictionary(K, V)) -> dictionary(K, V). +add(Key, Value, Dict) -> + {_, L, K1, V1, R} = add1(Key, Value, Dict), + {b, L, K1, V1, R}. + +-spec remove(ec_dictionary:key(K), dictionary(K, V)) -> dictionary(K, V). +remove(Key, Dictionary) -> + {Dict1, _} = erase_aux(Key, Dictionary), Dict1. + +-spec has_value(ec_dictionary:value(V), dictionary(_K, V)) -> boolean(). +has_value(Value, Dict) -> + fold(fun (_, NValue, _) when NValue == Value -> true; + (_, _, Acc) -> Acc + end, + false, Dict). + +-spec size(dictionary(_K, _V)) -> non_neg_integer(). +size(T) -> + size1(T). + +-spec to_list(dictionary(K, V)) -> + [{ec_dictionary:key(K), ec_dictionary:value(V)}]. +to_list(T) -> + to_list(T, []). + +-spec from_list([{ec_dictionary:key(K), ec_dictionary:value(V)}]) -> + dictionary(K, V). +from_list(L) -> + lists:foldl(fun ({K, V}, D) -> + add(K, V, D) + end, new(), + L). + +-spec keys(dictionary(K, _V)) -> [ec_dictionary:key(K)]. +keys(Dict) -> + keys(Dict, []). + +%%%=================================================================== +%%% Enternal functions +%%%=================================================================== +-spec keys(dictionary(K, _V), [ec_dictionary:key(K)]) -> + [ec_dictionary:key(K)]. +keys(empty, Tail) -> + Tail; +keys({_, L, K, _, R}, Tail) -> + keys(L, [K | keys(R, Tail)]). + + +-spec erase_aux(ec_dictionary:key(K), dictionary(K, V)) -> + {dictionary(K, V), boolean()}. +erase_aux(_, empty) -> + {empty, false}; +erase_aux(K, {b, A, Xk, Xv, B}) -> + if K < Xk -> + {A1, Dec} = erase_aux(K, A), + if Dec -> + unbalright(b, A1, Xk, Xv, B); + true -> + {{b, A1, Xk, Xv, B}, false} + end; + K > Xk -> + {B1, Dec} = erase_aux(K, B), + if Dec -> + unballeft(b, A, Xk, Xv, B1); + true -> + {{b, A, Xk, Xv, B1}, false} + end; + true -> + case B of + empty -> + blackify(A); + _ -> + {B1, {Mk, Mv}, Dec} = erase_min(B), + if Dec -> + unballeft(b, A, Mk, Mv, B1); + true -> + {{b, A, Mk, Mv, B1}, false} + end + end + end; +erase_aux(K, {r, A, Xk, Xv, B}) -> + if K < Xk -> + {A1, Dec} = erase_aux(K, A), + if Dec -> + unbalright(r, A1, Xk, Xv, B); + true -> + {{r, A1, Xk, Xv, B}, false} + end; + K > Xk -> + {B1, Dec} = erase_aux(K, B), + if Dec -> + unballeft(r, A, Xk, Xv, B1); + true -> + {{r, A, Xk, Xv, B1}, false} + end; + true -> + case B of + empty -> + {A, false}; + _ -> + {B1, {Mk, Mv}, Dec} = erase_min(B), + if Dec -> + unballeft(r, A, Mk, Mv, B1); + true -> + {{r, A, Mk, Mv, B1}, false} + end + end + end. + +-spec erase_min(dictionary(K, V)) -> + {dictionary(K, V), {ec_dictionary:key(K), ec_dictionary:value(V)}, boolean()}. +erase_min({b, empty, Xk, Xv, empty}) -> + {empty, {Xk, Xv}, true}; +erase_min({b, empty, Xk, Xv, {r, A, Yk, Yv, B}}) -> + {{b, A, Yk, Yv, B}, {Xk, Xv}, false}; +erase_min({b, empty, _, _, {b, _, _, _, _}}) -> + exit(boom); +erase_min({r, empty, Xk, Xv, A}) -> + {A, {Xk, Xv}, false}; +erase_min({b, A, Xk, Xv, B}) -> + {A1, Min, Dec} = erase_min(A), + if Dec -> + {T, Dec1} = unbalright(b, A1, Xk, Xv, B), + {T, Min, Dec1}; + true -> {{b, A1, Xk, Xv, B}, Min, false} + end; +erase_min({r, A, Xk, Xv, B}) -> + {A1, Min, Dec} = erase_min(A), + if Dec -> + {T, Dec1} = unbalright(r, A1, Xk, Xv, B), + {T, Min, Dec1}; + true -> {{r, A1, Xk, Xv, B}, Min, false} + end. + +blackify({r, A, K, V, B}) -> {{b, A, K, V, B}, false}; +blackify(Node) -> {Node, true}. + +unballeft(r, {b, A, Xk, Xv, B}, Yk, Yv, C) -> + {lbalance(b, {r, A, Xk, Xv, B}, Yk, Yv, C), false}; +unballeft(b, {b, A, Xk, Xv, B}, Yk, Yv, C) -> + {lbalance(b, {r, A, Xk, Xv, B}, Yk, Yv, C), true}; +unballeft(b, {r, A, Xk, Xv, {b, B, Yk, Yv, C}}, Zk, Zv, + D) -> + {{b, A, Xk, Xv, + lbalance(b, {r, B, Yk, Yv, C}, Zk, Zv, D)}, + false}. + +unbalright(r, A, Xk, Xv, {b, B, Yk, Yv, C}) -> + {rbalance(b, A, Xk, Xv, {r, B, Yk, Yv, C}), false}; +unbalright(b, A, Xk, Xv, {b, B, Yk, Yv, C}) -> + {rbalance(b, A, Xk, Xv, {r, B, Yk, Yv, C}), true}; +unbalright(b, A, Xk, Xv, + {r, {b, B, Yk, Yv, C}, Zk, Zv, D}) -> + {{b, rbalance(b, A, Xk, Xv, {r, B, Yk, Yv, C}), Zk, Zv, + D}, + false}. + +-spec fold(fun((ec_dictionary:key(K), ec_dictionary:value(V), any()) -> any()), + any(), dictionary(K, V)) -> any(). +fold(_, Acc, empty) -> Acc; +fold(F, Acc, {_, A, Xk, Xv, B}) -> + fold(F, F(Xk, Xv, fold(F, Acc, B)), A). + +add1(K, V, empty) -> {r, empty, K, V, empty}; +add1(K, V, {C, Left, K1, V1, Right}) when K < K1 -> + lbalance(C, add1(K, V, Left), K1, V1, Right); +add1(K, V, {C, Left, K1, V1, Right}) when K > K1 -> + rbalance(C, Left, K1, V1, add1(K, V, Right)); +add1(K, V, {C, L, _, _, R}) -> {C, L, K, V, R}. + +size1(empty) -> 0; +size1({_, L, _, _, R}) -> size1(L) + size1(R) + 1. + +to_list(empty, List) -> List; +to_list({_, A, Xk, Xv, B}, List) -> + to_list(A, [{Xk, Xv} | to_list(B, List)]). + +%% Balance a tree after (possibly) adding a node to the left/right. +-spec lbalance(color(), dictionary(K, V), + ec_dictionary:key(K), ec_dictionary:value(V), + dictionary(K, V)) -> + dictionary(K, V). +lbalance(b, {r, {r, A, Xk, Xv, B}, Yk, Yv, C}, Zk, Zv, + D) -> + {r, {b, A, Xk, Xv, B}, Yk, Yv, {b, C, Zk, Zv, D}}; +lbalance(b, {r, A, Xk, Xv, {r, B, Yk, Yv, C}}, Zk, Zv, + D) -> + {r, {b, A, Xk, Xv, B}, Yk, Yv, {b, C, Zk, Zv, D}}; +lbalance(C, A, Xk, Xv, B) -> {C, A, Xk, Xv, B}. + +-spec rbalance(color(), dictionary(K, V), + ec_dictionary:key(K), ec_dictionary:value(V), + dictionary(K, V)) -> + dictionary(K, V). +rbalance(b, A, Xk, Xv, + {r, {r, B, Yk, Yv, C}, Zk, Zv, D}) -> + {r, {b, A, Xk, Xv, B}, Yk, Yv, {b, C, Zk, Zv, D}}; +rbalance(b, A, Xk, Xv, + {r, B, Yk, Yv, {r, C, Zk, Zv, D}}) -> + {r, {b, A, Xk, Xv, B}, Yk, Yv, {b, C, Zk, Zv, D}}; +rbalance(C, A, Xk, Xv, B) -> {C, A, Xk, Xv, B}. diff --git a/src/ec_semver.erl b/src/ec_semver.erl index 77b43cd..3ffd591 100644 --- a/src/ec_semver.erl +++ b/src/ec_semver.erl @@ -1,3 +1,4 @@ +%%% vi:ts=4 sw=4 et %%%------------------------------------------------------------------- %%% @copyright (C) 2011, Erlware LLC %%% @doc @@ -7,113 +8,304 @@ %%%------------------------------------------------------------------- -module(ec_semver). --exports([ - compare/2 - ]). +-export([parse/1, + format/1, + eql/2, + gt/2, + gte/2, + lt/2, + lte/2, + pes/2, + between/3]). --export_type([ - semvar/0 - ]). +%% For internal use by the ec_semver_parser peg +-export([internal_parse_version/1]). + +-export_type([semver/0, + version_string/0, + any_version/0]). %%%=================================================================== %%% Public Types %%%=================================================================== --type semvar() :: string(). --type parsed_semvar() :: {MajorVsn::string(), - MinorVsn::string(), - PatchVsn::string(), - PathString::string()}. +-type version_element() :: non_neg_integer() | binary(). + +-type major_minor_patch_minpatch() :: + version_element() + | {version_element(), version_element()} + | {version_element(), version_element(), version_element()} + | {version_element(), version_element(), + version_element(), version_element()}. + +-type alpha_part() :: integer() | binary() | string(). +-type alpha_info() :: {PreRelease::[alpha_part()], + BuildVersion::[alpha_part()]}. + +-type semver() :: {major_minor_patch_minpatch(), alpha_info()}. + +-type version_string() :: string() | binary(). + +-type any_version() :: version_string() | semver(). %%%=================================================================== %%% API %%%=================================================================== -%% @doc Is semver version string A bigger than version string B? -%%
-%% Example: compare("3.2.5alpha", "3.10.6") returns: false
-%% 
--spec compare(VsnA::string(), VsnB::string()) -> boolean(). -compare(VsnA, VsnB) -> - compare_toks(tokens(VsnA),tokens(VsnB)). +%% @doc parse a string or binary into a valid semver representation +-spec parse(any_version()) -> semver(). +parse(Version) when erlang:is_list(Version) -> + case ec_semver_parser:parse(Version) of + {fail, _} -> + {erlang:iolist_to_binary(Version), {[],[]}}; + Good -> + Good + end; +parse(Version) when erlang:is_binary(Version) -> + case ec_semver_parser:parse(Version) of + {fail, _} -> + {Version, {[],[]}}; + Good -> + Good + end; +parse(Version) -> + Version. + +-spec format(semver()) -> iolist(). +format({Maj, {AlphaPart, BuildPart}}) + when erlang:is_integer(Maj); + erlang:is_binary(Maj) -> + [format_version_part(Maj), + format_vsn_rest(<<"-">>, AlphaPart), + format_vsn_rest(<<"+">>, BuildPart)]; +format({{Maj, Min}, {AlphaPart, BuildPart}}) -> + [format_version_part(Maj), ".", + format_version_part(Min), + format_vsn_rest(<<"-">>, AlphaPart), + format_vsn_rest(<<"+">>, BuildPart)]; +format({{Maj, Min, Patch}, {AlphaPart, BuildPart}}) -> + [format_version_part(Maj), ".", + format_version_part(Min), ".", + format_version_part(Patch), + format_vsn_rest(<<"-">>, AlphaPart), + format_vsn_rest(<<"+">>, BuildPart)]; +format({{Maj, Min, Patch, MinPatch}, {AlphaPart, BuildPart}}) -> + [format_version_part(Maj), ".", + format_version_part(Min), ".", + format_version_part(Patch), ".", + format_version_part(MinPatch), + format_vsn_rest(<<"-">>, AlphaPart), + format_vsn_rest(<<"+">>, BuildPart)]. + +-spec format_version_part(integer() | binary()) -> iolist(). +format_version_part(Vsn) + when erlang:is_integer(Vsn) -> + erlang:integer_to_list(Vsn); +format_version_part(Vsn) + when erlang:is_binary(Vsn) -> + Vsn. + + + +%% @doc test for quality between semver versions +-spec eql(any_version(), any_version()) -> boolean(). +eql(VsnA, VsnB) -> + NVsnA = normalize(parse(VsnA)), + NVsnB = normalize(parse(VsnB)), + NVsnA =:= NVsnB. + +%% @doc Test that VsnA is greater than VsnB +-spec gt(any_version(), any_version()) -> boolean(). +gt(VsnA, VsnB) -> + {MMPA, {AlphaA, PatchA}} = normalize(parse(VsnA)), + {MMPB, {AlphaB, PatchB}} = normalize(parse(VsnB)), + ((MMPA > MMPB) + orelse + ((MMPA =:= MMPB) + andalso + ((AlphaA =:= [] andalso AlphaB =/= []) + orelse + ((not (AlphaB =:= [] andalso AlphaA =/= [])) + andalso + (AlphaA > AlphaB)))) + orelse + ((MMPA =:= MMPB) + andalso + (AlphaA =:= AlphaB) + andalso + ((PatchB =:= [] andalso PatchA =/= []) + orelse + PatchA > PatchB))). + +%% @doc Test that VsnA is greater than or equal to VsnB +-spec gte(any_version(), any_version()) -> boolean(). +gte(VsnA, VsnB) -> + NVsnA = normalize(parse(VsnA)), + NVsnB = normalize(parse(VsnB)), + gt(NVsnA, NVsnB) orelse eql(NVsnA, NVsnB). + +%% @doc Test that VsnA is less than VsnB +-spec lt(any_version(), any_version()) -> boolean(). +lt(VsnA, VsnB) -> + {MMPA, {AlphaA, PatchA}} = normalize(parse(VsnA)), + {MMPB, {AlphaB, PatchB}} = normalize(parse(VsnB)), + ((MMPA < MMPB) + orelse + ((MMPA =:= MMPB) + andalso + ((AlphaB =:= [] andalso AlphaA =/= []) + orelse + ((not (AlphaA =:= [] andalso AlphaB =/= [])) + andalso + (AlphaA < AlphaB)))) + orelse + ((MMPA =:= MMPB) + andalso + (AlphaA =:= AlphaB) + andalso + ((PatchA =:= [] andalso PatchB =/= []) + orelse + PatchA < PatchB))). + +%% @doc Test that VsnA is less than or equal to VsnB +-spec lte(any_version(), any_version()) -> boolean(). +lte(VsnA, VsnB) -> + NVsnA = normalize(parse(VsnA)), + NVsnB = normalize(parse(VsnB)), + lt(NVsnA, NVsnB) orelse eql(NVsnA, NVsnB). + +%% @doc Test that VsnMatch is greater than or equal to Vsn1 and +%% less than or equal to Vsn2 +-spec between(any_version(), any_version(), any_version()) -> boolean(). +between(Vsn1, Vsn2, VsnMatch) -> + NVsnA = normalize(parse(Vsn1)), + NVsnB = normalize(parse(Vsn2)), + NVsnMatch = normalize(parse(VsnMatch)), + gte(NVsnMatch, NVsnA) andalso + lte(NVsnMatch, NVsnB). + +%% @doc check that VsnA is Approximately greater than VsnB +%% +%% Specifying ">= 2.6.5" is an optimistic version constraint. All +%% versions greater than the one specified, including major releases +%% (e.g. 3.0.0) are allowed. +%% +%% Conversely, specifying "~> 2.6" is pessimistic about future major +%% revisions and "~> 2.6.5" is pessimistic about future minor +%% revisions. +%% +%% "~> 2.6" matches cookbooks >= 2.6.0 AND < 3.0.0 +%% "~> 2.6.5" matches cookbooks >= 2.6.5 AND < 2.7.0 +pes(VsnA, VsnB) -> + internal_pes(parse(VsnA), parse(VsnB)). + +%%%=================================================================== +%%% Friend Functions +%%%=================================================================== +%% @doc helper function for the peg grammar to parse the iolist into a semver +-spec internal_parse_version(iolist()) -> semver(). +internal_parse_version([MMP, AlphaPart, BuildPart, _]) -> + {parse_major_minor_patch_minpatch(MMP), {parse_alpha_part(AlphaPart), + parse_alpha_part(BuildPart)}}. + +%% @doc helper function for the peg grammar to parse the iolist into a major_minor_patch +-spec parse_major_minor_patch_minpatch(iolist()) -> major_minor_patch_minpatch(). +parse_major_minor_patch_minpatch([MajVsn, [], [], []]) -> + strip_maj_version(MajVsn); +parse_major_minor_patch_minpatch([MajVsn, [<<".">>, MinVsn], [], []]) -> + {strip_maj_version(MajVsn), MinVsn}; +parse_major_minor_patch_minpatch([MajVsn, + [<<".">>, MinVsn], + [<<".">>, PatchVsn], []]) -> + {strip_maj_version(MajVsn), MinVsn, PatchVsn}; +parse_major_minor_patch_minpatch([MajVsn, + [<<".">>, MinVsn], + [<<".">>, PatchVsn], + [<<".">>, MinPatch]]) -> + {strip_maj_version(MajVsn), MinVsn, PatchVsn, MinPatch}. + +%% @doc helper function for the peg grammar to parse the iolist into an alpha part +-spec parse_alpha_part(iolist()) -> [alpha_part()]. +parse_alpha_part([]) -> + []; +parse_alpha_part([_, AV1, Rest]) -> + [erlang:iolist_to_binary(AV1) | + [format_alpha_part(Part) || Part <- Rest]]. + +%% @doc according to semver alpha parts that can be treated like +%% numbers must be. We implement that here by taking the alpha part +%% and trying to convert it to a number, if it succeeds we use +%% it. Otherwise we do not. +-spec format_alpha_part(iolist()) -> integer() | binary(). +format_alpha_part([<<".">>, AlphaPart]) -> + Bin = erlang:iolist_to_binary(AlphaPart), + try + erlang:list_to_integer(erlang:binary_to_list(Bin)) + catch + error:badarg -> + Bin + end. %%%=================================================================== %%% Internal Functions %%%=================================================================== +-spec strip_maj_version(iolist()) -> version_element(). +strip_maj_version([<<"v">>, MajVsn]) -> + MajVsn; +strip_maj_version([[], MajVsn]) -> + MajVsn; +strip_maj_version(MajVsn) -> + MajVsn. --spec tokens(semvar()) -> parsed_semvar(). -tokens(Vsn) -> - [MajorVsn, MinorVsn, RawPatch] = string:tokens(Vsn, "."), - {PatchVsn, PatchString} = split_patch(RawPatch), - {MajorVsn, MinorVsn, PatchVsn, PatchString}. +-spec to_list(integer() | binary() | string()) -> string() | binary(). +to_list(Detail) when erlang:is_integer(Detail) -> + erlang:integer_to_list(Detail); +to_list(Detail) when erlang:is_list(Detail); erlang:is_binary(Detail) -> + Detail. --spec split_patch(string()) -> - {PatchVsn::string(), PatchStr::string()}. -split_patch(RawPatch) -> - {PatchVsn, PatchStr} = split_patch(RawPatch, {"", ""}), - {lists:reverse(PatchVsn), PatchStr}. +-spec format_vsn_rest(binary() | string(), [integer() | binary()]) -> iolist(). +format_vsn_rest(_TypeMark, []) -> + []; +format_vsn_rest(TypeMark, [Head | Rest]) -> + [TypeMark, Head | + [[".", to_list(Detail)] || Detail <- Rest]]. --spec split_patch(string(), {AccPatchVsn::string(), AccPatchStr::string()}) -> - {PatchVsn::string(), PatchStr::string()}. -split_patch([], Acc) -> - Acc; -split_patch([Dig|T], {PatchVsn, PatchStr}) when Dig >= $0 andalso Dig =< $9 -> - split_patch(T, {[Dig|PatchVsn], PatchStr}); -split_patch(PatchStr, {PatchVsn, ""}) -> - {PatchVsn, PatchStr}. +%% @doc normalize the semver so they can be compared +-spec normalize(semver()) -> semver(). +normalize({Vsn, Rest}) + when erlang:is_binary(Vsn); + erlang:is_integer(Vsn) -> + {{Vsn, 0, 0, 0}, Rest}; +normalize({{Maj, Min}, Rest}) -> + {{Maj, Min, 0, 0}, Rest}; +normalize({{Maj, Min, Patch}, Rest}) -> + {{Maj, Min, Patch, 0}, Rest}; +normalize(Other = {{_, _, _, _}, {_,_}}) -> + Other. --spec compare_toks(parsed_semvar(), parsed_semvar()) -> boolean(). -compare_toks({MajA, MinA, PVA, PSA}, {MajB, MinB, PVB, PSB}) -> - compare_toks2({to_int(MajA), to_int(MinA), to_int(PVA), PSA}, - {to_int(MajB), to_int(MinB), to_int(PVB), PSB}). - --spec compare_toks2(parsed_semvar(), parsed_semvar()) -> boolean(). -compare_toks2({MajA, _MinA, _PVA, _PSA}, {MajB, _MinB, _PVB, _PSB}) - when MajA > MajB -> - true; -compare_toks2({_Maj, MinA, _PVA, _PSA}, {_Maj, MinB, _PVB, _PSB}) - when MinA > MinB -> - true; -compare_toks2({_Maj, _Min, PVA, _PSA}, {_Maj, _Min, PVB, _PSB}) - when PVA > PVB -> - true; -compare_toks2({_Maj, _Min, _PV, ""}, {_Maj, _Min, _PV, PSB}) when PSB /= ""-> - true; -compare_toks2({_Maj, _Min, _PV, PSA}, {_Maj, _Min, _PV, ""}) when PSA /= ""-> - false; -compare_toks2({_Maj, _Min, _PV, PSA}, {_Maj, _Min, _PV, PSB}) when PSA > PSB -> - true; -compare_toks2(_ToksA, _ToksB) -> - false. - --spec to_int(string()) -> integer(). -to_int(String) -> - try - list_to_integer(String) - catch - error:badarg -> - throw(invalid_semver_string) - end. - -%%%=================================================================== -%%% Test Functions -%%%=================================================================== - --ifndef(NOTEST). --include_lib("eunit/include/eunit.hrl"). - -split_patch_test() -> - ?assertMatch({"123", "alpha1"}, split_patch("123alpha1")). - -compare_test() -> - ?assertMatch(true, compare("1.2.3", "1.2.3alpha")), - ?assertMatch(true, compare("1.2.3beta", "1.2.3alpha")), - ?assertMatch(true, compare("1.2.4", "1.2.3")), - ?assertMatch(true, compare("1.3.3", "1.2.3")), - ?assertMatch(true, compare("2.2.3", "1.2.3")), - ?assertMatch(true, compare("4.2.3", "3.10.3")), - ?assertMatch(false, compare("1.2.3", "2.2.3")), - ?assertThrow(invalid_semver_string, compare("1.b.2", "1.3.4")), - ?assertThrow(invalid_semver_string, compare("1.2.2", "1.3.t")). - --endif. +%% @doc to do the pessimistic compare we need a parsed semver. This is +%% the internal implementation of the of the pessimistic run. The +%% external just ensures that versions are parsed. +-spec internal_pes(semver(), semver()) -> boolean(). +internal_pes(VsnA, {{LM, LMI}, Alpha}) + when erlang:is_integer(LM), + erlang:is_integer(LMI) -> + gte(VsnA, {{LM, LMI, 0}, Alpha}) andalso + lt(VsnA, {{LM + 1, 0, 0, 0}, {[], []}}); +internal_pes(VsnA, {{LM, LMI, LP}, Alpha}) + when erlang:is_integer(LM), + erlang:is_integer(LMI), + erlang:is_integer(LP) -> + gte(VsnA, {{LM, LMI, LP}, Alpha}) + andalso + lt(VsnA, {{LM, LMI + 1, 0, 0}, {[], []}}); +internal_pes(VsnA, {{LM, LMI, LP, LMP}, Alpha}) + when erlang:is_integer(LM), + erlang:is_integer(LMI), + erlang:is_integer(LP), + erlang:is_integer(LMP) -> + gte(VsnA, {{LM, LMI, LP, LMP}, Alpha}) + andalso + lt(VsnA, {{LM, LMI, LP + 1, 0}, {[], []}}); +internal_pes(Vsn, LVsn) -> + gte(Vsn, LVsn). diff --git a/src/ec_semver_parser.erl b/src/ec_semver_parser.erl new file mode 100644 index 0000000..c2fe186 --- /dev/null +++ b/src/ec_semver_parser.erl @@ -0,0 +1,302 @@ +-module(ec_semver_parser). +-export([parse/1,file/1]). +-define(p_anything,true). +-define(p_charclass,true). +-define(p_choose,true). +-define(p_not,true). +-define(p_one_or_more,true). +-define(p_optional,true). +-define(p_scan,true). +-define(p_seq,true). +-define(p_string,true). +-define(p_zero_or_more,true). + + + +-spec file(file:name()) -> any(). +file(Filename) -> case file:read_file(Filename) of {ok,Bin} -> parse(Bin); Err -> Err end. + +-spec parse(binary() | list()) -> any(). +parse(List) when is_list(List) -> parse(unicode:characters_to_binary(List)); +parse(Input) when is_binary(Input) -> + _ = setup_memo(), + Result = case 'semver'(Input,{{line,1},{column,1}}) of + {AST, <<>>, _Index} -> AST; + Any -> Any + end, + release_memo(), Result. + +-spec 'semver'(input(), index()) -> parse_result(). +'semver'(Input, Index) -> + p(Input, Index, 'semver', fun(I,D) -> (p_seq([fun 'major_minor_patch_min_patch'/2, p_optional(p_seq([p_string(<<"-">>), fun 'alpha_part'/2, p_zero_or_more(p_seq([p_string(<<".">>), fun 'alpha_part'/2]))])), p_optional(p_seq([p_string(<<"+">>), fun 'alpha_part'/2, p_zero_or_more(p_seq([p_string(<<".">>), fun 'alpha_part'/2]))])), p_not(p_anything())]))(I,D) end, fun(Node, _Idx) -> ec_semver:internal_parse_version(Node) end). + +-spec 'major_minor_patch_min_patch'(input(), index()) -> parse_result(). +'major_minor_patch_min_patch'(Input, Index) -> + p(Input, Index, 'major_minor_patch_min_patch', fun(I,D) -> (p_seq([p_choose([p_seq([p_optional(p_string(<<"v">>)), fun 'numeric_part'/2]), fun 'alpha_part'/2]), p_optional(p_seq([p_string(<<".">>), fun 'version_part'/2])), p_optional(p_seq([p_string(<<".">>), fun 'version_part'/2])), p_optional(p_seq([p_string(<<".">>), fun 'version_part'/2]))]))(I,D) end, fun(Node, Idx) ->transform('major_minor_patch_min_patch', Node, Idx) end). + +-spec 'version_part'(input(), index()) -> parse_result(). +'version_part'(Input, Index) -> + p(Input, Index, 'version_part', fun(I,D) -> (p_choose([fun 'numeric_part'/2, fun 'alpha_part'/2]))(I,D) end, fun(Node, Idx) ->transform('version_part', Node, Idx) end). + +-spec 'numeric_part'(input(), index()) -> parse_result(). +'numeric_part'(Input, Index) -> + p(Input, Index, 'numeric_part', fun(I,D) -> (p_one_or_more(p_charclass(<<"[0-9]">>)))(I,D) end, fun(Node, _Idx) ->erlang:list_to_integer(erlang:binary_to_list(erlang:iolist_to_binary(Node))) end). + +-spec 'alpha_part'(input(), index()) -> parse_result(). +'alpha_part'(Input, Index) -> + p(Input, Index, 'alpha_part', fun(I,D) -> (p_one_or_more(p_charclass(<<"[A-Za-z0-9-]">>)))(I,D) end, fun(Node, _Idx) ->erlang:iolist_to_binary(Node) end). + + +transform(_,Node,_Index) -> Node. +-type index() :: {{line, pos_integer()}, {column, pos_integer()}}. +-type input() :: binary(). +-type parse_failure() :: {fail, term()}. +-type parse_success() :: {term(), input(), index()}. +-type parse_result() :: parse_failure() | parse_success(). +-type parse_fun() :: fun((input(), index()) -> parse_result()). +-type xform_fun() :: fun((input(), index()) -> term()). + +-spec p(input(), index(), atom(), parse_fun(), xform_fun()) -> parse_result(). +p(Inp, StartIndex, Name, ParseFun, TransformFun) -> + case get_memo(StartIndex, Name) of % See if the current reduction is memoized + {ok, Memo} -> %Memo; % If it is, return the stored result + Memo; + _ -> % If not, attempt to parse + Result = case ParseFun(Inp, StartIndex) of + {fail,_} = Failure -> % If it fails, memoize the failure + Failure; + {Match, InpRem, NewIndex} -> % If it passes, transform and memoize the result. + Transformed = TransformFun(Match, StartIndex), + {Transformed, InpRem, NewIndex} + end, + memoize(StartIndex, Name, Result), + Result + end. + +-spec setup_memo() -> ets:tid(). +setup_memo() -> + put({parse_memo_table, ?MODULE}, ets:new(?MODULE, [set])). + +-spec release_memo() -> true. +release_memo() -> + ets:delete(memo_table_name()). + +-spec memoize(index(), atom(), parse_result()) -> true. +memoize(Index, Name, Result) -> + Memo = case ets:lookup(memo_table_name(), Index) of + [] -> []; + [{Index, Plist}] -> Plist + end, + ets:insert(memo_table_name(), {Index, [{Name, Result}|Memo]}). + +-spec get_memo(index(), atom()) -> {ok, term()} | {error, not_found}. +get_memo(Index, Name) -> + case ets:lookup(memo_table_name(), Index) of + [] -> {error, not_found}; + [{Index, Plist}] -> + case proplists:lookup(Name, Plist) of + {Name, Result} -> {ok, Result}; + _ -> {error, not_found} + end + end. + +-spec memo_table_name() -> ets:tid(). +memo_table_name() -> + get({parse_memo_table, ?MODULE}). + +-ifdef(p_eof). +-spec p_eof() -> parse_fun(). +p_eof() -> + fun(<<>>, Index) -> {eof, [], Index}; + (_, Index) -> {fail, {expected, eof, Index}} end. +-endif. + +-ifdef(p_optional). +-spec p_optional(parse_fun()) -> parse_fun(). +p_optional(P) -> + fun(Input, Index) -> + case P(Input, Index) of + {fail,_} -> {[], Input, Index}; + {_, _, _} = Success -> Success + end + end. +-endif. + +-ifdef(p_not). +-spec p_not(parse_fun()) -> parse_fun(). +p_not(P) -> + fun(Input, Index)-> + case P(Input,Index) of + {fail,_} -> + {[], Input, Index}; + {Result, _, _} -> {fail, {expected, {no_match, Result},Index}} + end + end. +-endif. + +-ifdef(p_assert). +-spec p_assert(parse_fun()) -> parse_fun(). +p_assert(P) -> + fun(Input,Index) -> + case P(Input,Index) of + {fail,_} = Failure-> Failure; + _ -> {[], Input, Index} + end + end. +-endif. + +-ifdef(p_seq). +-spec p_seq([parse_fun()]) -> parse_fun(). +p_seq(P) -> + fun(Input, Index) -> + p_all(P, Input, Index, []) + end. + +-spec p_all([parse_fun()], input(), index(), [term()]) -> parse_result(). +p_all([], Inp, Index, Accum ) -> {lists:reverse( Accum ), Inp, Index}; +p_all([P|Parsers], Inp, Index, Accum) -> + case P(Inp, Index) of + {fail, _} = Failure -> Failure; + {Result, InpRem, NewIndex} -> p_all(Parsers, InpRem, NewIndex, [Result|Accum]) + end. +-endif. + +-ifdef(p_choose). +-spec p_choose([parse_fun()]) -> parse_fun(). +p_choose(Parsers) -> + fun(Input, Index) -> + p_attempt(Parsers, Input, Index, none) + end. + +-spec p_attempt([parse_fun()], input(), index(), none | parse_failure()) -> parse_result(). +p_attempt([], _Input, _Index, Failure) -> Failure; +p_attempt([P|Parsers], Input, Index, FirstFailure)-> + case P(Input, Index) of + {fail, _} = Failure -> + case FirstFailure of + none -> p_attempt(Parsers, Input, Index, Failure); + _ -> p_attempt(Parsers, Input, Index, FirstFailure) + end; + Result -> Result + end. +-endif. + +-ifdef(p_zero_or_more). +-spec p_zero_or_more(parse_fun()) -> parse_fun(). +p_zero_or_more(P) -> + fun(Input, Index) -> + p_scan(P, Input, Index, []) + end. +-endif. + +-ifdef(p_one_or_more). +-spec p_one_or_more(parse_fun()) -> parse_fun(). +p_one_or_more(P) -> + fun(Input, Index)-> + Result = p_scan(P, Input, Index, []), + case Result of + {[_|_], _, _} -> + Result; + _ -> + {fail, {expected, Failure, _}} = P(Input,Index), + {fail, {expected, {at_least_one, Failure}, Index}} + end + end. +-endif. + +-ifdef(p_label). +-spec p_label(atom(), parse_fun()) -> parse_fun(). +p_label(Tag, P) -> + fun(Input, Index) -> + case P(Input, Index) of + {fail,_} = Failure -> + Failure; + {Result, InpRem, NewIndex} -> + {{Tag, Result}, InpRem, NewIndex} + end + end. +-endif. + +-ifdef(p_scan). +-spec p_scan(parse_fun(), input(), index(), [term()]) -> {[term()], input(), index()}. +p_scan(_, <<>>, Index, Accum) -> {lists:reverse(Accum), <<>>, Index}; +p_scan(P, Inp, Index, Accum) -> + case P(Inp, Index) of + {fail,_} -> {lists:reverse(Accum), Inp, Index}; + {Result, InpRem, NewIndex} -> p_scan(P, InpRem, NewIndex, [Result | Accum]) + end. +-endif. + +-ifdef(p_string). +-spec p_string(binary()) -> parse_fun(). +p_string(S) -> + Length = erlang:byte_size(S), + fun(Input, Index) -> + try + <> = Input, + {S, Rest, p_advance_index(S, Index)} + catch + error:{badmatch,_} -> {fail, {expected, {string, S}, Index}} + end + end. +-endif. + +-ifdef(p_anything). +-spec p_anything() -> parse_fun(). +p_anything() -> + fun(<<>>, Index) -> {fail, {expected, any_character, Index}}; + (Input, Index) when is_binary(Input) -> + <> = Input, + {<>, Rest, p_advance_index(<>, Index)} + end. +-endif. + +-ifdef(p_charclass). +-spec p_charclass(string() | binary()) -> parse_fun(). +p_charclass(Class) -> + {ok, RE} = re:compile(Class, [unicode, dotall]), + fun(Inp, Index) -> + case re:run(Inp, RE, [anchored]) of + {match, [{0, Length}|_]} -> + {Head, Tail} = erlang:split_binary(Inp, Length), + {Head, Tail, p_advance_index(Head, Index)}; + _ -> {fail, {expected, {character_class, binary_to_list(Class)}, Index}} + end + end. +-endif. + +-ifdef(p_regexp). +-spec p_regexp(binary()) -> parse_fun(). +p_regexp(Regexp) -> + {ok, RE} = re:compile(Regexp, [unicode, dotall, anchored]), + fun(Inp, Index) -> + case re:run(Inp, RE) of + {match, [{0, Length}|_]} -> + {Head, Tail} = erlang:split_binary(Inp, Length), + {Head, Tail, p_advance_index(Head, Index)}; + _ -> {fail, {expected, {regexp, binary_to_list(Regexp)}, Index}} + end + end. +-endif. + +-ifdef(line). +-spec line(index() | term()) -> pos_integer() | undefined. +line({{line,L},_}) -> L; +line(_) -> undefined. +-endif. + +-ifdef(column). +-spec column(index() | term()) -> pos_integer() | undefined. +column({_,{column,C}}) -> C; +column(_) -> undefined. +-endif. + +-spec p_advance_index(input() | unicode:charlist() | pos_integer(), index()) -> index(). +p_advance_index(MatchedInput, Index) when is_list(MatchedInput) orelse is_binary(MatchedInput)-> % strings + lists:foldl(fun p_advance_index/2, Index, unicode:characters_to_list(MatchedInput)); +p_advance_index(MatchedInput, Index) when is_integer(MatchedInput) -> % single characters + {{line, Line}, {column, Col}} = Index, + case MatchedInput of + $\n -> {{line, Line+1}, {column, 1}}; + _ -> {{line, Line}, {column, Col+1}} + end. diff --git a/src/ec_string.erl b/src/ec_string.erl deleted file mode 100644 index 2a06257..0000000 --- a/src/ec_string.erl +++ /dev/null @@ -1,128 +0,0 @@ -%%%------------------------------------------------------------------- -%%% @copyright (C) 2011, Erlware LLC -%%% @doc -%%% Helper functions for working with strings. -%%% @end -%%%------------------------------------------------------------------- --module(ec_string). - --export([ - compare_versions/2 - ]). -%%%=================================================================== -%%% API -%%%=================================================================== - -%% @doc Is arbitrary version string A bigger than version string B? -%% Valid version string elements are either separated by . or - or both. -%% Final version string elements may have a numeric followed directly by an -%% alpha numeric and will be compared separately as in 12alpha. -%% -%%
-%% Example: compare_versions("3-2-5-alpha", "3.10.6") will return false
-%%          compare_versions("3-2-alpha", "3.2.1-alpha") will return false
-%%          compare_versions("3-2alpha", "3.2.1-alpha") will return false
-%%          compare_versions("3.2.2", "3.2.2") will return false
-%%          compare_versions("3.2.1", "3.2.1-rc2") will return true
-%%          compare_versions("3.2.2", "3.2.1") will return true
-%% 
--spec compare_versions(VsnA::string(), VsnB::string()) -> boolean(). -compare_versions(VsnA, VsnB) -> - compare(string:tokens(VsnA, ".-"),string:tokens(VsnB, ".-")). - -%%%=================================================================== -%%% Internal Functions -%%%=================================================================== - --spec compare(string(), string()) -> boolean(). -compare([Str|TA], [Str|TB]) -> - compare(TA, TB); -compare([StrA|TA], [StrB|TB]) -> - fine_compare(split_numeric_alpha(StrA), TA, - split_numeric_alpha(StrB), TB); -compare([], [Str]) -> - not compare_against_nothing(Str); -compare([Str], []) -> - compare_against_nothing(Str); -compare([], [_,_|_]) -> - false; -compare([_,_|_], []) -> - true; -compare([], []) -> - false. - --spec compare_against_nothing(string()) -> boolean(). -compare_against_nothing(Str) -> - case split_numeric_alpha(Str) of - {_StrDig, ""} -> true; - {"", _StrAlpha} -> false; - {_StrDig, _StrAlpha} -> true - end. - --spec fine_compare({string(), string()}, string(), - {string(), string()}, string()) -> - boolean(). -fine_compare({_StrDigA, StrA}, TA, {_StrDigB, _StrB}, _TB) - when StrA /= "", TA /= [] -> - throw(invalid_version_string); -fine_compare({_StrDigA, _StrA}, _TA, {_StrDigB, StrB}, TB) - when StrB /= "", TB /= [] -> - throw(invalid_version_string); -fine_compare({"", _StrA}, _TA, {StrDigB, _StrB}, _TB) when StrDigB /= "" -> - false; -fine_compare({StrDigA, _StrA}, _TA, {"", _StrB}, _TB) when StrDigA /= "" -> - true; -fine_compare({StrDig, ""}, _TA, {StrDig, StrB}, _TB) when StrB /= "" -> - true; -fine_compare({StrDig, StrA}, _TA, {StrDig, ""}, _TB) when StrA /= "" -> - false; -fine_compare({StrDig, StrA}, _TA, {StrDig, StrB}, _TB) -> - StrA > StrB; -fine_compare({StrDigA, _StrA}, _TA, {StrDigB, _StrB}, _TB) -> - list_to_integer(StrDigA) > list_to_integer(StrDigB). - -%% In the case of a version sub part with a numeric then an alpha, -%% split out the numeric and alpha "24alpha" becomes {"24", "alpha"} --spec split_numeric_alpha(string()) -> - {PatchVsn::string(), PatchStr::string()}. -split_numeric_alpha(RawVsn) -> - {Num, Str} = split_numeric_alpha(RawVsn, {"", ""}), - {lists:reverse(Num), Str}. - --spec split_numeric_alpha(string(), {PatchVsnAcc::string(), - PatchStrAcc::string()}) -> - {PatchVsn::string(), PatchStr::string()}. -split_numeric_alpha([], Acc) -> - Acc; -split_numeric_alpha([Dig|T], {PatchVsn, PatchStr}) - when Dig >= $0 andalso Dig =< $9 -> - split_numeric_alpha(T, {[Dig|PatchVsn], PatchStr}); -split_numeric_alpha(PatchStr, {PatchVsn, ""}) -> - {PatchVsn, PatchStr}. - -%%%=================================================================== -%%% Test Functions -%%%=================================================================== - --ifndef(NOTEST). --include_lib("eunit/include/eunit.hrl"). - -split_numeric_alpha_test() -> - ?assertMatch({"123", "alpha1"}, split_numeric_alpha("123alpha1")). - -compare_versions_test() -> - ?assertMatch(true, compare_versions("1.2.3", "1.2.3alpha")), - ?assertMatch(true, compare_versions("1.2.3-beta", "1.2.3-alpha")), - ?assertMatch(true, compare_versions("1-2-3", "1-2-3alpha")), - ?assertMatch(true, compare_versions("1-2-3", "1-2-3-rc3")), - ?assertMatch(true, compare_versions("1.2.3beta", "1.2.3alpha")), - ?assertMatch(true, compare_versions("1.2.4", "1.2.3")), - ?assertMatch(true, compare_versions("1.3.3", "1.2.3")), - ?assertMatch(true, compare_versions("2.2.3", "1.2.3")), - ?assertMatch(true, compare_versions("4.2.3", "3.10.3")), - ?assertMatch(false, compare_versions("1.2.3", "2.2.3")), - ?assertMatch(false, compare_versions("1.2.2", "1.3.t")), - ?assertMatch(false, compare_versions("1.2t", "1.3.t")), - ?assertThrow(invalid_version_string, compare_versions("1.b.2", "1.3.4")). - --endif. diff --git a/src/ec_talk.erl b/src/ec_talk.erl index 0823169..8c3a105 100644 --- a/src/ec_talk.erl +++ b/src/ec_talk.erl @@ -1,4 +1,5 @@ %% -*- mode: Erlang; fill-column: 79; comment-column: 70; -*- +%% vi:ts=4 sw=4 et %%%--------------------------------------------------------------------------- %%% Permission is hereby granted, free of charge, to any person %%% obtaining a copy of this software and associated documentation @@ -38,18 +39,21 @@ say/1, say/2]). +-ifdef(TEST). +-export([get_boolean/1, + get_integer/1]). +-endif. + -export_type([prompt/0, type/0, supported/0]). --include_lib("eunit/include/eunit.hrl"). - %%============================================================================ %% Types %%============================================================================ -type prompt() :: string(). -type type() :: boolean | number | string. --type supported() :: string() | boolean() | number(). +-type supported() :: boolean() | number() | string(). %%============================================================================ %% API @@ -76,7 +80,7 @@ ask(Prompt) -> ask_default(Prompt, Default) -> ask_convert(Prompt, fun get_string/1, string, Default). -%% @doc Asks the user to respond to the prompt. Trys to return the +%% @doc Asks the user to respond to the prompt. Tries to return the %% value in the format specified by 'Type'. -spec ask(prompt(), type()) -> supported(). ask(Prompt, boolean) -> @@ -84,9 +88,9 @@ ask(Prompt, boolean) -> ask(Prompt, number) -> ask_convert(Prompt, fun get_integer/1, number, none); ask(Prompt, string) -> - ask_convert(Prompt, fun get_integer/1, string, none). + ask_convert(Prompt, fun get_string/1, string, none). -%% @doc Asks the user to respond to the prompt. Trys to return the +%% @doc Asks the user to respond to the prompt. Tries to return the %% value in the format specified by 'Type'. -spec ask_default(prompt(), type(), supported()) -> supported(). ask_default(Prompt, boolean, Default) -> @@ -100,8 +104,11 @@ ask_default(Prompt, string, Default) -> %% between min and max. -spec ask(prompt(), number(), number()) -> number(). ask(Prompt, Min, Max) - when is_list(Prompt), is_number(Min), is_number(Max) -> - Res = ask(Prompt, fun get_integer/1, none), + when erlang:is_list(Prompt), + erlang:is_number(Min), + erlang:is_number(Max), + Min =< Max -> + Res = ask_convert(Prompt, fun get_integer/1, number, none), case (Res >= Min andalso Res =< Max) of true -> Res; @@ -115,15 +122,17 @@ ask(Prompt, Min, Max) %% ============================================================================ %% @doc Actually does the work of asking, checking result and %% translating result into the requested format. --spec ask_convert(prompt(), fun(), type(), supported()) -> supported(). +-spec ask_convert(prompt(), fun((any()) -> any()), type(), supported() | none) -> supported(). ask_convert(Prompt, TransFun, Type, Default) -> - NewPrompt = Prompt ++ case Default of - none -> - []; - Default -> - " (" ++ sin_utils:term_to_list(Default) ++ ")" - end ++ "> ", - Data = string:strip(string:strip(io:get_line(NewPrompt)), both, $\n), + NewPrompt = + erlang:binary_to_list(erlang:iolist_to_binary([Prompt, + case Default of + none -> + []; + Default -> + [" (", io_lib:format("~p", [Default]) , ")"] + end, "> "])), + Data = string:trim(string:trim(io:get_line(NewPrompt)), both, [$\n]), Ret = TransFun(Data), case Ret of no_data -> @@ -141,7 +150,7 @@ ask_convert(Prompt, TransFun, Type, Default) -> Ret end. -%% @doc Trys to translate the result into a boolean +%% @doc Tries to translate the result into a boolean -spec get_boolean(string()) -> boolean(). get_boolean([]) -> no_data; @@ -168,7 +177,7 @@ get_boolean([$N | _]) -> get_boolean(_) -> no_clue. -%% @doc Trys to translate the result into an integer +%% @doc Tries to translate the result into an integer -spec get_integer(string()) -> integer(). get_integer([]) -> no_data; @@ -192,21 +201,3 @@ get_string(String) -> false -> no_clue end. - -%%%==================================================================== -%%% tests -%%%==================================================================== -general_test_() -> - [?_test(42 == get_integer("42")), - ?_test(500211 == get_integer("500211")), - ?_test(1234567890 == get_integer("1234567890")), - ?_test(12345678901234567890 == get_integer("12345678901234567890")), - ?_test(true == get_boolean("true")), - ?_test(false == get_boolean("false")), - ?_test(true == get_boolean("Ok")), - ?_test(true == get_boolean("ok")), - ?_test(true == get_boolean("Y")), - ?_test(true == get_boolean("y")), - ?_test(false == get_boolean("False")), - ?_test(false == get_boolean("No")), - ?_test(false == get_boolean("no"))]. diff --git a/src/ec_vsn.erl b/src/ec_vsn.erl new file mode 100644 index 0000000..e407b9f --- /dev/null +++ b/src/ec_vsn.erl @@ -0,0 +1,51 @@ +%%% vi:ts=4 sw=4 et +%%%------------------------------------------------------------------- +%%% @author Eric Merritt +%%% @copyright 2014 Erlware, LLC. +%%% @doc +%%% Provides a signature to manage returning semver formatted versions +%%% from various version control repositories. +%%% +%%% This interface is a member of the Erlware Commons Library. +%%% @end +%%%------------------------------------------------------------------- +-module(ec_vsn). + +%% API +-export([new/1, + vsn/1]). + +-export_type([t/0]). + +%%%=================================================================== +%%% Types +%%%=================================================================== + +-record(t, {callback, data}). + +%% This should be opaque, but that kills dialyzer so for now we export it +%% however you should not rely on the internal representation here +-type t() :: #t{}. + +-callback new() -> any(). +-callback vsn(any()) -> {ok, string()} | {error, Reason::any()}. + +%%%=================================================================== +%%% API +%%%=================================================================== + +%% @doc create a new dictionary object from the specified module. The +%% module should implement the dictionary behaviour. +%% +%% @param ModuleName The module name. +-spec new(module()) -> t(). +new(ModuleName) when erlang:is_atom(ModuleName) -> + #t{callback = ModuleName, data = ModuleName:new()}. + +%% @doc Return the semver or an error depending on what is possible +%% with this implementation in this directory. +%% +%% @param The dictionary object +-spec vsn(t()) -> {ok, string()} | {error, Reason::any()}. +vsn(#t{callback = Mod, data = Data}) -> + Mod:vsn(Data). diff --git a/src/erlware_commons.app.src b/src/erlware_commons.app.src new file mode 100644 index 0000000..7709d81 --- /dev/null +++ b/src/erlware_commons.app.src @@ -0,0 +1,11 @@ +{application,erlware_commons, + [{description,"Additional standard library for Erlang"}, + {vsn,"git"}, + {modules,[]}, + {registered,[]}, + {applications,[kernel,stdlib,cf]}, + {maintainers,["Eric Merritt","Tristan Sloughter", + "Jordan Wilberding","Martin Logan"]}, + {licenses,["Apache", "MIT"]}, + {links,[{"Github", + "https://github.com/erlware/erlware_commons"}]}]}. diff --git a/test/ec_cmd_log_tests.erl b/test/ec_cmd_log_tests.erl new file mode 100644 index 0000000..f1d1181 --- /dev/null +++ b/test/ec_cmd_log_tests.erl @@ -0,0 +1,39 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_cmd_log_tests). + +-include("include/ec_cmd_log.hrl"). +-include("src/ec_cmd_log.hrl"). +-include_lib("eunit/include/eunit.hrl"). + +should_test() -> + ErrorLogState = ec_cmd_log:new(error), + ?assertMatch(true, ec_cmd_log:should(ErrorLogState, ?EC_ERROR)), + ?assertMatch(true, not ec_cmd_log:should(ErrorLogState, ?EC_INFO)), + ?assertMatch(true, not ec_cmd_log:should(ErrorLogState, ?EC_DEBUG)), + ?assertEqual(?EC_ERROR, ec_cmd_log:log_level(ErrorLogState)), + ?assertEqual(error, ec_cmd_log:atom_log_level(ErrorLogState)), + + InfoLogState = ec_cmd_log:new(info), + ?assertMatch(true, ec_cmd_log:should(InfoLogState, ?EC_ERROR)), + ?assertMatch(true, ec_cmd_log:should(InfoLogState, ?EC_INFO)), + ?assertMatch(true, not ec_cmd_log:should(InfoLogState, ?EC_DEBUG)), + ?assertEqual(?EC_INFO, ec_cmd_log:log_level(InfoLogState)), + ?assertEqual(info, ec_cmd_log:atom_log_level(InfoLogState)), + + DebugLogState = ec_cmd_log:new(debug), + ?assertMatch(true, ec_cmd_log:should(DebugLogState, ?EC_ERROR)), + ?assertMatch(true, ec_cmd_log:should(DebugLogState, ?EC_INFO)), + ?assertMatch(true, ec_cmd_log:should(DebugLogState, ?EC_DEBUG)), + ?assertEqual(?EC_DEBUG, ec_cmd_log:log_level(DebugLogState)), + ?assertEqual(debug, ec_cmd_log:atom_log_level(DebugLogState)). + + +no_color_test() -> + LogState = ec_cmd_log:new(debug, command_line, none), + ?assertEqual("test", + ec_cmd_log:colorize(LogState, ?RED, true, "test")). + +color_test() -> + LogState = ec_cmd_log:new(debug, command_line, high), + ?assertEqual("\e[1;31m===> test\e[0m", + ec_cmd_log:colorize(LogState, ?RED, true, "test")). diff --git a/test/ec_cnv_tests.erl b/test/ec_cnv_tests.erl new file mode 100644 index 0000000..6bbad6e --- /dev/null +++ b/test/ec_cnv_tests.erl @@ -0,0 +1,28 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_cnv_tests). + +-include_lib("eunit/include/eunit.hrl"). + +to_integer_test() -> + ?assertError(badarg, ec_cnv:to_integer(1.5, strict)). + +to_float_test() -> + ?assertError(badarg, ec_cnv:to_float(10, strict)). + +to_atom_test() -> + ?assertMatch(true, ec_cnv:to_atom("true")), + ?assertMatch(true, ec_cnv:to_atom(<<"true">>)), + ?assertMatch(false, ec_cnv:to_atom(<<"false">>)), + ?assertMatch(false, ec_cnv:to_atom(false)), + ?assertError(badarg, ec_cnv:to_atom("hello_foo_bar_baz")), + + S = erlang:list_to_atom("1"), + ?assertMatch(S, ec_cnv:to_atom(1)). + +to_boolean_test()-> + ?assertMatch(true, ec_cnv:to_boolean(<<"true">>)), + ?assertMatch(true, ec_cnv:to_boolean("true")), + ?assertMatch(true, ec_cnv:to_boolean(true)), + ?assertMatch(false, ec_cnv:to_boolean(<<"false">>)), + ?assertMatch(false, ec_cnv:to_boolean("false")), + ?assertMatch(false, ec_cnv:to_boolean(false)). diff --git a/test/ec_file_tests.erl b/test/ec_file_tests.erl new file mode 100644 index 0000000..885f3dc --- /dev/null +++ b/test/ec_file_tests.erl @@ -0,0 +1,84 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_file_tests). + +-include_lib("eunit/include/eunit.hrl"). + +setup_test() -> + Dir = ec_file:insecure_mkdtemp(), + ec_file:mkdir_path(Dir), + ?assertMatch(false, ec_file:is_symlink(Dir)), + ?assertMatch(true, filelib:is_dir(Dir)). + +md5sum_test() -> + ?assertMatch("cfcd208495d565ef66e7dff9f98764da", ec_file:md5sum("0")). + +sha1sum_test() -> + ?assertMatch("b6589fc6ab0dc82cf12099d1c2d40ab994e8410c", ec_file:sha1sum("0")). + +file_test() -> + Dir = ec_file:insecure_mkdtemp(), + TermFile = filename:join(Dir, "ec_file/dir/file.term"), + TermFileCopy = filename:join(Dir, "ec_file/dircopy/file.term"), + filelib:ensure_dir(TermFile), + filelib:ensure_dir(TermFileCopy), + ec_file:write_term(TermFile, "term"), + ?assertMatch({ok, <<"\"term\". ">>}, ec_file:read(TermFile)), + ec_file:copy(filename:dirname(TermFile), + filename:dirname(TermFileCopy), + [recursive]). + +teardown_test() -> + Dir = ec_file:insecure_mkdtemp(), + ec_file:remove(Dir, [recursive]), + ?assertMatch(false, filelib:is_dir(Dir)). + +setup_base_and_target() -> + BaseDir = ec_file:insecure_mkdtemp(), + DummyContents = <<"This should be deleted">>, + SourceDir = filename:join([BaseDir, "source"]), + ok = file:make_dir(SourceDir), + Name1 = filename:join([SourceDir, "fileone"]), + Name2 = filename:join([SourceDir, "filetwo"]), + Name3 = filename:join([SourceDir, "filethree"]), + NoName = filename:join([SourceDir, "noname"]), + + ok = file:write_file(Name1, DummyContents), + ok = file:write_file(Name2, DummyContents), + ok = file:write_file(Name3, DummyContents), + ok = file:write_file(NoName, DummyContents), + {BaseDir, SourceDir, {Name1, Name2, Name3, NoName}}. + +exists_test() -> + BaseDir = ec_file:insecure_mkdtemp(), + SourceDir = filename:join([BaseDir, "source1"]), + NoName = filename:join([SourceDir, "noname"]), + ok = file:make_dir(SourceDir), + Name1 = filename:join([SourceDir, "fileone"]), + ok = file:write_file(Name1, <<"Testn">>), + ?assertMatch(true, ec_file:exists(Name1)), + ?assertMatch(false, ec_file:exists(NoName)). + +real_path_test() -> + BaseDir = "foo", + Dir = filename:absname(filename:join(BaseDir, "source1")), + LinkDir = filename:join([BaseDir, "link"]), + ok = ec_file:mkdir_p(Dir), + file:make_symlink(Dir, LinkDir), + ?assertEqual(Dir, ec_file:real_dir_path(LinkDir)), + ?assertEqual(directory, ec_file:type(Dir)), + ?assertEqual(symlink, ec_file:type(LinkDir)), + TermFile = filename:join(BaseDir, "test_file"), + ok = ec_file:write_term(TermFile, foo), + ?assertEqual(file, ec_file:type(TermFile)), + ?assertEqual(true, ec_file:is_symlink(LinkDir)), + ?assertEqual(false, ec_file:is_symlink(Dir)). + +find_test() -> + %% Create a directory in /tmp for the test. Clean everything afterwards + {BaseDir, _SourceDir, {Name1, Name2, Name3, _NoName}} = setup_base_and_target(), + Result = ec_file:find(BaseDir, "file[a-z]+\$"), + ?assertMatch(3, erlang:length(Result)), + ?assertEqual(true, lists:member(Name1, Result)), + ?assertEqual(true, lists:member(Name2, Result)), + ?assertEqual(true, lists:member(Name3, Result)), + ec_file:remove(BaseDir, [recursive]). diff --git a/test/ec_gb_trees_tests.erl b/test/ec_gb_trees_tests.erl new file mode 100644 index 0000000..2c0ee12 --- /dev/null +++ b/test/ec_gb_trees_tests.erl @@ -0,0 +1,67 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_gb_trees_tests). +-include_lib("eunit/include/eunit.hrl"). + +%% For me unit testing initially is about covering the obvious case. A +%% check to make sure that what you expect the tested functionality to +%% do, it actually does. As time goes on and people detect bugs you +%% add tests for those specific problems to the unit test suit. +%% +%% However, when getting started you can only test your basic +%% expectations. So here are the expectations I have for the add +%% functionality. +%% +%% 1) I can put arbitrary terms into the dictionary as keys +%% 2) I can put arbitrary terms into the dictionary as values +%% 3) When I put a value in the dictionary by a key, I can retrieve +%% that same value +%% 4) When I put a different value in the dictionary by key it does +%% not change other key value pairs. +%% 5) When I update a value the new value in available by the new key +%% 6) When a value does not exist a not found exception is created + +add_test() -> + Dict0 = ec_dictionary:new(ec_gb_trees), + + Key1 = foo, + Key2 = [1, 3], + Key3 = {"super"}, + Key4 = <<"fabulous">>, + Key5 = {"Sona", 2, <<"Zuper">>}, + + Value1 = Key5, + Value2 = Key4, + Value3 = Key2, + Value4 = Key3, + Value5 = Key1, + + Dict01 = ec_dictionary:add(Key1, Value1, Dict0), + Dict02 = ec_dictionary:add(Key3, Value3, + ec_dictionary:add(Key2, Value2, + Dict01)), + Dict1 = + ec_dictionary:add(Key5, Value5, + ec_dictionary:add(Key4, Value4, + Dict02)), + + ?assertMatch(Value1, ec_dictionary:get(Key1, Dict1)), + ?assertMatch(Value2, ec_dictionary:get(Key2, Dict1)), + ?assertMatch(Value3, ec_dictionary:get(Key3, Dict1)), + ?assertMatch(Value4, ec_dictionary:get(Key4, Dict1)), + ?assertMatch(Value5, ec_dictionary:get(Key5, Dict1)), + + + Dict2 = ec_dictionary:add(Key3, Value5, + ec_dictionary:add(Key2, Value4, Dict1)), + + + ?assertMatch(Value1, ec_dictionary:get(Key1, Dict2)), + ?assertMatch(Value4, ec_dictionary:get(Key2, Dict2)), + ?assertMatch(Value5, ec_dictionary:get(Key3, Dict2)), + ?assertMatch(Value4, ec_dictionary:get(Key4, Dict2)), + ?assertMatch(Value5, ec_dictionary:get(Key5, Dict2)), + + + ?assertThrow(not_found, ec_dictionary:get(should_blow_up, Dict2)), + ?assertThrow(not_found, ec_dictionary:get("This should blow up too", + Dict2)). diff --git a/test/ec_git_vsn_tests.erl b/test/ec_git_vsn_tests.erl new file mode 100644 index 0000000..0d2efe1 --- /dev/null +++ b/test/ec_git_vsn_tests.erl @@ -0,0 +1,13 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_git_vsn_tests). + +-include_lib("eunit/include/eunit.hrl"). + +parse_tags_test() -> + ?assertEqual({undefined, ""}, ec_git_vsn:parse_tags("a.b.c")). + +get_patch_count_test() -> + ?assertEqual(0, ec_git_vsn:get_patch_count("a.b.c")). + +collect_default_refcount_test() -> + ?assertMatch({"", _, _}, ec_git_vsn:collect_default_refcount("a.b.c")). diff --git a/test/ec_lists_tests.erl b/test/ec_lists_tests.erl new file mode 100644 index 0000000..f6f4025 --- /dev/null +++ b/test/ec_lists_tests.erl @@ -0,0 +1,172 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_lists_tests). + +-include_lib("eunit/include/eunit.hrl"). + +find1_test() -> + TestData = [1, 2, 3, 4, 5, 6], + Result = ec_lists:find(fun(5) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch({ok, 5}, Result), + + Result2 = ec_lists:find(fun(37) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch(error, Result2). + +find2_test() -> + TestData = ["one", "two", "three", "four", "five", "six"], + Result = ec_lists:find(fun("five") -> + true; + (_) -> + false + end, + TestData), + ?assertMatch({ok, "five"}, Result), + + Result2 = ec_lists:find(fun(super_duper) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch(error, Result2). + +find3_test() -> + TestData = [{"one", 1}, {"two", 2}, {"three", 3}, {"four", 5}, {"five", 5}, + {"six", 6}], + Result = ec_lists:find(fun({"one", 1}) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch({ok, {"one", 1}}, Result), + + Result2 = ec_lists:find(fun([fo, bar, baz]) -> + true; + ({"onehundred", 100}) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch(error, Result2). + +fetch1_test() -> + TestData = [1, 2, 3, 4, 5, 6], + Result = ec_lists:fetch(fun(5) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch(5, Result), + + ?assertThrow(not_found, + ec_lists:fetch(fun(37) -> + true; + (_) -> + false + end, + TestData)). + +fetch2_test() -> + TestData = ["one", "two", "three", "four", "five", "six"], + Result = ec_lists:fetch(fun("five") -> + true; + (_) -> + false + end, + TestData), + ?assertMatch("five", Result), + + ?assertThrow(not_found, + ec_lists:fetch(fun(super_duper) -> + true; + (_) -> + false + end, + TestData)). + +fetch3_test() -> + TestData = [{"one", 1}, {"two", 2}, {"three", 3}, {"four", 5}, {"five", 5}, + {"six", 6}], + Result = ec_lists:fetch(fun({"one", 1}) -> + true; + (_) -> + false + end, + TestData), + ?assertMatch({"one", 1}, Result), + + ?assertThrow(not_found, + ec_lists:fetch(fun([fo, bar, baz]) -> + true; + ({"onehundred", 100}) -> + true; + (_) -> + false + end, + TestData)). + +search1_test() -> + TestData = [1, 2, 3, 4, 5, 6], + Result = ec_lists:search(fun(5) -> + {ok, 5}; + (_) -> + not_found + end, + TestData), + ?assertMatch({ok, 5, 5}, Result), + + Result2 = ec_lists:search(fun(37) -> + {ok, 37}; + (_) -> + not_found + end, + TestData), + ?assertMatch(not_found, Result2). + +search2_test() -> + TestData = [1, 2, 3, 4, 5, 6], + Result = ec_lists:search(fun(1) -> + {ok, 10}; + (_) -> + not_found + end, + TestData), + ?assertMatch({ok, 10, 1}, Result), + + Result2 = ec_lists:search(fun(6) -> + {ok, 37}; + (_) -> + not_found + end, + TestData), + ?assertMatch({ok, 37, 6}, Result2). + +search3_test() -> + TestData = [1, 2, 3, 4, 5, 6], + Result = ec_lists:search(fun(10) -> + {ok, 10}; + (_) -> + not_found + end, + TestData), + ?assertMatch(not_found, Result), + + Result2 = ec_lists:search(fun(-1) -> + {ok, 37}; + (_) -> + not_found + end, + TestData), + ?assertMatch(not_found, Result2). diff --git a/test/ec_plists_tests.erl b/test/ec_plists_tests.erl new file mode 100644 index 0000000..3f945e9 --- /dev/null +++ b/test/ec_plists_tests.erl @@ -0,0 +1,84 @@ +%%% @copyright Erlware, LLC. +-module(ec_plists_tests). + +-include_lib("eunit/include/eunit.hrl"). + +%%%=================================================================== +%%% Tests +%%%=================================================================== + +map_good_test() -> + Results = ec_plists:map(fun(_) -> + ok + end, + lists:seq(1, 5)), + ?assertMatch([ok, ok, ok, ok, ok], + Results). + +ftmap_good_test() -> + Results = ec_plists:ftmap(fun(_) -> + ok + end, + lists:seq(1, 3)), + ?assertMatch([{value, ok}, {value, ok}, {value, ok}], + Results). + +filter_good_test() -> + Results = ec_plists:filter(fun(X) -> + X == show + end, + [show, show, remove]), + ?assertMatch([show, show], + Results). + +map_timeout_test() -> + ?assertExit(timeout, + ec_plists:map(fun(T) -> + timer:sleep(T), + T + end, + [1, 100], {timeout, 10})). + +ftmap_timeout_test() -> + ?assertExit(timeout, + ec_plists:ftmap(fun(X) -> + timer:sleep(X), + true + end, + [100, 1], {timeout, 10})). + +filter_timeout_test() -> + ?assertExit(timeout, + ec_plists:filter(fun(T) -> + timer:sleep(T), + T == 1 + end, + [1, 100], {timeout, 10})). + +map_bad_test() -> + ?assertExit({{nocatch,test_exception}, _}, + ec_plists:map(fun(_) -> + erlang:throw(test_exception) + end, + lists:seq(1, 5))). + + +ftmap_bad_test() -> + Results = + ec_plists:ftmap(fun(2) -> + erlang:throw(test_exception); + (N) -> + N + end, + lists:seq(1, 5)), + ?assertMatch([{value, 1}, {error,{throw,test_exception}}, {value, 3}, + {value, 4}, {value, 5}] , Results). + +external_down_message_test() -> + erlang:spawn_monitor(fun() -> erlang:throw(fail) end), + Results = ec_plists:map(fun(_) -> + ok + end, + lists:seq(1, 5)), + ?assertMatch([ok, ok, ok, ok, ok], + Results). diff --git a/test/ec_semver_tests.erl b/test/ec_semver_tests.erl new file mode 100644 index 0000000..0d3a18a --- /dev/null +++ b/test/ec_semver_tests.erl @@ -0,0 +1,447 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_semver_tests). + +-include_lib("eunit/include/eunit.hrl"). + +eql_test() -> + ?assertMatch(true, ec_semver:eql("1.0.0-alpha", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:eql("v1.0.0-alpha", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:eql("1", + "1.0.0")), + ?assertMatch(true, ec_semver:eql("v1", + "v1.0.0")), + ?assertMatch(true, ec_semver:eql("1.0", + "1.0.0")), + ?assertMatch(true, ec_semver:eql("1.0.0", + "1")), + ?assertMatch(true, ec_semver:eql("1.0.0.0", + "1")), + ?assertMatch(true, ec_semver:eql("1.0+alpha.1", + "1.0.0+alpha.1")), + ?assertMatch(true, ec_semver:eql("1.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1")), + ?assertMatch(true, ec_semver:eql("1.0-alpha.1+build.1", + "1.0.0.0-alpha.1+build.1")), + ?assertMatch(true, ec_semver:eql("1.0-alpha.1+build.1", + "v1.0.0.0-alpha.1+build.1")), + ?assertMatch(true, ec_semver:eql("1.0-pre-alpha.1", + "1.0.0-pre-alpha.1")), + ?assertMatch(true, ec_semver:eql("aa", "aa")), + ?assertMatch(true, ec_semver:eql("AA.BB", "AA.BB")), + ?assertMatch(true, ec_semver:eql("BBB-super", "BBB-super")), + ?assertMatch(true, not ec_semver:eql("1.0.0", + "1.0.1")), + ?assertMatch(true, not ec_semver:eql("1.0.0-alpha", + "1.0.1+alpha")), + ?assertMatch(true, not ec_semver:eql("1.0.0+build.1", + "1.0.1+build.2")), + ?assertMatch(true, not ec_semver:eql("1.0.0.0+build.1", + "1.0.0.1+build.2")), + ?assertMatch(true, not ec_semver:eql("FFF", "BBB")), + ?assertMatch(true, not ec_semver:eql("1", "1BBBB")). + +gt_test() -> + ?assertMatch(true, ec_semver:gt("1.0.0-alpha.1", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:gt("1.0.0.1-alpha.1", + "1.0.0.1-alpha")), + ?assertMatch(true, ec_semver:gt("1.0.0.4-alpha.1", + "1.0.0.2-alpha")), + ?assertMatch(true, ec_semver:gt("1.0.0.0-alpha.1", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:gt("1.0.0-beta.2", + "1.0.0-alpha.1")), + ?assertMatch(true, ec_semver:gt("1.0.0-beta.11", + "1.0.0-beta.2")), + ?assertMatch(true, ec_semver:gt("1.0.0-pre-alpha.14", + "1.0.0-pre-alpha.3")), + ?assertMatch(true, ec_semver:gt("1.0.0-beta.11", + "1.0.0.0-beta.2")), + ?assertMatch(true, ec_semver:gt("1.0.0-rc.1", "1.0.0-beta.11")), + ?assertMatch(true, ec_semver:gt("1.0.0-rc.1+build.1", "1.0.0-rc.1")), + ?assertMatch(true, ec_semver:gt("1.0.0", "1.0.0-rc.1+build.1")), + ?assertMatch(true, ec_semver:gt("1.0.0+0.3.7", "1.0.0")), + ?assertMatch(true, ec_semver:gt("1.3.7+build", "1.0.0+0.3.7")), + ?assertMatch(true, ec_semver:gt("1.3.7+build.2.b8f12d7", + "1.3.7+build")), + ?assertMatch(true, ec_semver:gt("1.3.7+build.2.b8f12d7", + "1.3.7.0+build")), + ?assertMatch(true, ec_semver:gt("1.3.7+build.11.e0f985a", + "1.3.7+build.2.b8f12d7")), + ?assertMatch(true, ec_semver:gt("aa.cc", + "aa.bb")), + ?assertMatch(true, not ec_semver:gt("1.0.0-alpha", + "1.0.0-alpha.1")), + ?assertMatch(true, not ec_semver:gt("1.0.0-alpha", + "1.0.0.0-alpha.1")), + ?assertMatch(true, not ec_semver:gt("1.0.0-alpha.1", + "1.0.0-beta.2")), + ?assertMatch(true, not ec_semver:gt("1.0.0-beta.2", + "1.0.0-beta.11")), + ?assertMatch(true, not ec_semver:gt("1.0.0-beta.11", + "1.0.0-rc.1")), + ?assertMatch(true, not ec_semver:gt("1.0.0-pre-alpha.3", + "1.0.0-pre-alpha.14")), + ?assertMatch(true, not ec_semver:gt("1.0.0-rc.1", + "1.0.0-rc.1+build.1")), + ?assertMatch(true, not ec_semver:gt("1.0.0-rc.1+build.1", + "1.0.0")), + ?assertMatch(true, not ec_semver:gt("1.0.0", + "1.0.0+0.3.7")), + ?assertMatch(true, not ec_semver:gt("1.0.0+0.3.7", + "1.3.7+build")), + ?assertMatch(true, not ec_semver:gt("1.3.7+build", + "1.3.7+build.2.b8f12d7")), + ?assertMatch(true, not ec_semver:gt("1.3.7+build.2.b8f12d7", + "1.3.7+build.11.e0f985a")), + ?assertMatch(true, not ec_semver:gt("1.0.0-alpha", + "1.0.0-alpha")), + ?assertMatch(true, not ec_semver:gt("1", + "1.0.0")), + ?assertMatch(true, not ec_semver:gt("aa.bb", + "aa.bb")), + ?assertMatch(true, not ec_semver:gt("aa.cc", + "aa.dd")), + ?assertMatch(true, not ec_semver:gt("1.0", + "1.0.0")), + ?assertMatch(true, not ec_semver:gt("1.0.0", + "1")), + ?assertMatch(true, not ec_semver:gt("1.0+alpha.1", + "1.0.0+alpha.1")), + ?assertMatch(true, not ec_semver:gt("1.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1")). + +lt_test() -> + ?assertMatch(true, ec_semver:lt("1.0.0-alpha", + "1.0.0-alpha.1")), + ?assertMatch(true, ec_semver:lt("1.0.0-alpha", + "1.0.0.0-alpha.1")), + ?assertMatch(true, ec_semver:lt("1.0.0-alpha.1", + "1.0.0-beta.2")), + ?assertMatch(true, ec_semver:lt("1.0.0-beta.2", + "1.0.0-beta.11")), + ?assertMatch(true, ec_semver:lt("1.0.0-pre-alpha.3", + "1.0.0-pre-alpha.14")), + ?assertMatch(true, ec_semver:lt("1.0.0-beta.11", + "1.0.0-rc.1")), + ?assertMatch(true, ec_semver:lt("1.0.0.1-beta.11", + "1.0.0.1-rc.1")), + ?assertMatch(true, ec_semver:lt("1.0.0-rc.1", + "1.0.0-rc.1+build.1")), + ?assertMatch(true, ec_semver:lt("1.0.0-rc.1+build.1", + "1.0.0")), + ?assertMatch(true, ec_semver:lt("1.0.0", + "1.0.0+0.3.7")), + ?assertMatch(true, ec_semver:lt("1.0.0+0.3.7", + "1.3.7+build")), + ?assertMatch(true, ec_semver:lt("1.3.7+build", + "1.3.7+build.2.b8f12d7")), + ?assertMatch(true, ec_semver:lt("1.3.7+build.2.b8f12d7", + "1.3.7+build.11.e0f985a")), + ?assertMatch(true, not ec_semver:lt("1.0.0-alpha", + "1.0.0-alpha")), + ?assertMatch(true, not ec_semver:lt("1", + "1.0.0")), + ?assertMatch(true, ec_semver:lt("1", + "1.0.0.1")), + ?assertMatch(true, ec_semver:lt("AA.DD", + "AA.EE")), + ?assertMatch(true, not ec_semver:lt("1.0", + "1.0.0")), + ?assertMatch(true, not ec_semver:lt("1.0.0.0", + "1")), + ?assertMatch(true, not ec_semver:lt("1.0+alpha.1", + "1.0.0+alpha.1")), + ?assertMatch(true, not ec_semver:lt("AA.DD", "AA.CC")), + ?assertMatch(true, not ec_semver:lt("1.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1")), + ?assertMatch(true, not ec_semver:lt("1.0.0-alpha.1", + "1.0.0-alpha")), + ?assertMatch(true, not ec_semver:lt("1.0.0-beta.2", + "1.0.0-alpha.1")), + ?assertMatch(true, not ec_semver:lt("1.0.0-beta.11", + "1.0.0-beta.2")), + ?assertMatch(true, not ec_semver:lt("1.0.0-pre-alpha.14", + "1.0.0-pre-alpha.3")), + ?assertMatch(true, not ec_semver:lt("1.0.0-rc.1", "1.0.0-beta.11")), + ?assertMatch(true, not ec_semver:lt("1.0.0-rc.1+build.1", "1.0.0-rc.1")), + ?assertMatch(true, not ec_semver:lt("1.0.0", "1.0.0-rc.1+build.1")), + ?assertMatch(true, not ec_semver:lt("1.0.0+0.3.7", "1.0.0")), + ?assertMatch(true, not ec_semver:lt("1.3.7+build", "1.0.0+0.3.7")), + ?assertMatch(true, not ec_semver:lt("1.3.7+build.2.b8f12d7", + "1.3.7+build")), + ?assertMatch(true, not ec_semver:lt("1.3.7+build.11.e0f985a", + "1.3.7+build.2.b8f12d7")). + +gte_test() -> + ?assertMatch(true, ec_semver:gte("1.0.0-alpha", + "1.0.0-alpha")), + + ?assertMatch(true, ec_semver:gte("1", + "1.0.0")), + + ?assertMatch(true, ec_semver:gte("1.0", + "1.0.0")), + + ?assertMatch(true, ec_semver:gte("1.0.0", + "1")), + + ?assertMatch(true, ec_semver:gte("1.0.0.0", + "1")), + + ?assertMatch(true, ec_semver:gte("1.0+alpha.1", + "1.0.0+alpha.1")), + + ?assertMatch(true, ec_semver:gte("1.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1")), + + ?assertMatch(true, ec_semver:gte("1.0.0-alpha.1+build.1", + "1.0.0.0-alpha.1+build.1")), + ?assertMatch(true, ec_semver:gte("1.0.0-alpha.1", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:gte("1.0.0-pre-alpha.2", + "1.0.0-pre-alpha")), + ?assertMatch(true, ec_semver:gte("1.0.0-beta.2", + "1.0.0-alpha.1")), + ?assertMatch(true, ec_semver:gte("1.0.0-beta.11", + "1.0.0-beta.2")), + ?assertMatch(true, ec_semver:gte("aa.bb", "aa.bb")), + ?assertMatch(true, ec_semver:gte("dd", "aa")), + ?assertMatch(true, ec_semver:gte("1.0.0-rc.1", "1.0.0-beta.11")), + ?assertMatch(true, ec_semver:gte("1.0.0-rc.1+build.1", "1.0.0-rc.1")), + ?assertMatch(true, ec_semver:gte("1.0.0", "1.0.0-rc.1+build.1")), + ?assertMatch(true, ec_semver:gte("1.0.0+0.3.7", "1.0.0")), + ?assertMatch(true, ec_semver:gte("1.3.7+build", "1.0.0+0.3.7")), + ?assertMatch(true, ec_semver:gte("1.3.7+build.2.b8f12d7", + "1.3.7+build")), + ?assertMatch(true, ec_semver:gte("1.3.7+build.11.e0f985a", + "1.3.7+build.2.b8f12d7")), + ?assertMatch(true, not ec_semver:gte("1.0.0-alpha", + "1.0.0-alpha.1")), + ?assertMatch(true, not ec_semver:gte("1.0.0-pre-alpha", + "1.0.0-pre-alpha.1")), + ?assertMatch(true, not ec_semver:gte("CC", "DD")), + ?assertMatch(true, not ec_semver:gte("1.0.0-alpha.1", + "1.0.0-beta.2")), + ?assertMatch(true, not ec_semver:gte("1.0.0-beta.2", + "1.0.0-beta.11")), + ?assertMatch(true, not ec_semver:gte("1.0.0-beta.11", + "1.0.0-rc.1")), + ?assertMatch(true, not ec_semver:gte("1.0.0-rc.1", + "1.0.0-rc.1+build.1")), + ?assertMatch(true, not ec_semver:gte("1.0.0-rc.1+build.1", + "1.0.0")), + ?assertMatch(true, not ec_semver:gte("1.0.0", + "1.0.0+0.3.7")), + ?assertMatch(true, not ec_semver:gte("1.0.0+0.3.7", + "1.3.7+build")), + ?assertMatch(true, not ec_semver:gte("1.0.0", + "1.0.0+build.1")), + ?assertMatch(true, not ec_semver:gte("1.3.7+build", + "1.3.7+build.2.b8f12d7")), + ?assertMatch(true, not ec_semver:gte("1.3.7+build.2.b8f12d7", + "1.3.7+build.11.e0f985a")). +lte_test() -> + ?assertMatch(true, ec_semver:lte("1.0.0-alpha", + "1.0.0-alpha.1")), + ?assertMatch(true, ec_semver:lte("1.0.0-alpha.1", + "1.0.0-beta.2")), + ?assertMatch(true, ec_semver:lte("1.0.0-beta.2", + "1.0.0-beta.11")), + ?assertMatch(true, ec_semver:lte("1.0.0-pre-alpha.2", + "1.0.0-pre-alpha.11")), + ?assertMatch(true, ec_semver:lte("1.0.0-beta.11", + "1.0.0-rc.1")), + ?assertMatch(true, ec_semver:lte("1.0.0-rc.1", + "1.0.0-rc.1+build.1")), + ?assertMatch(true, ec_semver:lte("1.0.0-rc.1+build.1", + "1.0.0")), + ?assertMatch(true, ec_semver:lte("1.0.0", + "1.0.0+0.3.7")), + ?assertMatch(true, ec_semver:lte("1.0.0+0.3.7", + "1.3.7+build")), + ?assertMatch(true, ec_semver:lte("1.3.7+build", + "1.3.7+build.2.b8f12d7")), + ?assertMatch(true, ec_semver:lte("1.3.7+build.2.b8f12d7", + "1.3.7+build.11.e0f985a")), + ?assertMatch(true, ec_semver:lte("1.0.0-alpha", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:lte("1", + "1.0.0")), + ?assertMatch(true, ec_semver:lte("1.0", + "1.0.0")), + ?assertMatch(true, ec_semver:lte("1.0.0", + "1")), + ?assertMatch(true, ec_semver:lte("1.0+alpha.1", + "1.0.0+alpha.1")), + ?assertMatch(true, ec_semver:lte("1.0.0.0+alpha.1", + "1.0.0+alpha.1")), + ?assertMatch(true, ec_semver:lte("1.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1")), + ?assertMatch(true, ec_semver:lte("aa","cc")), + ?assertMatch(true, ec_semver:lte("cc","cc")), + ?assertMatch(true, not ec_semver:lte("1.0.0-alpha.1", + "1.0.0-alpha")), + ?assertMatch(true, not ec_semver:lte("1.0.0-pre-alpha.2", + "1.0.0-pre-alpha")), + ?assertMatch(true, not ec_semver:lte("cc", "aa")), + ?assertMatch(true, not ec_semver:lte("1.0.0-beta.2", + "1.0.0-alpha.1")), + ?assertMatch(true, not ec_semver:lte("1.0.0-beta.11", + "1.0.0-beta.2")), + ?assertMatch(true, not ec_semver:lte("1.0.0-rc.1", "1.0.0-beta.11")), + ?assertMatch(true, not ec_semver:lte("1.0.0-rc.1+build.1", "1.0.0-rc.1")), + ?assertMatch(true, not ec_semver:lte("1.0.0", "1.0.0-rc.1+build.1")), + ?assertMatch(true, not ec_semver:lte("1.0.0+0.3.7", "1.0.0")), + ?assertMatch(true, not ec_semver:lte("1.3.7+build", "1.0.0+0.3.7")), + ?assertMatch(true, not ec_semver:lte("1.3.7+build.2.b8f12d7", + "1.3.7+build")), + ?assertMatch(true, not ec_semver:lte("1.3.7+build.11.e0f985a", + "1.3.7+build.2.b8f12d7")). + +between_test() -> + ?assertMatch(true, ec_semver:between("1.0.0-alpha", + "1.0.0-alpha.3", + "1.0.0-alpha.2")), + ?assertMatch(true, ec_semver:between("1.0.0-alpha.1", + "1.0.0-beta.2", + "1.0.0-alpha.25")), + ?assertMatch(true, ec_semver:between("1.0.0-beta.2", + "1.0.0-beta.11", + "1.0.0-beta.7")), + ?assertMatch(true, ec_semver:between("1.0.0-pre-alpha.2", + "1.0.0-pre-alpha.11", + "1.0.0-pre-alpha.7")), + ?assertMatch(true, ec_semver:between("1.0.0-beta.11", + "1.0.0-rc.3", + "1.0.0-rc.1")), + ?assertMatch(true, ec_semver:between("1.0.0-rc.1", + "1.0.0-rc.1+build.3", + "1.0.0-rc.1+build.1")), + + ?assertMatch(true, ec_semver:between("1.0.0.0-rc.1", + "1.0.0-rc.1+build.3", + "1.0.0-rc.1+build.1")), + ?assertMatch(true, ec_semver:between("1.0.0-rc.1+build.1", + "1.0.0", + "1.0.0-rc.33")), + ?assertMatch(true, ec_semver:between("1.0.0", + "1.0.0+0.3.7", + "1.0.0+0.2")), + ?assertMatch(true, ec_semver:between("1.0.0+0.3.7", + "1.3.7+build", + "1.2")), + ?assertMatch(true, ec_semver:between("1.3.7+build", + "1.3.7+build.2.b8f12d7", + "1.3.7+build.1")), + ?assertMatch(true, ec_semver:between("1.3.7+build.2.b8f12d7", + "1.3.7+build.11.e0f985a", + "1.3.7+build.10.a36faa")), + ?assertMatch(true, ec_semver:between("1.0.0-alpha", + "1.0.0-alpha", + "1.0.0-alpha")), + ?assertMatch(true, ec_semver:between("1", + "1.0.0", + "1.0.0")), + ?assertMatch(true, ec_semver:between("1.0", + "1.0.0", + "1.0.0")), + + ?assertMatch(true, ec_semver:between("1.0", + "1.0.0.0", + "1.0.0.0")), + ?assertMatch(true, ec_semver:between("1.0.0", + "1", + "1")), + ?assertMatch(true, ec_semver:between("1.0+alpha.1", + "1.0.0+alpha.1", + "1.0.0+alpha.1")), + ?assertMatch(true, ec_semver:between("1.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1", + "1.0.0-alpha.1+build.1")), + ?assertMatch(true, ec_semver:between("aaa", + "ddd", + "cc")), + ?assertMatch(true, not ec_semver:between("1.0.0-alpha.1", + "1.0.0-alpha.22", + "1.0.0")), + ?assertMatch(true, not ec_semver:between("1.0.0-pre-alpha.1", + "1.0.0-pre-alpha.22", + "1.0.0")), + ?assertMatch(true, not ec_semver:between("1.0.0", + "1.0.0-alpha.1", + "2.0")), + ?assertMatch(true, not ec_semver:between("1.0.0-beta.1", + "1.0.0-beta.11", + "1.0.0-alpha")), + ?assertMatch(true, not ec_semver:between("1.0.0-beta.11", "1.0.0-rc.1", + "1.0.0-rc.22")), + ?assertMatch(true, not ec_semver:between("aaa", "ddd", "zzz")). + +pes_test() -> + ?assertMatch(true, ec_semver:pes("1.0.0-rc.0", "1.0.0-rc.0")), + ?assertMatch(true, ec_semver:pes("1.0.0-rc.1", "1.0.0-rc.0")), + ?assertMatch(true, ec_semver:pes("1.0.0", "1.0.0-rc.0")), + ?assertMatch(false, ec_semver:pes("1.0.0-rc.0", "1.0.0-rc.1")), + ?assertMatch(true, ec_semver:pes("2.6.0", "2.6")), + ?assertMatch(true, ec_semver:pes("2.7", "2.6")), + ?assertMatch(true, ec_semver:pes("2.8", "2.6")), + ?assertMatch(true, ec_semver:pes("2.9", "2.6")), + ?assertMatch(true, ec_semver:pes("A.B", "A.A")), + ?assertMatch(true, not ec_semver:pes("3.0.0", "2.6")), + ?assertMatch(true, not ec_semver:pes("2.5", "2.6")), + ?assertMatch(true, ec_semver:pes("2.6.5", "2.6.5")), + ?assertMatch(true, ec_semver:pes("2.6.6", "2.6.5")), + ?assertMatch(true, ec_semver:pes("2.6.7", "2.6.5")), + ?assertMatch(true, ec_semver:pes("2.6.8", "2.6.5")), + ?assertMatch(true, ec_semver:pes("2.6.9", "2.6.5")), + ?assertMatch(true, ec_semver:pes("2.6.0.9", "2.6.0.5")), + ?assertMatch(true, not ec_semver:pes("2.7", "2.6.5")), + ?assertMatch(true, not ec_semver:pes("2.1.7", "2.1.6.5")), + ?assertMatch(true, not ec_semver:pes("A.A", "A.B")), + ?assertMatch(true, not ec_semver:pes("2.5", "2.6.5")). + +parse_test() -> + ?assertEqual({1, {[],[]}}, ec_semver:parse(<<"1">>)), + ?assertEqual({{1,2,34},{[],[]}}, ec_semver:parse(<<"1.2.34">>)), + ?assertEqual({<<"a">>, {[],[]}}, ec_semver:parse(<<"a">>)), + ?assertEqual({{<<"a">>,<<"b">>}, {[],[]}}, ec_semver:parse(<<"a.b">>)), + ?assertEqual({1, {[],[]}}, ec_semver:parse(<<"1">>)), + ?assertEqual({{1,2}, {[],[]}}, ec_semver:parse(<<"1.2">>)), + ?assertEqual({{1,2,2}, {[],[]}}, ec_semver:parse(<<"1.2.2">>)), + ?assertEqual({{1,99,2}, {[],[]}}, ec_semver:parse(<<"1.99.2">>)), + ?assertEqual({{1,99,2}, {[<<"alpha">>],[]}}, ec_semver:parse(<<"1.99.2-alpha">>)), + ?assertEqual({{1,99,2}, {[<<"alpha">>,1], []}}, ec_semver:parse(<<"1.99.2-alpha.1">>)), + ?assertEqual({{1,99,2}, {[<<"pre-alpha">>,1], []}}, ec_semver:parse(<<"1.99.2-pre-alpha.1">>)), + ?assertEqual({{1,99,2}, {[], [<<"build">>, 1, <<"a36">>]}}, + ec_semver:parse(<<"1.99.2+build.1.a36">>)), + ?assertEqual({{1,99,2,44}, {[], [<<"build">>, 1, <<"a36">>]}}, + ec_semver:parse(<<"1.99.2.44+build.1.a36">>)), + ?assertEqual({{1,99,2}, {[<<"alpha">>, 1], [<<"build">>, 1, <<"a36">>]}}, + ec_semver:parse("1.99.2-alpha.1+build.1.a36")), + ?assertEqual({{1,99,2}, {[<<"pre-alpha">>, 1], [<<"build">>, 1, <<"a36">>]}}, + ec_semver:parse("1.99.2-pre-alpha.1+build.1.a36")). + +version_format_test() -> + ?assertEqual(["1", [], []], ec_semver:format({1, {[],[]}})), + ?assertEqual(["1", ".", "2", ".", "34", [], []], ec_semver:format({{1,2,34},{[],[]}})), + ?assertEqual(<<"a">>, erlang:iolist_to_binary(ec_semver:format({<<"a">>, {[],[]}}))), + ?assertEqual(<<"a.b">>, erlang:iolist_to_binary(ec_semver:format({{<<"a">>,<<"b">>}, {[],[]}}))), + ?assertEqual(<<"1">>, erlang:iolist_to_binary(ec_semver:format({1, {[],[]}}))), + ?assertEqual(<<"1.2">>, erlang:iolist_to_binary(ec_semver:format({{1,2}, {[],[]}}))), + ?assertEqual(<<"1.2.2">>, erlang:iolist_to_binary(ec_semver:format({{1,2,2}, {[],[]}}))), + ?assertEqual(<<"1.99.2">>, erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[],[]}}))), + ?assertEqual(<<"1.99.2-alpha">>, erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[<<"alpha">>],[]}}))), + ?assertEqual(<<"1.99.2-alpha.1">>, erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[<<"alpha">>,1], []}}))), + ?assertEqual(<<"1.99.2-pre-alpha.1">>, erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[<<"pre-alpha">>,1], []}}))), + ?assertEqual(<<"1.99.2+build.1.a36">>, + erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[], [<<"build">>, 1, <<"a36">>]}}))), + ?assertEqual(<<"1.99.2.44+build.1.a36">>, + erlang:iolist_to_binary(ec_semver:format({{1,99,2,44}, {[], [<<"build">>, 1, <<"a36">>]}}))), + ?assertEqual(<<"1.99.2-alpha.1+build.1.a36">>, + erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[<<"alpha">>, 1], [<<"build">>, 1, <<"a36">>]}}))), + ?assertEqual(<<"1.99.2-pre-alpha.1+build.1.a36">>, + erlang:iolist_to_binary(ec_semver:format({{1,99,2}, {[<<"pre-alpha">>, 1], [<<"build">>, 1, <<"a36">>]}}))), + ?assertEqual(<<"1">>, erlang:iolist_to_binary(ec_semver:format({1, {[],[]}}))). diff --git a/test/ec_talk_tests.erl b/test/ec_talk_tests.erl new file mode 100644 index 0000000..9b7bd07 --- /dev/null +++ b/test/ec_talk_tests.erl @@ -0,0 +1,19 @@ +%%% @copyright 2024 Erlware, LLC. +-module(ec_talk_tests). + +-include_lib("eunit/include/eunit.hrl"). + +general_test_() -> + [?_test(42 == ec_talk:get_integer("42")), + ?_test(500_211 == ec_talk:get_integer("500211")), + ?_test(1_234_567_890 == ec_talk:get_integer("1234567890")), + ?_test(12_345_678_901_234_567_890 == ec_talk:get_integer("12345678901234567890")), + ?_test(true == ec_talk:get_boolean("true")), + ?_test(false == ec_talk:get_boolean("false")), + ?_test(true == ec_talk:get_boolean("Ok")), + ?_test(true == ec_talk:get_boolean("ok")), + ?_test(true == ec_talk:get_boolean("Y")), + ?_test(true == ec_talk:get_boolean("y")), + ?_test(false == ec_talk:get_boolean("False")), + ?_test(false == ec_talk:get_boolean("No")), + ?_test(false == ec_talk:get_boolean("no"))].