discovered (and hopefully fixed) a serious oversight: invalid calPDFs…

… could crash the currycarbon

src/Currycarbon/CLI/RunCalibrate.hs

@@ -135,43 +135,30 @@ runCalibrate (
             -> (FilePath -> RandomAgeSample -> IO ())
             -> IO ()
         flexOut _ascii namedCalExpr calPDF maybeSeed calPDFToFile calC14ToFile randomAgeSampleToFile = do
-            -- try to refine calPDF
             case refineCalDate calPDF of
-                -- refining did not work
-                Nothing -> do
+                Left e -> do
                     unless quiet $ do
                         putStrLn (renderNamedCalExpr namedCalExpr)
-                        hPutStrLn stderr "Warning: Could not calculate meaningful HDRs for this expression. \
-                                          \Check --densityFile."
-                    when (isJust hdrFile) $
-                        unless quiet $ hPutStrLn stderr "Nothing written to the HDR file"
-                    when (isJust densityFile) $
-                        calPDFToFile (fromJust densityFile) calPDF
-                    when (isJust ageSampling && isJust maybeSeed) $
-                        runAgeSampling (fromJust ageSampling) (fromJust maybeSeed) calPDF randomAgeSampleToFile
-                -- refining did work
-                Just calC14 -> do
+                        printE e
+                    when (isJust hdrFile) $ unless quiet $
+                        hPutStrLn stderr "<!> Error: Can not create --hdrFile"
+                Right calC14 -> do
                     unless quiet $ do
                         putStrLn (renderCalDatePretty _ascii (namedCalExpr, calPDF, calC14))
                     when (isJust hdrFile) $
                         calC14ToFile (fromJust hdrFile) calC14
-                    when (isJust densityFile) $
-                        calPDFToFile (fromJust densityFile) calPDF
-                    when (isJust ageSampling && isJust maybeSeed) $
-                        runAgeSampling (fromJust ageSampling) (fromJust maybeSeed) calPDF randomAgeSampleToFile
-
-        runAgeSampling ::
-               (Maybe Word, Word, FilePath)
-            -> Int
-            -> CalPDF
-            -> (FilePath -> RandomAgeSample -> IO ())
-            -> IO ()
-        runAgeSampling (_, nrOfSamples, path) seed calPDF randomAgeSampleToFile = do
-            let rng = R.mkStdGen seed
-                conf = AgeSamplingConf rng nrOfSamples
-                samplingResult = sampleAgesFromCalPDF conf calPDF
-            randomAgeSampleToFile path samplingResult
-
+            when (isJust ageSampling && isJust maybeSeed) $ do
+                let (_, nrOfSamples, path) = fromJust ageSampling
+                    rng = R.mkStdGen (fromJust maybeSeed)
+                    conf = AgeSamplingConf rng nrOfSamples
+                case sampleAgesFromCalPDF conf calPDF of
+                    Left e -> do
+                        unless quiet $ do
+                            printE e
+                            hPutStrLn stderr "<!> Error: Can not create --samplesFile"
+                    Right res -> randomAgeSampleToFile path res
+            when (isJust densityFile) $
+                calPDFToFile (fromJust densityFile) calPDF
 
 -- | Helper function to replace empty input names with a sequence of numbers,
 -- to get each input date an unique identifier

src/Currycarbon/Calibration/Calibration.hs

@@ -83,18 +83,19 @@ calibrateDate (CalibrateDatesConf Bchron{distribution=distr} allowOutside interp
 
 -- | Transforms the raw, calibrated probability density table to a meaningful representation of a
 -- calibrated radiocarbon date
-refineCalDates :: [CalPDF] -> [Maybe CalC14]
+refineCalDates :: [CalPDF] -> [Either CurrycarbonException CalC14]
 refineCalDates = map refineCalDate
 
-refineCalDate :: CalPDF -> Maybe CalC14
-refineCalDate (CalPDF name cals dens)
+refineCalDate :: CalPDF -> Either CurrycarbonException CalC14
+refineCalDate calPDF@(CalPDF name cals dens)
     -- don't calculate CalC14, if it's not meaningful
-    | VU.sum dens == 0 || VU.length (VU.filter (>= 1.0) dens) == 1 = Nothing
+    | isInvalidCalPDF calPDF =
+        Left $ CurrycarbonInvalidCalPDFException "refinement"
     -- for simple uniform age ranges
     | VU.length (VU.uniq dens) == 1 =
         let start = VU.head cals
             stop  = VU.last cals
-        in Just $ CalC14 {
+        in Right $ CalC14 {
           _calC14id           = name
         , _calC14RangeSummary = CalRangeSummary {
               _calRangeStartTwoSigma = start
@@ -108,7 +109,7 @@ refineCalDate (CalPDF name cals dens)
         }
     -- for normal post-calibration probability distributions
     | otherwise =
-        Just $ CalC14 {
+        Right $ CalC14 {
           _calC14id           = name
         , _calC14RangeSummary = CalRangeSummary {
               _calRangeStartTwoSigma = _hdrstart $ head hdrs95
@@ -166,13 +167,18 @@ data AgeSamplingConf = AgeSamplingConf {
     } deriving (Show, Eq)
 
 -- | Draw random samples from a probability density table
-sampleAgesFromCalPDF :: AgeSamplingConf -> CalPDF -> RandomAgeSample
-sampleAgesFromCalPDF (AgeSamplingConf rng n) (CalPDF calPDFid cals dens) =
+sampleAgesFromCalPDF :: AgeSamplingConf -> CalPDF -> Either CurrycarbonException RandomAgeSample
+sampleAgesFromCalPDF (AgeSamplingConf rng n) calPDF@(CalPDF calPDFid cals dens) =
     let weightedList = zip (VU.toList cals) (map toRational $ VU.toList dens)
         infSamplesList = sampleWeightedList rng weightedList
         samples = take (fromIntegral n) infSamplesList
-    in RandomAgeSample calPDFid (VU.fromList samples)
+    in if isInvalidCalPDF calPDF
+       then Left $ CurrycarbonInvalidCalPDFException "random age sampling"
+       else Right $ RandomAgeSample calPDFid (VU.fromList samples)
     where
         sampleWeightedList :: CMR.RandomGen g => g -> [(a, Rational)] -> [a]
         sampleWeightedList gen weights = CMR.evalRand m gen
             where m = sequence . repeat . CMR.fromList $ weights
+
+isInvalidCalPDF :: CalPDF -> Bool
+isInvalidCalPDF (CalPDF _ _ dens) = VU.sum dens == 0 || VU.any (>= 1.0) dens

src/Currycarbon/Utils.hs

@@ -7,9 +7,14 @@ import           Control.Exception (Exception)
 
 -- | Different exceptions for currycarbon
 data CurrycarbonException =
-      CurrycarbonCLIParsingException String -- ^ An exception to describe an issue in the currycarbon CLI input parsing
-    | CurrycarbonCalibrationRangeException String -- ^ An exection to describe the case that a
-                                                      -- date is not in the range of the supplied calibration curve
+    -- | An exception to describe an issue in the currycarbon CLI input parsing
+      CurrycarbonCLIParsingException String
+    -- | An exception to describe the case that a date is not in the range of
+    -- the supplied calibration curve
+    | CurrycarbonCalibrationRangeException String
+    -- | An exception for CalPDFs that are unsuitable for certain purposes
+    | CurrycarbonInvalidCalPDFException String
+    -- | An exception for any issues with the CLI
     | CurrycarbonCLIException String
     deriving (Show)
 
@@ -18,8 +23,11 @@ instance Exception CurrycarbonException
 renderCurrycarbonException :: CurrycarbonException -> String
 renderCurrycarbonException (CurrycarbonCLIParsingException s) =
     "<!> Error: Input can not be parsed\n" ++ s
-renderCurrycarbonException (CurrycarbonCalibrationRangeException s) =
-    s ++ " <!> Error: Date outside of calibration range"
+renderCurrycarbonException (CurrycarbonCalibrationRangeException i) =
+    "<!> Error: Date outside of calibration range. Date ID: " ++ i
+renderCurrycarbonException (CurrycarbonInvalidCalPDFException o) =
+    "<!> Error: Invalid CalPDF for " ++ o ++
+    ", either because all densities are 0 or one density is > 1"
 renderCurrycarbonException (CurrycarbonCLIException s) =
     "<!> Error: " ++ s