Update to latest dhall-lang

* Implement Text/show builtin
  dhall-lang/dhall-lang#365
* Don't tag encoded expressions with their version
  dhall-lang/dhall-lang#362
* Rename grammar rule for natural-raw:
  dhall-lang/dhall-lang#368

src/dhall_clj/alpha_normalize.clj

@@ -194,6 +194,9 @@
   (alpha-normalize [this]
     (map-chunks this alpha-normalize))
 
+  dhall_clj.ast.TextShow
+  (alpha-normalize [this] this)
+
   dhall_clj.ast.TextAppend
   (alpha-normalize [this]
     (-> this

src/dhall_clj/ast.clj

@@ -57,6 +57,7 @@
 (defrecord DoubleShow [])
 (defrecord TextT [])
 (defrecord TextLit [chunks])
+(defrecord TextShow [])
 (defrecord TextAppend [a b])
 (defrecord ListT [])
 (defrecord ListLit [type? exprs])
@@ -292,6 +293,9 @@
   (shift [this diff var]
     (map-chunks this (fn [c] (shift c diff var))))
 
+  TextShow
+  (shift [this diff var] this)
+
   TextAppend
   (shift [this diff var]
     (-> this
@@ -596,6 +600,9 @@
   (subst [this var e]
     (map-chunks this (fn [c] (subst c var e))))
 
+  TextShow
+  (subst [this var e] this)
+
   TextAppend
   (subst [this var e]
     (-> this

src/dhall_clj/beta_normalize.clj

@@ -1,12 +1,13 @@
 (ns dhall-clj.beta-normalize
   (:require [dhall-clj.alpha-normalize :refer [alpha-normalize]]
             [dhall-clj.ast :refer :all]
+            [clojure.string :as string]
             [medley.core :refer [map-vals]])
   (:import [dhall_clj.ast NaturalLit TextLit BoolLit Lam App ListBuild ListFold
             NaturalBuild NaturalFold OptionalBuild OptionalFold NaturalIsZero
             NaturalEven NaturalOdd NaturalToInteger NaturalShow IntegerLit
             IntegerShow IntegerToDouble DoubleLit DoubleShow ListLit ListLength
-            ListHead ListLast ListIndexed ListReverse RecordLit
+            ListHead ListLast ListIndexed ListReverse RecordLit TextShow
             UnionLit RecordT UnionT Some None]))
 
 (defprotocol IBetaNormalize
@@ -23,6 +24,24 @@
        (ab-normalize b))))
 
 
+(defn text-show [text]
+  (let [char-map {\" "\\\""
+                  \$ "\\u0024"
+                  \\ "\\\\"
+                  \backspace "\\b"
+                  \newline "\\n"
+                  \return "\\r"
+                  \tab "\\t"}
+        escape-control (fn [char]
+                         (if (<= (int char) 30)
+                           (format "\\u%04x" (int char))
+                           char))]
+    (str "\""
+         (apply str (map escape-control
+                         (seq (string/escape text char-map))))
+         "\"")))
+
+
 (extend-protocol IBetaNormalize
 
   dhall_clj.ast.Const
@@ -266,6 +285,13 @@
                   val      (:e (:b (:a (:a f'))))]
               (beta-normalize (->App just val)))
 
+            ;; TextShow
+            (and (instance? TextShow f')
+                 (instance? TextLit a')
+                 (= 1 (count (:chunks a')))
+                 (string? (first (:chunks a'))))
+            (beta-normalize (update a' :chunks (partial map text-show)))
+
             :else (->App f' a'))))))
 
   dhall_clj.ast.Let
@@ -469,6 +495,9 @@
                      :else                       (->TextAppend l r)))]
       (decide (beta-normalize a) (beta-normalize b))))
 
+  dhall_clj.ast.TextShow
+  (beta-normalize [this] this)
+
   dhall_clj.ast.ListT
   (beta-normalize [this] this)
 

src/dhall_clj/binary.clj

@@ -11,31 +11,17 @@
 (declare cbor)
 (declare decbor)
 
-(def protocol-version
-  "The currently supported version for the binary protocol"
-  "5.0.0")
-
-(def supported-versions
-  "A list of versions that will be accepted for deserialization"
-  [protocol-version])
-
 (defn encode
   "Encode `e` (which should be Dhall AST) into its binary form.
-  `version` is one of `supported-versions`. Will return a `ByteArray`."
-  ([e] (encode e protocol-version))
-  ([e version]
-   (if (some #{version} supported-versions)
-     (cbor/encode [version (cbor e)])
-     (fail/unsupported-version-encoding! version supported-versions))))
+  Will return a `ByteArray`."
+  [e]
+  (cbor/encode (cbor e)))
 
 (defn decode
   "Takes a bytearray `binary-expr`, and tries to decode it into Dhall AST.
   Will throw an exception of type `dhall-clj.fail/binary` on malformed input."
   [^bytes binary-expr]
-  (let [[version expression] (cbor/decode binary-expr)]
-    (if (some #{version} supported-versions)
-      (decbor expression)
-      (fail/unsupported-version-decoding! version supported-versions))))
+  (decbor (cbor/decode binary-expr)))
 
 
 ;;;; CBOR -> Dhall AST
@@ -78,6 +64,7 @@
       "List/reverse"      (->ListReverse)
       "Optional/fold"     (->OptionalFold)
       "Optional/build"    (->OptionalBuild)
+      "Text/show"         (->TextShow)
       "Bool"              (->BoolT)
       "Optional"          (->OptionalT)
       "None"              (->None)
@@ -382,6 +369,10 @@
   (cbor [{:keys [chunks]}]
     (into [] (concat [18] (map #(if (string? %) % (cbor %)) chunks))))
 
+  dhall_clj.ast.TextShow
+  (cbor [this]
+    "Text/show")
+
   dhall_clj.ast.TextAppend
   (cbor [{:keys [a b]}]
     [3 6 (cbor a) (cbor b)])

src/dhall_clj/emit.clj

@@ -173,6 +173,10 @@
         (apply str chunks')
         `(apply str ~chunks'))))
 
+  dhall_clj.ast.TextShow
+  (emit [this]
+    `str) ;; TODO
+
   dhall_clj.ast.TextAppend
   (emit [{:keys [a b]}]
     `(str ~(emit a) ~(emit b)))

src/dhall_clj/fail.clj

@@ -104,24 +104,6 @@
 ;; Serialization
 ;;
 
-(defn unsupported-version-encoding!
-  "Throws an ex-info if the version we are trying to encode with is not supported"
-  [version versions]
-  (throw-data
-    "Serialization error: version not supported"
-    {:type ::unsupported-version-encoding
-     :supported-versions versions
-     :current-version version}))
-
-(defn unsupported-version-decoding!
-  "Throws an ex-info if the version we are trying to decode with is not supported"
-  [version versions]
-  (throw-data
-    "Deserialization error: version not supported"
-    {:type ::unsupported-version-decoding
-     :supported-versions versions
-     :current-version version}))
-
 (defn vector-too-short!
   "Throws an ex-info if the vector `e` has less than `n` elems"
   [e n]

src/dhall_clj/import.clj

@@ -404,6 +404,9 @@
   (resolve-imports [this state]
     (map-chunks this (fn [c] (resolve-imports c state))))
 
+  dhall_clj.ast.TextShow
+  (resolve-imports [this state] this)
+
   dhall_clj.ast.TextAppend
   (resolve-imports [this state]
     (-> this

src/dhall_clj/parse.clj

@@ -45,6 +45,7 @@
    "List/reverse"
    "Optional/fold"
    "Optional/build"
+   "Text/show"
    "if"
    "then"
    "else"
@@ -348,7 +349,8 @@
       :List-indexed-raw      (->ListIndexed)
       :List-reverse-raw      (->ListReverse)
       :Optional-fold-raw     (->OptionalFold)
-      :Optional-build-raw    (->OptionalBuild))))
+      :Optional-build-raw    (->OptionalBuild)
+      :Text-show-raw         (->TextShow))))
 
 (defn identifier [e]
   (let [children (:c e)
@@ -359,7 +361,7 @@
                  (->> children first :c first :c (apply str)))
         ;; at the end of `children` there might be a DeBrujin index
         maybe-index (-> children butlast last)
-        index? (= :natural-raw (:t maybe-index))
+        index? (= :natural-literal-raw (:t maybe-index))
         index (if index?
                 (-> maybe-index :c first :c first read-string)
                 0)
@@ -622,9 +624,8 @@
                                  "t"  "\t"
                                  ;; Otherwise we're reading in a \uXXXX char
                                  (->> (nthrest content 2)
-                                    (mapv (fn [{:keys [c]}]
-                                            (-> c first :c first)))
-                                    (apply str "0x")
+                                    compact
+                                    (str "0x")
                                     hex->num
                                     char))]
                   (recur (rest children)

src/dhall_clj/typecheck.clj

@@ -341,6 +341,10 @@
       chunks)
     (->TextT))
 
+  dhall_clj.ast.TextShow
+  (typecheck [this _ctx]
+    (->Pi "_" (->TextT) (->TextT)))
+
   dhall_clj.ast.TextAppend
   (typecheck [{:keys [a b] :as this} ctx]
     (typecheck-binary this ctx TextT fail/cant-text-append!))

test/dhall_clj/binary_test.clj

@@ -40,6 +40,7 @@
                 (->DoubleT)
                 (->DoubleShow)
                 (->TextT)
+                (->TextShow)
                 (->ListT)
                 (->ListBuild)
                 (->ListFold)

test/dhall_clj/import_test.clj

@@ -14,7 +14,7 @@
              [me.raynes.fs :as fs]))
 
 
-(def prelude-hash "26e13b153cb428366610110d4d8f0c135e22b20179d5478bb16b1b83b3f2ca13")
+(def prelude-hash "e3be3dba308637ad7ab6d4ce9a11a342b087efbf2aa801c88a05a6babaae8e48")
 
 (def simple-success-cases
   {"Prelude import with hash"

test/dhall_clj/parser_test.clj

@@ -312,9 +312,6 @@
   "Here we list all the tests that blow up, so we categorize and exclude them.
   Note: they are vectors because the path creation is platform-sensitive."
   [
-   ;; Waiting for https://github.com/dhall-lang/dhall-haskell/pull/779
-   ["dhall-lang" "tests" "parser" "success" "annotations"]
-   ["dhall-lang" "tests" "parser" "success" "list"]
    ;; No CBOR for imports yet
    ["dhall-lang" "tests" "parser" "success" "collectionImportType"]
    ["dhall-lang" "tests" "parser" "success" "parenthesizeUsing"]
@@ -324,7 +321,8 @@
    ["dhall-lang" "tests" "parser" "success" "pathTermination"]
    ["dhall-lang" "tests" "parser" "success" "importAlt"]
    ["dhall-lang" "tests" "parser" "success" "asText"]
-   ;; Broken operators?
+   ["dhall-lang" "tests" "parser" "success" "unicodePaths"]
+   ;; https://github.com/dhall-lang/dhall-lang/issues/373
    ["dhall-lang" "tests" "parser" "success" "operators"]
    ;; Something's broken
    ["dhall-lang" "tests" "parser" "success" "largeExpression"]

test/dhall_clj/test_utils.clj

@@ -25,7 +25,11 @@
   [test-folder]
   (let [files (->> (list-files test-folder)
                  (remove failure-case?))
-        map-of-testcases (group-by #(->> % str (drop-last 7) (apply str)) files)]
+        map-of-testcases (group-by #(-> % str
+                                       (string/replace #"B.json" "")
+                                       (string/replace #"A.dhall" "")
+                                       (string/replace #"B.dhall" ""))
+                                   files)]
     (map-vals
       (fn [a-and-b]
         ;; We sort so we get the A.dhall file first