Correction : CLI.Lib.Shakespeare.Base : évite shakespeare et ses dépendances non...

[comptalang.git] / lib / Hcompta / Format / Ledger / Read.hs

diff --git a/lib/Hcompta/Format/Ledger/Read.hs b/lib/Hcompta/Format/Ledger/Read.hs
index 0d79fb82032c9600edb3004b2ad80f2ad0c60b5a..d0df8756ea6a2153e567ed598660e5302fc2f534 100644 (file)
--- a/lib/Hcompta/Format/Ledger/Read.hs
+++ b/lib/Hcompta/Format/Ledger/Read.hs
@@ -96,10 +96,10 @@ nil_Context =
 
 data Error
  =   Error_year_or_day_is_missing
- |   Error_invalid_day (Integer, Int, Int)
- |   Error_invalid_time_of_day (Integer, Integer, Integer)
- |   Error_transaction_not_equilibrated [Calc.Balance.Unit_Sum Amount]
- |   Error_virtual_transaction_not_equilibrated [Calc.Balance.Unit_Sum Amount]
+ |   Error_invalid_date (Integer, Int, Int)
+ |   Error_invalid_time_of_day (Int, Int, Integer)
+ |   Error_transaction_not_equilibrated Transaction [Calc.Balance.Unit_Sum Amount]
+ |   Error_virtual_transaction_not_equilibrated Transaction [Calc.Balance.Unit_Sum Amount]
  |   Error_reading_file FilePath Exception.IOException
  |   Error_including_file FilePath [R.Error Error]
  deriving (Show)
@@ -375,7 +375,7 @@ date def_year = (do
        guard $ month >= 1 && month <= 12
        guard $ day   >= 1 && day   <= 31
        day_ <- case Time.fromGregorianValid year month day of
-        Nothing   -> R.fail_with "date" (Error_invalid_day (year, month, day))
+        Nothing   -> R.fail_with "date" (Error_invalid_date (year, month, day))
         Just day_ -> return day_
        (hour, minu, sec, tz) <-
                R.option (0, 0, 0, Time.utc) $ R.try $ do
@@ -390,14 +390,11 @@ date def_year = (do
                                R.skipMany $ R.space_horizontal
                                time_zone
                        return
-                        ( R.integer_of_digits 10 hour
-                        , R.integer_of_digits 10 minu
+                        ( fromInteger $ R.integer_of_digits 10 hour
+                        , fromInteger $ R.integer_of_digits 10 minu
                         , maybe 0 (R.integer_of_digits 10) sec
                         , tz )
-       tod <- case Time.makeTimeOfDayValid
-        (fromInteger hour)
-        (fromInteger minu)
-        (fromInteger sec) of
+       tod <- case Time.makeTimeOfDayValid hour minu (fromInteger sec) of
         Nothing  -> R.fail_with "date" (Error_invalid_time_of_day (hour, minu, sec))
         Just tod -> return tod
        return $
@@ -611,7 +608,7 @@ amount_sep = '+'
 
 tags_of_comments :: [Comment] -> Tag_by_Name
 tags_of_comments =
-       Data.Map.unionsWith (flip (++))
+       Data.Map.unionsWith (++)
        . Data.List.map
         ( Data.Either.either (const Data.Map.empty) id
         . R.runParser (not_tag >> tags <* R.eof) () "" )
@@ -735,14 +732,34 @@ transaction = (do
                join (***) (Ledger.posting_by_Account . Data.List.map fst) $
                Data.List.partition ((Posting_Type_Virtual ==) . snd)
                 postings_not_regular
-       postings <-
-               case snd $ Calc.Balance.infer_equilibrium postings_unchecked of
-                Left  ko -> R.fail_with "transaction infer_equilibrium" (Error_transaction_not_equilibrated ko)
-                Right ok -> return ok
-       balanced_virtual_postings <-
-               case snd $ Calc.Balance.infer_equilibrium balanced_virtual_postings_unchecked of
-                Left  ko -> R.fail_with "transaction infer_equilibrium" (Error_virtual_transaction_not_equilibrated ko)
-                Right ok -> return ok
+       let tr_unchecked =
+               Transaction
+                { transaction_code=code_
+                , transaction_comments_before=comments_before
+                , transaction_comments_after=comments_after
+                , transaction_dates=(date_, dates_)
+                , transaction_description=description_
+                , transaction_postings=postings_unchecked
+                , transaction_postings_balance=Calc.Balance.balance
+                , transaction_virtual_postings=virtual_postings
+                , transaction_balanced_virtual_postings=balanced_virtual_postings_unchecked
+                , transaction_balanced_virtual_postings_balance=Calc.Balance.balance
+                , transaction_sourcepos=sourcepos
+                , transaction_status=status_
+                , transaction_tags=tags_
+                }
+       ( transaction_postings_balance
+        ,transaction_postings ) <-
+               case Calc.Balance.infer_equilibrium postings_unchecked of
+                (_, Left ko) -> R.fail_with "transaction infer_equilibrium"
+                                            (Error_transaction_not_equilibrated tr_unchecked ko)
+                (bal, Right ok) -> return (bal, ok)
+       ( transaction_balanced_virtual_postings_balance
+        ,transaction_balanced_virtual_postings ) <-
+               case Calc.Balance.infer_equilibrium balanced_virtual_postings_unchecked of
+                (_, Left ko) -> R.fail_with "transaction infer_equilibrium"
+                                            (Error_virtual_transaction_not_equilibrated tr_unchecked ko)
+                (bal, Right ok) -> return (bal, ok)
        return $
                Transaction
                 { transaction_code=code_
@@ -750,9 +767,11 @@ transaction = (do
                 , transaction_comments_after=comments_after
                 , transaction_dates=(date_, dates_)
                 , transaction_description=description_
-                , transaction_postings=postings
+                , transaction_postings
+                , transaction_postings_balance
                 , transaction_virtual_postings=virtual_postings
-                , transaction_balanced_virtual_postings=balanced_virtual_postings
+                , transaction_balanced_virtual_postings
+                , transaction_balanced_virtual_postings_balance
                 , transaction_sourcepos=sourcepos
                 , transaction_status=status_
                 , transaction_tags=tags_