mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
lib,cli: Assorted fixes for older GHC.
This commit is contained in:
parent
e4e533eb9f
commit
e63138ef7d
@ -40,6 +40,7 @@ exchange rates.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
@ -143,6 +144,9 @@ import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
|
||||
import qualified Data.Map as M
|
||||
import Data.Map (findWithDefault)
|
||||
import Data.Maybe (fromMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import Data.Word (Word8)
|
||||
|
@ -6,6 +6,7 @@ converted to 'Transactions' and queried like a ledger.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hledger.Data.Timeclock (
|
||||
@ -15,6 +16,9 @@ module Hledger.Data.Timeclock (
|
||||
where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (addDays)
|
||||
|
@ -7,11 +7,12 @@ tags.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Hledger.Data.Transaction (
|
||||
-- * Transaction
|
||||
@ -60,6 +61,9 @@ import Data.Default (def)
|
||||
import Data.List (intercalate, partition)
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
|
@ -11,8 +11,9 @@ to import modules below this one.
|
||||
-}
|
||||
|
||||
--- ** language
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
--- ** exports
|
||||
@ -53,6 +54,9 @@ import Data.List (group, sort, sortBy)
|
||||
import Data.List.NonEmpty (nonEmpty)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Ord (comparing)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
@ -1,5 +1,6 @@
|
||||
-- | Basic color helpers for prettifying console output.
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hledger.Utils.Color
|
||||
@ -13,6 +14,9 @@ module Hledger.Utils.Color
|
||||
)
|
||||
where
|
||||
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
import System.Console.ANSI
|
||||
import Hledger.Utils.Text (WideBuilder(..))
|
||||
|
@ -132,11 +132,11 @@ instance RegexContext Regexp String String where
|
||||
|
||||
-- Convert a Regexp string to a compiled Regex, or return an error message.
|
||||
toRegex :: Text -> Either RegexError Regexp
|
||||
toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM s)
|
||||
toRegex = memo $ \s -> mkRegexErr s (Regexp s <$> makeRegexM (T.unpack s)) -- Have to unpack here because Text instance in regex-tdfa only appears in 1.3.1
|
||||
|
||||
-- Like toRegex, but make a case-insensitive Regex.
|
||||
toRegexCI :: Text -> Either RegexError Regexp
|
||||
toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt s)
|
||||
toRegexCI = memo $ \s -> mkRegexErr s (RegexpCI s <$> makeRegexOptsM defaultCompOpt{caseSensitive=False} defaultExecOpt (T.unpack s)) -- Have to unpack here because Text instance in regex-tdfa only appears in 1.3.1
|
||||
|
||||
-- | Make a nice error message for a regexp error.
|
||||
mkRegexErr :: Text -> Maybe a -> Either RegexError a
|
||||
|
@ -1,6 +1,7 @@
|
||||
-- | Text.Tabular.AsciiArt from tabular-0.2.2.7, modified to treat
|
||||
-- wide characters as double width.
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Text.Tabular.AsciiWide where
|
||||
@ -8,6 +9,9 @@ module Text.Tabular.AsciiWide where
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Default (Default(..))
|
||||
import Data.List (intersperse, transpose)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import Data.Semigroup (stimesMonoid)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
@ -1,5 +1,7 @@
|
||||
-- | Calculate the width of String and Text, being aware of wide characters.
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Text.WideString (
|
||||
-- * wide-character-aware layout
|
||||
strWidth,
|
||||
@ -11,6 +13,9 @@ module Text.WideString (
|
||||
wbToText
|
||||
) where
|
||||
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
#endif
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
@ -28,6 +33,9 @@ instance Semigroup WideBuilder where
|
||||
|
||||
instance Monoid WideBuilder where
|
||||
mempty = WideBuilder mempty 0
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
mappend = (<>)
|
||||
#endif
|
||||
|
||||
-- | Convert a WideBuilder to a strict Text.
|
||||
wbToText :: WideBuilder -> Text
|
||||
|
@ -21,9 +21,6 @@ module Hledger.Cli.Commands.Aregister (
|
||||
|
||||
import Data.List (intersperse)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hledger.Cli.Commands.Check.Uniqueleafnames (
|
||||
@ -5,10 +6,13 @@ module Hledger.Cli.Commands.Check.Uniqueleafnames (
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Function
|
||||
import Data.List
|
||||
import Data.Function (on)
|
||||
import Data.List (groupBy, sortBy)
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Text (Text)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Hledger
|
||||
|
76
hledger/Hledger/Cli/Commands/Checkdates.hs
Executable file
76
hledger/Hledger/Cli/Commands/Checkdates.hs
Executable file
@ -0,0 +1,76 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE NoOverloadedStrings #-} -- prevent trouble if turned on in ghci
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Cli.Commands.Checkdates (
|
||||
checkdatesmode
|
||||
,checkdates
|
||||
) where
|
||||
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import System.Console.CmdArgs.Explicit
|
||||
import System.Exit
|
||||
|
||||
checkdatesmode :: Mode RawOpts
|
||||
checkdatesmode = hledgerCommandMode
|
||||
$(embedFileRelative "Hledger/Cli/Commands/Checkdates.txt")
|
||||
[flagNone ["unique"] (setboolopt "unique") "require that dates are unique"]
|
||||
[generalflagsgroup1]
|
||||
hiddenflags
|
||||
([], Just $ argsFlag "[QUERY]")
|
||||
|
||||
checkdates :: CliOpts -> Journal -> IO ()
|
||||
checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
|
||||
let ts = filter (rsQuery rspec `matchesTransaction`) $
|
||||
jtxns $ journalSelectingAmountFromOpts ropts j
|
||||
-- pprint rawopts
|
||||
let unique = boolopt "--unique" rawopts -- TEMP: it's this for hledger check dates
|
||||
|| boolopt "unique" rawopts -- and this for hledger check-dates (for some reason)
|
||||
let date = transactionDateFn ropts
|
||||
let compare a b =
|
||||
if unique
|
||||
then date a < date b
|
||||
else date a <= date b
|
||||
case checkTransactions compare ts of
|
||||
FoldAcc{fa_previous=Nothing} -> return ()
|
||||
FoldAcc{fa_error=Nothing} -> return ()
|
||||
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
|
||||
let
|
||||
uniquestr = T.pack $ if unique then " and/or not unique" else ""
|
||||
positionstr = T.pack . showGenericSourcePos $ tsourcepos error
|
||||
txn1str = linesPrepend (T.pack " ") $ showTransaction previous
|
||||
txn2str = linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error
|
||||
T.putStrLn $
|
||||
T.pack "Error: transaction date is out of order"
|
||||
<> uniquestr <> T.pack "\nat " <> positionstr <> T.pack ":\n\n"
|
||||
<> txn1str <> txn2str
|
||||
exitFailure
|
||||
|
||||
data FoldAcc a b = FoldAcc
|
||||
{ fa_error :: Maybe a
|
||||
, fa_previous :: Maybe b
|
||||
}
|
||||
|
||||
foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
|
||||
foldWhile _ acc [] = acc
|
||||
foldWhile fold acc (a:as) =
|
||||
case fold a acc of
|
||||
acc@FoldAcc{fa_error=Just _} -> acc
|
||||
acc -> foldWhile fold acc as
|
||||
|
||||
checkTransactions :: (Transaction -> Transaction -> Bool)
|
||||
-> [Transaction] -> FoldAcc Transaction Transaction
|
||||
checkTransactions compare = foldWhile f FoldAcc{fa_error=Nothing, fa_previous=Nothing}
|
||||
where
|
||||
f current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
|
||||
f current acc@FoldAcc{fa_previous=Just previous} =
|
||||
if compare previous current
|
||||
then acc{fa_previous=Just current}
|
||||
else acc{fa_error=Just current}
|
@ -4,8 +4,9 @@ A ledger-compatible @print@ command.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Cli.Commands.Print (
|
||||
printmode
|
||||
@ -18,6 +19,9 @@ where
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
import Data.List (intersperse)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
|
@ -4,10 +4,10 @@ A ledger-compatible @register@ command.
|
||||
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.Cli.Commands.Register (
|
||||
registermode
|
||||
@ -20,6 +20,9 @@ module Hledger.Cli.Commands.Register (
|
||||
|
||||
import Data.List (intersperse)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Semigroup ((<>))
|
||||
#endif
|
||||
-- import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
|
Loading…
Reference in New Issue
Block a user