From 50b1fc337334595445260a05b4f3da939dc7915a Mon Sep 17 00:00:00 2001
From: Julien Moutinho <julm+hdoc@autogeree.net>
Date: Tue, 18 Dec 2018 11:11:04 +0000
Subject: [PATCH] DTC: better handling of errors in judgments
---
Hdoc/DTC/Analyze/Check.hs | 5 +++++
Hdoc/DTC/Analyze/Collect.hs | 4 ++++
2 files changed, 9 insertions(+)
diff --git a/Hdoc/DTC/Analyze/Check.hs b/Hdoc/DTC/Analyze/Check.hs
index 8f6fb9c..1a344ab 100644
--- a/Hdoc/DTC/Analyze/Check.hs
+++ b/Hdoc/DTC/Analyze/Check.hs
@@ -27,6 +27,7 @@ data Errors a = Errors
, errors_judgment_judges_unknown :: HM.HashMap Ident a
, errors_judgment_grades_unknown :: HM.HashMap Ident a
, errors_judgment_grades_duplicated :: HM.HashMap Ident a
+ , errors_judgment_grade_duplicated :: HM.HashMap Ident a
, errors_judgment_judge_unknown :: HM.HashMap Name a
, errors_judgment_judge_duplicated :: HM.HashMap Name a
, errors_judgment_grade_unknown :: HM.HashMap Name a
@@ -43,6 +44,7 @@ instance Default (Errors a) where
, errors_judgment_judge_duplicated = def
, errors_judgment_grades_unknown = def
, errors_judgment_grades_duplicated = def
+ , errors_judgment_grade_duplicated = def
, errors_judgment_grade_unknown = def
, errors_judgment_choice_duplicated = def
}
@@ -57,6 +59,7 @@ instance Semigroup a => Semigroup (Errors a) where
, errors_judgment_judge_duplicated = hm_union errors_judgment_judge_duplicated
, errors_judgment_grades_unknown = hm_union errors_judgment_grades_unknown
, errors_judgment_grades_duplicated = hm_union errors_judgment_grades_duplicated
+ , errors_judgment_grade_duplicated = hm_union errors_judgment_grade_duplicated
, errors_judgment_grade_unknown = hm_union errors_judgment_grade_unknown
, errors_judgment_choice_duplicated = hm_union errors_judgment_choice_duplicated
} where hm_union get = HM.unionWith (<>) (get x) (get y)
@@ -74,6 +77,7 @@ instance Functor Errors where
, errors_judgment_judge_duplicated = fmap f errors_judgment_judge_duplicated
, errors_judgment_grades_unknown = fmap f errors_judgment_grades_unknown
, errors_judgment_grades_duplicated = fmap f errors_judgment_grades_duplicated
+ , errors_judgment_grade_duplicated = fmap f errors_judgment_grade_duplicated
, errors_judgment_grade_unknown = fmap f errors_judgment_grade_unknown
, errors_judgment_choice_duplicated = fmap f errors_judgment_choice_duplicated
}
@@ -99,6 +103,7 @@ errors All{..} =
, errors_judgment_judge_duplicated =
, errors_judgment_grades_unknown =
, errors_judgment_grades_duplicated =
+ , errors_judgment_grade_duplicated =
, errors_judgment_grade_unknown =
, errors_judgment_choice_duplicated =
-}
diff --git a/Hdoc/DTC/Analyze/Collect.hs b/Hdoc/DTC/Analyze/Collect.hs
index 4309951..8b48074 100644
--- a/Hdoc/DTC/Analyze/Collect.hs
+++ b/Hdoc/DTC/Analyze/Collect.hs
@@ -174,6 +174,10 @@ instance Collect ParaItem where
ParaOL items -> foldMap collect items
ParaUL items -> foldMap (foldMap collect) items
ParaJudgment j -> collect j
+instance Collect Judgment where
+ collect Judgment{..} = do
+ Reader{..} <- R.ask
+ return def{all_judgesRef = HM.singleton judgment_judgesId $ pure ((judgment_locTCT, judgment_posXML), reader_section) }
instance Collect ListItem where
collect ListItem{..} = foldMap collect paras
instance Collect Title where
--
2.47.2