diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# HGrib Change Log + +## 0.1.0.0 + +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,123 @@ +# HGrib + +Unofficial bindings for [ECMWF][]'s [GRIB API][] library for reading +[WMO FM-92 GRIB][] edition 1 and edition 2 messages. + +In this version of HGrib, only raw bindings for the +[documented][GRIB Docs] part of GRIB API is available. The next +versions are intended to include, in chronological order, + + * Raw bindings for the full API in the [grib_api.h][GRIB Header] C + header file. + + * A higher-level Haskell interface. + + +## Installation + +The following prerequisites are needed to build HGrib: + + * [GRIB API][] == 1.14.0 installed and discoverable by ghc (use + cabal's `--extra-include-dirs` and `--extra-lib-dirs` if it's + installed at a custom location); and + + * Haskell [base][] == 4.8.* + + * [c2hs][] == 0.26.* + +With these requirements available, HGrib can be installed from +[Hackage][] with [Cabal][]: + +``` +cabal install hgrib +``` + + +## Usage + +Right now, only raw bindings for the [documented][GRIB Docs] part of +GRIB API is available in `Data.Grib.Raw`. Much of the documentation +is copied into HGrib's [reference documentation][HGrib Docs] generated +by [Haddock][]. To be able to work with these bindings, bindings for +C's `fopen` is provided in `Data.Grib.Raw.CFile` (which is re-exported +by `Data.Grib.Raw`). An example of usage is GRIB API's +[get.c][GRIB Get] example re-written with HGrib's bindings: + +```haskell +import Control.Exception (assert) +import Data.Grib.Raw +import Foreign (allocaArray, allocaBytes) +import Text.Printf (printf) + + +filename :: FilePath +filename = "test/stage/regular_latlon_surface.grib1" + +assertIO :: Bool -> IO () +assertIO = flip assert $ return () + +main :: IO () +main = do + h <- withBinaryCFile filename ReadMode $ + gribHandleNewFromFile defaultGribContext + + _ <- gribSetString h "file" filename + + gribGetLong h "Ni" >>= printf "numberOfPointsAlongAParallel=%d\n" + gribGetLong h "Nj" >>= printf "numberOfPointsAlongAMeridian=%d\n" + + gribGetDouble h "yFirst" >>= printf "latitudeOfFirstGridPointInDegrees=%g\n" + gribGetDouble h "xFirst" >>= printf "longitudeOfFirstGridPointInDegrees=%g\n" + gribGetDouble h "yLast" >>= printf "latitudeOfLastGridPointInDegrees=%g\n" + gribGetDouble h "xLast" >>= printf "longitudeOfLastGridPointInDegrees=%g\n" + gribGetDouble h "DyInDegrees" >>= printf "jDirectionIncrementInDegrees=%g\n" + gribGetDouble h "DxInDegrees" >>= printf "iDirectionIncrementInDegrees=%g\n" + + len <- gribGetLength h "packingType" + allocaBytes len $ \bufr -> do + packingType <- gribGetString h "packingType" bufr len + printf "packingType=%s (%d)\n" packingType (length packingType + 1) + + size <- gribGetSize h "values" + allocaArray size $ \array -> do + values <- gribGetDoubleArray h "values" array size + let average = sum values / (fromIntegral . length $ values) + printf "There are %d values, average is %g\n" size average + + len' <- gribGetLength h "file" + assertIO $ len' == 1 + length filename + allocaBytes len' $ \bufr' -> do + file <- gribGetString h "file" bufr' len' + assertIO $ file == filename +``` + + +## Contributing + +Issues and pull requests are most welcome! + + +## Licenses + +HGrib was created and is currently maintained by +[Mattias Jakobsson][]. It is released under the +[GNU General Public License v3.0][GPL3]. ECMWF's GRIB API is released +under the [Apache license][]. **HGrib is in no way associated with +ECMWF or the original library.** + + +[Apache license]: https://software.ecmwf.int/wiki/display/GRIB/License +[base]: http://hackage.haskell.org/package/base +[c2hs]: https://github.com/haskell/c2hs +[Cabal]: https://www.haskell.org/cabal/ +[ECMWF]: http://www.ecmwf.int/ +[GPL3]: http://www.gnu.org/licenses/gpl-3.0.html +[GRIB API]: https://software.ecmwf.int/wiki/display/GRIB/Home +[GRIB Docs]: https://software.ecmwf.int/wiki/display/GRIB/Module+Index +[GRIB Get]: https://software.ecmwf.int/wiki/display/GRIB/get.c +[GRIB Header]: https://software.ecmwf.int/wiki/display/GRIB/grib_api.h+File+Reference +[Hackage]: http://hackage.haskell.org/ +[Haddock]: https://www.haskell.org/haddock/ +[HGRIB Docs]: https://hackage.haskell.org/package/hgrib +[Mattias Jakobsson]: https://github.com/mjakob +[WMO FM-92 GRIB]: http://www.wmo.int/pages/prog/www/WMOCodes/Guides/GRIB/Introduction_GRIB1-GRIB2.pdf diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/get.hs b/examples/get.hs new file mode 100644 --- /dev/null +++ b/examples/get.hs @@ -0,0 +1,45 @@ +import Control.Exception (assert) +import Data.Grib.Raw +import Foreign (allocaArray, allocaBytes) +import Text.Printf (printf) + + +filename :: FilePath +filename = "test/stage/regular_latlon_surface.grib1" + +assertIO :: Bool -> IO () +assertIO = flip assert $ return () + +main :: IO () +main = do + h <- withBinaryCFile filename ReadMode $ + gribHandleNewFromFile defaultGribContext + + _ <- gribSetString h "file" filename + + gribGetLong h "Ni" >>= printf "numberOfPointsAlongAParallel=%d\n" + gribGetLong h "Nj" >>= printf "numberOfPointsAlongAMeridian=%d\n" + + gribGetDouble h "yFirst" >>= printf "latitudeOfFirstGridPointInDegrees=%g\n" + gribGetDouble h "xFirst" >>= printf "longitudeOfFirstGridPointInDegrees=%g\n" + gribGetDouble h "yLast" >>= printf "latitudeOfLastGridPointInDegrees=%g\n" + gribGetDouble h "xLast" >>= printf "longitudeOfLastGridPointInDegrees=%g\n" + gribGetDouble h "DyInDegrees" >>= printf "jDirectionIncrementInDegrees=%g\n" + gribGetDouble h "DxInDegrees" >>= printf "iDirectionIncrementInDegrees=%g\n" + + len <- gribGetLength h "packingType" + allocaBytes len $ \bufr -> do + packingType <- gribGetString h "packingType" bufr len + printf "packingType=%s (%d)\n" packingType (length packingType + 1) + + size <- gribGetSize h "values" + allocaArray size $ \array -> do + values <- gribGetDoubleArray h "values" array size + let average = sum values / (fromIntegral . length $ values) + printf "There are %d values, average is %g\n" size average + + len' <- gribGetLength h "file" + assertIO $ len' == 1 + length filename + allocaBytes len' $ \bufr' -> do + file <- gribGetString h "file" bufr' len' + assertIO $ file == filename diff --git a/hgrib.cabal b/hgrib.cabal new file mode 100644 --- /dev/null +++ b/hgrib.cabal @@ -0,0 +1,100 @@ +-- Package description for HGrib. + +name: hgrib +version: 0.1.0.0 +synopsis: Unofficial bindings for GRIB API +description: + Unofficial bindings to ECMWF's GRIB API library for reading WMO + FM-92 GRIB edition 1 and edition 2 messages. +homepage: https://github.com/mjakob/hgrib +license: GPL-3 +license-file: LICENSE +author: Mattias Jakobsson +maintainer: mjakob422@gmail.com +copyright: (c) 2015 Mattias Jakobsson +category: Data +stability: unstable +bug-reports: https://github.com/mjakob/hgrib/issues +build-type: Simple +cabal-version: >=1.10 +extra-source-files: + CHANGELOG.md + README.md + test/stage/regular_latlon_surface.grib1 + test/stage/regular_latlon_surface.grib2 + +source-repository head + type: git + location: https://github.com/mjakob/hgrib.git + branch: develop + +source-repository this + type: git + location: https://github.com/mjakob/hgrib.git + tag: 0.1.0.0 + +library + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: + Data.Grib.Raw + Data.Grib.Raw.CFile + Data.Grib.Raw.Context + Data.Grib.Raw.Exception + Data.Grib.Raw.Handle + Data.Grib.Raw.Index + Data.Grib.Raw.Iterator + Data.Grib.Raw.KeysIterator + Data.Grib.Raw.Nearest + Data.Grib.Raw.Types + Data.Grib.Raw.Value + other-modules: + Data.Grib.Raw.Marshal + build-depends: + base == 4.8.* + build-tools: + c2hs == 0.26.* + extra-libraries: + grib_api + ghc-options: + -Wall + +test-suite tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Spec.hs + hs-source-dirs: test + other-modules: + Data.Grib.Raw.CFileSpec + Data.Grib.Raw.ContextSpec + Data.Grib.Raw.HandleSpec + Data.Grib.Raw.IndexSpec + Data.Grib.Raw.IteratorSpec + Data.Grib.Raw.KeysIteratorSpec + Data.Grib.Raw.NearestSpec + Data.Grib.Raw.Test + Data.Grib.Raw.ValueSpec + build-depends: + base == 4.8.* + , directory == 1.2.* + , hgrib + , hspec == 2.1.* + ghc-options: + -Wall + +flag build_examples + description: Build GRIB API example programs + default: False + manual: True + +executable get + default-language: Haskell2010 + main-is: get.hs + hs-source-dirs: examples + build-depends: + base == 4.8.* + , hgrib + ghc-options: + -Wall + if !flag(build_examples) + buildable: False diff --git a/src/Data/Grib/Raw.hs b/src/Data/Grib/Raw.hs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw.hs @@ -0,0 +1,36 @@ +{- | +Module : Data.Grib.Raw +Description : Raw Haskell bindings for ECMWF's C grib_api +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +This is the low-level side of HGrib where GRIB API's C functions are +imported using to a +great extent. +-} + +module Data.Grib.Raw + ( module Data.Grib.Raw.CFile + , module Data.Grib.Raw.Context + , module Data.Grib.Raw.Handle + , module Data.Grib.Raw.Index + , module Data.Grib.Raw.Iterator + , module Data.Grib.Raw.KeysIterator + , module Data.Grib.Raw.Nearest + , module Data.Grib.Raw.Types + , module Data.Grib.Raw.Value + ) where + +import Data.Grib.Raw.CFile +import Data.Grib.Raw.Context +import Data.Grib.Raw.Handle hiding (withGribHandle) +import Data.Grib.Raw.Index hiding (withGribIndex) +import Data.Grib.Raw.Iterator +import Data.Grib.Raw.KeysIterator +import Data.Grib.Raw.Nearest +import Data.Grib.Raw.Types +import Data.Grib.Raw.Value diff --git a/src/Data/Grib/Raw/CFile.chs b/src/Data/Grib/Raw/CFile.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/CFile.chs @@ -0,0 +1,63 @@ +{- | +Module : Data.Grib.Raw.CFile +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Open and close C streams in Haskell. +-} + +module Data.Grib.Raw.CFile + ( CFilePtr + , withBinaryCFile + , openBinaryCFile + , closeCFile + , IOMode(..) + ) where + +import Control.Exception (bracket) +import Control.Monad (when) +import Foreign.C +import System.IO (IOMode(..)) + + +#include + +-- |A pointer to a C stream (FILE). +{#pointer *FILE as CFilePtr -> CFile #} + +-- This comment is inserted to help Haddock keep all docs. + +-- |A constant indicating end of file. +eof :: CInt +eof = {#const EOF #} + +-- FILE *fopen(const char *path, const char *mode); +-- +-- This function is not macro expanded since we want to use the given +-- filename in the return value marshaller 'throwErrnoPathIfNull'. +-- +-- |Like 'System.IO.openBinaryFile', but return a 'CFilePtr' instead of a +-- file 'System.IO.Handle'. +openBinaryCFile :: FilePath -> IOMode -> IO CFilePtr +openBinaryCFile name mode = + withCString name $ \c_name -> + withCString mode_str $ \c_mode -> + throwErrnoPathIfNull "openBinaryCFile" name ({#call fopen #} c_name c_mode) + where mode_str = case mode of + ReadMode -> "rb" + WriteMode -> "wb" + AppendMode -> "ab" + ReadWriteMode -> "r+b" + +-- |Close an open 'Foreign.C.CFile'. +{#fun fclose as closeCFile { `CFilePtr' } -> `()' checkStatus*- #} + where checkStatus r = when (r == eof) $ throwErrno "closeCFile" + +-- |Like 'System.IO.withBinaryFile', but use a 'CFilePtr' instead of a file +-- 'System.IO.Handle'. +withBinaryCFile :: FilePath -> IOMode -> (CFilePtr -> IO a) -> IO a +withBinaryCFile name mode = bracket (openBinaryCFile name mode) closeCFile diff --git a/src/Data/Grib/Raw/Context.chs b/src/Data/Grib/Raw/Context.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Context.chs @@ -0,0 +1,262 @@ +{- | +Module : Data.Grib.Raw.Context +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +The context is a long life configuration object of the grib_api. It +is used to define special allocation and free routines or to set +special grib_api behaviours and variables. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Data.Grib.Raw.Context + ( -- * The GRIB Context + GribContext(..) + , defaultGribContext + , gribContextGetDefault + , gribContextNew + , gribContextDelete + , gribContextSetMemoryProc + , gribContextSetPersistentMemoryProc + , gribContextSetBufferMemoryProc + , gribContextSetPrintProc + , gribContextSetLoggingProc + + -- ** Control GTS Mode + , gribGtsHeaderOn + , gribGtsHeaderOff + + -- ** Control Gribex Mode + , gribGribexModeOn + , gribGribexModeOff + , gribGetGribexMode + + -- ** Control Multi-field Support + , gribMultiSupportOn + , gribMultiSupportOff + + -- * Foreign Function Type Definitions + , GribFreeProc + , GribMallocProc + , GribReallocProc + , GribLogProc + , GribPrintProc + , GribDataReadProc + , GribDataWriteProc + , GribDataTellProc + , GribDataSeekProc + , GribDataEofProc + ) where + +import Foreign +import Foreign.C + + +#include + +-- typedef struct grib_context grib_context; +-- +-- It doesn't seem like grib_context_delete() can be used in general, +-- hence no foreign pointer. +-- +-- |The context is a long life configuration object of the grib_api. It is +-- used to define special allocation and free routines or to set +-- special grib_api behaviours and variables. +{#pointer *grib_context as GribContext newtype #} deriving (Eq, Show) + +-- |A 'GribContext' containing a null pointer which makes the +-- functions receiving it use the default grib context. +defaultGribContext :: GribContext +defaultGribContext = GribContext nullPtr + +-- typedef void (*grib_free_proc)(const grib_context* c, void* data); +-- +-- |Grib free procedure, format of a procedure referenced in the +-- context that is used to free memory. +{#pointer grib_free_proc as GribFreeProc #} + +-- This comment is inserted to help Haddock keep all docs. + +-- typedef void* (*grib_malloc_proc)(const grib_context* c, size_t length); +-- +-- |Grib malloc procedure, format of a procedure referenced in the +-- context that is used to allocate memory. +{#pointer grib_malloc_proc as GribMallocProc #} + +-- typedef void* (*grib_realloc_proc)(const grib_context* c, void* data, +-- size_t length); +-- +-- |Grib realloc procedure, format of a procedure referenced in the +-- context that is used to reallocate memory. +{#pointer grib_realloc_proc as GribReallocProc #} + +-- typedef void (*grib_log_proc)(const grib_context* c, int level, +-- const char* mesg); +-- +-- |Grib loc proc, format of a procedure referenced in the context +-- that is used to log internal messages. +{#pointer grib_log_proc as GribLogProc #} + +-- typedef void (*grib_print_proc)(const grib_context* c, void* descriptor, +-- const char* mesg); +-- +-- |Grib print proc, format of a procedure referenced in the context +-- that is used to print external messages. +{#pointer grib_print_proc as GribPrintProc #} + +-- typedef size_t (*grib_data_read_proc)(const grib_context* c, void *ptr, +-- size_t size, void *stream); +-- +-- |Grib data read proc, format of a procedure referenced in the +-- context that is used to read from a stream in a resource. +{#pointer grib_data_read_proc as GribDataReadProc #} + +-- typedef size_t (*grib_data_write_proc)(const grib_context* c, const void *ptr, +-- size_t size, void *stream); +-- +-- |Grib data read write, format of a procedure referenced in the +-- context that is used to write to a stream from a resource. +{#pointer grib_data_write_proc as GribDataWriteProc #} + +-- typedef off_t (*grib_data_tell_proc)(const grib_context* c, void *stream); +-- +-- |Grib data tell, format of a procedure referenced in the context +-- that is used to tell the current position in a stream. +{#pointer grib_data_tell_proc as GribDataTellProc #} + +-- typedef off_t (*grib_data_seek_proc)(const grib_context* c, off_t offset, +-- int whence, void *stream); +-- +-- |Grib data seek, format of a procedure referenced in the context +-- that is used to seek the current position in a stream. +{#pointer grib_data_seek_proc as GribDataSeekProc #} + +-- typedef int (*grib_data_eof_proc)(const grib_context* c, void *stream); +-- +-- |Grib data eof, format of a procedure referenced in the context +-- that is used to test end of file. +{#pointer grib_data_eof_proc as GribDataEofProc #} + +-- grib_context* grib_context_get_default(void); +-- +-- |Get the static default context. +-- +-- Note that the returned object is different from +-- 'defaultGribContext', since that is just a null pointer and this is +-- a pointer to the real thing. They should, however, be able to be +-- used interchangeably with all the functions in this package. +{#fun grib_context_get_default as ^ {} -> `GribContext' #} + +-- grib_context* grib_context_new(grib_context* c); +-- +-- |Create and allocate a new context from a parent context. +{#fun grib_context_new as ^ { `GribContext' } -> `GribContext' #} + +-- void grib_context_delete(grib_context* c); +-- +-- It doesn't seem safe to call this function in general, not even +-- with contexts created by 'gribContextNew' since fields of the +-- default context is first copied (by 'gribContextNew') and then +-- deleted (by this function). +-- +-- |Frees the cached definition files of the context. +{#fun grib_context_delete as ^ { `GribContext' } -> `()' #} + +-- void grib_gts_header_on(grib_context* c); +-- +-- |Set the gts header mode on. The GTS headers will be preserved. +{#fun grib_gts_header_on as ^ { `GribContext' } -> `()' #} + +-- void grib_gts_header_off(grib_context* c); +-- +-- |Set the gts header mode off. The GTS headers will be deleted. +{#fun grib_gts_header_off as ^ { `GribContext' } -> `()' #} + +-- void grib_gribex_mode_on(grib_context* c); +-- +-- |Set the gribex mode on. Grib files will be compatible with +-- gribex. +{#fun grib_gribex_mode_on as ^ { `GribContext' } -> `()' #} + +-- int grib_get_gribex_mode(grib_context* c); +-- +-- |Get the gribex mode. +{#fun grib_get_gribex_mode as ^ { `GribContext' } -> `Bool' #} + +-- void grib_gribex_mode_off(grib_context* c); +-- +-- |Set the gribex mode off. Grib files won't be always compatible +-- with gribex. +{#fun grib_gribex_mode_off as ^ { `GribContext' } -> `()' #} + +-- void grib_context_set_memory_proc(grib_context* c, grib_malloc_proc griballoc, +-- grib_free_proc gribfree, +-- grib_realloc_proc gribrealloc); +-- +-- |Sets memory procedures of the context. +{#fun grib_context_set_memory_proc as ^ { + `GribContext' + , `GribMallocProc' + , `GribFreeProc' + , `GribReallocProc' + } -> `()' #} + +-- void grib_context_set_persistent_memory_proc(grib_context* c, +-- grib_malloc_proc griballoc, +-- grib_free_proc gribfree); +-- +-- |Sets memory procedures of the context for persistent data. +{#fun grib_context_set_persistent_memory_proc as ^ { + `GribContext' + , `GribMallocProc' + , `GribFreeProc' + } -> `()' #} + +-- void grib_context_set_buffer_memory_proc(grib_context* c, +-- grib_malloc_proc griballoc, +-- grib_free_proc gribfree, +-- grib_realloc_proc gribrealloc); +-- +-- |Sets memory procedures of the context for large buffers. +{#fun grib_context_set_buffer_memory_proc as ^ { + `GribContext' + , `GribMallocProc' + , `GribFreeProc' + , `GribReallocProc' + } -> `()' #} + +-- void grib_context_set_print_proc(grib_context* c, grib_print_proc printp); +-- +-- |Sets the context printing procedure used for user interaction. +{#fun grib_context_set_print_proc as ^ { + `GribContext' + , `GribPrintProc' + } -> `()' #} + +-- void grib_context_set_logging_proc(grib_context* c, grib_log_proc logp); +-- +-- |Sets the context logging procedure used for system (warning, +-- errors, infos ...) messages. +{#fun grib_context_set_logging_proc as ^ { + `GribContext' + , `GribLogProc' + } -> `()' #} + +-- void grib_multi_support_on(grib_context* c); +-- +-- |Turn on support for multiple fields in single grib messages. +{#fun grib_multi_support_on as ^ { `GribContext' } -> `()' #} + +-- void grib_multi_support_off(grib_context* c); +-- +-- |Turn off support for multiple fields in single grib messages. +{#fun grib_multi_support_off as ^ { `GribContext' } -> `()' #} diff --git a/src/Data/Grib/Raw/Exception.chs b/src/Data/Grib/Raw/Exception.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Exception.chs @@ -0,0 +1,116 @@ +{- | +Module : Data.Grib.Raw.Exception +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Exceptions for HGrib. +-} + +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.Grib.Raw.Exception + ( -- *GRIB Exceptions + GribException(..) + + -- **Predicates + , isAnyGribException + , isGribException + , isNullPtrReturned + + -- **Error codes + , ErrorCode(..) + ) where + +import Control.Exception +import Data.Typeable + + +#include + +-- |Error codes returned by the grib_api functions. +{#enum define ErrorCode { + GRIB_SUCCESS as GribSuccess + , GRIB_END_OF_FILE as GribEndOfFile + , GRIB_INTERNAL_ERROR as GribInternalError + , GRIB_BUFFER_TOO_SMALL as GribBufferTooSmall + , GRIB_NOT_IMPLEMENTED as GribNotImplemented + , GRIB_7777_NOT_FOUND as Grib7777NotFound + , GRIB_ARRAY_TOO_SMALL as GribArrayTooSmall + , GRIB_FILE_NOT_FOUND as GribFileNotFound + , GRIB_CODE_NOT_FOUND_IN_TABLE as GribCodeNotFoundInTable + , GRIB_WRONG_ARRAY_SIZE as GribWrongArraySize + , GRIB_NOT_FOUND as GribNotFound + , GRIB_IO_PROBLEM as GribIoProblem + , GRIB_INVALID_MESSAGE as GribInvalidMessage + , GRIB_DECODING_ERROR as GribDecodingError + , GRIB_ENCODING_ERROR as GribEncodingError + , GRIB_NO_MORE_IN_SET as GribNoMoreInSet + , GRIB_GEOCALCULUS_PROBLEM as GribGeocalculusProblem + , GRIB_OUT_OF_MEMORY as GribOutOfMemory + , GRIB_READ_ONLY as GribReadOnly + , GRIB_INVALID_ARGUMENT as GribInvalidArgument + , GRIB_NULL_HANDLE as GribNullHandle + , GRIB_INVALID_SECTION_NUMBER as GribInvalidSectionNumber + , GRIB_VALUE_CANNOT_BE_MISSING as GribValueCannotBeMissing + , GRIB_WRONG_LENGTH as GribWrongLength + , GRIB_INVALID_TYPE as GribInvalidType + , GRIB_WRONG_STEP as GribWrongStep + , GRIB_WRONG_STEP_UNIT as GribWrongStepUnit + , GRIB_INVALID_FILE as GribInvalidFile + , GRIB_INVALID_GRIB as GribInvalidGrib + , GRIB_INVALID_INDEX as GribInvalidIndex + , GRIB_INVALID_ITERATOR as GribInvalidIterator + , GRIB_INVALID_KEYS_ITERATOR as GribInvalidKeysIterator + , GRIB_INVALID_NEAREST as GribInvalidNearest + , GRIB_INVALID_ORDERBY as GribInvalidOrderby + , GRIB_MISSING_KEY as GribMissingKey + , GRIB_OUT_OF_AREA as GribOutOfArea + , GRIB_CONCEPT_NO_MATCH as GribConceptNoMatch + , GRIB_NO_DEFINITIONS as GribNoDefinitions + , GRIB_WRONG_TYPE as GribWrongType + , GRIB_END as GribEnd + , GRIB_NO_VALUES as GribNoValues + , GRIB_WRONG_GRID as GribWrongGrid + , GRIB_END_OF_INDEX as GribEndOfIndex + , GRIB_NULL_INDEX as GribNullIndex + , GRIB_PREMATURE_END_OF_FILE as GribPrematureEndOfFile + , GRIB_INTERNAL_ARRAY_TOO_SMALL as GribInternalArrayTooSmall + , GRIB_MESSAGE_TOO_LARGE as GribMessageTooLarge + , GRIB_CONSTANT_FIELD as GribConstantField + , GRIB_SWITCH_NO_MATCH as GribSwitchNoMatch + , GRIB_UNDERFLOW as GribUnderflow + , GRIB_MESSAGE_MALFORMED as GribMessageMalformed + , GRIB_CORRUPTED_INDEX as GribCorruptedIndex + , GRIB_INVALID_BPV as GribInvalidBpv + , GRIB_DIFFERENT_EDITION as GribDifferentEdition + , GRIB_VALUE_DIFFERENT as GribValueDifferent + , GRIB_INVALID_KEY_VALUE as GribInvalidKeyValue + } deriving (Eq, Show) #} + +-- This comment is inserted to help Haddock keep all docs. + +-- |An exception carrying an 'ErrorCode' or representing a returned +-- null pointer. +data GribException = GribException ErrorCode + | NullPtrReturned + deriving (Show, Typeable) + +instance Exception GribException + +-- |True for any 'GribException'. +isAnyGribException :: GribException -> Bool +isAnyGribException = const True + +-- |True if a 'GribException' carries the given 'ErrorCode'. +isGribException :: ErrorCode -> GribException -> Bool +isGribException code (GribException code') = code' == code +isGribException _ NullPtrReturned = False + +-- |True for 'NullPtrReturned'. +isNullPtrReturned :: GribException -> Bool +isNullPtrReturned NullPtrReturned = True +isNullPtrReturned _ = False diff --git a/src/Data/Grib/Raw/Handle.chs b/src/Data/Grib/Raw/Handle.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Handle.chs @@ -0,0 +1,286 @@ +{- | +Module : Data.Grib.Raw.Handle +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +The grib_handle is the structure giving access to parsed grib values +by keys. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +{-# LANGUAGE TupleSections #-} + +module Data.Grib.Raw.Handle + ( -- * The GRIB Handle + GribHandle(..) + , gribHandleNewFromFile + , gribHandleNewFromTemplate + , gribHandleNewFromSamples + , gribHandleClone + , gribWriteMessage + , withGribHandle + + -- ** Operations on raw messages + , gribGetMessage + , gribGetMessageCopy + , gribHandleNewFromMessage + , gribHandleNewFromMessageCopy + , gribHandleNewFromMultiMessage + + -- * The GRIB Multi Field Handle + , GribMultiHandle(..) + , gribMultiHandleNew + , gribMultiHandleAppend + , gribMultiHandleWrite + , withGribMultiHandle + + -- * Utilities + , gribCountInFile + ) where + +import Foreign +import Foreign.C + +{#import Data.Grib.Raw.CFile #} +{#import Data.Grib.Raw.Context #} +import Data.Grib.Raw.Marshal + + +#include + +{#typedef size_t CSize #} +{#default in `Int' [size_t] fromIntegral #} + +-- typedef struct grib_handle grib_handle; +-- +-- |Grib handle, structure giving access to parsed grib values by +-- keys. +{#pointer *grib_handle as GribHandle + foreign finalizer grib_handle_delete as gribHandleFinalizer + newtype #} + +instance Eq GribHandle where + GribHandle f1 == GribHandle f2 = f1 == f2 + +instance Show GribHandle where + show (GribHandle f) = "GribHandle " ++ show f + +checkHandle :: Ptr GribHandle -> IO GribHandle +checkHandle = checkForeignPtr GribHandle gribHandleFinalizer + +-- int grib_count_in_file(grib_context *c, FILE *f, int *n); +-- +-- |Counts the messages contained in a file resource. +{#fun grib_count_in_file as ^ { + `GribContext' + , `CFilePtr' + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- grib_handle* grib_handle_new_from_file(grib_context* c, FILE* f, int* error); +-- +-- |Create a handle from a file resource. +-- +-- The file is read until a message is found. The message is then +-- copied. +{#fun grib_handle_new_from_file as ^ { + `GribContext' + , `CFilePtr' + , alloca- `CInt' checkStatusPtr*- + } -> `GribHandle' #} + +-- int grib_write_message(grib_handle* h,const char* file,const char* mode); +-- +-- |Write a coded message to a file given its name and the C file mode +-- string, in that order. +{#fun grib_write_message as ^ { + `GribHandle' + , withCString* `FilePath' + , `String' + } -> `()' checkStatus*- #} + +-- grib_handle* grib_handle_new_from_message(grib_context* c, void* data, +-- size_t data_len); +-- +-- |Create a handle from a user message in memory. +-- +-- The message will not be freed at the end. The message will be +-- copied as soon as a modification is needed. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the message is invalid or a problem is +-- encountered. +-- +-- __WARNING!__ This method does not handle a message of zero length +-- gracefully. +{#fun grib_handle_new_from_message as ^ { + `GribContext' + , id `Message' + , `Int' + } -> `GribHandle' checkHandle* #} + +-- grib_handle* grib_handle_new_from_multi_message(grib_context* c,void** data, +-- size_t *data_len,int* error); +-- +-- |Create a handle from a user message in memory. +-- +-- The message will not be freed at the end. The message will be +-- copied as soon as a modification is needed. This function works +-- also with multi field messages. +{#fun grib_handle_new_from_multi_message as ^ { + `GribContext' + , with* `Message' peek* + , withIntegral* `Int' peekIntegral* + , alloca- `CInt' checkStatusPtr*- + } -> `GribHandle' #} + +-- grib_handle* grib_handle_new_from_message_copy(grib_context* c, +-- const void* data, +-- size_t data_len); +-- +-- |Create a handle from a user message. +-- +-- The message is copied and will be freed with the handle. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the message is invalid or a problem is +-- encountered. +{#fun grib_handle_new_from_message_copy as ^ { + `GribContext' + , id `Message' + , `Int' + } -> `GribHandle' checkHandle* #} + +-- DEPRECATED grib_handle* grib_handle_new_from_template(grib_context* c, +-- const char* res_name); +-- +-- |/This function has been deprecated in GRIB API./ +-- +-- Create a handle from a read_only template resource. +-- +-- The message is copied at the creation of the handle. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the resource is invalid or a problem is +-- encountered. +{#fun grib_handle_new_from_template as ^ { + `GribContext' + , `String' + } -> `GribHandle' checkHandle* #} + +-- grib_handle* grib_handle_new_from_samples(grib_context* c, +-- const char* res_name); +-- +-- |Create a handle from a message contained in a samples directory. +-- +-- The message is copied at the creation of the handle. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the resource is invalid or a problem is +-- encountered. +{#fun grib_handle_new_from_samples as ^ { + `GribContext' -- ^the context from which the handle will be + -- created (NULL for default context) + , `String' -- ^the resource name + } -> `GribHandle' checkHandle* #} + +-- grib_handle* grib_handle_clone(grib_handle *h); +-- +-- |Clone an existing handle using the context of the original handle. +-- +-- The message is copied and reparsed. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the message is invalid or a problem is +-- encountered. +{#fun grib_handle_clone as ^ { `GribHandle' } -> `GribHandle' checkHandle* #} + +-- typedef struct grib_multi_handle grib_multi_handle; +-- +-- |Grib multi field handle, structure used to build multi fields +-- messages. +{#pointer *grib_multi_handle as GribMultiHandle + foreign finalizer grib_multi_handle_delete as gribMultiHandleFinalizer + newtype #} + +instance Eq GribMultiHandle where + GribMultiHandle f1 == GribMultiHandle f2 = f1 == f2 + +instance Show GribMultiHandle where + show (GribMultiHandle f) = "GribMultiHandle " ++ show f + +checkMultiHandle :: Ptr GribMultiHandle -> IO GribMultiHandle +checkMultiHandle = checkForeignPtr GribMultiHandle gribMultiHandleFinalizer + +-- grib_multi_handle* grib_multi_handle_new(grib_context* c); +-- +-- |Create an empty multi field handle. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if a problem is encountered. +{#fun grib_multi_handle_new as ^ { + `GribContext' + } -> `GribMultiHandle' checkMultiHandle* #} + +-- int grib_multi_handle_append(grib_handle* h, int start_section, +-- grib_multi_handle* mh); +-- +-- |Append the sections starting with start_section of the message +-- pointed by h at the end of the multi field handle mh. +{#fun grib_multi_handle_append as ^ { + `GribHandle' + , `Int' + , `GribMultiHandle' + } -> `()' checkStatus*- #} + +-- int grib_multi_handle_write(grib_multi_handle* mh, FILE* f); +-- +-- |Write a multi field handle in a file. +{#fun grib_multi_handle_write as ^ { + `GribMultiHandle', + `CFilePtr' + } -> `()' checkStatus*- #} + +-- int grib_get_message(grib_handle* h, const void** message, +-- size_t *message_length); +-- +-- |Getting the message attached to a handle. +{#fun grib_get_message as ^ { + `GribHandle' + , alloca- `Message' peek* + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_get_message_copy(grib_handle* h, void* message, +-- size_t *message_length); +-- +-- |Getting a copy of the message attached to a handle. +-- +-- This operation may fail with: +-- +-- * @isGribException GribBufferTooSmall@ if the allocated message +-- is too small. +{#fun grib_get_message_copy as ^ { + `GribHandle' + -- ^the grib handle to which the buffer should be returned + , id `Message' id + -- ^the pointer to the data buffer to be filled + , withIntegral* `Int' peekIntegral* + -- ^the size in number of bytes of the allocated empty message + } -> `()' checkStatus*- + -- ^an IO action that will return the pointer to the data buffer + -- and the number of bytes retrieved +#} diff --git a/src/Data/Grib/Raw/Index.chs b/src/Data/Grib/Raw/Index.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Index.chs @@ -0,0 +1,296 @@ +{- | +Module : Data.Grib.Raw.Index +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +The grib_index is the structure giving indexed access to messages in a +file. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +module Data.Grib.Raw.Index + ( -- *The GRIB Index + GribIndex(..) + , gribIndexNewFromFile + , gribIndexNew + , gribIndexAddFile + , gribIndexWrite + , gribIndexRead + , withGribIndex + + -- **Get values from the index + , gribIndexGetSize + , gribIndexGetLong + , gribIndexGetDouble + , gribIndexGetString + + -- **Select values from the index + , gribIndexSelectLong + , gribIndexSelectDouble + , gribIndexSelectString + + -- **Other functions + , gribHandleNewFromIndex + ) where + +import Foreign +import Foreign.C + +{#import Data.Grib.Raw.Context #} +{#import Data.Grib.Raw.Handle #} +import Data.Grib.Raw.Marshal + +#include + +{#typedef size_t CSize #} + +-- typedef struct grib_index grib_index; +-- +-- |Index structure to access messages in a file. +{#pointer *grib_index as GribIndex + foreign finalizer grib_index_delete as gribIndexFinalizer + newtype #} + +-- grib_index* grib_index_new_from_file(grib_context* c, char* filename, +-- const char* keys, int *err); +-- +-- |Create a new index from a file. +-- +-- The file is indexed with the keys in argument. +{#fun grib_index_new_from_file as ^ { + `GribContext' + -- ^context + , withCString* `FilePath' + -- ^name of the file of messages to be indexed + , withJoinedCString* `[Key]' + -- ^a list of keys for the index. The type of the key can be + -- explicitly declared appending :l for long, :d for double, :s + -- for string to the key name. If the type is not declared + -- explicitly, the native type is assumed + , alloca- `CInt' checkStatusPtr*- + } -> `GribIndex' + -- ^an IO action that will return the new index +#} + +-- grib_index* grib_index_new(grib_context* c, const char* keys, int *err); +-- +-- |Create a new index based on a set of keys. +{#fun grib_index_new as ^ { + `GribContext' + -- ^context + , withJoinedCString* `[Key]' + -- ^a list of keys for the index. The type of the key can be + -- explicitly declared appending :l for long, :d for double, :s + -- for string to the key name. If the type is not declared + -- explicitly, the native type is assumed + , alloca- `CInt' checkStatusPtr*- + } -> `GribIndex' + -- ^an IO action that will return the new index +#} + +-- int grib_index_add_file(grib_index *index, const char *filename); +-- +-- |Indexes the file given in argument in the index given in argument. +{#fun grib_index_add_file as ^ { + `GribIndex' + , withCString* `FilePath' + } -> `()' checkStatus*- #} + +-- int grib_index_write(grib_index *index, const char *filename); +-- +-- |Write the index and its messages to file. +{#fun grib_index_write as ^ { + `GribIndex' + , withCString* `FilePath' + } -> `()' checkStatus*- #} + +-- grib_index* grib_index_read(grib_context* c, const char* filename, int *err); +-- +-- |Read messages and their index from a file. +{#fun grib_index_read as ^ { + `GribContext' + , withCString* `FilePath' + , alloca- `CInt' checkStatusPtr*- + } -> `GribIndex' #} + +-- int grib_index_get_size(grib_index* index, const char* key, size_t* size); +-- +-- |Get the number of distinct values of the key in argument contained +-- in the index. +-- +-- The key must belong to the index. +{#fun grib_index_get_size as ^ { + `GribIndex' + , withCString* `Key' + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_index_get_long(grib_index* index, const char* key, long* values, +-- size_t *size); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Get the distinct values of the key in argument contained in the index. +-- +-- This function is used when the type of the key was explicitly +-- defined as long or when the native type of the key is long. +-- +-- This function takes the address of an array that is used to +-- retrieve the values. It could potentially be re-used between +-- multiple calls. +gribIndexGetLong :: GribIndex -- ^an index created from a file. The + -- index must have been created with + -- the key in argument. + -> Key -- ^key for which the values are + -- returned + -> Ptr CLong -- ^array of values. The array must be + -- allocated before entering this + -- function and its size must be enough + -- to contain all the values. + -> Int -- ^size of the values array + -> IO [Int] -- ^an IO action that will return the + -- data in a list +gribIndexGetLong idx key ls n = withGribIndex idx $ \idx' -> + map fromIntegral <$> getArray (cCall idx') key ls n + where cCall = {#call grib_index_get_long as gribIndexGetLong'_ #} + +-- int grib_index_get_double(grib_index* index, const char* key, +-- double* values, size_t *size); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Get the distinct values of the key in argument contained in the index. +-- +-- This function is used when the type of the key was explicitly +-- defined as double or when the native type of the key is double. +-- +-- This function takes the address of an array that is used to +-- retrieve the values. It could potentially be re-used between +-- multiple calls. +gribIndexGetDouble :: GribIndex -- ^an index created from a + -- file. The index must have been + -- created with the key in + -- argument. + -> Key -- ^key for which the values are + -- returned + -> Ptr CDouble -- ^array of values. The array must + -- be allocated before entering + -- this function and its size must + -- be enough to contain all the + -- values. + -> Int -- ^size of the values array + -> IO [Double] -- ^an IO action that will return + -- the data in a list +gribIndexGetDouble idx key ds n = withGribIndex idx $ \idx' -> + map realToFrac <$> getArray (cCall idx') key ds n + where cCall = {#call grib_index_get_double as gribIndexGetDouble'_ #} + +-- int grib_index_get_string(grib_index* index, const char* key, char** values, +-- size_t *size); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Get the distinct values of the key in argument contained in the +-- index. +-- +-- This function is used when the type of the key was explicitly +-- defined as string or when the native type of the key is string. +-- +-- This function takes the address of an array that is used to +-- retrieve the values. It could potentially be re-used between +-- multiple calls. +-- +-- __WARNING!__ This function seem to leak memory unless the returned +-- strings in values are eventually freed with the grib context's +-- free_mem function. +gribIndexGetString :: GribIndex -- ^an index created from a + -- file. The index must have been + -- created with the key in + -- argument. + -> Key -- ^key for which the values are + -- returned + -> Ptr CString -- ^array of values. The array must + -- be allocated before entering + -- this function and its size must + -- be enough to contain all the + -- values. + -> Int -- ^size of the values array + -> IO [String] -- ^an IO action that will return + -- the data in a list +gribIndexGetString idx key ss n = withGribIndex idx $ \idx' -> + getArray (cCall idx') key ss n >>= mapM peekCString + where cCall = {#call grib_index_get_string as gribIndexGetString'_ #} + +-- int grib_index_select_long(grib_index* index, const char* key, long value); +-- +-- |Select the message subset with key==value. +-- +-- The index must have been created with the key in argument. The +-- value is a long. The key must have been created with long type or +-- have long as native type if the type was not explicitly defined in +-- the index creation. +{#fun grib_index_select_long as ^ { + `GribIndex' + , withCString* `Key' + , `Int' + } -> `()' checkStatus*- #} + +-- int grib_index_select_double(grib_index* index, const char* key, +-- double value); +-- +-- |Select the message subset with key==value. +-- +-- The index must have been created with the key in argument. The +-- value is a double. The key must have been created with double type +-- or have double as native type if the type was not explicitly +-- defined in the index creation. +{#fun grib_index_select_double as ^ { + `GribIndex' + , withCString* `Key' + , `Double' + } -> `()' checkStatus*- #} + +-- int grib_index_select_string(grib_index* index, const char* key, char* value); +-- +-- |Select the message subset with key==value. +-- +-- The index must have been created with the key in argument. The +-- value is a string. The key must have been created with string type +-- or have string as native type if the type was not explicitly +-- defined in the index creation. +{#fun grib_index_select_string as ^ { + `GribIndex' + , withCString* `Key' + , `String' + } -> `()' checkStatus*- #} + +-- grib_handle* grib_handle_new_from_index(grib_index* index,int *err); +-- +-- |Create a new handle from an index after having selected the key values. +-- +-- All the keys belonging to the index must be selected before calling +-- this function. Successive calls to this function will return all +-- the handles compatible with the constraints defined selecting the +-- values of the index keys. +-- +-- This operation may fail with: +-- +-- * @isGribException GribEndOfIndex@ when no more handles are +-- available from the index. +{#fun grib_handle_new_from_index as ^ { + `GribIndex' + , alloca- `CInt' checkStatusPtr*- + } -> `GribHandle' #} diff --git a/src/Data/Grib/Raw/Iterator.chs b/src/Data/Grib/Raw/Iterator.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Iterator.chs @@ -0,0 +1,131 @@ +{- | +Module : Data.Grib.Raw.Iterator +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Iterate on latitude, longitude, values. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +module Data.Grib.Raw.Iterator + ( -- *The GRIB Iterator + GribIterator(..) + , gribIteratorNew + , gribIteratorNext + , gribIteratorPrevious + , gribIteratorHasNext + , gribIteratorReset + , gribIteratorDelete + , withGribIterator + ) where + +import Control.Exception (bracket) +import Foreign +import Foreign.C + +{#import Data.Grib.Raw.Handle #} +import Data.Grib.Raw.Marshal + +#include + +-- typedef struct grib_iterator grib_iterator; +-- +-- If the grib_handle used to create a grib_iterator has been freed +-- (garbage collected), deleting the iterator leads to undefined +-- behavior since a reference to the handle is used to access the +-- grib_context that in turn is used to free the memory. Because of +-- this, we can't use a foreign pointer here. +-- +-- |Grib iterator, structure supporting a geographic iteration of +-- values on a grib message. +{#pointer *grib_iterator as GribIterator newtype #} deriving (Eq, Show) + +-- grib_iterator* grib_iterator_new(grib_handle* h, unsigned long flags, +-- int* error); +-- +-- |Create a new iterator from a handle, using current geometry and +-- values. +-- +-- The returned iterator needs to be manually deleted with +-- 'gribIteratorDelete'. However, due to the reason given in that +-- function, 'withGribIterator' should be preferred over this +-- function. +{#fun grib_iterator_new as ^ { + `GribHandle' + -- ^the handle from which the iterator will be created + , `Int' + -- ^flags for future use (ignored) + , alloca- `CInt' checkStatusPtr*- + } -> `GribIterator' + -- ^an IO action that will return the new iterator +#} + +-- int grib_iterator_next(grib_iterator *i, double* lat, double* lon, +-- double* value); +-- +-- |Get the next value from an iterator. +-- +-- This function returns a tuple @(status, latitude, longitude, +-- value)@, where @status@ is @True@ if successful and @False@ if no +-- more data is available. +{#fun grib_iterator_next as ^ { + `GribIterator' + , alloca- `Double' peekReal* + , alloca- `Double' peekReal* + , alloca- `Double' peekReal* + } -> `Bool' #} + +-- int grib_iterator_previous(grib_iterator *i, double* lat, double* lon, +-- double* value); +-- +-- |Like 'gribIteratorNext', but return the previous value instead. +{#fun grib_iterator_previous as ^ { + `GribIterator' + , alloca- `Double' peekReal* + , alloca- `Double' peekReal* + , alloca- `Double' peekReal* + } -> `Bool' #} + +-- int grib_iterator_has_next(grib_iterator *i); +-- +-- |Test procedure for values in an iterator. +{#fun grib_iterator_has_next as ^ { `GribIterator' } -> `Bool' #} + +-- int grib_iterator_reset(grib_iterator *i); +-- +-- |Reset the iterator. +{#fun grib_iterator_reset as ^ { `GribIterator' } -> `()' checkStatus*- #} + +-- int grib_iterator_delete(grib_iterator *i); +-- +-- |Frees an iterator from memory. +-- +-- If the 'GribHandle' used to create the iterator has been garbage +-- collected by the time this function is called, the behavior is +-- undefined. Because of this, 'withGribIterator' should be preferred +-- over directly using 'gribIteratorNew' and this function. +{#fun grib_iterator_delete as ^ { `GribIterator' } -> `()' checkStatus*- #} + +-- |Safely create, use and delete a 'GribIterator'. +-- +-- This function should be preferred over directly using +-- 'gribIteratorNew' and 'gribIteratorDelete'. +withGribIterator :: GribHandle + -- ^the handle from which the iterator will be created + -> Int + -- ^flags for future use (ignored) + -> (GribIterator -> IO a) + -- ^a function that will be called with the newly + -- created iterator + -> IO a + -- ^the result of the above function +withGribIterator h flags = bracket before after + where before = gribIteratorNew h flags + after iter = withGribHandle h $ \_ -> gribIteratorDelete iter diff --git a/src/Data/Grib/Raw/KeysIterator.chs b/src/Data/Grib/Raw/KeysIterator.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/KeysIterator.chs @@ -0,0 +1,166 @@ +{- | +Module : Data.Grib.Raw.KeysIterator +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +The keys iterator is designed to get the key names defined in a +message. Key names on which the iteration is carried out can be +filtered through their attributes or by the namespace they belong to. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +module Data.Grib.Raw.KeysIterator + ( -- *The GRIB Keys Iterator + GribKeysIterator(..) + , gribKeysIteratorNew + , gribKeysIteratorNext + , gribKeysIteratorGetName + , gribKeysIteratorRewind + , gribKeysIteratorDelete + , withGribKeysIterator + + -- **Iterator flags + , GribKeysIteratorFlag(..) + , gribKeysIteratorSetFlags + ) where + +import Control.Exception (bracket, throw) +import Foreign +import Foreign.C + +{#import Data.Grib.Raw.Exception #} +{#import Data.Grib.Raw.Handle #} +import Data.Grib.Raw.Marshal + + +#include + +-- |Filter flags for 'GribKeysIterator'. +{#enum define GribKeysIteratorFlag { + GRIB_KEYS_ITERATOR_ALL_KEYS as GribKeysIteratorAllKeys + , GRIB_KEYS_ITERATOR_SKIP_READ_ONLY as GribKeysIteratorSkipReadOnly + , GRIB_KEYS_ITERATOR_SKIP_OPTIONAL as GribKeysIteratorSkipOptional + , GRIB_KEYS_ITERATOR_SKIP_EDITION_SPECIFIC as + GribKeysIteratorSkipEditionSpecific + , GRIB_KEYS_ITERATOR_SKIP_CODED as GribKeysIteratorSkipCoded + , GRIB_KEYS_ITERATOR_SKIP_COMPUTED as GribKeysIteratorSkipComputed + , GRIB_KEYS_ITERATOR_SKIP_DUPLICATES as GribKeysIteratorSkipDuplicates + , GRIB_KEYS_ITERATOR_SKIP_FUNCTION as GribKeysIteratorSkipFunction + } deriving (Eq, Show) #} + +-- typedef struct grib_keys_iterator grib_keys_iterator; +-- +-- If the grib_handle used to create a grib_keys_iterator has been +-- freed (garbage collected), deleting the iterator leads to undefined +-- behavior since a reference to the handle is used to access the +-- grib_context that in turn is used to free the memory. Because of +-- this, we can't use a foreign pointer here. +-- +-- |Grib keys iterator. Iterator over keys. +{#pointer *grib_keys_iterator as GribKeysIterator newtype #} deriving (Eq, Show) + +-- grib_keys_iterator* grib_keys_iterator_new(grib_handle* h, +-- unsigned long filter_flags, +-- const char* name_space); +-- +-- |Create a new iterator from a valid and initialized handle. +-- +-- The returned iterator needs to be manually deleted with +-- 'gribKeysIteratorDelete'. However, due to the reason given in that +-- function, 'withGribKeysIterator' should be preferred over this +-- function. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the handle is invalid or the memory +-- allocation fails. +{#fun grib_keys_iterator_new as ^ { + `GribHandle' + -- ^the handle whose keys you want to iterate + , fromFlagList `[GribKeysIteratorFlag]' + -- ^flags to filter out some of the keys through their + -- attributes + , maybeWithCString* `Maybe String' + -- ^if not @Nothing@, the iteration is carried out only on keys + -- belonging to the namespace passed + } -> `GribKeysIterator' checkKeysIterator + -- ^an IO action that will return the new iterator +#} + where checkKeysIterator kiter@(GribKeysIterator ptr) + | ptr == nullPtr = throw NullPtrReturned + | otherwise = kiter + +-- int grib_keys_iterator_next(grib_keys_iterator *kiter); +-- +-- |Try to step to the next key and return @True@ if successful. +{#fun grib_keys_iterator_next as ^ { `GribKeysIterator' } -> `Bool' #} + +-- const char* grib_keys_iterator_get_name(grib_keys_iterator *kiter); +-- +-- |Get the key name from the iterator. +{#fun grib_keys_iterator_get_name as ^ { + `GribKeysIterator' + } -> `Key' peekCString* #} + +-- int grib_keys_iterator_delete(grib_keys_iterator* kiter); +-- +-- |Delete the iterator. +-- +-- If the 'GribHandle' used to create the iterator has been garbage +-- collected by the time this function is called, the behavior is +-- undefined. Because of this, 'withGribKeysIterator' should be +-- preferred over directly using 'gribKeysIteratorNew' and this +-- function. +{#fun grib_keys_iterator_delete as ^ { + `GribKeysIterator' + } -> `()' checkStatus*- #} + +-- int grib_keys_iterator_rewind(grib_keys_iterator* kiter); +-- +-- |Rewind the iterator. +{#fun grib_keys_iterator_rewind as ^ { + `GribKeysIterator' + } -> `()' checkStatus*- #} + +-- int grib_keys_iterator_set_flags(grib_keys_iterator *kiter, +-- unsigned long flags); +-- +-- |Update the flags of the iterator. +{#fun grib_keys_iterator_set_flags as ^ { + `GribKeysIterator' + , fromFlagList `[GribKeysIteratorFlag]' + } -> `()' checkStatus*- #} + +-- |Safely create, use and delete a 'GribKeysIterator'. +-- +-- This function should be preferred over directly using +-- 'gribKeysIteratorNew' and 'gribKeysIteratorDelete'. +-- +-- This operation may fail with: +-- +-- * @NullPtrReturned@ if the handle is invalid or the memory +-- allocation fails. +withGribKeysIterator :: GribHandle + -- ^the handle whose keys you want to iterate + -> [GribKeysIteratorFlag] + -- ^flags to filter out some of the keys through + -- their attributes + -> Maybe String + -- ^if not @Nothing@, the iteration is carried + -- out only on keys belonging to the namespace + -- passed + -> (GribKeysIterator -> IO a) + -- ^a function that will be called with the newly + -- created iterator + -> IO a + -- ^the result of the above function +withGribKeysIterator h flags ns = bracket before after + where before = gribKeysIteratorNew h flags ns + after kiter = withGribHandle h $ \_ -> gribKeysIteratorDelete kiter diff --git a/src/Data/Grib/Raw/Marshal.hs b/src/Data/Grib/Raw/Marshal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Marshal.hs @@ -0,0 +1,97 @@ +{- +Module : Data.Grib.Raw.Marshal +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Functions to marshal parameters between C and Haskell. +-} + +module Data.Grib.Raw.Marshal + ( module Data.Grib.Raw.Types + + , checkStatus + , checkStatusPtr + , fromFlagList + , maybeWithCString + , peekIntegral + , peekIntegralArray + , peekReal + , peekRealArray + , withIntegral + , withIntegralArrayLen + , withJoinedCString + , withRealArrayLen + + , checkForeignPtr + , getArray + ) where + +import Control.Exception (throw, throwIO) +import Control.Monad ((>=>)) +import Data.List (intercalate) +import Foreign +import Foreign.C + +import Data.Grib.Raw.Exception +import Data.Grib.Raw.Types + + +checkStatus :: CInt -> IO () +checkStatus 0 = return () +checkStatus status = throwIO . GribException . toEnum . fromIntegral $ status + +checkStatusPtr :: Ptr CInt -> IO () +checkStatusPtr = peek >=> checkStatus + +fromFlagList :: (Enum a, Integral b) => [a] -> b +fromFlagList = fromIntegral . foldr ((.|.) . fromEnum) zeroBits + +maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a +maybeWithCString (Just s) f = withCString s f +maybeWithCString Nothing f = f nullPtr + +peekIntegral :: (Integral a, Storable a, Num b) => Ptr a -> IO b +peekIntegral = fmap fromIntegral . peek + +peekIntegralArray :: (Integral a, Storable a, Num b) => Int -> Ptr a -> IO [b] +peekIntegralArray n = fmap (map fromIntegral) . peekArray n + +peekReal :: (Real a, Storable a, Fractional b) => Ptr a -> IO b +peekReal = fmap realToFrac . peek + +peekRealArray :: (Real a, Storable a, Fractional b) => Int -> Ptr a -> IO [b] +peekRealArray n = fmap (map realToFrac) . peekArray n + +withIntegral :: (Integral a, Num b, Storable b) => a -> (Ptr b -> IO c) -> IO c +withIntegral = with . fromIntegral + +withIntegralArrayLen :: (Integral a, Num b, Storable b, Num c) + => [a] -> ((Ptr b, c) -> IO d) -> IO d +withIntegralArrayLen xs f = + withArrayLen (map fromIntegral xs) $ \n xs' -> f (xs', fromIntegral n) + +withJoinedCString :: [String] -> (CString -> IO a) -> IO a +withJoinedCString ss = withCString (intercalate "," ss) + +withRealArrayLen :: (Real a, Fractional b, Storable b, Num c) + => [a] -> ((Ptr b, c) -> IO d) -> IO d +withRealArrayLen xs f = + withArrayLen (map realToFrac xs) $ \n xs' -> f (xs', fromIntegral n) + + +checkForeignPtr :: (ForeignPtr a -> a) -> FinalizerPtr a -> Ptr a -> IO a +checkForeignPtr makeA finalizer p + | p == nullPtr = throw NullPtrReturned + | otherwise = makeA <$> newForeignPtr finalizer p + +getArray :: (Storable a, Integral b, Storable b) + => (CString -> Ptr a -> Ptr b -> IO CInt) + -> Key -> Ptr a -> Int -> IO [a] +getArray cCall key xs n = + withCString key $ \key' -> with (fromIntegral n) $ \n' -> do + cCall key' xs n' >>= checkStatus + fromIntegral <$> peek n' >>= flip peekArray xs diff --git a/src/Data/Grib/Raw/Nearest.chs b/src/Data/Grib/Raw/Nearest.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Nearest.chs @@ -0,0 +1,167 @@ +{- | +Module : Data.Grib.Raw.Nearest +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Find the nearest grid points of an arbitrary point. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +module Data.Grib.Raw.Nearest + ( -- *The GRIB Nearest Iterator + GribNearest(..) + , gribNearestNew + , gribNearestFind + , gribNearestFindMultiple + , gribNearestDelete + , withGribNearest + + -- **Nearest flags + , GribNearestFlag(..) + ) where + +import Control.Exception (bracket) +import Foreign +import Foreign.C + +{#import Data.Grib.Raw.Handle #} +import Data.Grib.Raw.Marshal + + +#include + +{#typedef size_t CSize #} + +-- typedef struct grib_nearest grib_nearest; +-- +-- Unlike grib_iterator and grib_keys_iterator, grib_nearest doesn't +-- seem to hold a reference to the grib_handle. To keep the api +-- consistent, however, it is still treated analogous to those two +-- data types, i.e., no foreign pointer is used. +-- +-- |Grib nearest, structure used to find the nearest points of a +-- latitude longitude point. +{#pointer *grib_nearest as GribNearest newtype #} deriving (Eq, Show) + +-- |Filter flags for 'GribNearest'. +{#enum define GribNearestFlag { + GRIB_NEAREST_SAME_GRID as GribNearestSameGrid + , GRIB_NEAREST_SAME_DATA as GribNearestSameData + , GRIB_NEAREST_SAME_POINT as GribNearestSamePoint + } deriving (Eq, Show) #} + +-- grib_nearest* grib_nearest_new(grib_handle* h, int* error); +-- +-- |Create a new nearest from a handle, using current geometry. +-- +-- The returned object needs to be manually deleted with +-- 'gribNearestDelete'. This is handled automatically by +-- 'withGribNearest'. +{#fun grib_nearest_new as ^ { + `GribHandle' + , alloca- `CInt' checkStatusPtr*- + } -> `GribNearest' #} + +-- int grib_nearest_find(grib_nearest *nearest, grib_handle* h, double inlat, +-- double inlon, unsigned long flags, double* outlats, +-- double* outlons, double* values, double* distances, +-- int* indexes, size_t *len); +-- +-- |Find the 4 nearest points of a latitude longitude point. +-- +-- The flags are provided to speed up the process of searching. If you +-- are sure that the point you are asking for is not changing from a +-- call to another you can use GRIB_NEAREST_SAME_POINT. The same is +-- valid for the grid. Flags can be used together doing a bitwise +-- OR. The distances are given in kilometres. +{#fun grib_nearest_find as ^ { + `GribNearest' + , `GribHandle' + , `Double' + , `Double' + , fromFlagList `[GribNearestFlag]' + , allocaArray4- `[Double]' peekRealArray4* + , allocaArray4- `[Double]' peekRealArray4* + , allocaArray4- `[Double]' peekRealArray4* + , allocaArray4- `[Double]' peekRealArray4* + , allocaArray4- `[Int]' peekIntegralArray4* + , with4- `CSize' + } -> `()' checkStatus*- #} + where allocaArray4 :: Storable a => (Ptr a -> IO b) -> IO b + allocaArray4 = allocaArray 4 + peekIntegralArray4 = peekIntegralArray 4 + peekRealArray4 = peekRealArray 4 + with4 = with 4 + +-- int grib_nearest_delete(grib_nearest *nearest); +-- +-- |Frees an nearest from memory. +{#fun grib_nearest_delete as ^ { `GribNearest' } -> `()' checkStatus* #} + +-- int grib_nearest_find_multiple(grib_handle* h, int is_lsm, double* inlats, +-- double* inlons, long npoints, double* outlats, +-- double* outlons, double* values, +-- double* distances, int* indexes); +-- +-- This function is not macro expanded since the length of the output +-- arguments depend on the length of the input arguments. +-- +-- |Find the nearest point of a set of points whose latitudes and +-- longitudes are given in the inlats, inlons arrays respectively. +-- +-- If the flag is_lsm is 1 the nearest land point is returned and the +-- grib passed as handle (h) is considered a land sea mask. The land +-- nearest point is the nearest point with land sea mask +-- value>=0.5. If no nearest land points are found the nearest value +-- is returned. If the flag is_lsm is 0 the nearest point is +-- returned. values, distances, indexes (in the "values" array) for +-- the nearest points (ilons,ilats) are returned. +gribNearestFindMultiple :: GribHandle + -- ^handle from which geography and data + -- values are taken + -> Bool + -- ^lsm flag (@True@ -> nearest land, @False@ + -- -> nearest) + -> [Double] + -- ^latitudes of the points to search for + -> [Double] + -- ^longitudes of the points to search for + -> IO ([Double], [Double], [Double], [Double], [Int]) + -- ^an IO action that will return a tuple + -- @(latitudes, longitudes, values, distances, + -- indices)@ +gribNearestFindMultiple h lsm ilats ilons = + withGribHandle h $ \h' -> + let lsm' = fromBool lsm in + withArray (map realToFrac ilats) $ \ilats' -> + withArray (map realToFrac ilons) $ \ilons' -> + let n = min (length ilats) (length ilons) + n' = fromIntegral n in + allocaArray n $ \olats -> + allocaArray n $ \olons -> + allocaArray n $ \vals -> + allocaArray n $ \dists -> + allocaArray n $ \is -> do + status <- cCall h' lsm' ilats' ilons' n' olats olons vals dists is + checkStatus status + olats' <- map realToFrac <$> peekArray n olats + olons' <- map realToFrac <$> peekArray n olons + vals' <- map realToFrac <$> peekArray n vals + dists' <- map realToFrac <$> peekArray n dists + is' <- map fromIntegral <$> peekArray n is + return (olats', olons', vals', dists', is') + where cCall = {#call grib_nearest_find_multiple as gribNearestFindMultiple'_ #} + +-- |Safely create, use and delete a 'GribNearest'. +-- +-- This function is an easy alternative over using 'gribNearestNew' +-- and 'gribNearestDelete' directly. +withGribNearest :: GribHandle -> (GribNearest -> IO a) -> IO a +withGribNearest h = bracket (gribNearestNew h) gribNearestDelete diff --git a/src/Data/Grib/Raw/Types.hs b/src/Data/Grib/Raw/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Types.hs @@ -0,0 +1,31 @@ +{- | +Module : Data.Grib.Raw.Types +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Data types used to marshal parameters between C and Haskell. +-} + +module Data.Grib.Raw.Types + ( Bytes + , Key + , Message + ) where + +import Foreign +import Foreign.C + + +-- |A pointer to a number of bytes in memory. +type Bytes = Ptr CUChar + +-- |A key representing one or more consecutive octets in a GRIB +-- message. +type Key = String + +-- |A GRIB message stored in memory. +type Message = Ptr () diff --git a/src/Data/Grib/Raw/Value.chs b/src/Data/Grib/Raw/Value.chs new file mode 100644 --- /dev/null +++ b/src/Data/Grib/Raw/Value.chs @@ -0,0 +1,437 @@ +{- | +Module : Data.Grib.Raw.Value +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Access GRIB header and data values. + +Most of the documentation herein was copied from the official +documentation of +. +-} + +module Data.Grib.Raw.Value + ( -- * Get values + gribGetLong + , gribGetDouble + , gribGetLongArray + , gribGetDoubleArray + , gribGetDoubleElement + , gribGetDoubleElements + , gribGetString + , gribGetBytes + + , gribGetOffset + , gribGetSize + , gribGetLength + + -- * Set values + , gribSetLong + , gribSetDouble + , gribSetLongArray + , gribSetDoubleArray + , gribSetString + , gribSetBytes + + -- * Copy values + , gribCopyNamespace + ) where + +import Foreign +import Foreign.C + +{#import Data.Grib.Raw.Handle #} +import Data.Grib.Raw.Marshal + +#include + +{#typedef size_t CSize #} + +-- int grib_get_offset(grib_handle* h, const char* key, size_t* offset); +-- +-- |Get the number offset of a key in a message if several keys of +-- the same name are present, the offset of the last one is returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +{#fun grib_get_offset as ^ { + `GribHandle' + , withCString* `Key' + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_get_size(grib_handle* h, const char* key, size_t* size); +-- +-- |Get the number of coded value from a key, if several keys of the +-- same name are present, the total sum is returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +{#fun grib_get_size as ^ { + `GribHandle' + , withCString* `Key' + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_get_length(grib_handle* h, const char* key, size_t *length); +-- +-- |Get the length of the string representation of the key, if several +-- keys of the same name are present, the maximum length is returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +{#fun grib_get_length as ^ { + `GribHandle' + , withCString* `Key' + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_get_long(grib_handle* h, const char* key, long* value); +-- +-- |Get a long value from a key, if several keys of the same name are +-- present, the last one is returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +{#fun grib_get_long as ^ { + `GribHandle' + , withCString* `Key' + , alloca- `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_get_double(grib_handle* h, const char* key, double* value); +-- +-- |Get a double value from a key, if several keys of the same name +-- are present, the last one is returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +{#fun grib_get_double as ^ { + `GribHandle' + , withCString* `Key' + , alloca- `Double' peekReal* + } -> `()' checkStatus*- #} + +-- int grib_get_double_element(grib_handle* h, const char* key, int i, +-- double* value); +-- +-- There are no bounds check on i and a too large i often doesn't seem +-- to lead to a segmentation fault. +-- +-- |Get as double the i-th element of the "key" array. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +-- +-- __WARNING!__ There is no check if the index is out of bounds. +{#fun grib_get_double_element as ^ { + `GribHandle' + , withCString* `Key' + , `Int' + , alloca- `Double' peekReal* + } -> `()' checkStatus*- #} + +-- int grib_get_double_elements(grib_handle* h, const char* key, int* i, +-- long size, double* value); +-- +-- This function is not macro expanded since the length of the output +-- arguments depend on the length of the input arguments. +-- +-- |Get as double array the elements of the "key" array whose indexes +-- are listed in the input array i. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +-- +-- __WARNING!__ There is no check if the indices are out of bounds. +gribGetDoubleElements :: GribHandle -> Key -> [Int] -> IO [Double] +gribGetDoubleElements h key is = + withGribHandle h $ \h' -> + withCString key $ \key' -> + withArrayLen (map fromIntegral is) $ \n is' -> + allocaArray n $ \ds -> do + cCall h' key' is' (fromIntegral n) ds >>= checkStatus + map realToFrac <$> peekArray n ds + where cCall = {#call grib_get_double_elements as gribGetDoubleElements'_ #} + +-- int grib_get_string(grib_handle* h, const char* key, char* mesg, +-- size_t *length); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Get a string value from a key, if several keys of the same name +-- are present, the last one is returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribBufferTooSmall@ if the allocated string is +-- too small. +-- +-- This function takes an allocated 'CString' and its length, which is +-- used to retrieve the string returned by the IO action. The +-- 'CString' is not automatically allocated by this function since it +-- could potentially be re-used between multiple calls and the length +-- is not known beforehand. +gribGetString :: GribHandle -- ^the handle to get the data from + -> Key -- ^the key to be searched + -> CString -- ^the address of a string where the + -- data will be retrieved + -> Int -- ^the allocated length of the string + -> IO String -- ^an IO action that will return the + -- string +gribGetString h key cs n = + withGribHandle h $ \h' -> + withCString key $ \key' -> + with (fromIntegral n) $ \n' -> do + cCall h' key' cs n' >>= checkStatus + fromIntegral . subtract 1 <$> peek n' >>= curry peekCStringLen cs + where cCall = {#call grib_get_string as gribGetString'_ #} + +-- int grib_get_bytes(grib_handle* h, const char* key, unsigned char* bytes, +-- size_t *length); +-- +-- |Get raw bytes values from a key. +-- +-- If several keys of the same name are present, the last one is +-- returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribArrayTooSmall@ if the allocated array is +-- too small. +{#fun grib_get_bytes as ^ { + `GribHandle' + -- ^the handle to get the data from + , withCString* `Key' + -- ^the key to be searched + , id `Bytes' id + -- ^the address of a byte array where the data will be retrieved + , withIntegral* `Int' peekIntegral* + -- ^the allocated length of the byte array + } -> `()' checkStatus*- + -- ^an IO action that will return the address of the byte array + -- and the number of bytes retrieved +#} + +-- int grib_get_double_array(grib_handle* h, const char* key, double* vals, +-- size_t *length); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Get double array values from a key. +-- +-- If several keys of the same name are present, the last one is +-- returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribArrayTooSmall@ if the allocated array is +-- too small. +-- +-- This function takes an allocated array and its length, which is +-- used to retrieve the list returned by the IO action. The array is +-- not automatically allocated by this function since it could +-- potentially be re-used between multiple calls and the length is not +-- known beforehand. +gribGetDoubleArray :: GribHandle -- ^the handle to get the data from + -> Key -- ^the key to be searched + -> Ptr CDouble -- ^the address of a double array + -- where the data will be retrieved + -> Int -- ^the allocated length of the double + -- array + -> IO [Double] -- ^an IO action that will return the + -- data in a list +gribGetDoubleArray h key ds n = withGribHandle h $ \h' -> + map realToFrac <$> getArray (cCall h') key ds n + where cCall = {#call grib_get_double_array as gribGetDoubleArray'_ #} + +-- int grib_get_long_array(grib_handle* h, const char* key, long* vals, +-- size_t *length); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Get long array values from a key. +-- +-- If several keys of the same name are present, the last one is +-- returned. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribArrayTooSmall@ if the allocated array is +-- too small. +-- +-- This function takes an allocated array and its length, which is +-- used to retrieve the list returned by the IO action. The array is +-- not automatically allocated by this function since it could +-- potentially be re-used between multiple calls and the length is not +-- known beforehand. +gribGetLongArray :: GribHandle -- ^the handle to get the data from + -> Key -- ^the key to be searched + -> Ptr CLong -- ^the address of a long array where + -- the data will be retrieved + -> Int -- ^the allocated length of the long + -- array + -> IO [Int] -- ^an IO action that will return the + -- data in a list +gribGetLongArray h key ls n = withGribHandle h $ \h' -> + map fromIntegral <$> getArray (cCall h') key ls n + where cCall = {#call grib_get_long_array as gribGetLongArray'_ #} + +-- int grib_copy_namespace(grib_handle* dest, const char* name, +-- grib_handle* src); +-- +-- |Copy the keys belonging to a given namespace from a source handle +-- to a destination handle. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotImplemented@. +{#fun grib_copy_namespace as ^ { + `GribHandle' -- ^destination handle + , maybeWithCString* `Maybe String' -- ^namespace (pass @Nothing@ + -- to copy all keys) + , `GribHandle' -- ^source handle + } -> `()' checkStatus*- -- ^an IO action that will + -- copy the keys +#} + +-- int grib_set_long(grib_handle* h, const char* key, long val); +-- +-- |Set a long value from a key. +-- +-- If several keys of the same name are present, the last one is set. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribReadOnly@ if the key is read-only. +{#fun grib_set_long as ^ { + `GribHandle' + , withCString* `Key' + , `Int' + } -> `()' checkStatus*- #} + +-- int grib_set_double(grib_handle* h, const char* key, double val); +-- + +-- |Set a double value from a key. +-- +-- If several keys of the same name are present, the last one is set. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribReadOnly@ if the key is read-only. +{#fun grib_set_double as ^ { + `GribHandle' + , withCString* `Key' + , `Double' + } -> `()' checkStatus*- #} + +-- int grib_set_string(grib_handle* h, const char* key, const char* mesg, +-- size_t *length); +-- +-- This function is not macro expanded since an output marshaller +-- would want to return another data type than the corresponding input +-- marshaller accepts. +-- +-- |Set a string value from a key and return the actual packed length. +-- +-- If several keys of the same name are present, the last one is set. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribReadOnly@ if the key is read-only. +gribSetString :: GribHandle -> Key -> String -> IO Int +gribSetString h key msg = + withGribHandle h $ \h' -> + withCString key $ \key' -> + withCString msg $ \msg' -> + with (fromIntegral $ length msg) $ \n -> + cCall h' key' msg' n >>= checkStatus >> fromIntegral <$> peek n + where cCall = {#call grib_set_string as gribSetString'_ #} + +-- int grib_set_bytes(grib_handle* h, const char* key, +-- const unsigned char* bytes, size_t *length); +-- +-- |Set a bytes array from a key and return the actual packed length. +-- +-- If several keys of the same name are present, the last one is set. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing. +{#fun grib_set_bytes as ^ { + `GribHandle' + , withCString* `Key' + , id `Bytes' + , withIntegral* `Int' peekIntegral* + } -> `()' checkStatus*- #} + +-- int grib_set_double_array(grib_handle* h, const char* key, +-- const double* vals, size_t length); +-- +-- |Set a double array from a key. +-- +-- If several keys of the same name are present, the last one is set. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribReadOnly@ if the key is read-only. +-- +-- __WARNING!__ Strange things seem to happen if an empty list is +-- passed in. +{#fun grib_set_double_array as ^ { + `GribHandle' + , withCString* `Key' + , withRealArrayLen* `[Double]'& + } -> `()' checkStatus*- #} + +-- int grib_set_long_array(grib_handle* h, const char* key, const long* vals, +-- size_t length); +-- +-- |Set a long array from a key. +-- +-- If several keys of the same name are present, the last one is set. +-- +-- This operation may fail with: +-- +-- * @isGribException GribNotFound@ if the key is missing; or +-- +-- * @isGribException GribReadOnly@ if the key is read-only. +{#fun grib_set_long_array as ^ { + `GribHandle' + , withCString* `Key' + , withIntegralArrayLen* `[Int]'& + } -> `()' checkStatus*- #} diff --git a/test/Data/Grib/Raw/CFileSpec.hs b/test/Data/Grib/Raw/CFileSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/CFileSpec.hs @@ -0,0 +1,80 @@ +{- | +Module : Data.Grib.Raw.CFileSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.CFile. +-} + +module Data.Grib.Raw.CFileSpec (main, spec) where + +import Control.Exception (bracket) +import Foreign +import System.Directory (getTemporaryDirectory, removeFile) +import System.IO (hClose, openTempFile) +import System.IO.Error (isDoesNotExistError) + +import Test.Hspec +import Data.Grib.Raw.CFile + + +main :: IO () +main = hspec spec + +createTempFile :: IO FilePath +createTempFile = do + tempDir <- getTemporaryDirectory + (path, h) <- openTempFile tempDir "CFile.test" + hClose h + return path + +withTempFile :: (FilePath -> IO ()) -> IO () +withTempFile = bracket createTempFile removeFile + +spec :: Spec +spec = do + describe "openBinaryCFile" $ do + it "should open an existing file in ReadMode" $ withTempFile $ \name -> do + f <- openBinaryCFile name ReadMode + f `shouldNotBe` nullPtr + closeCFile f + + it "should fail to open a non-existing file in ReadMode" $ + openBinaryCFile "I-dont-exist.test" ReadMode + `shouldThrow` isDoesNotExistError + + it "should open a file in WriteMode" $ withTempFile $ \name -> do + f <- openBinaryCFile name WriteMode + f `shouldNotBe` nullPtr + closeCFile f + + it "should open a file in AppendMode" $ withTempFile $ \name -> do + f <- openBinaryCFile name AppendMode + f `shouldNotBe` nullPtr + closeCFile f + + it "should open a file in ReadWriteMode" $ withTempFile $ \name -> do + f <- openBinaryCFile name ReadWriteMode + f `shouldNotBe` nullPtr + closeCFile f + + describe "withBinaryCFile" $ do + it "should open an existing file in ReadMode" $ withTempFile $ \name -> + withBinaryCFile name ReadMode (`shouldNotBe` nullPtr) + + it "should fail to open a non-existing file in ReadMode" $ + withBinaryCFile "I-dont-exist.test" ReadMode (\_ -> return ()) + `shouldThrow` isDoesNotExistError + + it "should open a file in WriteMode" $ withTempFile $ \name -> + withBinaryCFile name WriteMode (`shouldNotBe` nullPtr) + + it "should open a file in AppendMode" $ withTempFile $ \name -> + withBinaryCFile name AppendMode (`shouldNotBe` nullPtr) + + it "should open a file in ReadWriteMode" $ withTempFile $ \name -> + withBinaryCFile name ReadWriteMode (`shouldNotBe` nullPtr) diff --git a/test/Data/Grib/Raw/ContextSpec.hs b/test/Data/Grib/Raw/ContextSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/ContextSpec.hs @@ -0,0 +1,70 @@ +{- | +Module : Data.Grib.Raw.ContextSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.Context. +-} + +module Data.Grib.Raw.ContextSpec (main, spec) where + +import Control.Exception (bracket) + +import Test.Hspec +import Data.Grib.Raw.Context + + +main :: IO () +main = hspec spec + +withGribexMode :: GribContext -> IO () -> IO () +withGribexMode ctx action = + bracket saveMode restoreMode (const action) + where saveMode = gribGetGribexMode ctx + restoreMode True = gribGribexModeOn ctx + restoreMode False = gribGribexModeOff ctx + +spec :: Spec +spec = do + let ctx = defaultGribContext + + describe "gribContextGetDefault" $ + it "should not return a null context" $ + gribContextGetDefault `shouldNotReturn` defaultGribContext + + describe "gribContextNew" $ do + it "should not return a null context" $ + gribContextNew ctx `shouldNotReturn` defaultGribContext + + it "should not return the default context" $ + gribContextGetDefault >>= (gribContextNew ctx `shouldNotReturn`) + + describe "gribGtsHeaderOff" $ + it "should return nothing" $ + gribGtsHeaderOff ctx `shouldReturn` () + + describe "gribGtsHeaderOn" $ after_ (gribGtsHeaderOff ctx) $ + it "should return nothing" $ + gribGtsHeaderOn ctx `shouldReturn` () + + describe "gribGribexModeOn" $ around_ (withGribexMode ctx) $ + it "should enable gribex mode" $ do + gribGribexModeOn ctx `shouldReturn` () + gribGetGribexMode ctx `shouldReturn` True + + describe "gribGribexModeOff" $ around_ (withGribexMode ctx) $ + it "should disable gribex mode" $ do + gribGribexModeOff ctx `shouldReturn` () + gribGetGribexMode ctx `shouldReturn` False + + describe "gribMultiSupportOff" $ + it "should return nothing" $ + gribMultiSupportOff ctx `shouldReturn` () + + describe "gribMultiSupportOn" $ after_ (gribMultiSupportOff ctx) $ + it "should return nothing" $ + gribMultiSupportOn ctx `shouldReturn` () diff --git a/test/Data/Grib/Raw/HandleSpec.hs b/test/Data/Grib/Raw/HandleSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/HandleSpec.hs @@ -0,0 +1,120 @@ +{- | +Module : Data.Grib.Raw.HandleSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.Handle. +-} + +module Data.Grib.Raw.HandleSpec (main, spec) where + +import Control.Monad (void) +import Foreign (allocaBytes, nullPtr) + +import Test.Hspec +import Data.Grib.Raw +import Data.Grib.Raw.Exception +import Data.Grib.Raw.Test + + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + let ctx = defaultGribContext + + describe "gribHandleNewFromSamples" $ do + it "should succeed for the GRIB1 resource" $ + void $ gribHandleNewFromSamples ctx "GRIB1" + + it "should fail with NullPtrReturned for a missing resource" $ + gribHandleNewFromSamples ctx "GRIB0" `shouldThrow` isNullPtrReturned + + describe "gribHandleClone" $ + it "should succeed" $ + withRegular1 $ \h -> + void $ gribHandleClone h + + describe "gribWriteMessage" $ + let gribPath = "test/stage/test.grib" in + after_ (safeRemoveFile gribPath) $ + it "should write a message to file" $ + withRegular1 $ \h -> do + gribWriteMessage h gribPath "wb" `shouldReturn` () + withBinaryCFile gribPath ReadMode $ \f -> + void $ gribHandleNewFromFile ctx f + + describe "gribGetMessage" $ + it "should return a message of length 1100" $ + withRegular1 $ \h -> do + (_, len) <- gribGetMessage h + len `shouldBe` 1100 + + describe "gribGetMessageCopy" $ do + it "should return a message of length 1100" $ + withRegular1 $ \h -> allocaBytes 1101 $ \p -> do + (_, len) <- gribGetMessageCopy h p 1101 + len `shouldBe` 1100 + + it "should fail with GribBufferTooSmall when the allocation is too small" $ + withRegular1 $ \h -> + gribGetMessageCopy h nullPtr 0 + `shouldThrow` isGribException GribBufferTooSmall + + describe "gribHandleNewFromMessage" $ + it "should succeed if the message is valid" $ + withRegular1 $ \h -> + void $ gribGetMessage h >>= uncurry (gribHandleNewFromMessage ctx) + + describe "gribHandleNewFromMessageCopy" $ do + it "should succeed if the message is valid" $ + withRegular1 $ \h -> + void $ gribGetMessage h >>= uncurry (gribHandleNewFromMessageCopy ctx) + + it "should fail with NullPtrReturned if the message is invalid" $ + gribHandleNewFromMessageCopy ctx nullPtr 0 + `shouldThrow` isNullPtrReturned + + describe "gribHandleNewFromMultiMessage" $ + let checkMultiMessageLength = withRegular1 $ \h -> do + (msg, len) <- gribGetMessage h + (_, _, len') <- gribHandleNewFromMultiMessage ctx msg len + len' `shouldBe` 0 + in do + context "in multi mode" $ after_ (gribMultiSupportOff ctx) $ + it "should return a message of zero length if given a single message" $ + gribMultiSupportOn ctx >> checkMultiMessageLength + + context "not in multi mode" $ + it "should return a message of zero length if given a single message" + checkMultiMessageLength + + describe "gribMultiHandleAppend" $ + it "should succeed if the handle is valid" $ + withRegular1 $ \h -> + void $ gribMultiHandleNew ctx >>= gribMultiHandleAppend h 4 + + describe "gribMultiHandleWrite" $ + let gribPath = "test/stage/test.grib" in + after_ (safeRemoveFile gribPath) $ + after_ (gribMultiSupportOff ctx) $ + it "should write a multi message to file" $ do + gribMultiSupportOn ctx + withRegular2 $ \h -> do + mh <- gribMultiHandleNew ctx + gribMultiHandleAppend h 4 mh + gribMultiHandleAppend h 4 mh + withBinaryCFile gribPath WriteMode $ \f -> + gribMultiHandleWrite mh f + withGribFile gribPath $ \h' -> + gribGetLong h' "editionNumber" `shouldReturn` 2 + + describe "gribCountInFile" $ + it "should return 1 for the regular grib file" $ + withBinaryCFile regular1Path ReadMode $ \f -> + gribCountInFile ctx f `shouldReturn` 1 diff --git a/test/Data/Grib/Raw/IndexSpec.hs b/test/Data/Grib/Raw/IndexSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/IndexSpec.hs @@ -0,0 +1,101 @@ +{- | +Module : Data.Grib.Raw.IndexSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.Index. +-} + +module Data.Grib.Raw.IndexSpec (main, spec) where + +import Control.Exception (tryJust) +import Control.Monad (guard) +import Data.Either (isRight) +import Foreign (alloca) + +import Test.Hspec +import Data.Grib.Raw +import Data.Grib.Raw.Exception +import Data.Grib.Raw.Test hiding (withRegular1) + + +main :: IO () +main = hspec spec + +withGribIndex :: FilePath -> [Key] -> (GribIndex -> IO ()) -> IO () +withGribIndex name keys = (gribIndexNewFromFile defaultGribContext name keys >>=) + +withRegular1 :: [Key] -> (GribIndex -> IO ()) -> IO () +withRegular1 = withGribIndex regular1Path + +isGribEndOfIndex :: GribException -> Bool +isGribEndOfIndex = isGribException GribEndOfIndex + +spec :: Spec +spec = do + let ctx = defaultGribContext + keys = ["paramId", "number"] + + describe "gribIndexGetSize" $ + it "should return 1 for Ni" $ + withRegular1 ["Ni"] $ \idx -> + gribIndexGetSize idx "Ni" `shouldReturn` 1 + + describe "gribIndexGetLong" $ + it "should return [16] for Ni" $ + withRegular1 ["Ni"] $ \idx -> alloca $ \l -> + gribIndexGetLong idx "Ni" l 1 `shouldReturn` [16] + + describe "gribIndexGetDouble" $ + it "should return [60] for yFirst" $ + withRegular1 ["yFirst"] $ \idx -> alloca $ \d -> + gribIndexGetDouble idx "yFirst" d 1 `shouldReturn` [60] + + describe "gribIndexGetString" $ + it "should return [\"grid_simple\"] for packingType" $ + withRegular1 ["packingType"] $ \idx -> alloca $ \s -> + gribIndexGetString idx "packingType" s 1 `shouldReturn` ["grid_simple"] + + describe "gribHandleNewFromIndex" $ do + it "should succeed after gribIndexSelectLong \"Ni\" 16" $ + withRegular1 ["Ni"] $ \idx -> do + gribIndexSelectLong idx "Ni" 16 `shouldReturn` () + tryJust (guard . isGribEndOfIndex) (gribHandleNewFromIndex idx) >>= + (`shouldSatisfy` isRight) + + it "should succeed after gribIndexSelectDouble \"yFirst\" 60" $ + withRegular1 ["yFirst"] $ \idx -> do + gribIndexSelectDouble idx "yFirst" 60 `shouldReturn` () + tryJust (guard . isGribEndOfIndex) (gribHandleNewFromIndex idx) >>= + (`shouldSatisfy` isRight) + + it "should succeed after gribIndexSelectString \"packingtype\" \ + \\"grid_simple\"" $ + withRegular1 ["packingType"] $ \idx -> do + gribIndexSelectString idx "packingType" "grid_simple" `shouldReturn` () + tryJust (guard . isGribEndOfIndex) (gribHandleNewFromIndex idx) >>= + (`shouldSatisfy` isRight) + + it "should fail with GribEndOfIndex after selecting nothing" $ + withRegular1 ["Ni"] $ \idx -> do + gribIndexSelectLong idx "Ni" 0 `shouldReturn` () + gribHandleNewFromIndex idx `shouldThrow` isGribEndOfIndex + + describe "gribIndexNew and gribIndexAddFile" $ + it "should create a new index and add a file to it" $ do + idx <- gribIndexNew ctx keys + gribIndexAddFile idx regular1Path `shouldReturn` () + gribIndexGetSize idx "paramId" `shouldReturn` 1 + + describe "gribIndexWrite and gribIndexRead" $ + let idxPath = "test/stage/test.grib.idx" in + after_ (safeRemoveFile idxPath) $ + it "should write an index to file and read it back in again" $ + withRegular1 keys $ \idx -> do + gribIndexWrite idx idxPath `shouldReturn` () + idx' <- gribIndexRead ctx idxPath + gribIndexGetSize idx' "paramId" `shouldReturn` 1 diff --git a/test/Data/Grib/Raw/IteratorSpec.hs b/test/Data/Grib/Raw/IteratorSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/IteratorSpec.hs @@ -0,0 +1,48 @@ +{- | +Module : Data.Grib.Raw.IteratorSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.Iterator. +-} + +module Data.Grib.Raw.IteratorSpec (main, spec) where + +import Test.Hspec +import Data.Grib.Raw +import Data.Grib.Raw.Test + + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "GribIterator" $ do + it "should have next after creation" $ + withRegular1 $ \h -> withGribIterator h 0 $ \iter -> + gribIteratorHasNext iter `shouldReturn` True + + it "should not have previous after creation" $ + withRegular1 $ \h -> withGribIterator h 0 $ \iter -> do + (status, _, _, _) <- gribIteratorPrevious iter + status `shouldBe` False + + it "should return (True, 60, 0, 279) in the 1st step" $ + withRegular1 $ \h -> withGribIterator h 0 $ \iter -> + gribIteratorNext iter `shouldReturn` (True, 60, 0, 279) + + it "should return (True, 60, 2, 279.961) in the 2nd step" $ + withRegular1 $ \h -> withGribIterator h 0 $ \iter -> do + _ <- gribIteratorNext iter + gribIteratorNext iter `shouldReturn` (True, 60, 2, 279.9609375) + + it "should return (True, 60, 0, 279) after reset" $ + withRegular1 $ \h -> withGribIterator h 0 $ \iter -> do + _ <- gribIteratorNext iter + gribIteratorReset iter + gribIteratorNext iter `shouldReturn` (True, 60, 0, 279) diff --git a/test/Data/Grib/Raw/KeysIteratorSpec.hs b/test/Data/Grib/Raw/KeysIteratorSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/KeysIteratorSpec.hs @@ -0,0 +1,60 @@ +{- | +Module : Data.Grib.Raw.KeysIteratorSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.KeysIterator. +-} + +module Data.Grib.Raw.KeysIteratorSpec (main, spec) where + +import Test.Hspec +import Data.Grib.Raw +import Data.Grib.Raw.Test + + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "GribKeysIterator" $ do + it "should return parametersVersion in the 1st step with no filters" $ + withRegular1 $ \h -> withGribKeysIterator h [] Nothing $ \kiter -> do + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorGetName kiter `shouldReturn` "parametersVersion" + + it "should return UseEcmfConventions in the 2nd step with no filters" $ + withRegular1 $ \h -> withGribKeysIterator h [] Nothing $ \kiter -> do + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorGetName kiter `shouldReturn` "UseEcmfConventions" + + it "should return totalLength in the 1st step with SkipComputed" $ + let flags = [GribKeysIteratorSkipComputed] in + withRegular1 $ \h -> withGribKeysIterator h flags Nothing $ \kiter -> do + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorGetName kiter `shouldReturn` "totalLength" + + it "should return totalLength when SkipComputed is set after creation" $ + let flags = [GribKeysIteratorSkipComputed] in + withRegular1 $ \h -> withGribKeysIterator h [] Nothing $ \kiter -> do + gribKeysIteratorSetFlags kiter flags + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorGetName kiter `shouldReturn` "totalLength" + + it "should return edition in the 1st step in namespace ls" $ + withRegular1 $ \h -> withGribKeysIterator h [] (Just "ls") $ \kiter -> do + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorGetName kiter `shouldReturn` "edition" + + it "should return parametersVersion after rewinding with no filters" $ + withRegular1 $ \h -> withGribKeysIterator h [] Nothing $ \kiter -> do + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorRewind kiter + gribKeysIteratorNext kiter `shouldReturn` True + gribKeysIteratorGetName kiter `shouldReturn` "parametersVersion" diff --git a/test/Data/Grib/Raw/NearestSpec.hs b/test/Data/Grib/Raw/NearestSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/NearestSpec.hs @@ -0,0 +1,40 @@ +{- | +Module : Data.Grib.Raw.NearestSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.Nearest. +-} + +module Data.Grib.Raw.NearestSpec (main, spec) where + +import Test.Hspec +import Data.Grib.Raw +import Data.Grib.Raw.Test + + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "gribNearestFind" $ + it "should return indices [248, 247, 232, 231] for a point (31, 15)" $ + withRegular1 $ \h -> withGribNearest h $ \nearest -> + gribNearestFind nearest h 31 15 [] `shouldReturn` + ([30, 30, 32, 32], [16, 14, 16, 14], + [289.1650390625, 288.1396484375, 289.1982421875, 288.2177734375], + [146.6943567638852 , 146.6943567638852 , + 146.04418798713152, 146.04418798713152], + [248, 247, 232, 231]) + + describe "gribNearestFindMultiple" $ + it "should return indices [247, 248] for points (31, 14) and (31, 16)" $ + withRegular1 $ \h -> + gribNearestFindMultiple h False [31, 31] [14, 16] `shouldReturn` + ([30, 30], [14, 16], [288.1396484375, 289.1650390625], + [111.13331652195225, 111.13331652195225], [247, 248]) diff --git a/test/Data/Grib/Raw/Test.hs b/test/Data/Grib/Raw/Test.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/Test.hs @@ -0,0 +1,48 @@ +{- | +Module : Data.Grib.Raw.Test +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Utilities for the unit tests of HGrib's raw interface. +-} + +module Data.Grib.Raw.Test + ( safeRemoveFile + , withGribFile + , regular1Path + , regular2Path + , withRegular1 + , withRegular2 + ) where + +import Control.Exception (tryJust) +import Control.Monad ((>=>), guard, void) +import System.Directory (removeFile) +import System.IO.Error (isDoesNotExistError) + +import Data.Grib.Raw + + +safeRemoveFile :: FilePath -> IO () +safeRemoveFile path = + void $ tryJust (guard . isDoesNotExistError) (removeFile path) + +withGribFile :: FilePath -> (GribHandle -> IO ()) -> IO () +withGribFile name f = withBinaryCFile name ReadMode $ + gribHandleNewFromFile defaultGribContext >=> f + +regular1Path :: FilePath +regular1Path = "test/stage/regular_latlon_surface.grib1" + +regular2Path :: FilePath +regular2Path = "test/stage/regular_latlon_surface.grib2" + +withRegular1 :: (GribHandle -> IO ()) -> IO () +withRegular1 = withGribFile regular1Path + +withRegular2 :: (GribHandle -> IO ()) -> IO () +withRegular2 = withGribFile regular2Path diff --git a/test/Data/Grib/Raw/ValueSpec.hs b/test/Data/Grib/Raw/ValueSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Grib/Raw/ValueSpec.hs @@ -0,0 +1,282 @@ +{- | +Module : Data.Grib.Raw.ValueSpec +Copyright : (c) Mattias Jakobsson 2015 +License : GPL-3 + +Maintainer : mjakob422@gmail.com +Stability : unstable +Portability : portable + +Unit and regression tests for Data.Grib.Raw.Value. +-} + +module Data.Grib.Raw.ValueSpec (main, spec) where + +import Foreign + +import Test.Hspec +import Data.Grib.Raw +import Data.Grib.Raw.Exception +import Data.Grib.Raw.Test + + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "gribGetLong" $ do + it "should return 16 for numberOfPointsAlongAParallel" $ + withRegular1 $ \h -> + gribGetLong h "Ni" `shouldReturn` 16 + + it "should return 31 for numberOfPointsAlongAMeridian" $ + withRegular1 $ \h -> + gribGetLong h "Nj" `shouldReturn` 31 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetLong h "missingKey" `shouldThrow` isGribException GribNotFound + + describe "gribGetDouble" $ do + it "should return 60 for latitudeOfFirstGridPointInDegrees" $ + withRegular1 $ \h -> + gribGetDouble h "latitudeOfFirstGridPointInDegrees" `shouldReturn` 60 + + it "should return 0 for longitudeOfFirstGridPointInDegrees" $ + withRegular1 $ \h -> + gribGetDouble h "longitudeOfFirstGridPointInDegrees" `shouldReturn` 0 + + it "should return 0 for latitudeOfLastGridPointInDegrees" $ + withRegular1 $ \h -> + gribGetDouble h "latitudeOfLastGridPointInDegrees" `shouldReturn` 0 + + it "should return 30 for longitudeOfLastGridPointInDegrees" $ + withRegular1 $ \h -> + gribGetDouble h "longitudeOfLastGridPointInDegrees" `shouldReturn` 30 + + it "should return 2 for jDirectionIncrementInDegrees" $ + withRegular1 $ \h -> + gribGetDouble h "jDirectionIncrementInDegrees" `shouldReturn` 2 + + it "should return 2 for iDirectionIncrementInDegrees" $ + withRegular1 $ \h -> + gribGetDouble h "iDirectionIncrementInDegrees" `shouldReturn` 2 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetDouble h "missingKey" `shouldThrow` isGribException GribNotFound + + describe "gribGetLongArray" $ do + it "should return [16] for numberOfPointsAlongAParallel" $ + withRegular1 $ \h -> allocaArray 10 $ \ls -> + gribGetLongArray h "Ni" ls 10 `shouldReturn` [16] + + it "should return [31] for numberOfPointsAlongAMeridian" $ + withRegular1 $ \h -> allocaArray 10 $ \ls -> + gribGetLongArray h "Nj" ls 10 `shouldReturn` [31] + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> allocaArray 10 $ \ls -> + gribGetLongArray h "missingKey" ls 10 + `shouldThrow` isGribException GribNotFound + + it "should fail with GribArrayTooSmall if the array is too small" $ + withRegular1 $ \h -> + gribGetLongArray h "Ni" nullPtr 0 + `shouldThrow` isGribException GribArrayTooSmall + + describe "gribGetDoubleArray" $ do + it "should return 496 values with an average of 291.585" $ + withRegular1 $ \h -> allocaArray 500 $ \ds -> do + ds' <- gribGetDoubleArray h "values" ds 500 + length ds' `shouldBe` 496 + sum ds' / 496 `shouldBe` 291.5852483933972 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> allocaArray 10 $ \ds -> + gribGetDoubleArray h "missingKey" ds 10 + `shouldThrow` isGribException GribNotFound + + it "should fail with GribArrayTooSmall if the array is too small" $ + withRegular1 $ \h -> + gribGetDoubleArray h "values" nullPtr 0 + `shouldThrow` isGribException GribArrayTooSmall + + describe "gribGetDoubleElement" $ do + it "should return 279 for the 0th value" $ + withRegular1 $ \h -> + gribGetDoubleElement h "values" 0 `shouldReturn` 279 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetDoubleElement h "missingKey" 0 + `shouldThrow` isGribException GribNotFound + + describe "gribGetDoubleElements" $ do + it "should return [279] for the 0th value" $ + withRegular1 $ \h -> + gribGetDoubleElements h "values" [0] `shouldReturn` [279] + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetDoubleElements h "missingKey" [0] + `shouldThrow` isGribException GribNotFound + + describe "gribGetString" $ do + it "should return \"grid_simple\" for packingType" $ + withRegular1 $ \h -> allocaBytes 12 $ \bufr -> + gribGetString h "packingType" bufr 12 `shouldReturn` "grid_simple" + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> allocaBytes 2 $ \bufr -> + gribGetString h "missingKey" bufr 2 + `shouldThrow` isGribException GribNotFound + + it "should fail with GribBufferTooSmall if the buffer is too small" $ + withRegular1 $ \h -> allocaBytes 1 $ \bufr -> + gribGetString h "packingType" bufr 1 + `shouldThrow` isGribException GribBufferTooSmall + + describe "gribGetBytes" $ do + it "should return 2 for numberOfPointsAlongAParallel" $ + withRegular1 $ \h -> allocaArray 4 $ \bs -> + gribGetBytes h "Ni" bs 4 >>= \(_, n) -> n `shouldBe` 2 + + it "should return 2 for numberOfPointsAlongAMeridian" $ + withRegular1 $ \h -> allocaArray 4 $ \bs -> + gribGetBytes h "Nj" bs 4 >>= \(_, n) -> n `shouldBe` 2 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> allocaArray 1 $ \bs -> + gribGetBytes h "missingKey" bs 1 + `shouldThrow` isGribException GribNotFound + + it "should fail with GribArrayTooSmall if the array is too small" $ + withRegular1 $ \h -> allocaArray 1 $ \bs -> + gribGetBytes h "totalLength" bs 1 + `shouldThrow` isGribException GribArrayTooSmall + + describe "gribGetOffset" $ do + it "should return 66 for numberOfPointsAlongAParallel" $ + withRegular1 $ \h -> + gribGetOffset h "Ni" `shouldReturn` 66 + + it "should return 68 for numberOfPointsAlongAMeridian" $ + withRegular1 $ \h -> + gribGetOffset h "Nj" `shouldReturn` 68 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetOffset h "missingKey" `shouldThrow` isGribException GribNotFound + + describe "gribGetSize" $ do + it "should return 496 for the values" $ + withRegular1 $ \h -> + gribGetSize h "values" `shouldReturn` 496 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetSize h "missingKey" `shouldThrow` isGribException GribNotFound + + describe "gribGetLength" $ do + it "should return 256 for packingType" $ + withRegular1 $ \h -> + gribGetLength h "packingType" `shouldReturn` 256 + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribGetLength h "missingKey" `shouldThrow` isGribException GribNotFound + + describe "gribSetLong" $ do + it "should update centre to 80" $ + withRegular1 $ \h -> let newCentre = 80 in do + gribSetLong h "centre" newCentre + gribGetLong h "centre" `shouldReturn` newCentre + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribSetLong h "missingKey" 0 `shouldThrow` isGribException GribNotFound + + it "should fail with GribReadOnly if the key is read-only" $ + withRegular1 $ \h -> + gribSetLong h "getNumberOfValues" 0 + `shouldThrow` isGribException GribReadOnly + + describe "gribSetDouble" $ do + it "should update missingValue to 0" $ + withRegular1 $ \h -> let newMissingValue = 0 in do + gribSetDouble h "missingValue" newMissingValue + gribGetDouble h "missingValue" `shouldReturn` newMissingValue + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribSetDouble h "missingKey" 0 `shouldThrow` isGribException GribNotFound + + it "should fail with GribReadOnly if the key is read-only" $ + withRegular1 $ \h -> + gribSetDouble h "referenceValue" 0 + `shouldThrow` isGribException GribReadOnly + + describe "gribSetLongArray" $ do + it "should update centre to 80" $ + withRegular1 $ \h -> let newCentre = 80 in do + gribSetLongArray h "centre" [newCentre] + gribGetLong h "centre" `shouldReturn` newCentre + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribSetLongArray h "missingKey" [1] + `shouldThrow` isGribException GribNotFound + + it "should fail with GribReadOnly if the key is read-only" $ + withRegular1 $ \h -> + gribSetLongArray h "getNumberOfValues" [1] + `shouldThrow` isGribException GribReadOnly + + describe "gribSetDoubleArray" $ do + it "should set all values to zero" $ + withRegular1 $ \h -> gribGetSize h "values" >>= \n -> + allocaArray n $ \ds -> let newVals = replicate n 0 in do + gribSetDoubleArray h "values" newVals + gribGetDoubleArray h "values" ds n `shouldReturn` newVals + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribSetDoubleArray h "missingKey" [1] + `shouldThrow` isGribException GribNotFound + + it "should fail with GribReadOnly if the key is read-only" $ + withRegular1 $ \h -> + gribSetDoubleArray h "referenceValue" [1] + `shouldThrow` isGribException GribReadOnly + + describe "gribSetString" $ do + it "should set a new file key and return its length" $ + withRegular1 $ \h -> + let len = length regular1Path in + allocaBytes (len + 1) $ \cs -> do + gribSetString h "file" regular1Path `shouldReturn` len + gribGetString h "file" cs (len + 1) `shouldReturn` regular1Path + + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> + gribSetString h "missingKey" "" + `shouldThrow` isGribException GribNotFound + + it "should fail with GribReadOnly if the key is read-only" $ + withRegular1 $ \h -> + gribSetString h "referenceValue" "" + `shouldThrow` isGribException GribReadOnly + + describe "gribSetBytes" $ + it "should fail with GribNotFound if the key is missing" $ + withRegular1 $ \h -> allocaArray 1 $ \bs -> + gribSetBytes h "missingKey" bs 1 + `shouldThrow` isGribException GribNotFound + + describe "gribCopyNamespace" $ + it "should fail with GribNotImplemented" $ + withRegular1 $ \h -> + gribCopyNamespace h Nothing h + `shouldThrow` isGribException GribNotImplemented diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/stage/regular_latlon_surface.grib1 b/test/stage/regular_latlon_surface.grib1 new file mode 100644 Binary files /dev/null and b/test/stage/regular_latlon_surface.grib1 differ diff --git a/test/stage/regular_latlon_surface.grib2 b/test/stage/regular_latlon_surface.grib2 new file mode 100644 Binary files /dev/null and b/test/stage/regular_latlon_surface.grib2 differ