From 1ed06f3bc8bbc14c622fc7577da40cf005a1d376 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Sat, 28 Aug 2021 22:51:28 +1000 Subject: [PATCH] pkg!: Remove Hledger.Utils.UTF8IOCompat module. This module does nothing beyond define error' and usageError, which have been moved to Hledger.Utils. --- .../Hledger/Data/PeriodicTransaction.hs | 3 +- hledger-lib/Hledger/Utils.hs | 17 ++- hledger-lib/Hledger/Utils/Parse.hs | 3 +- hledger-lib/Hledger/Utils/Regex.hs | 6 +- hledger-lib/Hledger/Utils/Test.hs | 1 - hledger-lib/Hledger/Utils/UTF8IOCompat.hs | 105 ------------------ hledger-lib/hledger-lib.cabal | 1 - hledger-lib/package.yaml | 1 - hledger-web/Hledger/Web/Main.hs | 2 - hledger/Hledger/Cli/Commands/Activity.hs | 2 - hledger/Hledger/Cli/Commands/Diff.hs | 2 - hledger/Hledger/Cli/Commands/Files.hs | 2 - 12 files changed, 12 insertions(+), 133 deletions(-) delete mode 100644 hledger-lib/Hledger/Utils/UTF8IOCompat.hs diff --git a/hledger-lib/Hledger/Data/PeriodicTransaction.hs b/hledger-lib/Hledger/Data/PeriodicTransaction.hs index 0061ffc75..02cbd9019 100644 --- a/hledger-lib/Hledger/Data/PeriodicTransaction.hs +++ b/hledger-lib/Hledger/Data/PeriodicTransaction.hs @@ -20,8 +20,7 @@ import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Posting (post, commentAddTagNextLine) import Hledger.Data.Transaction -import Hledger.Utils.UTF8IOCompat (error') -import Hledger.Utils.Debug +import Hledger.Utils -- $setup -- >>> :set -XOverloadedStrings diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 0e50db745..8b1e526fc 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -4,9 +4,7 @@ Standard imports and utilities which are useful everywhere, or needed low in the module hierarchy. This is the bottom of hledger's module graph. -} -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} module Hledger.Utils (---- provide these frequently used modules - or not, for clearer api: -- module Control.Monad, @@ -30,8 +28,6 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c module Hledger.Utils.Tree, -- Debug.Trace.trace, -- module Data.PPrint, - -- module Hledger.Utils.UTF8IOCompat - error',userError',usageError, -- the rest need to be done in each module I think ) where @@ -65,9 +61,6 @@ import Hledger.Utils.Text import Hledger.Utils.Test import Hledger.Utils.Color import Hledger.Utils.Tree --- import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) --- import Hledger.Utils.UTF8IOCompat (readFile,writeFile,appendFile,getContents,putStr,putStrLn) -import Hledger.Utils.UTF8IOCompat (error',userError',usageError) -- tuples @@ -96,7 +89,6 @@ sixth6 (_,_,_,_,_,x) = x -- currying - curry2 :: ((a, b) -> c) -> a -> b -> c curry2 f x y = f (x, y) @@ -235,6 +227,14 @@ sequence' ms = do mapM' :: Monad f => (a -> f b) -> [a] -> f [b] mapM' f = sequence' . map f +-- | Simpler alias for errorWithoutStackTrace +error' :: String -> a +error' = errorWithoutStackTrace + +-- | A version of errorWithoutStackTrace that adds a usage hint. +usageError :: String -> a +usageError = error' . (++ " (use -h to see usage)") + -- | Like embedFile, but takes a path relative to the package directory. -- Similar to embedFileRelative ? embedFileRelative :: FilePath -> Q Exp @@ -247,7 +247,6 @@ embedFileRelative f = makeRelativeToProject f >>= embedStringFile -- where -- QuasiQuoter{quoteExp=hereFileExp} = hereFile - -- | Make classy lenses for Hledger options fields. -- This is intended to be used with BalancingOpts, InputOpt, ReportOpts, -- ReportSpec, and CliOpts. diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index 9c2c1e3fd..7248ce2b4 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -47,7 +47,6 @@ import Text.Megaparsec.Custom import Text.Printf import Hledger.Data.Types -import Hledger.Utils.UTF8IOCompat (error') -- | A parser of string to some type. type SimpleStringParser a = Parsec CustomErr String a @@ -110,7 +109,7 @@ fromparse fromparse = either parseerror id parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a -parseerror e = error' $ showParseError e -- PARTIAL: +parseerror e = errorWithoutStackTrace $ showParseError e -- PARTIAL: showParseError :: (Show t, Show (Token t), Show e) diff --git a/hledger-lib/Hledger/Utils/Regex.hs b/hledger-lib/Hledger/Utils/Regex.hs index bec1865ec..704cf9895 100644 --- a/hledger-lib/Hledger/Utils/Regex.hs +++ b/hledger-lib/Hledger/Utils/Regex.hs @@ -75,8 +75,6 @@ import Text.Regex.TDFA ( RegexLike(..), RegexMaker(..), RegexOptions(..), RegexContext(..) ) -import Hledger.Utils.UTF8IOCompat (error') - -- | Regular expression. Extended regular expression-ish syntax ? But does not support eg (?i) syntax. data Regexp @@ -140,11 +138,11 @@ mkRegexErr s = maybe (Left errmsg) Right -- Convert a Regexp string to a compiled Regex, throw an error toRegex' :: Text -> Regexp -toRegex' = either error' id . toRegex +toRegex' = either errorWithoutStackTrace id . toRegex -- Like toRegex', but make a case-insensitive Regex. toRegexCI' :: Text -> Regexp -toRegexCI' = either error' id . toRegexCI +toRegexCI' = either errorWithoutStackTrace id . toRegexCI -- | A replacement pattern. May include numeric backreferences (\N). type Replacement = String diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs index dcc00c574..8918c7ec2 100644 --- a/hledger-lib/Hledger/Utils/Test.hs +++ b/hledger-lib/Hledger/Utils/Test.hs @@ -41,7 +41,6 @@ import Text.Megaparsec.Custom ) import Hledger.Utils.Debug (pshow) --- import Hledger.Utils.UTF8IOCompat (error') -- * tasty helpers diff --git a/hledger-lib/Hledger/Utils/UTF8IOCompat.hs b/hledger-lib/Hledger/Utils/UTF8IOCompat.hs deleted file mode 100644 index 4f697f6b1..000000000 --- a/hledger-lib/Hledger/Utils/UTF8IOCompat.hs +++ /dev/null @@ -1,105 +0,0 @@ -{-# LANGUAGE CPP #-} -{- | - -UTF-8 aware string IO functions that will work across multiple platforms -and GHC versions. Includes code from Text.Pandoc.UTF8 ((C) 2010 John -MacFarlane). - -Example usage: - - import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) - import UTF8IOCompat (readFile,writeFile,appendFile,getContents,putStr,putStrLn) - import UTF8IOCompat (SystemString,fromSystemString,toSystemString,error',userError') - -2013/4/10 update: we now trust that current GHC versions & platforms -do the right thing, so this file is a no-op and on its way to being removed. -Not carefully tested. - -2019/10/20 update: all packages have base>=4.9 which corresponds to GHC v8.0.1 -and higher. Tear this file apart! - --} --- TODO obsolete ? - -module Hledger.Utils.UTF8IOCompat ( - readFile, - writeFile, - appendFile, - getContents, - hGetContents, - putStr, - putStrLn, - hPutStr, - hPutStrLn, - -- - error', - userError', - usageError, -) -where - --- import Control.Monad (liftM) --- import qualified Data.ByteString.Lazy as B --- import qualified Data.ByteString.Lazy.Char8 as B8 --- import qualified Data.ByteString.Lazy.UTF8 as U8 (toString, fromString) -import Prelude hiding (readFile, writeFile, appendFile, getContents, putStr, putStrLn) -import System.IO -- (Handle) - --- bom :: B.ByteString --- bom = B.pack [0xEF, 0xBB, 0xBF] - --- stripBOM :: B.ByteString -> B.ByteString --- stripBOM s | bom `B.isPrefixOf` s = B.drop 3 s --- stripBOM s = s - --- readFile :: FilePath -> IO String --- readFile = liftM (U8.toString . stripBOM) . B.readFile - --- writeFile :: FilePath -> String -> IO () --- writeFile f = B.writeFile f . U8.fromString - --- appendFile :: FilePath -> String -> IO () --- appendFile f = B.appendFile f . U8.fromString - --- getContents :: IO String --- getContents = liftM (U8.toString . stripBOM) B.getContents - --- hGetContents :: Handle -> IO String --- hGetContents h = liftM (U8.toString . stripBOM) (B.hGetContents h) - --- putStr :: String -> IO () --- putStr = bs_putStr . U8.fromString - --- putStrLn :: String -> IO () --- putStrLn = bs_putStrLn . U8.fromString - --- hPutStr :: Handle -> String -> IO () --- hPutStr h = bs_hPutStr h . U8.fromString - --- hPutStrLn :: Handle -> String -> IO () --- hPutStrLn h = bs_hPutStrLn h . U8.fromString - --- -- span GHC versions including 6.12.3 - 7.4.1: --- bs_putStr = B8.putStr --- bs_putStrLn = B8.putStrLn --- bs_hPutStr = B8.hPut --- bs_hPutStrLn h bs = B8.hPut h bs >> B8.hPut h (B.singleton 0x0a) - --- | A SystemString-aware version of error. -error' :: String -> a -error' = -#if __GLASGOW_HASKELL__ < 800 --- (easier than if base < 4.9) - error -#else - errorWithoutStackTrace -#endif - --- | A SystemString-aware version of userError. -userError' :: String -> IOError -userError' = userError - --- | A SystemString-aware version of error that adds a usage hint. -usageError :: String -> a -usageError = error' . (++ " (use -h to see usage)") - diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index fa3e90d52..d07931881 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -86,7 +86,6 @@ library Hledger.Utils.Test Hledger.Utils.Text Hledger.Utils.Tree - Hledger.Utils.UTF8IOCompat Text.Tabular.AsciiWide other-modules: Text.Megaparsec.Custom diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index daebcac7b..05e1f7c2f 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -138,7 +138,6 @@ library: - Hledger.Utils.Test - Hledger.Utils.Text - Hledger.Utils.Tree - - Hledger.Utils.UTF8IOCompat - Text.Tabular.AsciiWide # other-modules: # - Ledger.Parser.Text diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 6831d229d..08eacbfa0 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -20,7 +20,6 @@ import Network.Socket import Network.Wai (Application) import Network.Wai.Handler.Warp (runSettings, runSettingsSocket, defaultSettings, setHost, setPort) import Network.Wai.Handler.Launch (runHostPortFullUrl) -import Prelude hiding (putStrLn) import System.Directory (removeFile) import System.Environment ( getArgs, withArgs ) import System.Exit (exitSuccess, exitFailure) @@ -32,7 +31,6 @@ import Yesod.Default.Main (defaultDevelApp) import Hledger import Hledger.Cli hiding (progname,prognameandversion) -import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Web.Application (makeApplication) import Hledger.Web.Settings (Extra(..), parseExtra) import Hledger.Web.Test (hledgerWebTest) diff --git a/hledger/Hledger/Cli/Commands/Activity.hs b/hledger/Hledger/Cli/Commands/Activity.hs index fcbf7cf06..236993d2d 100644 --- a/hledger/Hledger/Cli/Commands/Activity.hs +++ b/hledger/Hledger/Cli/Commands/Activity.hs @@ -15,8 +15,6 @@ import Text.Printf import Hledger import Hledger.Cli.CliOptions -import Prelude hiding (putStr) -import Hledger.Utils.UTF8IOCompat (putStr) activitymode = hledgerCommandMode $(embedFileRelative "Hledger/Cli/Commands/Activity.txt") diff --git a/hledger/Hledger/Cli/Commands/Diff.hs b/hledger/Hledger/Cli/Commands/Diff.hs index a66db04dd..a968519a1 100644 --- a/hledger/Hledger/Cli/Commands/Diff.hs +++ b/hledger/Hledger/Cli/Commands/Diff.hs @@ -22,8 +22,6 @@ import qualified Data.Text.IO as T import System.Exit (exitFailure) import Hledger -import Prelude hiding (putStrLn) -import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Cli.CliOptions -- | Command line options for this command. diff --git a/hledger/Hledger/Cli/Commands/Files.hs b/hledger/Hledger/Cli/Commands/Files.hs index ddfe770ee..0337b90e2 100644 --- a/hledger/Hledger/Cli/Commands/Files.hs +++ b/hledger/Hledger/Cli/Commands/Files.hs @@ -15,8 +15,6 @@ import qualified Data.Text as T import Safe (headMay) import Hledger -import Prelude hiding (putStrLn) -import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Cli.CliOptions