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

-- | Interface function to trigger calibration from the command line
runCalibrate :: CalibrateOptions -> IO ()
runCalibrate :: CalibrateOptions -> IO ()
runCalibrate (CalibrateOptions [UncalC14]
uncalDates [FilePath]
uncalFile Maybe FilePath
calCurveFile CalibrationMethod
method Bool
allowOutside Bool
noInterpolate Bool
quiet Maybe FilePath
densityFile Maybe FilePath
hdrFile Maybe FilePath
calCurveSegmentFile Maybe FilePath
calCurveMatrixFile) = do
    -- compile dates
    [[UncalC14]]
entitiesFromFile <- (FilePath -> IO [UncalC14]) -> [FilePath] -> IO [[UncalC14]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [UncalC14]
readUncalC14FromFile [FilePath]
uncalFile
    let uncalDatesRenamed :: [UncalC14]
uncalDatesRenamed = [UncalC14] -> [UncalC14]
replaceEmptyNames ([UncalC14] -> [UncalC14]) -> [UncalC14] -> [UncalC14]
forall a b. (a -> b) -> a -> b
$ [UncalC14]
uncalDates [UncalC14] -> [UncalC14] -> [UncalC14]
forall a. [a] -> [a] -> [a]
++ [[UncalC14]] -> [UncalC14]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[UncalC14]]
entitiesFromFile
    if [UncalC14] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UncalC14]
uncalDatesRenamed
    then Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Nothing to calibrate. See currycarbon -h for help"
    else do
        -- calibration
        Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Calibrating..."
        CalCurveBP
calCurve <- IO CalCurveBP
-> (FilePath -> IO CalCurveBP) -> Maybe FilePath -> IO CalCurveBP
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CalCurveBP -> IO CalCurveBP
forall (m :: * -> *) a. Monad m => a -> m a
return CalCurveBP
intcal20) FilePath -> IO CalCurveBP
readCalCurveFromFile Maybe FilePath
calCurveFile
        let calConf :: CalibrateDatesConf
calConf = CalibrateDatesConf
defaultCalConf {
              _calConfMethod :: CalibrationMethod
_calConfMethod = CalibrationMethod
method
            , _calConfAllowOutside :: Bool
_calConfAllowOutside = Bool
allowOutside
            , _calConfInterpolateCalCurve :: Bool
_calConfInterpolateCalCurve = Bool -> Bool
not Bool
noInterpolate
            }
        let errorOrCalPDFs :: [Either CurrycarbonException CalPDF]
errorOrCalPDFs = CalibrateDatesConf
-> CalCurveBP -> [UncalC14] -> [Either CurrycarbonException CalPDF]
calibrateDates CalibrateDatesConf
calConf CalCurveBP
calCurve [UncalC14]
uncalDatesRenamed
        Bool
-> CalCurveBP
-> [(UncalC14, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
True CalCurveBP
calCurve ([(UncalC14, Either CurrycarbonException CalPDF)] -> IO ())
-> [(UncalC14, Either CurrycarbonException CalPDF)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [UncalC14]
-> [Either CurrycarbonException CalPDF]
-> [(UncalC14, Either CurrycarbonException CalPDF)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UncalC14]
uncalDatesRenamed [Either CurrycarbonException CalPDF]
errorOrCalPDFs
        where
            handleDates :: Bool -> CalCurveBP -> [(UncalC14, Either CurrycarbonException CalPDF)] -> IO ()
            handleDates :: Bool
-> CalCurveBP
-> [(UncalC14, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ CalCurveBP
_ [] = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Done."
            handleDates Bool
True CalCurveBP
calCurve ((UncalC14, Either CurrycarbonException CalPDF)
x:[(UncalC14, Either CurrycarbonException CalPDF)]
xs) = case (UncalC14, Either CurrycarbonException CalPDF)
x of
                (UncalC14
_, Left CurrycarbonException
ex)        -> CurrycarbonException -> IO ()
printEx CurrycarbonException
ex                          IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> CalCurveBP
-> [(UncalC14, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
True  CalCurveBP
calCurve [(UncalC14, Either CurrycarbonException CalPDF)]
xs
                (UncalC14
uncal, Right CalPDF
cPDF) -> CalCurveBP -> UncalC14 -> CalPDF -> IO ()
handleFirstDate CalCurveBP
calCurve UncalC14
uncal CalPDF
cPDF IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> CalCurveBP
-> [(UncalC14, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
False CalCurveBP
calCurve [(UncalC14, Either CurrycarbonException CalPDF)]
xs
            handleDates Bool
False CalCurveBP
calCurve ((UncalC14, Either CurrycarbonException CalPDF)
x:[(UncalC14, Either CurrycarbonException CalPDF)]
xs) = case (UncalC14, Either CurrycarbonException CalPDF)
x of
                (UncalC14
_, Left CurrycarbonException
ex)        -> CurrycarbonException -> IO ()
printEx CurrycarbonException
ex                          IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> CalCurveBP
-> [(UncalC14, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
False CalCurveBP
calCurve [(UncalC14, Either CurrycarbonException CalPDF)]
xs
                (UncalC14
uncal, Right CalPDF
cPDF) -> UncalC14 -> CalPDF -> IO ()
handleOtherDate UncalC14
uncal CalPDF
cPDF          IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> CalCurveBP
-> [(UncalC14, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
False CalCurveBP
calCurve [(UncalC14, Either CurrycarbonException CalPDF)]
xs
            handleFirstDate :: CalCurveBP -> UncalC14 -> CalPDF -> IO ()
            handleFirstDate :: CalCurveBP -> UncalC14 -> CalPDF -> IO ()
handleFirstDate CalCurveBP
calCurve UncalC14
uncal CalPDF
calPDF = do
                -- calcurve segment or calcurve matrix file
                if Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
calCurveSegmentFile Bool -> Bool -> Bool
|| Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
calCurveMatrixFile 
                then do
                    Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ 
                        FilePath
"The calCurveSegment file and the calCurveMatrix file only consider the first date, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                        UncalC14 -> FilePath
renderUncalC14 UncalC14
uncal
                    let calCurveSegment :: CalCurveBCAD
calCurveSegment = Bool -> CalCurveBP -> CalCurveBCAD
prepareCalCurveSegment (Bool -> Bool
not Bool
noInterpolate) (CalCurveBP -> CalCurveBCAD) -> CalCurveBP -> CalCurveBCAD
forall a b. (a -> b) -> a -> b
$ UncalC14 -> CalCurveBP -> CalCurveBP
getRelevantCalCurveSegment UncalC14
uncal CalCurveBP
calCurve
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
calCurveSegmentFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
                        FilePath -> CalCurveBCAD -> IO ()
writeCalCurve (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
calCurveSegmentFile) CalCurveBCAD
calCurveSegment
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
calCurveMatrixFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 
                        FilePath -> CalCurveMatrix -> IO ()
writeCalCurveMatrix (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
calCurveMatrixFile) (CalCurveMatrix -> IO ()) -> CalCurveMatrix -> IO ()
forall a b. (a -> b) -> a -> b
$ 
                        UncalPDF -> CalCurveBCAD -> CalCurveMatrix
makeCalCurveMatrix (UncalC14 -> UncalPDF
uncalToPDF UncalC14
uncal) CalCurveBCAD
calCurveSegment
                else do
                    -- other output
                    let calC14 :: CalC14
calC14 = CalPDF -> CalC14
refineCalDate CalPDF
calPDF
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet              (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ (UncalC14, CalPDF, CalC14) -> FilePath
renderCalDatePretty (UncalC14
uncal, CalPDF
calPDF, CalC14
calC14)
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
hdrFile)     (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CalC14 -> IO ()
writeCalC14 (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
hdrFile) CalC14
calC14
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
densityFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CalPDF -> IO ()
writeCalPDF (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
densityFile) CalPDF
calPDF
            handleOtherDate :: UncalC14 -> CalPDF -> IO ()
            handleOtherDate :: UncalC14 -> CalPDF -> IO ()
handleOtherDate UncalC14
uncal CalPDF
calPDF = do
                let calC14 :: CalC14
calC14 = CalPDF -> CalC14
refineCalDate CalPDF
calPDF
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet              (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ (UncalC14, CalPDF, CalC14) -> FilePath
renderCalDatePretty (UncalC14
uncal, CalPDF
calPDF, CalC14
calC14)
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
hdrFile)     (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CalC14 -> IO ()
appendCalC14 (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
hdrFile) CalC14
calC14
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
densityFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> CalPDF -> IO ()
appendCalPDF (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
densityFile) CalPDF
calPDF
            printEx :: CurrycarbonException -> IO ()
            printEx :: CurrycarbonException -> IO ()
printEx CurrycarbonException
ex = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> FilePath
renderCurrycarbonException CurrycarbonException
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 :: [UncalC14] -> [UncalC14]
replaceEmptyNames [UncalC14]
xs =
    (UncalC14 -> Int -> UncalC14) -> [UncalC14] -> [Int] -> [UncalC14]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UncalC14 -> Int -> UncalC14
replaceName [UncalC14]
xs [Int
1..]
    where
        replaceName :: UncalC14 -> Int -> UncalC14
        replaceName :: UncalC14 -> Int -> UncalC14
replaceName (UncalC14 FilePath
name YearBP
mean YearBP
std) Int
number =
            if FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"unknownSampleName"
            then FilePath -> YearBP -> YearBP -> UncalC14
UncalC14 (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
number) YearBP
mean YearBP
std
            else FilePath -> YearBP -> YearBP -> UncalC14
UncalC14 FilePath
name YearBP
mean YearBP
std