simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-27 04:13:11 +03:00
Code Issues Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/hledger-balance-as-budget.hs
View File

@ -8,7 +8,7 @@
{-| Construct two balance reports for two different time periods and use one of the as "budget" for {-| Construct two balance reports for two different time periods and use one of the as "budget" for
the other, thus comparing them 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 System.Environment (getArgs)
import Hledger.Cli import Hledger.Cli

2
bin/hledger-check-fancyassertions.hs
View File

@ -112,7 +112,7 @@ import Data.Time.Calendar (toGregorian)
import Data.Time.Calendar.OrdinalDate (mondayStartWeek, sundayStartWeek, toOrdinalDate) import Data.Time.Calendar.OrdinalDate (mondayStartWeek, sundayStartWeek, toOrdinalDate)
import Data.Text (Text, isPrefixOf, pack, unpack) import Data.Text (Text, isPrefixOf, pack, unpack)
import qualified Data.Text as T 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.Data as H
import qualified Hledger.Query as H import qualified Hledger.Query as H
import qualified Hledger.Read as H import qualified Hledger.Read as H

2
bin/hledger-combine-balances.hs
View File

@ -11,7 +11,7 @@ import System.Environment (getArgs)
import Hledger.Cli import Hledger.Cli
import qualified Data.Map as M import qualified Data.Map as M
import Data.Map.Merge.Strict 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 :: MultiBalanceReport -> MultiBalanceReport -> MultiBalanceReport
appendReports r1 r2 = appendReports r1 r2 =

2
bin/hledger-swap-dates.hs
View File

@ -9,7 +9,7 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
import Data.String.QQ (s) 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
import Hledger.Cli import Hledger.Cli

8
examples/unicode-bom.journal Normal file
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 проверка

6
hledger-lib/Hledger/Data/PeriodicTransaction.hs
View File

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

4
hledger-lib/Hledger/Data/TransactionModifier.hs
View File

@ -63,10 +63,10 @@ modifyTransactions atypes atags styles d tmods ts = do
-- Currently the only kind of modification possible is adding automated -- Currently the only kind of modification possible is adding automated
-- postings when certain other postings are present. -- 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]} -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
-- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False -- >>> 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] -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2]
-- 0000-01-01 -- 0000-01-01
-- ping $1.00 -- ping $1.00

6
hledger-lib/Hledger/Read.hs
View File

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

28
hledger-lib/Hledger/Read/CsvReader.hs
View File

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

19
hledger-lib/Hledger/Utils.hs
View File

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

5
hledger-lib/hledger-lib.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 1.12 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 -- see: https://github.com/sol/hpack
@ -137,6 +137,7 @@ library
, uglymemo , uglymemo
, unordered-containers >=0.2 , unordered-containers >=0.2
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, with-utf8 >=1.0.0
default-language: Haskell2010 default-language: Haskell2010
test-suite doctest test-suite doctest
@ -188,6 +189,7 @@ test-suite doctest
, uglymemo , uglymemo
, unordered-containers >=0.2 , unordered-containers >=0.2
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, with-utf8 >=1.0.0
if impl(ghc < 9.2) if impl(ghc < 9.2)
buildable: False buildable: False
default-language: Haskell2010 default-language: Haskell2010
@ -241,5 +243,6 @@ test-suite unittest
, uglymemo , uglymemo
, unordered-containers >=0.2 , unordered-containers >=0.2
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, with-utf8 >=1.0.0
buildable: True buildable: True
default-language: Haskell2010 default-language: Haskell2010

5
hledger-lib/package.yaml
View File

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

4
hledger/Hledger/Cli/Commands/Accounts.hs
View File

@ -22,7 +22,7 @@ module Hledger.Cli.Commands.Accounts (
import Data.List import Data.List
import qualified Data.Text as T 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 System.Console.CmdArgs.Explicit as C
import Hledger import Hledger
@ -96,4 +96,4 @@ accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{_rsQuery=query,_rsRepo
where where
spacer = T.replicate (maxwidth - T.length (showName a)) " " spacer = T.replicate (maxwidth - T.length (showName a)) " "
maxwidth = maximum $ map (T.length . showName) clippedaccts 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

10
hledger/Hledger/Cli/Commands/Add.hs
View File

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

4
hledger/Hledger/Cli/Commands/Checkdates.hs
View File

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

6
hledger/Hledger/Cli/Commands/Close.hs
View File

@ -12,7 +12,7 @@ import Data.Function (on)
import Data.List (groupBy) import Data.List (groupBy)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import qualified Data.Text as T 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 Data.Time.Calendar (addDays)
import System.Console.CmdArgs.Explicit as C 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] ++ [posting{paccount=openingacct, pamount=if explicit then mixedAmountSetFullPrecision (maNegate totalamt) else missingmixedamt} | not interleaved]
-- print them -- print them
when closing . T.putStr $ showTransaction closingtxn when closing . TIO.putStr $ showTransaction closingtxn
when opening . T.putStr $ showTransaction openingtxn when opening . TIO.putStr $ showTransaction openingtxn

4
hledger/Hledger/Cli/Commands/Codes.hs
View File

@ -16,7 +16,7 @@ module Hledger.Cli.Commands.Codes (
) where ) where
import qualified Data.Text as T 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
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -36,4 +36,4 @@ codes CliOpts{reportspec_=rspec} j = do
let ts = entriesReport rspec j let ts = entriesReport rspec j
codes = (if empty_ (_rsReportOpts rspec) then id else filter (not . T.null)) $ codes = (if empty_ (_rsReportOpts rspec) then id else filter (not . T.null)) $
map tcode ts map tcode ts
mapM_ T.putStrLn codes mapM_ TIO.putStrLn codes

4
hledger/Hledger/Cli/Commands/Commodities.hs
View File

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

4
hledger/Hledger/Cli/Commands/Descriptions.hs
View File

@ -15,7 +15,7 @@ module Hledger.Cli.Commands.Descriptions (
) where ) where
import Data.List.Extra (nubSort) 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
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -35,4 +35,4 @@ descriptions CliOpts{reportspec_=rspec} j = do
let ts = entriesReport rspec j let ts = entriesReport rspec j
descriptions = nubSort $ map tdescription ts descriptions = nubSort $ map tdescription ts
mapM_ T.putStrLn descriptions mapM_ TIO.putStrLn descriptions

6
hledger/Hledger/Cli/Commands/Diff.hs
View File

@ -18,7 +18,7 @@ import Data.Ord (comparing)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Time (diffDays) import Data.Time (diffDays)
import Data.Either (partitionEithers) 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 Lens.Micro (set)
import System.Exit (exitFailure) 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 let unmatchedtxn2 = unmatchedtxns R pp2 m
putStrLn "These transactions are in the first file only:\n" 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" putStrLn "These transactions are in the second file only:\n"
mapM_ (T.putStr . showTransaction) unmatchedtxn2 mapM_ (TIO.putStr . showTransaction) unmatchedtxn2
diff _ _ = do diff _ _ = do
putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME" putStrLn "Please specify two input files. Usage: hledger diff -f FILE1 -f FILE2 FULLACCOUNTNAME"

4
hledger/Hledger/Cli/Commands/Import.hs
View File

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

4
hledger/Hledger/Cli/Commands/Notes.hs
View File

@ -16,7 +16,7 @@ module Hledger.Cli.Commands.Notes (
) where ) where
import Data.List.Extra (nubSort) 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
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -35,4 +35,4 @@ notes :: CliOpts -> Journal -> IO ()
notes CliOpts{reportspec_=rspec} j = do notes CliOpts{reportspec_=rspec} j = do
let ts = entriesReport rspec j let ts = entriesReport rspec j
notes = nubSort $ map transactionNote ts notes = nubSort $ map transactionNote ts
mapM_ T.putStrLn notes mapM_ TIO.putStrLn notes

4
hledger/Hledger/Cli/Commands/Payees.hs
View File

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

4
hledger/Hledger/Cli/Commands/Prices.hs
View File

@ -10,7 +10,7 @@ where
import qualified Data.Map as M import qualified Data.Map as M
import Data.List import Data.List
import qualified Data.Text as T 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
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
@ -45,7 +45,7 @@ prices opts j = do
++ ifBoolOpt "infer-market-prices" cprices ++ ifBoolOpt "infer-market-prices" cprices
++ ifBoolOpt "infer-reverse-prices" rcprices -- TODO: shouldn't this show reversed P prices also ? valuation will use them ++ 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 $ sortOn pddate $
filter (matchesPriceDirective q) $ filter (matchesPriceDirective q) $
allprices allprices

6
hledger/Hledger/Cli/Commands/Print.hs
View File

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

6
hledger/Hledger/Cli/Commands/Registermatch.hs
View File

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

4
hledger/Hledger/Cli/Commands/Rewrite.hs
View File

@ -14,7 +14,7 @@ import Data.Functor.Identity
import Data.List (sortOn, foldl') import Data.List (sortOn, foldl')
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T 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
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Commands.Print import Hledger.Cli.Commands.Print
@ -66,7 +66,7 @@ printOrDiff opts
diffOutput :: Journal -> Journal -> IO () diffOutput :: Journal -> Journal -> IO ()
diffOutput j j' = do diffOutput j j' = do
let changed = [(originalTransaction t, originalTransaction t') | (t, t') <- zip (jtxns j) (jtxns j'), t /= t'] 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]) type Chunk = (SourcePos, [DiffLine Text])

10
hledger/Hledger/Cli/Commands/Roi.hs
View File

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

4
hledger/Hledger/Cli/Commands/Tags.hs
View File

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

19
hledger/Hledger/Cli/Main.hs
View File

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

23
hledger/Hledger/Cli/Utils.hs
View File

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

6
hledger/hledger.cabal
View File

@ -1,6 +1,6 @@
cabal-version: 1.12 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 -- see: https://github.com/sol/hpack
@ -172,6 +172,7 @@ library
, unordered-containers , unordered-containers
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, utility-ht >=0.0.13 , utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0 , wizards >=1.0
if (!(os(windows))) && (flag(terminfo)) if (!(os(windows))) && (flag(terminfo))
build-depends: build-depends:
@ -221,6 +222,7 @@ executable hledger
, unordered-containers , unordered-containers
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, utility-ht >=0.0.13 , utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0 , wizards >=1.0
if (!(os(windows))) && (flag(terminfo)) if (!(os(windows))) && (flag(terminfo))
build-depends: build-depends:
@ -271,6 +273,7 @@ test-suite unittest
, unordered-containers , unordered-containers
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, utility-ht >=0.0.13 , utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0 , wizards >=1.0
if (!(os(windows))) && (flag(terminfo)) if (!(os(windows))) && (flag(terminfo))
build-depends: build-depends:
@ -320,6 +323,7 @@ benchmark bench
, unordered-containers , unordered-containers
, utf8-string >=0.3.5 , utf8-string >=0.3.5
, utility-ht >=0.0.13 , utility-ht >=0.0.13
, with-utf8 >=1.0.0
, wizards >=1.0 , wizards >=1.0
buildable: False buildable: False
if (!(os(windows))) && (flag(terminfo)) if (!(os(windows))) && (flag(terminfo))

1
hledger/package.yaml
View File

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

26
hledger/test/i18n/unicode-balance.test
View File

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

1
hledger/test/i18n/unicode-bom.journal Symbolic link
View File

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

1
hledger/test/i18n/unicode.journal Symbolic link
View File

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

7
stack8.6.yaml
View File

@ -15,8 +15,6 @@ packages:
extra-deps: extra-deps:
# for Shake.hs (regex doesn't support base-compat-0.11): # for Shake.hs (regex doesn't support base-compat-0.11):
- regex-1.0.2.0@rev:1 - 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): # for testing base-compat 0.11 compatibility (mutually exclusive with the above):
# - aeson-1.4.6.0 # - aeson-1.4.6.0
# - aeson-compat-0.3.9 # - aeson-compat-0.3.9
@ -29,6 +27,11 @@ extra-deps:
- prettyprinter-1.7.0 - prettyprinter-1.7.0
- prettyprinter-ansi-terminal-1.1.2 - prettyprinter-ansi-terminal-1.1.2
- doctest-0.18.1 - 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: # for hledger:
- githash-0.1.4.0 - githash-0.1.4.0
# for hledger-ui: # for hledger-ui: