lib,cli: Assorted fixes for older GHC.

hledger-lib/Hledger/Data/Amount.hs

@@ -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)

hledger-lib/Hledger/Data/Timeclock.hs

@@ -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)

hledger-lib/Hledger/Data/Transaction.hs

@@ -7,11 +7,12 @@ tags.
 
 -}
 
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE CPP               #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE Rank2Types        #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# 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

hledger-lib/Hledger/Read.hs

@@ -11,8 +11,9 @@ to import modules below this one.
 -}
 
 --- ** language
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE PackageImports #-}
+{-# 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

hledger-lib/Hledger/Utils/Color.hs

@@ -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(..))

hledger-lib/Hledger/Utils/Regex.hs

@@ -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

hledger-lib/Text/Tabular/AsciiWide.hs

@@ -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

hledger-lib/Text/WideString.hs

@@ -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

hledger/Hledger/Cli/Commands/Aregister.hs

@@ -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

hledger/Hledger/Cli/Commands/Check/Uniqueleafnames.hs

@@ -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.Function (on)
-import Data.List
+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

hledger/Hledger/Cli/Commands/Checkdates.hs

@@ -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}

hledger/Hledger/Cli/Commands/Print.hs

@@ -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

hledger/Hledger/Cli/Commands/Register.hs

@@ -4,10 +4,10 @@ A ledger-compatible @register@ command.
 
 -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards   #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# 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