From aa47d8ddc9912963795a9e556bd953aa5ba4c6f6 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Fri, 27 Dec 2019 16:54:41 -0800
Subject: [PATCH] web: fix add form completions (fixes #1156)

It seems like show (toJSON "a") used to give "\"a\"" instead of
"String \"a\"". I haven't found the root cause, it's possible
that this fix won't work if built with older libs.
---
 hledger-web/Hledger/Web/Widget/AddForm.hs | 28 +++++++++++++++++++----
 hledger-web/templates/add-form.hamlet     |  4 ++--
 2 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/hledger-web/Hledger/Web/Widget/AddForm.hs b/hledger-web/Hledger/Web/Widget/AddForm.hs
index 69c840751..24c775ee8 100644
--- a/hledger-web/Hledger/Web/Widget/AddForm.hs
+++ b/hledger-web/Hledger/Web/Widget/AddForm.hs
@@ -13,7 +13,7 @@ module Hledger.Web.Widget.AddForm
 
 import Control.Monad.State.Strict (evalStateT)
 import Data.Bifunctor (first)
-import Data.List (dropWhileEnd, nub, sort, unfoldr)
+import Data.List (dropWhileEnd, intercalate, nub, sort, unfoldr)
 import Data.Maybe (isJust)
 #if !(MIN_VERSION_base(4,13,0))
 import Data.Semigroup ((<>))
@@ -73,10 +73,6 @@ addForm j today = identifyForm "add" $ \extra -> do
   -- bindings used in add-form.hamlet
   let descriptions = sort $ nub $ tdescription <$> jtxns j
       journals = fst <$> jfiles j
-      listToJsonArray :: [Text] -> Markup
-      listToJsonArray = preEscapedString . escapeJSSpecialChars . show . toJSON
-        where
-          escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>" -- #236
 
   pure (validateTransaction dateRes descRes postRes, $(widgetFile "add-form"))
 
@@ -98,6 +94,28 @@ addForm j today = identifyForm "add" $ \extra -> do
       , fieldEnctype = UrlEncoded
       }
 
+    -- Used in add-form.hamlet
+    toBloodhoundJson :: [Text] -> Markup
+    toBloodhoundJson ts =
+      -- This used to work, but since 1.16, it seems like something changed.
+      -- toJSON ("a"::Text) gives String "a" instead of "a", etc.
+      -- preEscapedString . escapeJSSpecialChars . show . toJSON
+      preEscapedString $ concat [
+        "[",
+        intercalate "," $ map (
+          ("{\"value\":" ++).
+          (++"}").
+          escapeJSSpecialChars .
+          drop 7 .  -- "String "
+          show .
+          toJSON
+          ) ts,
+        "]"
+        ]
+      where
+        -- avoid https://github.com/simonmichael/hledger/issues/236
+        escapeJSSpecialChars = regexReplaceCI "</script>" "<\\/script>"
+
 validateTransaction ::
      FormResult Day
   -> FormResult Text
diff --git a/hledger-web/templates/add-form.hamlet b/hledger-web/templates/add-form.hamlet
index 43e221114..b4197b8e6 100644
--- a/hledger-web/templates/add-form.hamlet
+++ b/hledger-web/templates/add-form.hamlet
@@ -1,7 +1,7 @@
 <script>
   jQuery(document).ready(function() {
     descriptionsSuggester = new Bloodhound({
-      local:#{listToJsonArray descriptions},
+      local:#{toBloodhoundJson descriptions},
       limit:100,
       datumTokenizer: function(d) { return [d.value]; },
       queryTokenizer: function(q) { return [q]; }
@@ -9,7 +9,7 @@
     descriptionsSuggester.initialize();
 
     accountsSuggester = new Bloodhound({
-      local:#{listToJsonArray (journalAccountNamesDeclaredOrImplied j)},
+      local:#{toBloodhoundJson (journalAccountNamesDeclaredOrImplied j)},
       limit:100,
       datumTokenizer: function(d) { return [d.value]; },
       queryTokenizer: function(q) { return [q]; }