{-# 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)
data CalibrateOptions = CalibrateOptions {
CalibrateOptions -> [CalExpr]
_calibrateExprs :: [CalExpr]
, CalibrateOptions -> [String]
_calibrateExprFiles :: [FilePath]
, CalibrateOptions -> Maybe String
_calibrateCalCurveFile :: Maybe FilePath
, CalibrateOptions -> CalibrationMethod
_calibrateCalibrationMethod :: CalibrationMethod
, CalibrateOptions -> Bool
_calibrateAllowOutside :: Bool
, CalibrateOptions -> Bool
_calibrateDontInterpolateCalCurve :: Bool
, CalibrateOptions -> Bool
_calibrateQuiet :: Bool
, CalibrateOptions -> String
_calibrateStdOutEncoding :: String
, CalibrateOptions -> Maybe String
_calibrateDensityFile :: Maybe FilePath
, CalibrateOptions -> Maybe String
_calibrateHDRFile :: Maybe FilePath
, CalibrateOptions -> Maybe String
_calibrateCalCurveSegmentFile :: Maybe FilePath
, CalibrateOptions -> Maybe String
_calibrateCalCurveMatrixFile :: Maybe FilePath
}
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"
[[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
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
}
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
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
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)