web: Switch to Data.Text, instead of unpacking to String

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,7 +148,7 @@ 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
+    ,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)
@@ -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).

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

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|
       <button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
 |]
  where
-  filtering = not $ null q
+  filtering = not $ T.null q
 
 -- -- | Edit journal form.
 -- editform :: ViewData -> HtmlUrl AppRoute
@@ -163,11 +163,11 @@ searchform VD{..} = [hamlet|
 -- |]
 
 -- | Link to a topic in the manual.
-helplink :: String -> String -> HtmlUrl AppRoute
+helplink :: Text -> Text -> HtmlUrl AppRoute
 helplink topic label = [hamlet|
 <a href=#{u} target=hledgerhelp>#{label}
 |]
-    where u = manualurl ++ if null topic then "" else '#':topic
+    where u = manualurl <> if T.null topic then "" else T.cons '#' topic
 
 nulltemplate :: HtmlUrl AppRoute
 nulltemplate = [hamlet||]
@@ -207,22 +207,19 @@ balanceReportAsHtml _ vd@VD{..} (items',total) =
        hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
        inacctclass = case inacctmatcher of
          Just m' -> if m' `matchesAccount` acct then "inacct" else ""
-                       Nothing -> "" :: String
+         Nothing -> "" :: Text
        indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) "&nbsp;"
-       acctquery = (RegisterR, [("q", T.pack $ accountQuery acct)])
-       acctonlyquery = (RegisterR, [("q", T.pack $ accountOnlyQuery acct)])
+       acctquery = (RegisterR, [("q", accountQuery acct)])
+       acctonlyquery = (RegisterR, [("q", accountOnlyQuery acct)])
 
-accountQuery :: AccountName -> String
-accountQuery a = "inacct:" ++ T.unpack (quoteIfSpaced a) -- (accountNameToAccountRegex a)
+accountQuery :: AccountName -> Text
+accountQuery = ("inacct:" <>) .  quoteIfSpaced
 
-accountOnlyQuery :: AccountName -> String
-accountOnlyQuery a = "inacctonly:" ++ T.unpack (quoteIfSpaced a ) -- (accountNameToAccountRegex a)
+accountOnlyQuery :: AccountName -> Text
+accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
 
 accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
-accountUrl r a = (r, [("q", T.pack $ accountQuery a)])
-
--- stringIfLongerThan :: Int -> String -> String
--- stringIfLongerThan n s = if length s > n then s else ""
+accountUrl r a = (r, [("q", accountQuery a)])
 
 numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
 numberTransactionsReportItems [] = []
@@ -240,7 +237,8 @@ numberTransactionsReportItems items = number 0 nulldate items
 
 mixedAmountAsHtml :: MixedAmount -> Html
 mixedAmountAsHtml b = preEscapedString $ unlines $ map addclass $ lines $ showMixedAmountWithoutPrice b
-    where addclass = printf "<span class=\"%s\">%s</span><br/>" (c :: String)
-          c = case isNegativeMixedAmount b of Just True -> "negative amount"
+    where addclass = printf "<span class=\"%s\">%s</span><br/>" (c :: Text)
+          c = case isNegativeMixedAmount b of
+            Just True -> "negative amount"
             _         -> "positive amount"
 

hledger-web/Handler/JournalR.hs

@@ -5,8 +5,6 @@ module Handler.JournalR where
 
 import Import
 
-import qualified Data.Text as T
-
 import Handler.AddForm
 import Handler.Common
 
@@ -27,8 +25,8 @@ getJournalR = do
       filtering = m /= Any
       -- showlastcolumn = if injournal && not filtering then False else True
       title = case inacct of
-                Nothing       -> "General Journal"++s2
-                Just (a,inclsubs) -> "Transactions in "++T.unpack a++s1++s2
+                Nothing       -> "General Journal" <> s2
+                Just (a,inclsubs) -> "Transactions in " <> a <> s1 <> s2
                   where s1 = if inclsubs then "" else " (excluding subaccounts)"
                 where
                   s2 = if filtering then ", filtered" else ""
@@ -78,11 +76,7 @@ $forall p' <- tpostings torig
   <td .amount .nonhead style="text-align:right;">#{mixedAmountAsHtml $ pamount p'}
 |]
      where
-       acctlink a = (RegisterR, [("q", T.pack $ accountQuery a)])
-       -- datetransition | newm = "newmonth"
-       --                | newd = "newday"
-       --                | otherwise = "" :: String
+       acctlink a = (RegisterR, [("q", accountQuery a)])
        (date, desc) = (show $ tdate torig, tdescription torig)
-       -- acctquery = (here, [("q", T.pack $ accountQuery acct)])
        showamt = not split || not (isZeroMixedAmount amt)
 

hledger-web/Handler/RegisterR.hs

@@ -28,8 +28,7 @@ getRegisterR = do
   -- staticRootUrl <- (staticRoot . settings) <$> getYesod
   let -- injournal = isNothing inacct
       filtering = m /= Any
-      -- title = "Transactions in "++a++s1++s2
-      title = T.unpack a++s1++s2
+      title = a <> s1 <> s2
         where
           (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
           s1 = if inclsubs then "" else " (excluding subaccounts)"
@@ -89,10 +88,10 @@ registerItemsHtml _ vd (balancelabel,items) = [hamlet|
 |]
 
      where
-       evenodd = if even n then "even" else "odd" :: String
+       evenodd = if even n then "even" else "odd" :: Text
        datetransition | newm = "newmonth"
                       | newd = "newday"
-                      | otherwise = "" :: String
+                      | otherwise = "" :: Text
        (firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct)
        -- acctquery = (here, [("q", pack $ accountQuery acct)])
        showamt = not split || not (isZeroMixedAmount amt)
@@ -171,9 +170,9 @@ registerChartHtml percommoditytxnreports =
 |]
            -- [#{dayToJsTimestamp $ ltrace "\ndate" $ triDate i}, #{ltrace "balancequantity" $ simpleMixedAmountQuantity $ triCommodityBalance c i}, '#{ltrace "balance" $ show $ triCommodityBalance c i}, '#{ltrace "amount" $ show $ triCommodityAmount c i}''],
  where
-   charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports
-           of "" -> ""
-              s  -> s++":"
+   charttitle = case maybe "" (fst.snd) $ headMay percommoditytxnreports of
+     "" -> ""
+     s  -> s <> ":"
    colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex
    commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)]
    simpleMixedAmountQuantity = maybe 0 aquantity . headMay . amounts

hledger-web/Settings.hs

@@ -7,6 +7,7 @@
 module Settings where
 
 import Data.Default (def)
+import Data.Semigroup ((<>))
 import Data.Text (Text)
 import Data.Yaml
 import Language.Haskell.TH.Syntax (Q, Exp)
@@ -18,9 +19,11 @@ import Yesod.Default.Util
 import Settings.Development
 
 
-hledgerorgurl, manualurl :: String
+hledgerorgurl :: Text
 hledgerorgurl = "http://hledger.org"
-manualurl         = hledgerorgurl++"/manual"
+
+manualurl :: Text
+manualurl = hledgerorgurl <> "/manual"
 
 -- | The default IP address to listen on. May be overridden with --host.
 defhost :: String