[bug#58261] [PATCH v2 06/13] gnu: Add gemmi.

[David Elsing]

* gnu/packages/chemistry.scm (gemmi): New variable.
---
 gnu/packages/chemistry.scm                    | 118 +++++++++++
 .../patches/gemmi-fix-sajson-types.patch      |  11 +
 .../sajson-for-gemmi-build-with-gcc10.patch   |  45 ++++
 .../sajson-for-gemmi-numbers-as-strings.patch | 195 ++++++++++++++++++
 4 files changed, 369 insertions(+)
 create mode 100644 gnu/packages/patches/gemmi-fix-sajson-types.patch
 create mode 100644 gnu/packages/patches/sajson-for-gemmi-build-with-gcc10.patch
 create mode 100644 
gnu/packages/patches/sajson-for-gemmi-numbers-as-strings.patch

diff --git a/gnu/packages/chemistry.scm b/gnu/packages/chemistry.scm
index c517610fe8..d8f1608a3a 100644
--- a/gnu/packages/chemistry.scm
+++ b/gnu/packages/chemistry.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 ;;; Copyright © 2020 Vincent Legoll <vincent.legoll@gmail.com>
 ;;; Copyright © 2021 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2022 David Elsing <david.elsing@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +24,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages chemistry)
+  #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module ((guix licenses) #:prefix license:)
@@ -35,6 +37,7 @@ (define-module (gnu packages chemistry)
   #:use-module (gnu packages boost)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
+  #:use-module (gnu packages cpp)
   #:use-module (gnu packages documentation)
   #:use-module (gnu packages fontutils)
   #:use-module (gnu packages gl)
@@ -50,8 +53,10 @@ (define-module (gnu packages chemistry)
   #:use-module (gnu packages qt)
   #:use-module (gnu packages serialization)
   #:use-module (gnu packages sphinx)
+  #:use-module (gnu packages stb)
   #:use-module (gnu packages xml)
   #:use-module (guix build-system cmake)
+  #:use-module (guix build-system copy)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system python))
 
@@ -566,3 +571,116 @@ (define-public python-pymol
 used to prepare publication-quality figures, to share interactive results with
 your colleagues, or to generate pre-rendered animations.")
     (license license:bsd-3)))
+
+(define-public sajson-for-gemmi
+  (package/inherit sajson
+    (name "sajson-for-gemmi")
+    (source (origin
+              (inherit (package-source sajson))
+              (patches (search-patches
+                        "sajson-for-gemmi-numbers-as-strings.patch"
+                        "sajson-for-gemmi-build-with-gcc10.patch"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments sajson)
+       ((#:tests? _ #f) #f)
+       ((#:phases phases)
+        #~(modify-phases #$phases
+            (delete 'build)))))))
+
+(define-public gemmi
+  (package
+    (name "gemmi")
+    (version "0.5.7")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/project-gemmi/gemmi";)
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "00km5q726bslrw7xbfwb3f3mrsk19qbimfnl3hvr4wi1y3z8i18a"))
+              (patches
+               (search-patches "gemmi-fix-sajson-types.patch"))
+              (modules '((guix build utils)))
+              (snippet
+               '(begin
+                  (delete-file-recursively "include/gemmi/third_party")
+                  (delete-file-recursively "third_party")))))
+    (outputs '("out" "bin" "python"))
+    (build-system cmake-build-system)
+    (native-inputs
+     (list fast-float
+           optionparser
+           pegtl
+           pocketfft-cpp
+           pybind11
+           sajson-for-gemmi
+           stb-sprintf
+           tinydir))
+    (inputs (list python zlib))
+    (arguments
+     (list
+      #:configure-flags
+      #~(let* ((python-lib
+                (string-append
+                 #$output:python "/lib/python"
+                 #$(version-major+minor (package-version python))
+                 "/site-packages")))
+          (list "-DUSE_PYTHON=ON"
+                (string-append "-DPYTHON_INSTALL_DIR=" python-lib)))
+      #:phases
+      #~(modify-phases %standard-phases
+          (add-after 'unpack 'patch-includes
+            (lambda _
+              (substitute* "include/gemmi/sprintf.hpp"
+                (("<stb/stb_sprintf.h>") "<stb_sprintf.h>"))
+              (substitute* "include/gemmi/dirwalk.hpp"
+                (("\"third_party/tinydir.h\"") "<tinydir.h>"))
+              (substitute* "include/gemmi/cif.hpp"
+                (("\"third_party/tao/pegtl.hpp\"") "<tao/pegtl.hpp>"))
+              (substitute* "include/gemmi/json.hpp"
+                (("\"third_party/sajson.h\"") "<sajson.h>"))
+              (substitute* "python/gemmi.cpp"
+                (("\"gemmi/third_party/tao/pegtl/parse_error.hpp\"")
+                 "<tao/pegtl/parse_error.hpp>"))
+              (substitute* '("include/gemmi/atof.hpp"
+                             "include/gemmi/numb.hpp")
+                (("\"third_party/fast_float.h\"")
+                 "<fast_float/fast_float.h>"))
+              (substitute* "include/gemmi/fourier.hpp"
+                (("\"third_party/pocketfft_hdronly.h\"")
+                 "<pocketfft_hdronly.h>"))))
+          (add-after 'patch-includes 'patch-cif
+            (lambda _
+              (substitute* "include/gemmi/cif.hpp"
+                (((string-append
+                   "^.*using analyze_t = pegtl::analysis::generic"
+                   "<pegtl::analysis::rule_type::ANY>;.*$")) "")
+                (("TAOCPP_PEGTL_") "TAO_PEGTL_"))))
+          (add-after 'unpack 'change-bin-prefix
+            (lambda _
+              (substitute* "CMakeLists.txt"
+                (("install\\(TARGETS program DESTINATION bin\\)")
+                 (string-append
+                  "install(TARGETS program DESTINATION "
+                  #$output:bin "/bin)")))))
+          (replace 'check
+            (lambda* (#:key tests? #:allow-other-keys)
+              (when tests?
+                (with-directory-excursion "../source"
+                  (setenv "PYTHONPATH" "../build")
+                  (invoke "python3" "-m" "unittest" "discover" "-v"
+                          "-s" "tests"))))))))
+    (home-page "https://gemmi.readthedocs.io/en/latest/";)
+    (synopsis "Macromolecular crystallography library and utilities")
+    (description "GEMMI is a C++ library for macromolecular crystallography.
+It can be used for working with
+@enumerate
+@item macromolecular models (content of PDB, PDBx/mmCIF and mmJSON files),
+@item refinement restraints (CIF files),
+@item reflection data (MTZ and mmCIF formats),
+@item data on a 3D grid (electron density maps, masks, MRC/CCP4 format)
+@item crystallographic symmetry.
+@end enumerate")
+    (license license:mpl2.0)))
diff --git a/gnu/packages/patches/gemmi-fix-sajson-types.patch 
b/gnu/packages/patches/gemmi-fix-sajson-types.patch
new file mode 100644
index 0000000000..9633ddac8b
--- /dev/null
+++ b/gnu/packages/patches/gemmi-fix-sajson-types.patch
@@ -0,0 +1,11 @@
+diff -ur a/include/gemmi/json.hpp b/include/gemmi/json.hpp
+--- a/include/gemmi/json.hpp
++++ b/include/gemmi/json.hpp
+@@ -38,6 +38,7 @@
+ 
+ inline std::string as_cif_value(const sajson::value& val) {
+   switch (val.get_type()) {
++    case sajson::TYPE_INTEGER:
+     case sajson::TYPE_DOUBLE:
+       return val.as_string();
+     case sajson::TYPE_NULL:
diff --git a/gnu/packages/patches/sajson-for-gemmi-build-with-gcc10.patch 
b/gnu/packages/patches/sajson-for-gemmi-build-with-gcc10.patch
new file mode 100644
index 0000000000..878706dc79
--- /dev/null
+++ b/gnu/packages/patches/sajson-for-gemmi-build-with-gcc10.patch
@@ -0,0 +1,45 @@
+This patch is from the upstream pull request
+https://github.com/chadaustin/sajson/pull/54.
+It fixes linking with GCC.
+
+diff --git a/include/sajson.h b/include/sajson.h
+index 8b4e05a..1bd045b 100644
+--- a/include/sajson.h
++++ b/include/sajson.h
+@@ -138,12 +138,17 @@ constexpr inline size_t make_element(tag t, size_t 
value) {
+ // header. This trick courtesy of Rich Geldreich's Purple JSON parser.
+ template <typename unused = void>
+ struct globals_struct {
++    static const unsigned char parse_flags[256];
++};
++typedef globals_struct<> globals;
++
+ // clang-format off
+ 
+     // bit 0 (1) - set if: plain ASCII string character
+     // bit 1 (2) - set if: whitespace
+     // bit 4 (0x10) - set if: 0-9 e E .
+-    constexpr static const uint8_t parse_flags[256] = {
++    template <typename unused>
++    const unsigned char globals_struct<unused>::parse_flags[256] = {
+      // 0    1    2    3    4    5    6    7      8    9    A    B    C    D  
  E    F
+         0,   0,   0,   0,   0,   0,   0,   0,     0,   2,   2,   0,   0,   2, 
  0,   0, // 0
+         0,   0,   0,   0,   0,   0,   0,   0,     0,   0,   0,   0,   0,   0, 
  0,   0, // 1
+@@ -162,15 +167,13 @@ struct globals_struct {
+     };
+ 
+ // clang-format on
+-};
+-typedef globals_struct<> globals;
+ 
+-constexpr inline bool is_plain_string_character(char c) {
++inline bool is_plain_string_character(char c) {
+     // return c >= 0x20 && c <= 0x7f && c != 0x22 && c != 0x5c;
+     return (globals::parse_flags[static_cast<unsigned char>(c)] & 1) != 0;
+ }
+ 
+-constexpr inline bool is_whitespace(char c) {
++inline bool is_whitespace(char c) {
+     // return c == '\r' || c == '\n' || c == '\t' || c == ' ';
+     return (globals::parse_flags[static_cast<unsigned char>(c)] & 2) != 0;
+ }
diff --git a/gnu/packages/patches/sajson-for-gemmi-numbers-as-strings.patch 
b/gnu/packages/patches/sajson-for-gemmi-numbers-as-strings.patch
new file mode 100644
index 0000000000..6f476b8583
--- /dev/null
+++ b/gnu/packages/patches/sajson-for-gemmi-numbers-as-strings.patch
@@ -0,0 +1,195 @@
+Patch for gemmi: Keep numbers in JSON file as strings.
+
+Adapted from this commit of the bundled fork of sajson in gemmi:
+https://github.com/project-gemmi/gemmi/commit/fccbca4f6040364ba708613e1429c2251872240d
+
+diff -ur a/include/sajson.h b/include/sajson.h
+--- a/include/sajson.h
++++ b/include/sajson.h
+@@ -411,43 +411,6 @@
+ };
+ } // namespace internal
+ 
+-namespace integer_storage {
+-enum { word_length = 1 };
+-
+-inline int load(const size_t* location) {
+-    int value;
+-    memcpy(&value, location, sizeof(value));
+-    return value;
+-}
+-
+-inline void store(size_t* location, int value) {
+-    // NOTE: Most modern compilers optimize away this constant-size
+-    // memcpy into a single instruction. If any don't, and treat
+-    // punning through a union as legal, they can be special-cased.
+-    static_assert(
+-        sizeof(value) <= sizeof(*location),
+-        "size_t must not be smaller than int");
+-    memcpy(location, &value, sizeof(value));
+-}
+-} // namespace integer_storage
+-
+-namespace double_storage {
+-enum { word_length = sizeof(double) / sizeof(size_t) };
+-
+-inline double load(const size_t* location) {
+-    double value;
+-    memcpy(&value, location, sizeof(double));
+-    return value;
+-}
+-
+-inline void store(size_t* location, double value) {
+-    // NOTE: Most modern compilers optimize away this constant-size
+-    // memcpy into a single instruction. If any don't, and treat
+-    // punning through a union as legal, they can be special-cased.
+-    memcpy(location, &value, sizeof(double));
+-}
+-} // namespace double_storage
+-
+ /// Represents a JSON value.  First, call get_type() to check its type,
+ /// which determines which methods are available.
+ ///
+@@ -585,70 +548,10 @@
+         return length;
+     }
+ 
+-    /// If a numeric value was parsed as a 32-bit integer, returns it.
+-    /// Only legal if get_type() is TYPE_INTEGER.
+-    int get_integer_value() const {
+-        assert_tag(tag::integer);
+-        return integer_storage::load(payload);
+-    }
+-
+-    /// If a numeric value was parsed as a double, returns it.
+-    /// Only legal if get_type() is TYPE_DOUBLE.
+-    double get_double_value() const {
+-        assert_tag(tag::double_);
+-        return double_storage::load(payload);
+-    }
+-
+-    /// Returns a numeric value as a double-precision float.
+-    /// Only legal if get_type() is TYPE_INTEGER or TYPE_DOUBLE.
+-    double get_number_value() const {
+-        assert_tag_2(tag::integer, tag::double_);
+-        if (value_tag == tag::integer) {
+-            return get_integer_value();
+-        } else {
+-            return get_double_value();
+-        }
+-    }
+-
+-    /// Returns true and writes to the output argument if the numeric value
+-    /// fits in a 53-bit integer.  This is useful for timestamps and other
+-    /// situations where integral values with greater than 32-bit precision
+-    /// are used, as 64-bit values are not understood by all JSON
+-    /// implementations or languages.
+-    /// Returns false if the value is not an integer or not in range.
+-    /// Only legal if get_type() is TYPE_INTEGER or TYPE_DOUBLE.
+-    bool get_int53_value(int64_t* out) const {
+-        // Make sure the output variable is always defined to avoid any
+-        // possible situation like
+-        // https://gist.github.com/chadaustin/2c249cb850619ddec05b23ca42cf7a18
+-        *out = 0;
+-
+-        assert_tag_2(tag::integer, tag::double_);
+-        switch (value_tag) {
+-        case tag::integer:
+-            *out = get_integer_value();
+-            return true;
+-        case tag::double_: {
+-            double v = get_double_value();
+-            if (v < -(1LL << 53) || v > (1LL << 53)) {
+-                return false;
+-            }
+-            int64_t as_int = static_cast<int64_t>(v);
+-            if (as_int != v) {
+-                return false;
+-            }
+-            *out = as_int;
+-            return true;
+-        }
+-        default:
+-            return false;
+-        }
+-    }
+-
+     /// Returns the length of the string.
+     /// Only legal if get_type() is TYPE_STRING.
+     size_t get_string_length() const {
+-        assert_tag(tag::string);
++        assert_tag_3(tag::string, tag::integer, tag::double_);
+         return payload[1] - payload[0];
+     }
+ 
+@@ -659,7 +562,7 @@
+     /// embedded NULs.
+     /// Only legal if get_type() is TYPE_STRING.
+     const char* as_cstring() const {
+-        assert_tag(tag::string);
++        assert_tag_3(tag::string, tag::integer, tag::double_);
+         return text + payload[0];
+     }
+ 
+@@ -667,7 +570,7 @@
+     /// Returns a string's value as a std::string.
+     /// Only legal if get_type() is TYPE_STRING.
+     std::string as_string() const {
+-        assert_tag(tag::string);
++        assert_tag_3(tag::string, tag::integer, tag::double_);
+         return std::string(text + payload[0], text + payload[1]);
+     }
+ #endif
+@@ -690,6 +593,10 @@
+         assert(e1 == value_tag || e2 == value_tag);
+     }
+ 
++    void assert_tag_3(tag e1, tag e2, tag e3) const {
++        assert(e1 == value_tag || e2 == value_tag || e3 == value_tag);
++    }
++
+     void assert_in_bounds(size_t i) const { assert(i < get_length()); }
+ 
+     const tag value_tag;
+@@ -2059,6 +1966,8 @@
+     std::pair<char*, internal::tag> parse_number(char* p) {
+         using internal::tag;
+ 
++      size_t start = p - input.get_data();
++
+         // Assume 32-bit, two's complement integers.
+         static constexpr unsigned RISKY = INT_MAX / 10u;
+         unsigned max_digit_after_risky = INT_MAX % 10u;
+@@ -2235,23 +2144,18 @@
+                 u = 0u - u;
+             }
+         }
++
++        bool success;
++        size_t* out = allocator.reserve(2, &success);
++        if (SAJSON_UNLIKELY(!success)) {
++            return std::make_pair(oom(p, "number"), tag::null);
++        }
++        out[0] = start;
++        out[1] = p - input.get_data();
++
+         if (try_double) {
+-            bool success;
+-            size_t* out
+-                = allocator.reserve(double_storage::word_length, &success);
+-            if (SAJSON_UNLIKELY(!success)) {
+-                return std::make_pair(oom(p, "double"), tag::null);
+-            }
+-            double_storage::store(out, d);
+             return std::make_pair(p, tag::double_);
+         } else {
+-            bool success;
+-            size_t* out
+-                = allocator.reserve(integer_storage::word_length, &success);
+-            if (SAJSON_UNLIKELY(!success)) {
+-                return std::make_pair(oom(p, "integer"), tag::null);
+-            }
+-            integer_storage::store(out, static_cast<int>(u));
+             return std::make_pair(p, tag::integer);
+         }
+     }
-- 
2.37.0