From 8937ed457d6e43a78a6ec620a73dfb0731b19c6d Mon Sep 17 00:00:00 2001 From: ob Date: Sat, 13 Feb 2010 20:00:34 +0000 Subject: [PATCH] GHC 6.12.1 has UTF8 support on board. Using System.IO.UTF8 can cause problems. Therefore use System.IO.UTF8 only on previous versions. Testet with GHC 6.10.4 and 6.12.1 --- Commands/Add.hs | 15 ++++++++++----- Commands/Balance.hs | 5 ++++- Commands/Histogram.hs | 5 ++++- Commands/Print.hs | 5 ++++- Commands/Register.hs | 5 ++++- Commands/Stats.hs | 5 ++++- Commands/Web.hs | 23 ++++++++++++++++++++++- Ledger/IO.hs | 3 +++ Ledger/Parse.hs | 5 ++++- Ledger/Utils.hs | 5 ++++- Options.hs | 6 ++++++ Utils.hs | 5 +++++ hledger.hs | 2 ++ 13 files changed, 76 insertions(+), 13 deletions(-) diff --git a/Commands/Add.hs b/Commands/Add.hs index c058f88a5..299d82053 100644 --- a/Commands/Add.hs +++ b/Commands/Add.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| A history-aware add command to help with data entry. @@ -6,12 +7,16 @@ A history-aware add command to help with data entry. module Commands.Add where -import Prelude hiding (putStr, putStrLn, getLine, appendFile) import Ledger import Options import Commands.Register (showRegisterReport) +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding (putStr, putStrLn, getLine, appendFile) import System.IO.UTF8 -import System.IO (stderr, hFlush) +import System.IO ( stderr, hFlush ) +#else +import System.IO ( stderr, hFlush, hPutStrLn, hPutStr ) +#endif import System.IO.Error import Text.ParserCombinators.Parsec import Utils (ledgerFromStringWithOpts) @@ -24,9 +29,9 @@ add :: [Opt] -> [String] -> Ledger -> IO () add opts args l | filepath (journal l) == "-" = return () | otherwise = do - hPutStrLn stderr - "Enter one or more transactions, which will be added to your ledger file.\n\ - \To complete a transaction, enter . as account name. To quit, press control-c." + hPutStrLn stderr $ + "Enter one or more transactions, which will be added to your ledger file.\n" + ++"To complete a transaction, enter . as account name. To quit, press control-c." today <- getCurrentDay getAndAddTransactions l opts args today `catch` (\e -> unless (isEOFError e) $ ioError e) diff --git a/Commands/Balance.hs b/Commands/Balance.hs index 9cc61f745..40bef7ddd 100644 --- a/Commands/Balance.hs +++ b/Commands/Balance.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| A ledger-compatible @balance@ command. @@ -96,7 +97,6 @@ balance report: module Commands.Balance where -import Prelude hiding (putStr) import Ledger.Utils import Ledger.Types import Ledger.Amount @@ -104,7 +104,10 @@ import Ledger.AccountName import Ledger.Posting import Ledger.Ledger import Options +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding ( putStr ) import System.IO.UTF8 +#endif -- | Print a balance report. diff --git a/Commands/Histogram.hs b/Commands/Histogram.hs index ae8d7ad27..f4437e0c4 100644 --- a/Commands/Histogram.hs +++ b/Commands/Histogram.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Print a histogram report. @@ -6,10 +7,12 @@ Print a histogram report. module Commands.Histogram where -import Prelude hiding (putStr) import Ledger import Options +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding ( putStr ) import System.IO.UTF8 +#endif barchar = '*' diff --git a/Commands/Print.hs b/Commands/Print.hs index 886873ae8..31d28d3a2 100644 --- a/Commands/Print.hs +++ b/Commands/Print.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| A ledger-compatible @print@ command. @@ -6,10 +7,12 @@ A ledger-compatible @print@ command. module Commands.Print where -import Prelude hiding (putStr) import Ledger import Options +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding ( putStr ) import System.IO.UTF8 +#endif -- | Print ledger transactions in standard format. diff --git a/Commands/Register.hs b/Commands/Register.hs index da985d7dd..a6b3e2488 100644 --- a/Commands/Register.hs +++ b/Commands/Register.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| A ledger-compatible @register@ command. @@ -6,10 +7,12 @@ A ledger-compatible @register@ command. module Commands.Register where -import Prelude hiding (putStr) import Ledger import Options +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding ( putStr ) import System.IO.UTF8 +#endif -- | Print a register report. diff --git a/Commands/Stats.hs b/Commands/Stats.hs index 4c477b60c..744c60b9a 100644 --- a/Commands/Stats.hs +++ b/Commands/Stats.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Print some statistics for the ledger. @@ -6,10 +7,12 @@ Print some statistics for the ledger. module Commands.Stats where -import Prelude hiding (putStr) import Ledger import Options +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding ( putStr ) import System.IO.UTF8 +#endif -- | Print various statistics for the ledger. diff --git a/Commands/Web.hs b/Commands/Web.hs index 0bed87612..3dc33cbf1 100644 --- a/Commands/Web.hs +++ b/Commands/Web.hs @@ -6,7 +6,9 @@ A web-based UI. module Commands.Web where +#if __GLASGOW_HASKELL__ <= 610 import Codec.Binary.UTF8.String (decodeString) +#endif import Control.Applicative.Error (Failing(Success,Failure)) import Control.Concurrent import Control.Monad.Reader (ask) @@ -50,7 +52,7 @@ import Commands.Register import Ledger import Utils (openBrowserOn) import Ledger.IO (readLedger) - +# -- import Debug.Trace -- strace :: Show a => a -> a -- strace a = trace (show a) a @@ -244,8 +246,13 @@ searchform env = do addform :: Hack.Env -> HSP XML addform env = do let inputs = Hack.Contrib.Request.inputs env +#if __GLASGOW_HASKELL__ <= 610 date = decodeString $ fromMaybe "" $ lookup "date" inputs desc = decodeString $ fromMaybe "" $ lookup "desc" inputs +#else + date = fromMaybe "" $ lookup "date" inputs + desc = fromMaybe "" $ lookup "desc" inputs +#endif
@@ -268,8 +275,13 @@ addform env = do transactionfields :: Int -> Hack.Env -> HSP XML transactionfields n env = do let inputs = Hack.Contrib.Request.inputs env +#if __GLASGOW_HASKELL__ <= 610 acct = decodeString $ fromMaybe "" $ lookup acctvar inputs amt = decodeString $ fromMaybe "" $ lookup amtvar inputs +#else + acct = fromMaybe "" $ lookup acctvar inputs + amt = fromMaybe "" $ lookup amtvar inputs +#endif [NBSP][NBSP] @@ -292,12 +304,21 @@ handleAddform l = do validate :: Hack.Env -> Day -> Failing Transaction validate env today = let inputs = Hack.Contrib.Request.inputs env +#if __GLASGOW_HASKELL__ <= 610 date = decodeString $ fromMaybe "today" $ lookup "date" inputs desc = decodeString $ fromMaybe "" $ lookup "desc" inputs acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs amt1 = decodeString $ fromMaybe "" $ lookup "amt1" inputs acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs amt2 = decodeString $ fromMaybe "" $ lookup "amt2" inputs +#else + date = fromMaybe "today" $ lookup "date" inputs + desc = fromMaybe "" $ lookup "desc" inputs + acct1 = fromMaybe "" $ lookup "acct1" inputs + amt1 = fromMaybe "" $ lookup "amt1" inputs + acct2 = fromMaybe "" $ lookup "acct2" inputs + amt2 = fromMaybe "" $ lookup "amt2" inputs +#endif validateDate "" = ["missing date"] validateDate _ = [] validateDesc "" = ["missing description"] diff --git a/Ledger/IO.hs b/Ledger/IO.hs index d2cf5bee7..d06ff86f5 100644 --- a/Ledger/IO.hs +++ b/Ledger/IO.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Utilities for doing I/O with ledger files. -} @@ -12,8 +13,10 @@ import Ledger.Utils (getCurrentLocalTime) import Ledger.Dates (nulldatespan) import System.Directory (getHomeDirectory) import System.Environment (getEnv) +#if __GLASGOW_HASKELL__ <= 610 import Prelude hiding (readFile) import System.IO.UTF8 +#endif import System.FilePath (()) import System.Time (getClockTime) diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index aff8f059d..d763d17b5 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Parsers for standard ledger and timelog files. @@ -6,13 +7,15 @@ Parsers for standard ledger and timelog files. module Ledger.Parse where -import Prelude hiding (readFile, putStr, putStrLn, print, getContents) import Control.Monad.Error (ErrorT(..), MonadIO, liftIO, throwError, catchError) import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Char import Text.ParserCombinators.Parsec.Combinator import System.Directory +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding (readFile, putStr, putStrLn, print, getContents) import System.IO.UTF8 +#endif import Ledger.Utils import Ledger.Types import Ledger.Dates diff --git a/Ledger/Utils.hs b/Ledger/Utils.hs index 08ba220dd..d2683e844 100644 --- a/Ledger/Utils.hs +++ b/Ledger/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Provide standard imports and utilities which are useful everywhere, or @@ -23,7 +24,6 @@ module Text.RegexPR, module Test.HUnit, ) where -import Prelude hiding (readFile) import Char import Control.Exception import Control.Monad @@ -36,7 +36,10 @@ import Data.Time.Clock import Data.Time.Calendar import Data.Time.LocalTime import Debug.Trace +#if __GLASGOW_HASKELL__ <= 610 +import Prelude hiding (readFile) import System.IO.UTF8 +#endif import Test.HUnit import Text.Printf import Text.RegexPR diff --git a/Options.hs b/Options.hs index a8a6af03d..995b1d394 100644 --- a/Options.hs +++ b/Options.hs @@ -11,7 +11,9 @@ import Ledger.IO (myLedgerPath,myTimelogPath) import Ledger.Utils import Ledger.Types import Ledger.Dates +#if __GLASGOW_HASKELL__ <= 610 import Codec.Binary.UTF8.String (decodeString) +#endif import Control.Monad (liftM) progname = "hledger" @@ -149,7 +151,11 @@ optValuesForConstructors fs opts = concatMap get opts -- YYYY/MM/DD format based on the current time. parseArguments :: IO ([Opt], String, [String]) parseArguments = do +#if __GLASGOW_HASKELL__ <= 610 args <- liftM (map decodeString) getArgs +#else + args <- getArgs +#endif let (os,as,es) = getOpt Permute options args -- istimequery <- usingTimeProgramName -- let os' = if istimequery then (Period "today"):os else os diff --git a/Utils.hs b/Utils.hs index 25cafe1e9..1b49f6e74 100644 --- a/Utils.hs +++ b/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-| Utilities for top-level modules and ghci. See also "Ledger.IO" and @@ -12,7 +13,11 @@ import Ledger import Options (Opt(..),ledgerFilePathFromOpts) -- ,optsToFilterSpec) import System.Directory (doesFileExist) import System.IO (stderr) +#if __GLASGOW_HASKELL__ <= 610 import System.IO.UTF8 (hPutStrLn) +#else +import System.IO (hPutStrLn) +#endif import System.Exit import System.Cmd (system) import System.Info (os) diff --git a/hledger.hs b/hledger.hs index d98cb069a..cf28f13c9 100644 --- a/hledger.hs +++ b/hledger.hs @@ -36,8 +36,10 @@ See "Ledger.Ledger" for more examples. -} module Main where +#if __GLASGOW_HASKELL__ <= 610 import Prelude hiding (putStr, putStrLn) import System.IO.UTF8 +#endif import Commands.All import Ledger