resolving merge conflict

src/Currycarbon/CLI/RunCalibrate.hs

@@ -170,25 +170,28 @@ runCalibrate (
 -- | Helper function to replace empty input names with a sequence of numbers,
 -- to get each input date an unique identifier
 replaceEmptyNames :: [NamedCalExpr] -> [NamedCalExpr]
-replaceEmptyNames = zipWith (modifyExpr . show) ([1..] :: [Integer])
+replaceEmptyNames = zipWith (modifyNamedExpr . show) ([1..] :: [Integer])
     where
-        modifyExpr :: String -> NamedCalExpr -> NamedCalExpr
-        modifyExpr i nexpr = nexpr { _expr = replaceName i (_expr nexpr) }
+        modifyNamedExpr :: String -> NamedCalExpr -> NamedCalExpr
+        modifyNamedExpr i nexpr =
+            if _exprID nexpr == ""
+            then nexpr { _exprID = i, _expr = replaceName i (_expr nexpr) }
+            else nexpr {              _expr = replaceName i (_expr nexpr) }
         replaceName :: String -> CalExpr -> CalExpr
         replaceName i (UnCalDate (UncalC14 name x y)) =
-            if name == "unknownSampleName"
+            if name == ""
             then UnCalDate $ UncalC14 i x y
             else UnCalDate $ UncalC14 name x y
         replaceName i (WindowBP (TimeWindowBP name start stop)) =
-            if name == "unknownSampleName"
+            if name == ""
             then WindowBP $ TimeWindowBP i start stop
             else WindowBP $ TimeWindowBP name start stop
         replaceName i (WindowBCAD (TimeWindowBCAD name start stop)) =
-            if name == "unknownSampleName"
+            if name == ""
             then WindowBCAD $ TimeWindowBCAD i start stop
             else WindowBCAD $ TimeWindowBCAD name start stop
         replaceName i (CalDate (CalPDF name x y)) =
-            if name == "unknownSampleName"
+            if name == ""
             then CalDate $ CalPDF i x y
             else CalDate $ CalPDF name x y
         replaceName i (SumCal a b)     = SumCal (replaceName (i ++ "s") a) (replaceName (i ++ "S") b)

src/Currycarbon/ParserHelpers.hs

@@ -20,26 +20,37 @@ parseVector parser = do
     _ <- P.char 'c'
     parseInParens (P.sepBy parser consumeCommaSep)
 
--- * Low level blocks
+parseArgumentWithDefault :: String -> P.Parser b -> b -> P.Parser b
+parseArgumentWithDefault argumentName parseValue defaultValue =
+    P.option defaultValue (parseArgument argumentName parseValue)
 
-parseOptionalArgumentComma :: String -> P.Parser b -> P.Parser (Maybe b)
-parseOptionalArgumentComma argumentName parseValue =
-    P.optionMaybe $ P.try (parseArgumentComma argumentName parseValue)
+parseArgumentOptional :: String -> P.Parser b -> P.Parser (Maybe b)
+parseArgumentOptional argumentName parseValue =
+    P.optionMaybe $ P.try (parseArgument argumentName parseValue)
 
-parseArgumentComma :: String -> P.Parser b -> P.Parser b
-parseArgumentComma argumentName parseValue = do
-    res <- parseArgument argumentName parseValue
+parseArgument :: String -> P.Parser b -> P.Parser b
+parseArgument argumentName parseValue = do
+    res <- parseArgumentWithoutComma argumentName parseValue
     P.optional consumeCommaSep
     return res
 
-parseArgument :: String -> P.Parser b -> P.Parser b
-parseArgument argumentName parseValue =
-    P.try parseNamedArgument P.<|> parseUnnamedArgument
-    where
-        parseNamedArgument = do
-            (_,b) <- parseKeyValuePair (P.string argumentName) parseValue
-            return b
-        parseUnnamedArgument = parseValue
+parseNamedArgumentOptional :: String -> P.Parser b -> P.Parser (Maybe b)
+parseNamedArgumentOptional argumentName parseValue =
+    P.optionMaybe $ P.try (parseNamedArgument argumentName parseValue)
+
+-- * Low level blocks
+
+parseArgumentWithoutComma :: String -> P.Parser b -> P.Parser b
+parseArgumentWithoutComma argumentName parseValue =
+    P.try (parseNamedArgument argumentName parseValue) P.<|> parseUnnamedArgument parseValue
+
+parseNamedArgument :: String -> P.Parser b -> P.Parser b
+parseNamedArgument argumentName parseValue = do
+    (_,b) <- parseKeyValuePair (P.string argumentName) parseValue
+    return b
+
+parseUnnamedArgument :: P.Parser b -> P.Parser b
+parseUnnamedArgument parseValue = parseValue
 
 parseKeyValuePair :: P.Parser a -> P.Parser b -> P.Parser (a,b)
 parseKeyValuePair parseKey parseValue = do
@@ -75,7 +86,7 @@ parseAnyString =
     where
         inDoubleQuotes = P.between (P.char '"') (P.char '"') (P.many P.anyChar)
         inSingleQuotes = P.between (P.char '\'') (P.char '\'') (P.many P.anyChar)
-        inNoQuotes = P.many (P.noneOf ",")
+        inNoQuotes = P.many (P.noneOf ",)")
 
 -- * Sequence parsers
 
@@ -115,15 +126,15 @@ parsePositiveFloatNumber = do
 
 parseIntegerSequence :: P.Parser [Int]
 parseIntegerSequence = do
-    start <- parseInteger
+    start <- parseInt
     _ <- P.oneOf ":"
-    stop <- parseInteger
+    stop <- parseInt
     _ <- P.oneOf ":"
     by <- fromIntegral <$> parsePositiveInt
     return [start,(start+by)..stop]
 
-parseInteger :: P.Parser Int
-parseInteger = do
+parseInt :: P.Parser Int
+parseInt = do
     P.try parseNegativeInt P.<|> parsePositiveInt
 
 parseNegativeInt :: P.Parser Int

src/Currycarbon/Parsers.hs

@@ -4,7 +4,6 @@ module Currycarbon.Parsers where
 
 import           Currycarbon.Types
 import           Currycarbon.Utils
-import Currycarbon.Calibration.Utils
 import Currycarbon.ParserHelpers
 
 import           Control.Exception   (throwIO)
@@ -13,7 +12,6 @@ import qualified Data.Vector         as V
 import qualified Data.Vector.Unboxed as VU
 import qualified Text.Parsec         as P
 import qualified Text.Parsec.String  as P
-import qualified Text.Parsec.Perm    as P
 
 -- * Parsing, rendering and writing functions
 --
@@ -87,9 +85,8 @@ renderCalDatePretty ascii (calExpr, calPDF, calC14) =
 renderNamedCalExpr :: NamedCalExpr -> String
 renderNamedCalExpr (NamedCalExpr exprID calExpr) = renderExprID exprID ++ " " ++ renderCalExpr calExpr
 
-renderExprID :: Maybe String -> String
-renderExprID Nothing  = ""
-renderExprID (Just s) = "{" ++ s ++ "}"
+renderExprID :: String -> String
+renderExprID s = "[" ++ s ++ "]"
 
 renderCalExpr :: CalExpr -> String
 renderCalExpr (UnCalDate a)               = renderUncalC14 a
@@ -101,66 +98,77 @@ renderCalExpr (ProductCal a b)            = "(" ++ renderCalExpr a ++ " * " ++ r
 
 renderTimeWindowBP :: TimeWindowBP -> String
 renderTimeWindowBP (TimeWindowBP name start stop) =
-    name ++ ":" ++ renderYearBP start ++ " --- " ++ renderYearBP stop
+    name ++ ":" ++ renderYearBP start ++ "-" ++ renderYearBP stop
 
 renderTimeWindowBCAD :: TimeWindowBCAD -> String
 renderTimeWindowBCAD (TimeWindowBCAD name start stop) =
-    name ++ ":" ++ renderYearBCAD start ++ " -+- " ++ renderYearBCAD stop
-
+    name ++ ":" ++ renderYearBCAD start ++ "-" ++ renderYearBCAD stop
 
 parseTimeWindowBP :: P.Parser TimeWindowBP
-parseTimeWindowBP = do
-    parseRecordType "rangeBP" $ do
-        res@(TimeWindowBP _ start stop) <- P.permute $
-            TimeWindowBP
-                P.<$$> parseArgumentComma "name" parseAnyString
-                P.<||> parseArgumentComma "start" parseWord
-                P.<||> parseArgumentComma "stop" parseWord
-        --name <- parseArgumentComma "name" parseAnyString
-        --start <- parseArgumentComma "start" parseWord
-        --stop  <- parseArgumentComma "stop" parseWord
-        if start >= stop
-        then return res
-        else fail "the BP stop date can not be larger than the start date"
+parseTimeWindowBP = parseRecordType "rangeBP" $ do
+    name  <- parseArgument "name" parseAnyString
+    start <- parseArgument "start" parseWord
+    stop  <- parseArgument "stop" parseWord
+    if start >= stop
+    then return (TimeWindowBP name start stop)
+    else fail "the BP stop date can not be larger than the start date"
 
 parseTimeWindowBCAD :: P.Parser TimeWindowBCAD
-parseTimeWindowBCAD = do
-    name <- P.many (P.noneOf ",")
-    _ <- parseCharInSpace ','
-    start <- parseInteger
-    _ <- P.spaces *> P.string "-+-" <* P.spaces
-    stop <- parseInteger
+parseTimeWindowBCAD = parseRecordType "rangeBCAD" $ do
+    name  <- parseArgument "name" parseAnyString
+    start <- parseArgument "start" parseInt
+    stop  <- parseArgument "stop" parseInt
     if start <= stop
     then return (TimeWindowBCAD name start stop)
     else fail "the BC/AD stop date can not be smaller than the start date"
 
 -- https://gist.github.com/abhin4v/017a36477204a1d57745
-add :: P.Parser CalExpr
-add = SumCal <$> term <*> (parseCharInSpace '+' *> expr)
+addFun :: P.Parser CalExpr
+addFun = parseRecordType "sum" $ do
+    a <- parseArgument "a" term
+    b <- parseArgument "b" expr
+    return $ SumCal a b
+
+addOperator :: P.Parser CalExpr
+addOperator = SumCal <$> term <*> (parseCharInSpace '+' *> expr)
+
+mulFun :: P.Parser CalExpr
+mulFun = parseRecordType "product" $ do
+    a <- parseArgument "a" factor
+    b <- parseArgument "b" term
+    return $ ProductCal a b
 
-mul :: P.Parser CalExpr
-mul = ProductCal <$> factor <*> (parseCharInSpace '*' *> term)
+mulOperator :: P.Parser CalExpr
+mulOperator = ProductCal <$> factor <*> (parseCharInSpace '*' *> term)
 
 parens :: P.Parser CalExpr
 parens = P.between (parseCharInSpace '(') (parseCharInSpace ')') expr
 
 factor :: P.Parser CalExpr
 factor =      P.try parens
+        P.<|> P.try addFun
+        P.<|> P.try mulFun
         P.<|> P.try (WindowBP <$> parseTimeWindowBP)
         P.<|> P.try (WindowBCAD <$> parseTimeWindowBCAD)
         P.<|> (UnCalDate <$> parseUncalC14)
 
 term :: P.Parser CalExpr
-term = P.try mul P.<|> factor
+term = P.try mulOperator P.<|> factor
 
 expr :: P.Parser CalExpr
-expr = P.try add P.<|> term -- <* P.eof
+expr = P.try addOperator P.<|> term -- <* P.eof
 
 namedExpr :: P.Parser NamedCalExpr
-namedExpr = do
-    name <- P.optionMaybe $
-        P.between (parseCharInSpace '{') (parseCharInSpace '}') (P.many1 $ P.noneOf "}")
-    NamedCalExpr name <$> expr
+namedExpr = P.try record P.<|> (NamedCalExpr "" <$> expr)
+    where
+        record = parseRecordType "calExpr" $ P.try long P.<|> short
+        long = do
+            name <- parseArgument "name" parseAnyString
+            ex   <- parseArgument "expr" expr
+            return (NamedCalExpr name ex)
+        short = do
+            ex   <- parseArgument "expr" expr
+            return (NamedCalExpr "" ex)
 
 readNamedCalExprs :: String -> Either String [NamedCalExpr]
 readNamedCalExprs s =
@@ -224,21 +232,17 @@ readUncalC14 s =
         uncalC14SepBySemicolon = P.sepBy parseUncalC14 (P.char ';' <* P.spaces) <* P.eof
 
 parseUncalC14 :: P.Parser UncalC14
-parseUncalC14 = do
-    P.try long P.<|> short
+parseUncalC14 = parseRecordType "uncalC14" $ P.try long P.<|> short
     where
         long = do
-            name <- P.many (P.noneOf ",")
-            _ <- P.oneOf ","
-            mean <- parseWord
-            _ <- P.oneOf ","
-            std <- parseWord
-            return (UncalC14 name mean std)
+            name  <- parseArgument "name" parseAnyString
+            age   <- parseArgument "age" parseWord
+            sigma <- parseArgument "sigma" parseWord
+            return (UncalC14 name age sigma)
         short = do
-            mean <- parseWord
-            _ <- P.oneOf ","
-            std <- parseWord
-            return (UncalC14 "unknownSampleName" mean std)
+            age   <- parseArgument "age" parseWord
+            sigma <- parseArgument "sigma" parseWord
+            return (UncalC14 "" age sigma)
 
 -- CalC14
 -- | Write 'CalC14's to the file system. The output file is a long .csv file with the following structure:
@@ -305,7 +309,7 @@ renderCalRangeSummary s =
 -- BP
 renderYearBP :: YearBP -> String
 renderYearBP x =
-    show x ++ "BP" ++ " (" ++ (renderYearBCAD $ bp2BCAD x) ++ ")"
+    show x ++ "BP" -- ++ " (" ++ (renderYearBCAD $ bp2BCAD x) ++ ")"
 
 -- BCAD
 renderYearBCAD :: YearBCAD -> String

src/Currycarbon/SumCalibration.hs

@@ -16,9 +16,7 @@ evalNamedCalExpr :: CalibrateDatesConf -> CalCurveBP -> NamedCalExpr -> Either C
 evalNamedCalExpr conf curve (NamedCalExpr exprID expr) = 
     case evalCalExpr conf curve expr of
         Left err     -> Left err
-        Right calPDF -> case exprID of
-            Nothing -> Right calPDF
-            Just x  -> Right $ calPDF { _calPDFid = x }
+        Right calPDF -> Right calPDF { _calPDFid = exprID }
 
 -- | Evaluate a dating expression by calibrating the individual dates and forming the respective
 --   sums and products of post-calibration density distributions

src/Currycarbon/Types.hs

@@ -113,7 +113,7 @@ data CalPDF = CalPDF {
 -- | A data type for named calibration expressions
 data NamedCalExpr = NamedCalExpr {
     -- | Expression identifier
-      _exprID :: Maybe String
+      _exprID :: String
     -- | Expression
     , _expr   :: CalExpr
     }