fix!: utf-8: Use with-utf8 to ensure all files are read and written with utf8 encoding. (#1619)

May also fix #1154, #1033, #708, #536, #73: testing is needed.

This aims to solve all problems where misconfigured locales lead to
parsers failing on utf8-encoded data. This should hopefully avoid
encoding issues, but since it fundamentally alters how encoding is dealt
with it may lead to unexpected outcomes. Widespread testing on a number
of different platforms would be useful.
This commit is contained in:
Stephen Morgan 2022-03-10 11:29:43 +11:00
parent db26456e1c
commit e233f001c5
37 changed files with 150 additions and 119 deletions

View File

@ -8,7 +8,7 @@
{-| Construct two balance reports for two different time periods and use one of the as "budget" for
the other, thus comparing them
-}
import Data.Text.Lazy.IO as TL
import Data.Text.Lazy.IO as TL (putStrLn) -- Only putStr and friends are safe
import System.Environment (getArgs)
import Hledger.Cli

View File

@ -112,7 +112,7 @@ import Data.Time.Calendar (toGregorian)
import Data.Time.Calendar.OrdinalDate (mondayStartWeek, sundayStartWeek, toOrdinalDate)
import Data.Text (Text, isPrefixOf, pack, unpack)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as T (putStrLn) -- Only putStr and friends are safe
import qualified Hledger.Data as H
import qualified Hledger.Query as H
import qualified Hledger.Read as H

View File

@ -11,7 +11,7 @@ import System.Environment (getArgs)
import Hledger.Cli
import qualified Data.Map as M
import Data.Map.Merge.Strict
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.IO as TL (putStrLn) -- Only putStr and friends are safe
appendReports :: MultiBalanceReport -> MultiBalanceReport -> MultiBalanceReport
appendReports r1 r2 =

View File

@ -9,7 +9,7 @@
{-# LANGUAGE RecordWildCards #-}
import Data.String.QQ (s)
import qualified Data.Text.IO as T
import qualified Data.Text.IO as T (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli

View File

@ -0,0 +1,8 @@
; unicode in description, account name and currency symbol
2010/1/1 ß
(ß) 10 ß
; as above but with characters from code pages not installed on a western ms windows machine
2010/1/1 проверка
(проверка) 10 проверка

View File

@ -12,7 +12,7 @@ module Hledger.Data.PeriodicTransaction (
where
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStr) -- Only putStr and friends are safe
import Text.Printf
import Hledger.Data.Types
@ -36,7 +36,7 @@ _ptgen str = do
case checkPeriodicTransactionStartDate i s t of
Just e -> error' e -- PARTIAL:
Nothing ->
mapM_ (T.putStr . showTransaction) $
mapM_ (TIO.putStr . showTransaction) $
runPeriodicTransaction
nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
nulldatespan
@ -48,7 +48,7 @@ _ptgenspan str span = do
case checkPeriodicTransactionStartDate i s t of
Just e -> error' e -- PARTIAL:
Nothing ->
mapM_ (T.putStr . showTransaction) $
mapM_ (TIO.putStr . showTransaction) $
runPeriodicTransaction
nullperiodictransaction{ ptperiodexpr=t , ptspan=s, ptinterval=i, ptpostings=["a" `post` usd 1] }
span

View File

@ -63,10 +63,10 @@ modifyTransactions atypes atags styles d tmods ts = do
-- Currently the only kind of modification possible is adding automated
-- postings when certain other postings are present.
--
-- >>> import qualified Data.Text.IO as T
-- >>> import qualified Data.Text.IO as TIO (putStr) -- Only putStr and friends are safe
-- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
-- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False
-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate
-- >>> test = either putStr (TIO.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction (const Nothing) (const []) mempty nulldate
-- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2]
-- 0000-01-01
-- ping $1.00

View File

@ -64,7 +64,7 @@ import Data.Ord (comparing)
import Data.Semigroup (sconcat)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Text.IO.Utf8 (writeFile)
import Data.Time (Day)
import Safe (headDef)
import System.Directory (doesFileExist, getHomeDirectory)
@ -232,7 +232,7 @@ ensureJournalFileExists f = do
hPutStr stderr $ "Creating hledger journal file " <> show f <> ".\n"
-- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
-- we currently require unix line endings on all platforms.
newJournalContent >>= T.writeFile f
newJournalContent >>= writeFile f
-- | Does any part of this path contain non-. characters and end with a . ?
-- Such paths are not safe to use on Windows (cf #1056).
@ -259,7 +259,7 @@ latestDates = headDef [] . take 1 . group . reverse . sort
-- | Remember that these transaction dates were the latest seen when
-- reading this journal file.
saveLatestDates :: LatestDates -> FilePath -> IO ()
saveLatestDates dates f = T.writeFile (latestDatesFileFor f) $ T.unlines $ map showDate dates
saveLatestDates dates f = writeFile (latestDatesFileFor f) $ T.unlines $ map showDate dates
-- | What were the latest transaction dates seen the last time this
-- journal file was read ? If there were multiple transactions on the

View File

@ -37,6 +37,7 @@ module Hledger.Read.CsvReader (
where
--- ** imports
import Prelude hiding (getContents, writeFile)
import Control.Applicative (liftA2)
import Control.Monad (unless, when)
import Control.Monad.Except (ExceptT(..), liftEither, throwError)
@ -44,9 +45,14 @@ import qualified Control.Monad.Fail as Fail
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State.Strict (StateT, get, modify', evalStateT)
import Control.Monad.Trans.Class (lift)
import Data.Char (toLower, isDigit, isSpace, isAlphaNum, ord)
import Data.Bifunctor (first)
import Data.Functor ((<&>))
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Char (toLower, isDigit, isSpace, isAlphaNum, ord)
import qualified Data.Csv as Cassava
import qualified Data.Csv.Parser.Megaparsec as CassavaMP
import Data.Foldable (asum, toList)
import Data.List (elemIndex, foldl', intersperse, mapAccumL, nub, sortBy)
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.MemoUgly (memo)
@ -54,8 +60,9 @@ import Data.Ord (comparing)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.IO (getContents) -- Only putStr and friends are safe
import Data.Text.IO.Utf8 (writeFile)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day)
@ -63,11 +70,6 @@ import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Safe (atMay, headMay, lastMay, readMay)
import System.Directory (doesFileExist)
import System.FilePath ((</>), takeDirectory, takeExtension, takeFileName)
import qualified Data.Csv as Cassava
import qualified Data.Csv.Parser.Megaparsec as CassavaMP
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Foldable (asum, toList)
import Text.Megaparsec hiding (match, parse)
import Text.Megaparsec.Char (char, newline, string)
import Text.Megaparsec.Custom (customErrorBundlePretty, parseErrorAt)
@ -197,7 +199,7 @@ expandIncludes dir content = mapM (expandLine dir) (T.lines content) >>= return
where
expandLine dir line =
case line of
(T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< T.readFile f'
(T.stripPrefix "include " -> Just f) -> expandIncludes dir' =<< readFilePortably f'
where
f' = dir </> T.unpack (T.dropWhile isSpace f)
dir' = takeDirectory f'
@ -745,8 +747,8 @@ readJournalFromCsv mrulesfile csvfile csvdata = do
-- than one date and the first date is more recent than the last):
-- reverse them to get same-date transactions ordered chronologically.
txns' =
(if newestfirst || mdataseemsnewestfirst == Just True
then dbg7 "reversed csv txns" . reverse else id)
(if newestfirst || mdataseemsnewestfirst == Just True
then dbg7 "reversed csv txns" . reverse else id)
txns
where
newestfirst = dbg6 "newestfirst" $ isJust $ getDirective "newest-first" rules
@ -759,7 +761,7 @@ readJournalFromCsv mrulesfile csvfile csvdata = do
liftIO $ when (not rulesfileexists) $ do
dbg1IO "creating conversion rules file" rulesfile
T.writeFile rulesfile rulestext
writeFile rulesfile rulestext
return nulljournal{jtxns=txns''}
@ -774,14 +776,14 @@ parseSeparator = specials . T.toLower
parseCsv :: Char -> FilePath -> Text -> ExceptT String IO CSV
parseCsv separator filePath csvdata = ExceptT $
case filePath of
"-" -> parseCassava separator "(stdin)" <$> T.getContents
"-" -> parseCassava separator "(stdin)" <$> getContents
_ -> return $ if T.null csvdata then Right mempty else parseCassava separator filePath csvdata
parseCassava :: Char -> FilePath -> Text -> Either String CSV
parseCassava separator path content =
either (Left . errorBundlePretty) (Right . parseResultToCsv) <$>
CassavaMP.decodeWith (decodeOptions separator) Cassava.NoHeader path $
BL.fromStrict $ T.encodeUtf8 content
BL.fromStrict $ encodeUtf8 content
decodeOptions :: Char -> Cassava.DecodeOptions
decodeOptions separator = Cassava.defaultDecodeOptions {
@ -792,7 +794,7 @@ parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV
parseResultToCsv = toListList . unpackFields
where
toListList = toList . fmap toList
unpackFields = (fmap . fmap) T.decodeUtf8
unpackFields = (fmap . fmap) decodeUtf8
printCSV :: CSV -> TL.Text
printCSV = TB.toLazyText . unlinesB . map printRecord

View File

@ -36,7 +36,7 @@ import Data.FileEmbed (makeRelativeToProject, embedStringFile)
import Data.List.Extra (foldl', foldl1', uncons, unsnoc)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (hGetContents) -- Only putStr and friends are safe
import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Clock (getCurrentTime)
import Data.Time.LocalTime (LocalTime, ZonedTime, getCurrentTimeZone,
@ -48,10 +48,10 @@ import Lens.Micro ((&), (.~))
import Lens.Micro.TH (DefName(TopName), lensClass, lensField, makeLensesWith, classyRules)
import System.Console.ANSI (Color,ColorIntensity,ConsoleLayer(..), SGR(..), setSGRCode)
import System.Directory (getHomeDirectory)
import System.FilePath (isRelative, (</>))
import System.IO
(Handle, IOMode (..), hGetEncoding, hSetEncoding, hSetNewlineMode,
openFile, stdin, universalNewlineMode, utf8_bom)
import System.FilePath ((</>), isRelative)
import System.IO (Handle, IOMode (..), hGetEncoding, hSetEncoding,
hSetNewlineMode, stdin, universalNewlineMode, utf8_bom)
import qualified System.IO.Utf8 as Utf8
import Hledger.Utils.Debug
import Hledger.Utils.Parse
@ -175,7 +175,7 @@ expandHomePath = \case
-- using the system locale's text encoding,
-- ignoring any utf8 BOM prefix (as seen in paypal's 2018 CSV, eg) if that encoding is utf8.
readFilePortably :: FilePath -> IO Text
readFilePortably f = openFile f ReadMode >>= readHandlePortably
readFilePortably f = Utf8.openFile f ReadMode >>= readHandlePortably
-- | Like readFilePortably, but read from standard input if the path is "-".
readFileOrStdinPortably :: String -> IO Text
@ -183,15 +183,14 @@ readFileOrStdinPortably f = openFileOrStdin f ReadMode >>= readHandlePortably
where
openFileOrStdin :: String -> IOMode -> IO Handle
openFileOrStdin "-" _ = return stdin
openFileOrStdin f m = openFile f m
openFileOrStdin f m = Utf8.openFile f m
readHandlePortably :: Handle -> IO Text
readHandlePortably h = do
hSetNewlineMode h universalNewlineMode
menc <- hGetEncoding h
when (fmap show menc == Just "UTF-8") $ -- XXX no Eq instance, rely on Show
hSetEncoding h utf8_bom
T.hGetContents h
hSetNewlineMode h universalNewlineMode
menc <- hGetEncoding h
when (fmap show menc == Just "UTF-8") $ hSetEncoding h utf8_bom -- No Eq instance, rely on Show
TIO.hGetContents h
-- | Total version of maximum, for integral types, giving 0 for an empty list.
maximum' :: Integral a => [a] -> a

View File

@ -1,6 +1,6 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.34.7.
--
-- see: https://github.com/sol/hpack
@ -137,6 +137,7 @@ library
, uglymemo
, unordered-containers >=0.2
, utf8-string >=0.3.5
, with-utf8 >=1.0.0
default-language: Haskell2010
test-suite doctest
@ -188,6 +189,7 @@ test-suite doctest
, uglymemo
, unordered-containers >=0.2
, utf8-string >=0.3.5
, with-utf8 >=1.0.0
if impl(ghc < 9.2)
buildable: False
default-language: Haskell2010
@ -241,5 +243,6 @@ test-suite unittest
, uglymemo
, unordered-containers >=0.2
, utf8-string >=0.3.5
, with-utf8 >=1.0.0
buildable: True
default-language: Haskell2010

View File

@ -48,8 +48,10 @@ dependencies:
- Decimal >=0.5.1
- directory
- doclayout >=0.3 && <0.4
- extra >=1.6.3
- file-embed >=0.0.10
- filepath
- Glob >= 0.9
- hashtables >=1.2.3.1
- megaparsec >=7.0.0 && <9.3
- microlens >=0.4
@ -70,8 +72,7 @@ dependencies:
- unordered-containers >=0.2
- uglymemo
- utf8-string >=0.3.5
- extra >=1.6.3
- Glob >= 0.9
- with-utf8 >=1.0.0
# for ledger-parse:
#- parsers >=0.5
#- system-filepath

View File

@ -22,7 +22,7 @@ module Hledger.Cli.Commands.Accounts (
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import System.Console.CmdArgs.Explicit as C
import Hledger
@ -96,4 +96,4 @@ accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query,_rsRepo
where
spacer = T.replicate (maxwidth - T.length (showName a)) " "
maxwidth = maximum $ map (T.length . showName) clippedaccts
forM_ clippedaccts $ \a -> T.putStrLn $ showName a <> showType a
forM_ clippedaccts $ \a -> TIO.putStrLn $ showName a <> showType a

View File

@ -26,9 +26,9 @@ import Data.List (isPrefixOf)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (hPutStr, putStr) -- Only putStr and friends are safe
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.IO as TLIO (putStrLn) -- Only putStr and friends are safe
import Data.Time.Calendar (Day)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Lens.Micro ((^.))
@ -184,7 +184,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
prevInput' = prevInput{prevDescAndCmnt=Just descAndCommentString}
when (isJust mbaset) . liftIO $ do
hPutStrLn stderr "Using this similar transaction for defaults:"
T.hPutStr stderr $ showTransaction (fromJust mbaset)
TIO.hPutStr stderr $ showTransaction (fromJust mbaset)
confirmedTransactionWizard prevInput' es' ((EnterNewPosting TxnParams{txnDate=date, txnCode=code, txnDesc=desc, txnCmnt=comment} Nothing) : stack)
Nothing ->
confirmedTransactionWizard prevInput es (drop 1 stack)
@ -435,7 +435,7 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do
-- unelided shows all amounts explicitly, in case there's a price, cf #283
when (debug_ opts > 0) $ do
putStrLn $ printf "\nAdded transaction to %s:" f
TL.putStrLn =<< registerFromString (showTransaction t)
TLIO.putStrLn =<< registerFromString (showTransaction t)
return j{jtxns=ts++[t]}
-- | Append a string, typically one or more transactions, to a journal
@ -448,7 +448,7 @@ journalAddTransaction j@Journal{jtxns=ts} opts t = do
--
appendToJournalFileOrStdout :: FilePath -> Text -> IO ()
appendToJournalFileOrStdout f s
| f == "-" = T.putStr s'
| f == "-" = TIO.putStr s'
| otherwise = appendFile f $ T.unpack s'
where s' = "\n" <> ensureOneNewlineTerminated s

View File

@ -7,7 +7,7 @@ module Hledger.Cli.Commands.Checkdates (
) where
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit
@ -43,7 +43,7 @@ checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
positionstr = T.pack . showGenericSourcePos $ tsourcepos error
txn1str = linesPrepend (T.pack " ") $ showTransaction previous
txn2str = linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
T.putStrLn $
TIO.putStrLn $
T.pack "Error: transaction date is out of order"
<> uniquestr <> T.pack "\nat " <> positionstr <> T.pack ":\n\n"
<> txn1str <> txn2str

View File

@ -12,7 +12,7 @@ import Data.Function (on)
import Data.List (groupBy)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStr) -- Only putStr and friends are safe
import Data.Time.Calendar (addDays)
import System.Console.CmdArgs.Explicit as C
@ -169,5 +169,5 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do
++ [posting{paccount=openingacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved]
-- print them
when closing . T.putStr $ showTransaction closingtxn
when opening . T.putStr $ showTransaction openingtxn
when closing . TIO.putStr $ showTransaction closingtxn
when opening . TIO.putStr $ showTransaction openingtxn

View File

@ -16,7 +16,7 @@ module Hledger.Cli.Commands.Codes (
) where
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
@ -36,4 +36,4 @@ codes CliOpts{reportspec_=rspec} j = do
let ts = entriesReport rspec j
codes = (if empty_ (_rsReportOpts rspec) then id else filter (not . T.null)) $
map tcode ts
mapM_ T.putStrLn codes
mapM_ TIO.putStrLn codes

View File

@ -13,7 +13,7 @@ module Hledger.Cli.Commands.Commodities (
) where
import qualified Data.Set as S
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
@ -30,4 +30,4 @@ commoditiesmode = hledgerCommandMode
commodities :: CliOpts -> Journal -> IO ()
commodities _copts =
-- TODO support --declared/--used like accounts, payees
mapM_ T.putStrLn . S.filter (/= "AUTO") . journalCommodities
mapM_ TIO.putStrLn . S.filter (/= "AUTO") . journalCommodities

View File

@ -15,7 +15,7 @@ module Hledger.Cli.Commands.Descriptions (
) where
import Data.List.Extra (nubSort)
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
@ -35,4 +35,4 @@ descriptions CliOpts{reportspec_=rspec} j = do
let ts = entriesReport rspec j
descriptions = nubSort $ map tdescription ts
mapM_ T.putStrLn descriptions
mapM_ TIO.putStrLn descriptions

View File

@ -18,7 +18,7 @@ import Data.Ord (comparing)
import Data.Maybe (fromJust)
import Data.Time (diffDays)
import Data.Either (partitionEithers)
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStr) -- Only putStr and friends are safe
import Lens.Micro (set)
import System.Exit (exitFailure)
@ -108,10 +108,10 @@ diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{_rsQuery=Acct acctRe}} _ = d
let unmatchedtxn2 = unmatchedtxns R pp2 m
putStrLn "These transactions are in the first file only:\n"
mapM_ (T.putStr . showTransaction) unmatchedtxn1
mapM_ (TIO.putStr . showTransaction) unmatchedtxn1
putStrLn "These transactions are in the second file only:\n"
mapM_ (T.putStr . showTransaction) unmatchedtxn2
mapM_ (TIO.putStr . showTransaction) unmatchedtxn2
diff _ _ = do
putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"

View File

@ -9,7 +9,7 @@ where
import Control.Monad
import Data.List
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStr) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Add (journalAddTransaction)
@ -60,7 +60,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
printf "; would import %d new transactions from %s:\n\n" (length newts) inputstr
-- TODO how to force output here ?
-- length (jtxns newj) `seq` print' opts{rawopts_=("explicit",""):rawopts} newj
mapM_ (T.putStr . showTransaction) newts
mapM_ (TIO.putStr . showTransaction) newts
newts | catchup -> do
printf "marked %s as caught up, skipping %d unimported transactions\n\n" inputstr (length newts)
newts -> do

View File

@ -16,7 +16,7 @@ module Hledger.Cli.Commands.Notes (
) where
import Data.List.Extra (nubSort)
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
@ -35,4 +35,4 @@ notes :: CliOpts -> Journal -> IO ()
notes CliOpts{reportspec_=rspec} j = do
let ts = entriesReport rspec j
notes = nubSort $ map transactionNote ts
mapM_ T.putStrLn notes
mapM_ TIO.putStrLn notes

View File

@ -15,7 +15,7 @@ module Hledger.Cli.Commands.Payees (
) where
import qualified Data.Set as S
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import System.Console.CmdArgs.Explicit as C
import Hledger
@ -45,4 +45,4 @@ payees CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query}} j = do
if | declared && not used -> matcheddeclaredpayees
| not declared && used -> matchedusedpayees
| otherwise -> matcheddeclaredpayees <> matchedusedpayees
mapM_ T.putStrLn payees
mapM_ TIO.putStrLn payees

View File

@ -10,7 +10,7 @@ where
import qualified Data.Map as M
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit
@ -45,7 +45,7 @@ prices opts j = do
++ ifBoolOpt "infer-market-prices" cprices
++ ifBoolOpt "infer-reverse-prices" rcprices -- TODO: shouldn't this show reversed P prices also ? valuation will use them
mapM_ (T.putStrLn . showPriceDirective) $
mapM_ (TIO.putStrLn . showPriceDirective) $
sortOn pddate $
filter (matchesPriceDirective q) $
allprices

View File

@ -18,7 +18,7 @@ where
import Data.Text (Text)
import Data.List (intersperse)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStr, putStrLn) -- Only putStr and friends are safe
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Lens.Micro ((^.), _Just, has)
@ -206,5 +206,5 @@ postingToCSV p =
printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch opts j desc = do
case journalSimilarTransaction opts j desc of
Nothing -> putStrLn "no matches found."
Just t -> T.putStr $ showTransaction t
Nothing -> TIO.putStrLn "no matches found."
Just t -> TIO.putStr $ showTransaction t

View File

@ -10,7 +10,7 @@ where
import Data.Char (toUpper)
import Data.List
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.IO as TLIO (putStr, putStrLn) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Register
@ -28,8 +28,8 @@ registermatch opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j =
[desc] -> do
let ps = [p | (_,_,_,p,_) <- postingsReport rspec j]
case similarPosting ps desc of
Nothing -> putStrLn "no matches found."
Just p -> TL.putStr $ postingsReportAsText opts [pri]
Nothing -> TLIO.putStrLn "no matches found."
Just p -> TLIO.putStr $ postingsReportAsText opts [pri]
where pri = (Just (postingDate p)
,Nothing
,tdescription <$> ptransaction p

View File

@ -14,7 +14,7 @@ import Data.Functor.Identity
import Data.List (sortOn, foldl')
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStr) -- Only putStr and friends are safe
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Print
@ -66,7 +66,7 @@ printOrDiff opts
diffOutput :: Journal -> Journal -> IO ()
diffOutput j j' = do
let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t']
T.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed
TIO.putStr $ renderPatch $ map (uncurry $ diffTxn j) changed
type Chunk = (SourcePos, [DiffLine Text])

View File

@ -25,7 +25,7 @@ import Data.List
import Numeric.RootFinding
import Data.Decimal
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.Lazy.IO as TLIO (putStr, putStrLn) -- Only putStr and friends are safe
import System.Console.CmdArgs.Explicit as CmdArgs
import Text.Tabular.AsciiWide as Tab
@ -85,7 +85,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
trans = dbg3 "investments" $ jtxns filteredj
when (null trans) $ do
putStrLn "No relevant transactions found. Check your investments query"
TLIO.putStrLn "No relevant transactions found. Check your investments query"
exitFailure
let spans = snd $ reportSpan filteredj rspec
@ -146,7 +146,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
, Tab.Group Tab.SingleLine [Header "IRR", Header "TWR"]])
tableBody
TL.putStrLn $ Tab.render prettyTables id id id table
TLIO.putStrLn $ Tab.render prettyTables id id id table
timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountValue (OneSpan spanBegin spanEnd valueBeforeAmt valueAfter cashFlow pnl) = do
let valueBefore = unMix valueBeforeAmt
@ -229,7 +229,7 @@ timeWeightedReturn showCashFlow prettyTables investmentsQuery trans mixedAmountV
unitPrices = add initialUnitPrice unitPrices'
unitBalances = add initialUnits unitBalances'
TL.putStr $ Tab.render prettyTables id id T.pack
TLIO.putStr $ Tab.render prettyTables id id T.pack
(Table
(Tab.Group NoLine (map (Header . showDate) dates))
(Tab.Group DoubleLine [ Tab.Group Tab.SingleLine [Tab.Header "Portfolio value", Tab.Header "Unit balance"]
@ -259,7 +259,7 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB
when showCashFlow $ do
printf "\nIRR cash flow for %s - %s\n" (showDate spanBegin) (showDate (addDays (-1) spanEnd))
let (dates, amounts) = unzip totalCF
TL.putStrLn $ Tab.render prettyTables id id id
TLIO.putStrLn $ Tab.render prettyTables id id id
(Table
(Tab.Group Tab.NoLine (map (Header . showDate) dates))
(Tab.Group Tab.SingleLine [Header "Amount"])

View File

@ -10,7 +10,7 @@ where
import qualified Control.Monad.Fail as Fail
import Data.List.Extra (nubSort)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import Safe
import System.Console.CmdArgs.Explicit as C
import Hledger
@ -55,4 +55,4 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
, let r = if values then v else t
, not (values && T.null v && not empty)
]
mapM_ T.putStrLn tagsorvalues
mapM_ TIO.putStrLn tagsorvalues

View File

@ -41,17 +41,18 @@ etc.
module Hledger.Cli.Main where
import Data.Char (isDigit)
import Data.List
import Safe
import Data.List (isPrefixOf)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Main.Utf8 (withUtf8)
import Safe (headDef, headMay)
import qualified System.Console.CmdArgs.Explicit as C
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Printf
import System.Environment (getArgs)
import System.Exit (exitFailure, exitWith)
import System.FilePath (dropExtension)
import System.Process (system)
import Text.Printf (printf)
import Hledger.Cli
import Data.Time.Clock.POSIX (getPOSIXTime)
-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
@ -96,7 +97,7 @@ mainmode addons = defMode {
-- | Let's go!
main :: IO ()
main = do
main = withUtf8 $ do
progstarttime <- getPOSIXTime
-- Choose and run the appropriate internal or external command based

View File

@ -30,16 +30,19 @@ module Hledger.Cli.Utils
)
where
import Prelude hiding (putStr, putStrLn, writeFile)
import Control.Exception as C
import Control.Monad.Except (ExceptT, liftIO)
import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.IO as TL
import qualified Data.Text.IO as TIO (putStrLn) -- Only putStr and friends are safe
import qualified Data.Text.IO.Utf8 as TIO
import qualified Data.Text.Lazy.IO as TLIO (putStr) -- Only putStr and friends are safe
import qualified Data.Text.Lazy.IO.Utf8 as TLIO
import Data.Time (Day)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Lens.Micro ((^.))
@ -111,9 +114,7 @@ anonymiseByOpts opts =
-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten.
writeOutput :: CliOpts -> String -> IO ()
writeOutput opts s = do
f <- outputFileFromOpts opts
(maybe putStr writeFile f) s
writeOutput opts = writeOutputLazyText opts . TL.pack
-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten. This function operates on Lazy
@ -121,7 +122,7 @@ writeOutput opts s = do
writeOutputLazyText :: CliOpts -> TL.Text -> IO ()
writeOutputLazyText opts s = do
f <- outputFileFromOpts opts
(maybe TL.putStr TL.writeFile f) s
(maybe TLIO.putStr TLIO.writeFile f) s
-- -- | Get a journal from the given string and options, or throw an error.
-- readJournal :: CliOpts -> String -> IO Journal
@ -189,8 +190,8 @@ openBrowserOn u = trybrowsers browsers u
ExitSuccess -> return ExitSuccess
ExitFailure _ -> trybrowsers bs u
trybrowsers [] u = do
putStrLn $ printf "Could not start a web browser (tried: %s)" $ intercalate ", " browsers
putStrLn $ printf "Please open your browser and visit %s" u
TIO.putStrLn . T.pack $ "Could not start a web browser (tried: " <> intercalate ", " browsers <> ")"
TIO.putStrLn . T.pack $ "Please open your browser and visit " <> u
return $ ExitFailure 127
browsers | os=="darwin" = ["open"]
| os=="mingw32" = ["c:/Program Files/Mozilla Firefox/firefox.exe"]
@ -217,12 +218,12 @@ writeFileWithBackupIfChanged :: FilePath -> T.Text -> IO Bool
writeFileWithBackupIfChanged f t = do
s <- readFilePortably f
if t == s then return False
else backUpFile f >> T.writeFile f t >> return True
else backUpFile f >> TIO.writeFile f t >> return True
-- | Back up this file with a (incrementing) numbered suffix, then
-- overwrite it with this new text, or give an error.
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup f t = backUpFile f >> writeFile f t
writeFileWithBackup f t = backUpFile f >> TIO.writeFile f (T.pack t)
readFileStrictly :: FilePath -> IO T.Text
readFileStrictly f = readFilePortably f >>= \s -> C.evaluate (T.length s) >> return s

View File

@ -1,6 +1,6 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.34.6.
--
-- see: https://github.com/sol/hpack
@ -172,6 +172,7 @@ library
, unordered-containers
, utf8-string >=0.3.5
, utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0
if (!(os(windows))) && (flag(terminfo))
build-depends:
@ -221,6 +222,7 @@ executable hledger
, unordered-containers
, utf8-string >=0.3.5
, utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0
if (!(os(windows))) && (flag(terminfo))
build-depends:
@ -271,6 +273,7 @@ test-suite unittest
, unordered-containers
, utf8-string >=0.3.5
, utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0
if (!(os(windows))) && (flag(terminfo))
build-depends:
@ -320,6 +323,7 @@ benchmark bench
, unordered-containers
, utf8-string >=0.3.5
, utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0
buildable: False
if (!(os(windows))) && (flag(terminfo))

View File

@ -130,6 +130,7 @@ dependencies:
- unordered-containers
- utf8-string >=0.3.5
- utility-ht >=0.0.13
- with-utf8 >=1.0.0
- wizards >=1.0
when:

View File

@ -1,11 +1,17 @@
hledger -f - balance
<<<
2009-01-01 проверка
τράπεζα 10 руб
नकद
>>>
10 руб τράπεζα
-10 руб नकद
# 1. Works with unicode input.
$hledger -f unicode.journal balance
10 ß ß
10 проверка проверка
--------------------
0
>>>=0
10 ß
10 проверка
>=0
# 2. Handles a byte order mark.
$ hledger -f unicode-bom.journal balance
10 ß ß
10 проверка проверка
--------------------
10 ß
10 проверка
>=0

View File

@ -0,0 +1 @@
../../../examples/unicode-bom.journal

View File

@ -0,0 +1 @@
../../../examples/unicode.journal

View File

@ -15,8 +15,6 @@ packages:
extra-deps:
# for Shake.hs (regex doesn't support base-compat-0.11):
- regex-1.0.2.0@rev:1
- doclayout-0.3.1.1
- emojis-0.1.2
# for testing base-compat 0.11 compatibility (mutually exclusive with the above):
# - aeson-1.4.6.0
# - aeson-compat-0.3.9
@ -29,6 +27,11 @@ extra-deps:
- prettyprinter-1.7.0
- prettyprinter-ansi-terminal-1.1.2
- doctest-0.18.1
- doclayout-0.3.1.1
- emojis-0.1.2
- with-utf8-1.0.2.3
- th-compat-0.1.3
- th-env-0.1.0.3
# for hledger:
- githash-0.1.4.0
# for hledger-ui: