From e7c457f9704c8db34eb273bf3c3a7882d29422a1 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 19 May 2016 16:29:39 -0700
Subject: [PATCH] extra: update, stackify hledger-check-dates

---
 extra/hledger-check-dates.hs | 111 ++++++++++++++++++-----------------
 1 file changed, 58 insertions(+), 53 deletions(-)

diff --git a/extra/hledger-check-dates.hs b/extra/hledger-check-dates.hs
index 8c4735105..73a952a7c 100755
--- a/extra/hledger-check-dates.hs
+++ b/extra/hledger-check-dates.hs
@@ -1,4 +1,9 @@
-#!/usr/bin/env runhaskell
+#!/usr/bin/env stack
+{- stack runghc --verbosity info
+   --package hledger-lib
+   --package hledger
+-}
+
 {-|
 hledger-check-dates [--strict] [--date2] [-f JOURNALFILE]
 
@@ -12,19 +17,19 @@ import Text.Printf
 
 argsmode :: Mode RawOpts
 argsmode = (defCommandMode ["check-dates"])
-	{ modeHelp = "check that transactions' date are monotonically increasing"
-	, modeGroupFlags = Group
-		{ groupNamed =
-			[ ("Input",inputflags)
-			, ("Reporting",reportflags)
-			, ("Misc",helpflags)
-			]
-		,groupUnnamed = [
-			flagNone ["strict"] (\opts -> setboolopt "strict" opts) "makes date comparing strict"
-		 ]
-		, groupHidden = []
-		}
-	}
+  { modeHelp = "check that transactions' date are monotonically increasing"
+  , modeGroupFlags = Group
+    { groupNamed =
+      [ ("Input",inputflags)
+      , ("Reporting",reportflags)
+      , ("Misc",helpflags)
+      ]
+    ,groupUnnamed = [
+      flagNone ["strict"] (\opts -> setboolopt "strict" opts) "makes date comparing strict"
+     ]
+    , groupHidden = []
+    }
+  }
 
 data FoldAcc a b = FoldAcc
  { fa_error    :: Maybe a
@@ -32,50 +37,50 @@ data FoldAcc a b = FoldAcc
  }
 
 foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
-foldWhile fold acc [] = acc
+foldWhile _ acc [] = acc
 foldWhile fold acc (a:as) =
-	case fold a acc of
-	 acc@FoldAcc{fa_error=Just a} -> acc
-	 acc -> foldWhile fold acc 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 ts =
-	foldWhile fold FoldAcc{fa_error=Nothing, fa_previous=Nothing} ts
-	where
-		fold current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
-		fold current acc@FoldAcc{fa_previous=Just previous} =
-			if compare previous current
-			then acc{fa_previous=Just current}
-			else acc{fa_error=Just current}
+  foldWhile fold FoldAcc{fa_error=Nothing, fa_previous=Nothing} ts
+  where
+    fold current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
+    fold current acc@FoldAcc{fa_previous=Just previous} =
+      if compare previous current
+      then acc{fa_previous=Just current}
+      else acc{fa_error=Just current}
 
 main :: IO ()
 main = do
-	opts <- getCliOpts argsmode
-	withJournalDo opts $
-	 \cliopts@CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
-		d <- getCurrentDay
-		let ropts_ = ropts{flat_=True}
-		let q = queryFromOpts d ropts_
-		let ts = filter (q `matchesTransaction`) $
-			jtxns $ journalSelectingAmountFromOpts ropts j
-		let strict = boolopt "strict" opts
-		let date = transactionDateFn ropts
-		let compare a b =
-			if strict
-			then date a <  date b
-			else date a <= date b
-		case checkTransactions compare ts of
-		 FoldAcc{fa_previous=Nothing} -> putStrLn "ok (empty journal)"
-		 FoldAcc{fa_error=Nothing}    -> putStrLn "ok"
-		 FoldAcc{fa_error=Just error, fa_previous=Just previous} ->
-			putStrLn $ printf ("ERROR: transaction out of%s date order"
-			 ++ "\nPrevious date: %s"
-			 ++ "\nDate: %s"
-			 ++ "\nLocation: %s"
-			 ++ "\nTransaction:\n\n%s")
-			 (if strict then " STRICT" else "")
-			 (show $ date previous)
-			 (show $ date error)
-			 (show $ tsourcepos error)
-			 (showTransactionUnelided error)
+  opts <- getCliOpts argsmode
+  withJournalDo opts $
+   \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
+    d <- getCurrentDay
+    let ropts_ = ropts{accountlistmode_=ALFlat}
+    let q = queryFromOpts d ropts_
+    let ts = filter (q `matchesTransaction`) $
+             jtxns $ journalSelectingAmountFromOpts ropts j
+    let strict = boolopt "strict" opts
+    let date = transactionDateFn ropts
+    let compare a b =
+          if strict
+          then date a <  date b
+          else date a <= date b
+    case checkTransactions compare ts of
+     FoldAcc{fa_previous=Nothing} -> putStrLn "ok (empty journal)"
+     FoldAcc{fa_error=Nothing}    -> putStrLn "ok"
+     FoldAcc{fa_error=Just error, fa_previous=Just previous} ->
+      putStrLn $ printf ("ERROR: transaction out of%s date order"
+       ++ "\nPrevious date: %s"
+       ++ "\nDate: %s"
+       ++ "\nLocation: %s"
+       ++ "\nTransaction:\n\n%s")
+       (if strict then " STRICT" else "")
+       (show $ date previous)
+       (show $ date error)
+       (show $ tsourcepos error)
+       (showTransactionUnelided error)