{-# 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)

-- | 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 -> [FilePath]
_calibrateExprFiles :: [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 -> FilePath
_calibrateStdOutEncoding :: String -- ^ Encoding of the stdout stream (show TextEncoding)
      , 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 [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"
    -- compile dates
    [[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
        -- prep data
        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
            }
        -- run calibration
        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
        -- 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 -> 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

-- | 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 = (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)