RunCalibrate.hs

{-# LANGUAGE BangPatterns #-}

module Currycarbon.CLI.RunCalibrate
    (CalibrateOptions (..), runCalibrate) where

import           Currycarbon.CalCurves.Intcal20
import           Currycarbon.Calibration.Calibration
import           Currycarbon.Parsers
import           Currycarbon.Types
import           Currycarbon.Utils

import           Control.Monad      (when, unless)
import           Data.Either        (rights, lefts, isRight)
import           Data.Foldable      (forM_)
import           Data.Maybe         (fromJust, isJust)
import           System.IO          (hPutStrLn, stderr)

-- | A data type to represent the options to the CLI module function runCalibrate
data CalibrateOptions = CalibrateOptions {
        _calibrateUncalC14 :: [UncalC14]  -- ^ Uncalibrated dates that should be calibrated
      , _calibrateUncalC14File :: [FilePath] -- ^ List of files with uncalibrated dates to be calibrated
      , _calibrateCalCurveFile :: Maybe FilePath -- ^ Path to a .14c file
      , _calibrateCalibrationMethod :: CalibrationMethod -- ^ Calibration algorithm that should be used
      , _calibrateAllowOutside :: Bool -- ^ Allow calibration to run outside of the range of the calibration curve 
      , _calibrateDontInterpolateCalCurve :: Bool -- ^ Don't interpolate the calibration curve
      , _calibrateQuiet :: Bool -- ^ Suppress the printing of calibration results to the command line
      , _calibrateDensityFile :: Maybe FilePath -- ^ Path to an output file (see CLI documentation)
      , _calibrateHDRFile :: Maybe FilePath -- ^ Path to an output file
      , _calibrateCalCurveSegmentFile :: Maybe FilePath -- ^ Path to an output file 
      , _calibrateCalCurveMatrixFile :: Maybe FilePath -- ^ Path to an output file 
    }

-- | Interface function to trigger calibration from the command line
runCalibrate :: CalibrateOptions -> IO ()
runCalibrate (CalibrateOptions uncalDates uncalFile calCurveFile method allowOutside noInterpolate quiet densityFile hdrFile calCurveSegmentFile calCurveMatrixFile) = do
    -- compile dates
    entitiesFromFile <- mapM readUncalC14FromFile uncalFile
    let uncalDatesRenamed = replaceEmptyNames $ uncalDates ++ concat entitiesFromFile
    if null uncalDatesRenamed
    then hPutStrLn stderr "Nothing to calibrate. See currycarbon -h for help"
    else do
        -- calibration
        hPutStrLn stderr "Calibrating..."
        calCurve <- maybe (return intcal20) readCalCurveFromFile calCurveFile
        let calConf = defaultCalConf {
              _calConfMethod = method
            , _calConfAllowOutside = allowOutside
            , _calConfInterpolateCalCurve = not noInterpolate
            }
        let errorOrCalPDFs = calibrateDates calConf calCurve uncalDatesRenamed
        handleDates True calCurve $ zip uncalDatesRenamed errorOrCalPDFs
        where
            handleDates :: Bool -> CalCurveBP -> [(UncalC14, Either CurrycarbonException CalPDF)] -> IO ()
            handleDates _ _ [] = hPutStrLn stderr "Done."
            handleDates True calCurve (x:xs) = case x of
                (_, Left ex)        -> printEx ex                          >> handleDates True  calCurve xs
                (uncal, Right cPDF) -> handleFirstDate calCurve uncal cPDF >> handleDates False calCurve xs
            handleDates False calCurve (x:xs) = case x of
                (_, Left ex)        -> printEx ex                          >> handleDates False calCurve xs
                (uncal, Right cPDF) -> handleOtherDate uncal cPDF          >> handleDates False calCurve xs
            handleFirstDate :: CalCurveBP -> UncalC14 -> CalPDF -> IO ()
            handleFirstDate calCurve uncal calPDF = do
                -- calcurve segment or calcurve matrix file
                if isJust calCurveSegmentFile || isJust calCurveMatrixFile 
                then do
                    hPutStrLn stderr $ 
                        "The calCurveSegment file and the calCurveMatrix file only consider the first date, " ++
                        renderUncalC14 uncal
                    let calCurveSegment = prepareCalCurveSegment (not noInterpolate) $ getRelevantCalCurveSegment uncal calCurve
                    when (isJust calCurveSegmentFile) $ 
                        writeCalCurve (fromJust calCurveSegmentFile) calCurveSegment
                    when (isJust calCurveMatrixFile) $ 
                        writeCalCurveMatrix (fromJust calCurveMatrixFile) $ 
                        makeCalCurveMatrix (uncalToPDF uncal) calCurveSegment
                else do
                    -- other output
                    let calC14 = refineCalDate calPDF
                    unless quiet              $ putStrLn $ renderCalDatePretty (uncal, calPDF, calC14)
                    when (isJust hdrFile)     $ writeCalC14 (fromJust hdrFile) calC14
                    when (isJust densityFile) $ writeCalPDF (fromJust densityFile) calPDF
            handleOtherDate :: UncalC14 -> CalPDF -> IO ()
            handleOtherDate uncal calPDF = do
                let calC14 = refineCalDate calPDF
                unless quiet              $ putStrLn $ renderCalDatePretty (uncal, calPDF, calC14)
                when (isJust hdrFile)     $ appendCalC14 (fromJust hdrFile) calC14
                when (isJust densityFile) $ appendCalPDF (fromJust densityFile) calPDF
            printEx :: CurrycarbonException -> IO ()
            printEx ex = hPutStrLn stderr $ renderCurrycarbonException ex

-- | Helper function to replace empty input names with a sequence of numbers, 
-- to get each input date an unique identifier
replaceEmptyNames :: [UncalC14] -> [UncalC14]
replaceEmptyNames xs =
    zipWith replaceName xs [1..]
    where
        replaceName :: UncalC14 -> Int -> UncalC14
        replaceName (UncalC14 name mean std) number =
            if name == "unknownSampleName"
            then UncalC14 (show number) mean std
            else UncalC14 name mean std