From ee97e476c872360bf7e9933dc49d67cf8691eef6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Fri, 8 Jun 2018 23:10:05 +0200 Subject: [PATCH] web: Switch to Data.Text, instead of unpacking to String --- hledger-web/Foundation.hs | 17 +++++----- hledger-web/Handler/AddForm.hs | 17 +++++----- hledger-web/Handler/Common.hs | 54 +++++++++++++++----------------- hledger-web/Handler/JournalR.hs | 14 +++------ hledger-web/Handler/RegisterR.hs | 21 ++++++------- hledger-web/Settings.hs | 9 ++++-- 6 files changed, 63 insertions(+), 69 deletions(-) diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index 56b68dabd..9ad3da4fc 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -8,7 +8,6 @@ import Data.IORef (IORef, readIORef, writeIORef) import Data.List (isPrefixOf, sort, nub) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as T import Data.Time.Calendar (Day) import Network.HTTP.Conduit (Manager) import Text.Blaze (Markup) @@ -149,10 +148,10 @@ data ViewData = VD { ,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request ,today :: Day -- ^ today's date (for queries containing relative dates) ,j :: Journal -- ^ the up-to-date parsed unfiltered journal - ,q :: String -- ^ the current q parameter, the main query expression - ,m :: Query -- ^ a query parsed from the q parameter + ,q :: Text -- ^ the current q parameter, the main query expression + ,m :: Query -- ^ a query parsed from the q parameter ,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter - ,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter) + ,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter) ,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr ,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable ,showsidebar :: Bool -- ^ current showsidebar cookie value @@ -165,10 +164,10 @@ nullviewdata :: ViewData nullviewdata = viewdataWithDateAndParams nulldate "" "" "" -- | Make a ViewData using the given date and request parameters, and defaults elsewhere. -viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData +viewdataWithDateAndParams :: Day -> Text -> Text -> Text -> ViewData viewdataWithDateAndParams d q a p = - let (querymatcher,queryopts) = parseQuery d (T.pack q) - (acctsmatcher,acctsopts) = parseQuery d (T.pack a) + let (querymatcher,queryopts) = parseQuery d q + (acctsmatcher,acctsopts) = parseQuery d a in VD { opts = defwebopts ,j = nulljournal @@ -235,8 +234,8 @@ getViewData = do return (j, Just e) -- | Get the named request parameter, or the empty string if not present. - getParameterOrNull :: String -> Handler String - getParameterOrNull p = T.unpack `fmap` fromMaybe "" <$> lookupGetParam (T.pack p) + getParameterOrNull :: Text -> Handler Text + getParameterOrNull = fmap (fromMaybe "") . lookupGetParam -- | Get the message that was set by the last request, in a -- referentially transparent manner (allowing multiple reads). diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index aa4d11372..cdf1338e2 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -8,9 +8,10 @@ module Handler.AddForm where import Import import Control.Monad.State.Strict (evalStateT) -import Data.List (sort) import Data.Either (lefts, rights) +import Data.List (sort) import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free +import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Time.Calendar import Data.Void (Void) @@ -24,9 +25,9 @@ import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout) -- Don't know how to handle the variable posting fields with yesod-form yet. data AddForm = AddForm { addFormDate :: Day - , addFormDescription :: Maybe Text -- String + , addFormDescription :: Maybe Text -- , addFormPostings :: [(AccountName, String)] - , addFormJournalFile :: Maybe Text -- FilePath + , addFormJournalFile :: Maybe Text } deriving Show @@ -46,11 +47,11 @@ postAddForm = do validateJournalFile :: Text -> Either FormMessage Text validateJournalFile f | T.unpack f `elem` journalFilePaths j = Right f - | otherwise = Left $ MsgInvalidEntry $ T.pack "the selected journal file \"" <> f <> "\"is unknown" + | otherwise = Left $ MsgInvalidEntry $ "the selected journal file \"" <> f <> "\"is unknown" validateDate :: Text -> Handler (Either FormMessage Day) validateDate s = return $ - case fixSmartDateStrEither' today $ T.pack $ strip $ T.unpack s of + case fixSmartDateStrEither' today (T.strip s) of Right d -> Right d Left _ -> Left $ MsgInvalidEntry $ "could not parse date \"" <> s <> "\":" @@ -60,7 +61,7 @@ postAddForm = do <*> iopt (check validateJournalFile textField) "journal" ok <- case formresult of - FormMissing -> showErrors ["there is no form data"::String] >> return False + FormMissing -> showErrors ["there is no form data" :: Text] >> return False FormFailure errs -> showErrors errs >> return False FormSuccess dat -> do let AddForm{ @@ -68,7 +69,7 @@ postAddForm = do ,addFormDescription=mdesc ,addFormJournalFile=mjournalfile } = dat - desc = maybe "" T.unpack mdesc + desc = fromMaybe "" mdesc journalfile = maybe (journalFilePath j) T.unpack mjournalfile -- 2. the fixed fields look good; now process the posting fields adhocly, @@ -101,7 +102,7 @@ postAddForm = do | otherwise = either (\e -> Left [L.head $ lines e]) Right (balanceTransaction Nothing $ nulltransaction { tdate=date - ,tdescription=T.pack desc + ,tdescription=desc ,tpostings=[nullposting{paccount=acct, pamount=Mixed [amt]} | (acct,amt) <- zip accts amts] }) case etxn of diff --git a/hledger-web/Handler/Common.hs b/hledger-web/Handler/Common.hs index ec2520632..c5065f343 100644 --- a/hledger-web/Handler/Common.hs +++ b/hledger-web/Handler/Common.hs @@ -24,13 +24,13 @@ import Hledger.Web.WebOptions -- | Standard hledger-web page layout. #if MIN_VERSION_yesod(1,6,0) -hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerFor App Html +hledgerLayout :: ViewData -> Text -> HtmlUrl AppRoute -> HandlerFor App Html #else -hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerT App IO Html +hledgerLayout :: ViewData -> Text -> HtmlUrl AppRoute -> HandlerT App IO Html #endif hledgerLayout vd title content = do defaultLayout $ do - setTitle $ toHtml $ title ++ " - hledger-web" + setTitle $ toHtml $ title <> " - hledger-web" toWidget [hamlet| ^{topbar vd} ^{sidebar vd} @@ -39,8 +39,8 @@ hledgerLayout vd title content = do ^{content} |] where - showmd = if showsidebar vd then "col-md-8" else "col-md-12" :: String - showsm = if showsidebar vd then "col-sm-8" else "col-sm-12" :: String + showmd = if showsidebar vd then "col-md-8" else "col-md-12" :: Text + showsm = if showsidebar vd then "col-sm-8" else "col-sm-12" :: Text -- | Global toolbar/heading area. topbar :: ViewData -> HtmlUrl AppRoute @@ -55,8 +55,8 @@ topbar VD{..} = [hamlet| |] where title = takeFileName $ journalFilePath j - showmd = if showsidebar then "col-md-4" else "col-any-0" :: String - showsm = if showsidebar then "col-sm-4" else "" :: String + showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text + showsm = if showsidebar then "col-sm-4" else "" :: Text -- | The sidebar used on most views. sidebar :: ViewData -> HtmlUrl AppRoute @@ -71,13 +71,13 @@ sidebar vd@VD{..} = ^{accounts} |] where - journalcurrent = if here == JournalR then "inacct" else "" :: String + journalcurrent = if here == JournalR then "inacct" else "" :: Text ropts = reportopts_ $ cliopts_ opts -- flip the default for items with zero amounts, show them by default ropts' = ropts{empty_=not $ empty_ ropts} accounts = balanceReportAsHtml opts vd $ balanceReport ropts' am j - showmd = if showsidebar then "col-md-4" else "col-any-0" :: String - showsm = if showsidebar then "col-sm-4" else "" :: String + showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text + showsm = if showsidebar then "col-sm-4" else "" :: Text -- -- | Navigation link, preserving parameters and possibly highlighted. -- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute @@ -114,7 +114,7 @@ searchform VD{..} = [hamlet|