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.
This commit is contained in:
Simon Michael 2019-12-27 16:54:41 -08:00
parent c5537cedb5
commit aa47d8ddc9
2 changed files with 25 additions and 7 deletions

View File

@ -13,7 +13,7 @@ module Hledger.Web.Widget.AddForm
import Control.Monad.State.Strict (evalStateT) import Control.Monad.State.Strict (evalStateT)
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.List (dropWhileEnd, nub, sort, unfoldr) import Data.List (dropWhileEnd, intercalate, nub, sort, unfoldr)
import Data.Maybe (isJust) import Data.Maybe (isJust)
#if !(MIN_VERSION_base(4,13,0)) #if !(MIN_VERSION_base(4,13,0))
import Data.Semigroup ((<>)) import Data.Semigroup ((<>))
@ -73,10 +73,6 @@ addForm j today = identifyForm "add" $ \extra -> do
-- bindings used in add-form.hamlet -- bindings used in add-form.hamlet
let descriptions = sort $ nub $ tdescription <$> jtxns j let descriptions = sort $ nub $ tdescription <$> jtxns j
journals = fst <$> jfiles 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")) pure (validateTransaction dateRes descRes postRes, $(widgetFile "add-form"))
@ -98,6 +94,28 @@ addForm j today = identifyForm "add" $ \extra -> do
, fieldEnctype = UrlEncoded , 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 :: validateTransaction ::
FormResult Day FormResult Day
-> FormResult Text -> FormResult Text

View File

@ -1,7 +1,7 @@
<script> <script>
jQuery(document).ready(function() { jQuery(document).ready(function() {
descriptionsSuggester = new Bloodhound({ descriptionsSuggester = new Bloodhound({
local:#{listToJsonArray descriptions}, local:#{toBloodhoundJson descriptions},
limit:100, limit:100,
datumTokenizer: function(d) { return [d.value]; }, datumTokenizer: function(d) { return [d.value]; },
queryTokenizer: function(q) { return [q]; } queryTokenizer: function(q) { return [q]; }
@ -9,7 +9,7 @@
descriptionsSuggester.initialize(); descriptionsSuggester.initialize();
accountsSuggester = new Bloodhound({ accountsSuggester = new Bloodhound({
local:#{listToJsonArray (journalAccountNamesDeclaredOrImplied j)}, local:#{toBloodhoundJson (journalAccountNamesDeclaredOrImplied j)},
limit:100, limit:100,
datumTokenizer: function(d) { return [d.value]; }, datumTokenizer: function(d) { return [d.value]; },
queryTokenizer: function(q) { return [q]; } queryTokenizer: function(q) { return [q]; }