{-# 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 (when, unless)
import Data.Maybe (fromJust, isJust, fromMaybe)
import System.IO (hPutStrLn, stderr, stdout)
data CalibrateOptions = CalibrateOptions {
CalibrateOptions -> [CalExpr]
_calibrateExprs :: [CalExpr]
, CalibrateOptions -> [FilePath]
_calibrateExprFiles :: [FilePath]
, CalibrateOptions -> Maybe FilePath
_calibrateCalCurveFile :: Maybe FilePath
, CalibrateOptions -> CalibrationMethod
_calibrateCalibrationMethod :: CalibrationMethod
, CalibrateOptions -> Bool
_calibrateAllowOutside :: Bool
, CalibrateOptions -> Bool
_calibrateDontInterpolateCalCurve :: Bool
, CalibrateOptions -> Bool
_calibrateQuiet :: Bool
, CalibrateOptions -> FilePath
_calibrateStdOutEncoding :: String
, CalibrateOptions -> Maybe FilePath
_calibrateDensityFile :: Maybe FilePath
, CalibrateOptions -> Maybe FilePath
_calibrateHDRFile :: Maybe FilePath
, CalibrateOptions -> Maybe FilePath
_calibrateCalCurveSegmentFile :: Maybe FilePath
, CalibrateOptions -> Maybe FilePath
_calibrateCalCurveMatrixFile :: Maybe FilePath
}
runCalibrate :: CalibrateOptions -> IO ()
runCalibrate :: CalibrateOptions -> IO ()
runCalibrate (CalibrateOptions [CalExpr]
exprs [FilePath]
exprFiles Maybe FilePath
calCurveFile CalibrationMethod
method Bool
allowOutside Bool
noInterpolate Bool
quiet FilePath
encoding Maybe FilePath
densityFile Maybe FilePath
hdrFile Maybe FilePath
calCurveSegmentFile Maybe FilePath
calCurveMatrixFile) = do
let ascii :: Bool
ascii = FilePath
encoding FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"UTF-8"
[[CalExpr]]
exprsFromFile <- (FilePath -> IO [CalExpr]) -> [FilePath] -> IO [[CalExpr]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [CalExpr]
readCalExprFromFile [FilePath]
exprFiles
let exprsRenamed :: [CalExpr]
exprsRenamed = [CalExpr] -> [CalExpr]
replaceEmptyNames ([CalExpr] -> [CalExpr]) -> [CalExpr] -> [CalExpr]
forall a b. (a -> b) -> a -> b
$ [CalExpr]
exprs [CalExpr] -> [CalExpr] -> [CalExpr]
forall a. [a] -> [a] -> [a]
++ [[CalExpr]] -> [CalExpr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CalExpr]]
exprsFromFile
if [CalExpr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CalExpr]
exprsRenamed
then Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Nothing to calibrate. See currycarbon -h for help"
else do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Method: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CalibrationMethod -> FilePath
forall a. Show a => a -> FilePath
show CalibrationMethod
method
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Curve: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"IntCal20" Maybe FilePath
calCurveFile
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
}
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Calibrating..."
let errorOrCalPDFs :: [Either CurrycarbonException CalPDF]
errorOrCalPDFs = (CalExpr -> Either CurrycarbonException CalPDF)
-> [CalExpr] -> [Either CurrycarbonException CalPDF]
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 ([(CalExpr, Either CurrycarbonException CalPDF)] -> IO ())
-> [(CalExpr, Either CurrycarbonException CalPDF)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [CalExpr]
-> [Either CurrycarbonException CalPDF]
-> [(CalExpr, Either CurrycarbonException CalPDF)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CalExpr]
exprsRenamed [Either CurrycarbonException CalPDF]
errorOrCalPDFs
where
handleDates :: Bool -> Bool -> CalCurveBP -> [(CalExpr, Either CurrycarbonException CalPDF)] -> IO ()
handleDates :: Bool
-> Bool
-> CalCurveBP
-> [(CalExpr, Either CurrycarbonException CalPDF)]
-> IO ()
handleDates Bool
_ Bool
_ CalCurveBP
_ [] = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"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 IO () -> IO () -> IO ()
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 IO () -> IO () -> IO ()
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 IO () -> IO () -> IO ()
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 IO () -> IO () -> IO ()
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
-> (FilePath -> CalPDF -> IO ())
-> (FilePath -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF FilePath -> CalPDF -> IO ()
writeCalPDF FilePath -> CalC14 -> IO ()
writeCalC14
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"Warning: 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
firstOut Bool
_ascii CalCurveBP
_ CalExpr
calExpr CalPDF
calPDF = do
Bool
-> CalExpr
-> CalPDF
-> (FilePath -> CalPDF -> IO ())
-> (FilePath -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF FilePath -> CalPDF -> IO ()
writeCalPDF FilePath -> CalC14 -> IO ()
writeCalC14
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (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) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"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
-> (FilePath -> CalPDF -> IO ())
-> (FilePath -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF FilePath -> CalPDF -> IO ()
appendCalPDF FilePath -> CalC14 -> IO ()
appendCalC14
flexOut :: Bool -> CalExpr -> CalPDF -> (FilePath -> CalPDF -> IO ()) -> (FilePath -> CalC14 -> IO ()) -> IO ()
flexOut :: Bool
-> CalExpr
-> CalPDF
-> (FilePath -> CalPDF -> IO ())
-> (FilePath -> CalC14 -> IO ())
-> IO ()
flexOut Bool
_ascii CalExpr
calExpr CalPDF
calPDF FilePath -> CalPDF -> IO ()
calPDFToFile FilePath -> CalC14 -> IO ()
calC14ToFile = do
case CalPDF -> Maybe CalC14
refineCalDate CalPDF
calPDF of
Maybe CalC14
Nothing -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stdout (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CalExpr -> FilePath
renderCalExpr CalExpr
calExpr
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Warning: Could not calculate meaningful HDRs for this expression. Check --densityFile."
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
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"Nothing written to the HDR file"
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 ()
calPDFToFile (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
densityFile) CalPDF
calPDF
Just CalC14
calC14 -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stdout (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> (CalExpr, CalPDF, CalC14) -> FilePath
renderCalDatePretty Bool
_ascii (CalExpr
calExpr, 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 ()
calC14ToFile (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 ()
calPDFToFile (Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FilePath
densityFile) CalPDF
calPDF
printE :: CurrycarbonException -> IO ()
printE :: CurrycarbonException -> IO ()
printE CurrycarbonException
e = Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> FilePath
renderCurrycarbonException CurrycarbonException
e
replaceEmptyNames :: [CalExpr] -> [CalExpr]
replaceEmptyNames :: [CalExpr] -> [CalExpr]
replaceEmptyNames = (Integer -> CalExpr -> CalExpr)
-> [Integer] -> [CalExpr] -> [CalExpr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FilePath -> CalExpr -> CalExpr
replaceName (FilePath -> CalExpr -> CalExpr)
-> (Integer -> FilePath) -> Integer -> CalExpr -> CalExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> FilePath
forall a. Show a => a -> FilePath
show) ([Integer
1..] :: [Integer])
where
replaceName :: String -> CalExpr -> CalExpr
replaceName :: FilePath -> CalExpr -> CalExpr
replaceName FilePath
i (UnCalDate (UncalC14 FilePath
name YearBP
x YearBP
y)) =
if FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"unknownSampleName"
then UncalC14 -> CalExpr
UnCalDate (UncalC14 -> CalExpr) -> UncalC14 -> CalExpr
forall a b. (a -> b) -> a -> b
$ FilePath -> YearBP -> YearBP -> UncalC14
UncalC14 FilePath
i YearBP
x YearBP
y
else UncalC14 -> CalExpr
UnCalDate (UncalC14 -> CalExpr) -> UncalC14 -> CalExpr
forall a b. (a -> b) -> a -> b
$ FilePath -> YearBP -> YearBP -> UncalC14
UncalC14 FilePath
name YearBP
x YearBP
y
replaceName FilePath
i (CalDate (CalPDF FilePath
name Vector YearBCAD
x Vector Float
y)) =
if FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"unknownSampleName"
then CalPDF -> CalExpr
CalDate (CalPDF -> CalExpr) -> CalPDF -> CalExpr
forall a b. (a -> b) -> a -> b
$ FilePath -> Vector YearBCAD -> Vector Float -> CalPDF
CalPDF FilePath
i Vector YearBCAD
x Vector Float
y
else CalPDF -> CalExpr
CalDate (CalPDF -> CalExpr) -> CalPDF -> CalExpr
forall a b. (a -> b) -> a -> b
$ FilePath -> Vector YearBCAD -> Vector Float -> CalPDF
CalPDF FilePath
name Vector YearBCAD
x Vector Float
y
replaceName FilePath
i (SumCal CalExpr
a CalExpr
b) = CalExpr -> CalExpr -> CalExpr
SumCal (FilePath -> CalExpr -> CalExpr
replaceName (FilePath
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"s") CalExpr
a) (FilePath -> CalExpr -> CalExpr
replaceName (FilePath
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"S") CalExpr
b)
replaceName FilePath
i (ProductCal CalExpr
a CalExpr
b) = CalExpr -> CalExpr -> CalExpr
ProductCal (FilePath -> CalExpr -> CalExpr
replaceName (FilePath
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"p") CalExpr
a) (FilePath -> CalExpr -> CalExpr
replaceName (FilePath
i FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"P") CalExpr
b)