Move SortSpec to Hledger.Reports.ReportOptions

As part of this migration, I also switched from using Data.List.splitOn
to Hledger.Utils.splitAtElement.

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -16,17 +16,15 @@ module Hledger.Reports.PostingsReport (
   postingsReport,
   mkpostingsReportItem,
   SortSpec,
-  getSortSpec,
 
   -- * Tests
   tests_PostingsReport
 )
 where
 
-import Data.List (nub, sortBy, sortOn, stripPrefix, isPrefixOf)
-import Data.List.Split (splitOn)
+import Data.List (nub, sortBy, sortOn)
 import Data.List.Extra (nubSort)
-import Data.Maybe (isJust, isNothing, fromMaybe)
+import Data.Maybe (isJust, isNothing)
 import Data.Ord
 import Data.Text (Text)
 import Data.Time.Calendar (Day)
@@ -65,44 +63,15 @@ instance HasAmounts PostingsReportItem where
 -- with a tuple.
 type SummaryPosting = (Posting, Period)
 
--- Possible value expressions taken by the --sort command
--- Each of these takes a bool, which shows if it has been inverted
--- (True -> has been inverted, reverse the order)
-data ValueExp
-    = Date' Bool
-    | Account' Bool
-    | Amount' Bool
-    deriving (Show)
-type SortSpec = [ValueExp]
-
--- Load a SortSpec from the argument given to --sort
--- If there is no spec given, then sort by [Date' False] by default
-getSortSpec :: RawOpts -> SortSpec
-getSortSpec opts = 
-    let opt = maybestringopt "sort" opts
-        optParser s = 
-          let terms = map strip $ splitOn "," s 
-              termParser t = case trimmed of
-                "date" -> Date' isNegated
-                "account" -> Account' isNegated
-                "amount" -> Amount' isNegated
-                _ -> error' $ "unsupported value expression '" ++ t ++ "' given to --sort"
-                where isNegated = isPrefixOf "-" t
-                      trimmed = fromMaybe t (stripPrefix "-" t)
-          in map termParser terms
-    in maybe [Date' False] optParser opt 
-
 -- | Select postings from the journal and add running balance and other
 -- information to make a postings report. Used by eg hledger's register command.
-postingsReport :: ReportSpec -> Maybe SortSpec -> Journal -> PostingsReport
-postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} sortspec j = items
+postingsReport :: ReportSpec -> Journal -> PostingsReport
+postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} j = items
     where
       (reportspan, colspans) = reportSpanBothDates j rspec
       whichdate   = whichDate ropts
       mdepth      = queryDepth $ _rsQuery rspec
       multiperiod = interval_ /= NoInterval
-      -- Sort by the date (or date2) field if nothing else is specified
-      sspec = fromMaybe [Date' False] sortspec
 
       -- postings to be included in the report, and similarly-matched postings before the report start date
       (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
@@ -115,7 +84,7 @@ postingsReport rspec@ReportSpec{_rsReportOpts=ropts@ReportOpts{..}} sortspec j =
           summariseps = summarisePostingsByInterval whichdate mdepth showempty colspans
           showempty = empty_ || average_
 
-      sortedps = sortPostings ropts sspec displayps
+      sortedps = sortPostings ropts sortspec_ displayps
 
       -- Posting report items ready for display.
       items =
@@ -273,11 +242,8 @@ negatePostingAmount = postingTransformAmount negate
 
 tests_PostingsReport = testGroup "PostingsReport" [
 
-   let sspec = Just [Date' False]
-   in
-
    testCase "postingsReport" $ do
-    let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} sspec journal) @?= n
+    let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} journal) @?= n
     -- with the query specified explicitly
     (Any, nulljournal) `gives` 0
     (Any, samplejournal) `gives` 13
@@ -286,10 +252,10 @@ tests_PostingsReport = testGroup "PostingsReport" [
     (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
     (And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2
     -- with query and/or command-line options
-    (length $ postingsReport defreportspec sspec samplejournal) @?= 13
-    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1}} sspec samplejournal) @?= 11
-    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1, empty_=True}} sspec samplejournal) @?= 20
-    (length $ postingsReport defreportspec{_rsQuery=Acct $ toRegex' "assets:bank:checking"} sspec samplejournal) @?= 5
+    (length $ postingsReport defreportspec samplejournal) @?= 13
+    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
+    (length $ postingsReport defreportspec{_rsReportOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
+    (length $ postingsReport defreportspec{_rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
 
      -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
      -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking             $1,$1)

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -21,6 +21,8 @@ module Hledger.Reports.ReportOptions (
   HasReportOpts(..),
   ReportSpec(..),
   HasReportSpec(..),
+  SortField(..),
+  SortSpec,
   overEither,
   setEither,
   BalanceCalculation(..),
@@ -71,7 +73,7 @@ import Data.Char (toLower)
 import Data.Either (fromRight)
 import Data.Either.Extra (eitherToMaybe)
 import Data.Functor.Identity (Identity(..))
-import Data.List.Extra (find, isPrefixOf, nubSort)
+import Data.List.Extra (find, isPrefixOf, nubSort, stripPrefix)
 import Data.Maybe (fromMaybe, isJust, isNothing)
 import qualified Data.Text as T
 import Data.Time.Calendar (Day, addDays)
@@ -142,6 +144,8 @@ data ReportOpts = ReportOpts {
     ,average_          :: Bool
     -- for posting reports (register)
     ,related_          :: Bool
+    -- for sorting reports (register)
+    ,sortspec_             :: SortSpec
     -- for account transactions reports (aregister)
     ,txn_dates_        :: Bool
     -- for balance reports (bal, bs, cf, is)
@@ -197,6 +201,7 @@ defreportopts = ReportOpts
     , querystring_      = []
     , average_          = False
     , related_          = False
+    , sortspec_         = [Date' False]  -- by default, sort by date in ascending order
     , txn_dates_        = False
     , balancecalc_      = def
     , balanceaccum_     = def
@@ -251,6 +256,7 @@ rawOptsToReportOpts d rawopts =
           ,querystring_      = querystring
           ,average_          = boolopt "average" rawopts
           ,related_          = boolopt "related" rawopts
+          ,sortspec_         = getSortSpec rawopts
           ,txn_dates_        = boolopt "txn-dates" rawopts
           ,balancecalc_      = balancecalcopt rawopts
           ,balanceaccum_     = balanceaccumopt rawopts
@@ -663,6 +669,36 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
     consIf f b = if b then (f True:) else id
     consJust f = maybe id ((:) . f)
 
+-- Methods/types needed for --sort argument
+
+-- Possible arguments taken by the --sort command
+-- Each of these takes a bool, which shows if it has been inverted
+-- (True -> has been inverted, reverse the order)
+data SortField
+    = Date' Bool
+    | Account' Bool
+    | Amount' Bool
+    deriving (Show)
+type SortSpec = [SortField]
+
+-- Load a SortSpec from the argument given to --sort
+-- If there is no spec given, then sort by [Date' False] by default
+getSortSpec :: RawOpts -> SortSpec
+getSortSpec opts = 
+    let opt = maybestringopt "sort" opts
+        optParser s = 
+          let terms = map strip $ splitAtElement ',' s 
+              termParser t = case trimmed of
+                "date" -> Date' isNegated
+                "account" -> Account' isNegated
+                "amount" -> Amount' isNegated
+                _ -> error' $ "unsupported field '" ++ t ++ "' given to --sort"
+                where isNegated = isPrefixOf "-" t
+                      trimmed = fromMaybe t (stripPrefix "-" t)
+          in map termParser terms
+    in maybe [Date' False] optParser opt 
+
+
 -- Report dates.
 
 -- | The effective report span is the start and end dates specified by

hledger-lib/hledger-lib.cabal

@@ -147,7 +147,6 @@ library
     , pretty-simple >4 && <5
     , regex-tdfa
     , safe >=0.3.20
-    , split >=0.1
     , tabular >=0.2
     , tasty >=1.2.3
     , tasty-hunit >=0.10.0.2

hledger/Hledger/Cli/Commands/Add.hs

@@ -460,7 +460,7 @@ ensureOneNewlineTerminated = (<>"\n") . T.dropWhileEnd (=='\n')
 registerFromString :: T.Text -> IO TL.Text
 registerFromString s = do
   j <- readJournal' s
-  return . postingsReportAsText opts $ postingsReport rspec Nothing j
+  return . postingsReportAsText opts $ postingsReport rspec j
       where
         ropts = defreportopts{empty_=True}
         rspec = defreportspec{_rsReportOpts=ropts}

hledger/Hledger/Cli/Commands/Register.hs

@@ -86,7 +86,7 @@ register opts@CliOpts{rawopts_=rawopts, reportspec_=rspec} j
   | otherwise = writeOutputLazyText opts $ render $ styleAmounts styles rpt
   where
     styles = journalCommodityStylesWith HardRounding j
-    rpt = postingsReport rspec (Just (getSortSpec rawopts)) j
+    rpt = postingsReport rspec j
     render | fmt=="txt"  = postingsReportAsText opts
            | fmt=="csv"  = printCSV . postingsReportAsCsv
            | fmt=="tsv"  = printTSV . postingsReportAsCsv
@@ -261,7 +261,7 @@ tests_Register = testGroup "Register" [
     testCase "unicode in register layout" $ do
       j <- readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n"
       let rspec = defreportspec
-      (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec Nothing j)
+      (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j)
         @?=
         unlines
         ["2009-01-01 медвежья шкура       расходы:покупки                100           100"