{-# LANGUAGE BangPatterns #-}

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

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

import           Control.Monad                       (unless, when)
import           Data.Maybe                          (fromJust, fromMaybe,
                                                      isJust)
import           System.IO                           (hPutStrLn, stderr, stdout)

-- | A data type to represent the options to the CLI module function runCalibrate
data CalibrateOptions = CalibrateOptions {
        CalibrateOptions -> [CalExpr]
_calibrateExprs                   :: [CalExpr] -- ^ String listing the uncalibrated dates that should be calibrated
      , CalibrateOptions -> [String]
_calibrateExprFiles               :: [FilePath] -- ^ List of files with uncalibrated dates to be calibrated
      , CalibrateOptions -> Maybe String
_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 -> String
_calibrateStdOutEncoding          :: String -- ^ Encoding of the stdout stream (show TextEncoding)
      , CalibrateOptions -> Maybe String
_calibrateDensityFile             :: Maybe FilePath -- ^ Path to an output file (see CLI documentation)
      , CalibrateOptions -> Maybe String
_calibrateHDRFile                 :: Maybe FilePath -- ^ Path to an output file
      , CalibrateOptions -> Maybe String
_calibrateCalCurveSegmentFile     :: Maybe FilePath -- ^ Path to an output file
      , CalibrateOptions -> Maybe String
_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 [CalExpr]
exprs [String]
exprFiles Maybe String
calCurveFile CalibrationMethod
method Bool
allowOutside Bool
noInterpolate Bool
quiet String
encoding Maybe String
densityFile Maybe String
hdrFile Maybe String
calCurveSegmentFile Maybe String
calCurveMatrixFile) = do
    let ascii :: Bool
ascii = String
encoding forall a. Eq a => a -> a -> Bool
/= String
"UTF-8"
    -- compile dates
    [[CalExpr]]
exprsFromFile <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [CalExpr]
readCalExprFromFile [String]
exprFiles
    let exprsRenamed :: [CalExpr]
exprsRenamed = [CalExpr] -> [CalExpr]
replaceEmptyNames forall a b. (a -> b) -> a -> b
$ [CalExpr]
exprs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CalExpr]]
exprsFromFile
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CalExpr]
exprsRenamed
    then Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Nothing to calibrate. See currycarbon -h for help"
    else do
        -- prep data
        Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Method: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CalibrationMethod
method
        Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Curve: " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe String
"IntCal20" Maybe String
calCurveFile
        CalCurveBP
calCurve <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return CalCurveBP
intcal20) String -> IO CalCurveBP
readCalCurveFromFile Maybe String
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
            }
        -- run calibration
        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Calibrating..."
        let errorOrCalPDFs :: [Either CurrycarbonException CalPDF]
errorOrCalPDFs = forall a b. (a -> b) -> [a] -> [b]
map (CalibrateDatesConf
-> CalCurveBP -> CalExpr -> Either CurrycarbonException CalPDF
evalCalExpr CalibrateDatesConf
calConf CalCurveBP
calCurve) [CalExpr]
exprsRenamed
        Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
ascii Bool
True CalCurveBP
calCurve forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [CalExpr]
exprsRenamed [Either CurrycarbonException CalPDF]
errorOrCalPDFs
    where
        -- the bool manages if a date is the first, calibratable date
        handleDates :: Bool -> Bool -> CalCurveBP -> [(CalExpr, Either CurrycarbonException CalPDF)] -> IO ()
        handleDates :: Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ Bool
_ CalCurveBP
_ [] = Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Done."
        handleDates Bool
_ascii Bool
True CalCurveBP
calCurve ((CalExpr, Either CurrycarbonException CalPDF)
firstDate:[(CalExpr, Either CurrycarbonException CalPDF)]
otherDates) = case (CalExpr, Either CurrycarbonException CalPDF)
firstDate of
            (CalExpr
_, Left CurrycarbonException
e)           -> CurrycarbonException -> IO ()
printE CurrycarbonException
e                              forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ascii Bool
True  CalCurveBP
calCurve [(CalExpr, Either CurrycarbonException CalPDF)]
otherDates
            (CalExpr
calExpr, Right CalPDF
cPDF) -> Bool -> CalCurveBP -> CalExpr -> CalPDF -> IO ()
firstOut Bool
_ascii CalCurveBP
calCurve CalExpr
calExpr CalPDF
cPDF forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ascii Bool
False CalCurveBP
calCurve [(CalExpr, Either CurrycarbonException CalPDF)]
otherDates
        handleDates Bool
_ascii Bool
False CalCurveBP
calCurve ((CalExpr, Either CurrycarbonException CalPDF)
firstDate:[(CalExpr, Either CurrycarbonException CalPDF)]
otherDates) = case (CalExpr, Either CurrycarbonException CalPDF)
firstDate of
            (CalExpr
_, Left CurrycarbonException
e)           -> CurrycarbonException -> IO ()
printE CurrycarbonException
e                              forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ascii Bool
False CalCurveBP
calCurve [(CalExpr, Either CurrycarbonException CalPDF)]
otherDates
            (CalExpr
calExpr, Right CalPDF
cPDF) -> Bool -> CalExpr -> CalPDF -> IO ()
otherOut Bool
_ascii CalExpr
calExpr CalPDF
cPDF          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ascii Bool
False CalCurveBP
calCurve [(CalExpr, Either CurrycarbonException CalPDF)]
otherDates
        firstOut :: Bool -> CalCurveBP -> CalExpr -> CalPDF -> IO ()
        firstOut :: Bool -> CalCurveBP -> CalExpr -> CalPDF -> IO ()
firstOut Bool
_ascii CalCurveBP
calCurve calExpr :: CalExpr
calExpr@(UnCalDate UncalC14
uncal) CalPDF
calPDF = do
            Bool
-> CalExpr
-> CalPDF
-> (String -> CalPDF -> IO ())
-> (String -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF String -> CalPDF -> IO ()
writeCalPDF String -> CalC14 -> IO ()
writeCalC14
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
calCurveSegmentFile Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe String
calCurveMatrixFile) forall a b. (a -> b) -> a -> b
$ do
                Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
                    String
"Warning: The calCurveSegment file and the calCurveMatrix file only consider the first date, " forall a. [a] -> [a] -> [a]
++
                    UncalC14 -> String
renderUncalC14 UncalC14
uncal
                let calCurveSegment :: CalCurveBCAD
calCurveSegment = Bool -> CalCurveBP -> CalCurveBCAD
prepareCalCurveSegment (Bool -> Bool
not Bool
noInterpolate) forall a b. (a -> b) -> a -> b
$ UncalC14 -> CalCurveBP -> CalCurveBP
getRelevantCalCurveSegment UncalC14
uncal CalCurveBP
calCurve
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
calCurveSegmentFile) forall a b. (a -> b) -> a -> b
$
                    String -> CalCurveBCAD -> IO ()
writeCalCurve (forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
calCurveSegmentFile) CalCurveBCAD
calCurveSegment
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
calCurveMatrixFile) forall a b. (a -> b) -> a -> b
$
                    String -> CalCurveMatrix -> IO ()
writeCalCurveMatrix (forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
calCurveMatrixFile) forall a b. (a -> b) -> a -> b
$
                    UncalPDF -> CalCurveBCAD -> CalCurveMatrix
makeCalCurveMatrix (UncalC14 -> UncalPDF
uncalToPDF UncalC14
uncal) CalCurveBCAD
calCurveSegment
        firstOut Bool
_ascii CalCurveBP
_ CalExpr
calExpr CalPDF
calPDF = do
            Bool
-> CalExpr
-> CalPDF
-> (String -> CalPDF -> IO ())
-> (String -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF String -> CalPDF -> IO ()
writeCalPDF String -> CalC14 -> IO ()
writeCalC14
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
calCurveSegmentFile Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe String
calCurveMatrixFile) forall a b. (a -> b) -> a -> b
$ do
                Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Warning: The calCurveSegment file and the calCurveMatrix file can only be produced for simple dates"
        otherOut :: Bool -> CalExpr -> CalPDF -> IO ()
        otherOut :: Bool -> CalExpr -> CalPDF -> IO ()
otherOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF =
            Bool
-> CalExpr
-> CalPDF
-> (String -> CalPDF -> IO ())
-> (String -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF String -> CalPDF -> IO ()
appendCalPDF String -> CalC14 -> IO ()
appendCalC14
        flexOut :: Bool ->  CalExpr -> CalPDF -> (FilePath -> CalPDF -> IO ()) -> (FilePath -> CalC14 -> IO ()) -> IO ()
        flexOut :: Bool
-> CalExpr
-> CalPDF
-> (String -> CalPDF -> IO ())
-> (String -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF String -> CalPDF -> IO ()
calPDFToFile String -> CalC14 -> IO ()
calC14ToFile = do
            case CalPDF -> Maybe CalC14
refineCalDate CalPDF
calPDF of
                Maybe CalC14
Nothing -> do
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet forall a b. (a -> b) -> a -> b
$ do
                        Handle -> String -> IO ()
hPutStrLn Handle
stdout forall a b. (a -> b) -> a -> b
$ CalExpr -> String
renderCalExpr CalExpr
calExpr
                        Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Warning: Could not calculate meaningful HDRs for this expression. Check --densityFile."
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
hdrFile)     forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Nothing written to the HDR file"
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
densityFile) forall a b. (a -> b) -> a -> b
$ String -> CalPDF -> IO ()
calPDFToFile (forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
densityFile) CalPDF
calPDF
                Just CalC14
calC14 -> do
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet              forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stdout forall a b. (a -> b) -> a -> b
$ Bool -> (CalExpr, CalPDF, CalC14) -> String
renderCalDatePretty Bool
_ascii (CalExpr
calExpr, CalPDF
calPDF, CalC14
calC14)
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
hdrFile)     forall a b. (a -> b) -> a -> b
$ String -> CalC14 -> IO ()
calC14ToFile (forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
hdrFile) CalC14
calC14
                    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe String
densityFile) forall a b. (a -> b) -> a -> b
$ String -> CalPDF -> IO ()
calPDFToFile (forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
densityFile) CalPDF
calPDF
        printE :: CurrycarbonException -> IO ()
        printE :: CurrycarbonException -> IO ()
printE CurrycarbonException
e = Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException CurrycarbonException
e

-- | Helper function to replace empty input names with a sequence of numbers,
-- to get each input date an unique identifier
replaceEmptyNames :: [CalExpr] -> [CalExpr]
replaceEmptyNames :: [CalExpr] -> [CalExpr]
replaceEmptyNames = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> CalExpr -> CalExpr
replaceName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) ([Integer
1..] :: [Integer])
    where
        replaceName :: String -> CalExpr -> CalExpr
        replaceName :: String -> CalExpr -> CalExpr
replaceName String
i (UnCalDate (UncalC14 String
name YearBP
x YearBP
y)) =
            if String
name forall a. Eq a => a -> a -> Bool
== String
"unknownSampleName"
            then UncalC14 -> CalExpr
UnCalDate forall a b. (a -> b) -> a -> b
$ String -> YearBP -> YearBP -> UncalC14
UncalC14 String
i YearBP
x YearBP
y
            else UncalC14 -> CalExpr
UnCalDate forall a b. (a -> b) -> a -> b
$ String -> YearBP -> YearBP -> UncalC14
UncalC14 String
name YearBP
x YearBP
y
        replaceName String
i (CalDate (CalPDF String
name Vector YearBCAD
x Vector Float
y)) =
            if String
name forall a. Eq a => a -> a -> Bool
== String
"unknownSampleName"
            then CalPDF -> CalExpr
CalDate forall a b. (a -> b) -> a -> b
$ String -> Vector YearBCAD -> Vector Float -> CalPDF
CalPDF String
i Vector YearBCAD
x Vector Float
y
            else CalPDF -> CalExpr
CalDate forall a b. (a -> b) -> a -> b
$ String -> Vector YearBCAD -> Vector Float -> CalPDF
CalPDF String
name Vector YearBCAD
x Vector Float
y
        replaceName String
i (SumCal CalExpr
a CalExpr
b)     = CalExpr -> CalExpr -> CalExpr
SumCal (String -> CalExpr -> CalExpr
replaceName (String
i forall a. [a] -> [a] -> [a]
++ String
"s") CalExpr
a) (String -> CalExpr -> CalExpr
replaceName (String
i forall a. [a] -> [a] -> [a]
++ String
"S") CalExpr
b)
        replaceName String
i (ProductCal CalExpr
a CalExpr
b) = CalExpr -> CalExpr -> CalExpr
ProductCal (String -> CalExpr -> CalExpr
replaceName (String
i forall a. [a] -> [a] -> [a]
++ String
"p") CalExpr
a) (String -> CalExpr -> CalExpr
replaceName (String
i forall a. [a] -> [a] -> [a]
++ String
"P") CalExpr
b)