cli: Commands.Balance.registerQueryUrl: correctly escape URL using modern-uri package

This commit is contained in:
Henning Thielemann 2024-09-28 20:54:46 +02:00 committed by Simon Michael
parent 3cd6e95746
commit 9cdd21bf6d
3 changed files with 13 additions and 2 deletions

View File

@ -238,6 +238,7 @@ Currently, empty cells show 0.
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module Hledger.Cli.Commands.Balance ( module Hledger.Cli.Commands.Balance (
-- ** balance command -- ** balance command
@ -283,6 +284,8 @@ import Data.Time (addDays, fromGregorian)
import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt) import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt)
import Lucid as L hiding (value_) import Lucid as L hiding (value_)
import Safe (headMay, maximumMay) import Safe (headMay, maximumMay)
import qualified Text.URI as Uri
import qualified Text.URI.QQ as UriQQ
import Text.Tabular.AsciiWide import Text.Tabular.AsciiWide
(Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..), (Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..),
cellWidth, concatTables, renderColumns, renderRowB, renderTableByRowsB, textCell) cellWidth, concatTables, renderColumns, renderRowB, renderTableByRowsB, textCell)
@ -586,8 +589,14 @@ headerCell text =
registerQueryUrl :: [Text] -> Text registerQueryUrl :: [Text] -> Text
registerQueryUrl query = registerQueryUrl query =
"register?q=" <> Uri.render $
T.intercalate "+" (map quoteIfSpaced $ filter (not . T.null) query) [UriQQ.uri|register|] {
Uri.uriQuery =
[Uri.QueryParam [UriQQ.queryKey|q|] $
fromMaybe (error "register URI query construction failed") $
Uri.mkQueryValue $ T.unwords $
map quoteIfSpaced $ filter (not . T.null) query]
}
-- cf. Web.Widget.Common -- cf. Web.Widget.Common
removeDates :: [Text] -> [Text] removeDates :: [Text] -> [Text]

View File

@ -172,6 +172,7 @@ library
, math-functions >=0.3.3.0 , math-functions >=0.3.3.0
, megaparsec >=7.0.0 && <9.7 , megaparsec >=7.0.0 && <9.7
, microlens >=0.4 , microlens >=0.4
, modern-uri >=0.3
, mtl >=2.2.1 , mtl >=2.2.1
, process , process
, regex-tdfa , regex-tdfa

View File

@ -205,6 +205,7 @@ library:
- Diff >=0.2 - Diff >=0.2
- hashable >=1.2.4 - hashable >=1.2.4
- lucid - lucid
- modern-uri >=0.3
executables: executables:
hledger: hledger: