{-# LANGUAGE OverloadedStrings #-}

module Currycarbon.Parsers where

import Currycarbon.Types
import Currycarbon.Utils

import           Control.Exception              (throwIO)
import           Data.List                      (intercalate, transpose)
import qualified Text.Parsec                    as P
import qualified Text.Parsec.String             as P
import qualified Data.Vector.Unboxed            as VU
import qualified Data.Vector                    as V

-- * Parsing, rendering and writing functions
--
-- $importExport
--
-- This module contains a number of functions to manage data input and 
-- output plumbing for different datatypes

-- CalibrationMethod
readCalibrationMethod :: String -> Either String CalibrationMethod
readCalibrationMethod :: String -> Either String CalibrationMethod
readCalibrationMethod String
s =
    case Parsec String () CalibrationMethod
-> () -> String -> String -> Either ParseError CalibrationMethod
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () CalibrationMethod
parseCalibrationMethod () String
"" String
s of
        Left ParseError
err -> String -> Either String CalibrationMethod
forall a b. a -> Either a b
Left (String -> Either String CalibrationMethod)
-> String -> Either String CalibrationMethod
forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException (CurrycarbonException -> String) -> CurrycarbonException -> String
forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException (String -> CurrycarbonException) -> String -> CurrycarbonException
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right CalibrationMethod
x -> CalibrationMethod -> Either String CalibrationMethod
forall a b. b -> Either a b
Right CalibrationMethod
x

parseCalibrationMethod :: P.Parser CalibrationMethod
parseCalibrationMethod :: Parsec String () CalibrationMethod
parseCalibrationMethod = do
    Parsec String () CalibrationMethod
-> Parsec String () CalibrationMethod
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parsec String () CalibrationMethod
forall u. ParsecT String u Identity CalibrationMethod
bchron Parsec String () CalibrationMethod
-> Parsec String () CalibrationMethod
-> Parsec String () CalibrationMethod
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parsec String () CalibrationMethod
forall u. ParsecT String u Identity CalibrationMethod
matrixMultiplication
    where
        bchron :: ParsecT String u Identity CalibrationMethod
bchron = do
            String
_ <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"Bchron,"
            ParsecT String u Identity CalibrationMethod
-> ParsecT String u Identity CalibrationMethod
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try ParsecT String u Identity CalibrationMethod
forall u. ParsecT String u Identity CalibrationMethod
studentT ParsecT String u Identity CalibrationMethod
-> ParsecT String u Identity CalibrationMethod
-> ParsecT String u Identity CalibrationMethod
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> ParsecT String u Identity CalibrationMethod
forall u. ParsecT String u Identity CalibrationMethod
normal
        studentT :: ParsecT String u Identity CalibrationMethod
studentT = do
            String
_ <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"StudentT,"
            Double
dof <- String -> Double
forall a. Read a => String -> a
read (String -> Double)
-> ParsecT String u Identity String
-> ParsecT String u Identity Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
            CalibrationMethod -> ParsecT String u Identity CalibrationMethod
forall (m :: * -> *) a. Monad m => a -> m a
return (CalibrationDistribution -> CalibrationMethod
Bchron (CalibrationDistribution -> CalibrationMethod)
-> CalibrationDistribution -> CalibrationMethod
forall a b. (a -> b) -> a -> b
$ Double -> CalibrationDistribution
StudentTDist Double
dof)
        normal :: ParsecT String u Identity CalibrationMethod
normal = do
            String
_ <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"Normal"
            CalibrationMethod -> ParsecT String u Identity CalibrationMethod
forall (m :: * -> *) a. Monad m => a -> m a
return (CalibrationDistribution -> CalibrationMethod
Bchron CalibrationDistribution
NormalDist)
        matrixMultiplication :: ParsecT String u Identity CalibrationMethod
matrixMultiplication = do
            String
_ <- String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"MatrixMult"
            CalibrationMethod -> ParsecT String u Identity CalibrationMethod
forall (m :: * -> *) a. Monad m => a -> m a
return CalibrationMethod
MatrixMultiplication

-- | Combine 'CalExpr', 'CalPDF' and 'CalC14' to render pretty command line output
-- like this:
-- 
-- @
-- DATE: (5000±30BP + 5100±100BP)
-- Calibrated: 4150BC \>\> 3941BC \> 3814BC \< 3660BC \<\< 3651BC
-- 1-sigma: 3941-3864BC, 3810-3707BC, 3667-3660BC
-- 2-sigma: 4150-4148BC, 4048-3651BC
--                                           ▁                
--                                           ▒▁ ▁▁            
--                                   ▁▁▁    ▁▒▒▁▒▒            
--                                 ▁▁▒▒▒    ▒▒▒▒▒▒            
--                               ▁▁▒▒▒▒▒▁▁▁▁▒▒▒▒▒▒▁ ▁         
--                           ▁▁▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▒▁        
--         ▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▁▁▁▁▁▁▁▁
--  -4330 ┄──┬─────┬─────┬─────┬──────┬─────┬─────┬─────┬─────┄ -3530
--                    \>            \>       \^         \<        
--                                 ──────  ──────── ──        
--                    ─     ──────────────────────────
-- @
--
renderCalDatePretty :: 
       Bool -- ^ Should the CLI plot be restricted to (boring) ASCII symbols?
    -> (CalExpr, CalPDF, CalC14)
    -> String
renderCalDatePretty :: Bool -> (CalExpr, CalPDF, CalC14) -> String
renderCalDatePretty Bool
ascii (CalExpr
calExpr, CalPDF
calPDF, CalC14
calC14) =
    String
"DATE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [
          CalExpr -> String
renderCalExpr CalExpr
calExpr
        , CalC14 -> String
renderCalC14 CalC14
calC14
        , Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF Bool
ascii Int
6 Int
50 CalPDF
calPDF CalC14
calC14
        ]

renderCalExpr :: CalExpr -> String
renderCalExpr :: CalExpr -> String
renderCalExpr (UnCalDate UncalC14
a)               = UncalC14 -> String
renderUncalC14 UncalC14
a
renderCalExpr (CalDate (CalPDF String
name Vector Int
_ Vector Float
_)) = String
name
renderCalExpr (SumCal CalExpr
a CalExpr
b)                = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
renderCalExpr (ProductCal CalExpr
a CalExpr
b)            = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalExpr -> String
renderCalExpr CalExpr
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- https://gist.github.com/abhin4v/017a36477204a1d57745
spaceChar :: Char -> P.Parser Char
spaceChar :: Char -> Parser Char
spaceChar Char
c = ParsecT String () Identity ()
-> ParsecT String () Identity () -> Parser Char -> Parser Char
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces (Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
c)
--spaceChar = P.char

add :: P.Parser CalExpr
add :: Parser CalExpr
add = CalExpr -> CalExpr -> CalExpr
SumCal (CalExpr -> CalExpr -> CalExpr)
-> Parser CalExpr
-> ParsecT String () Identity (CalExpr -> CalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CalExpr
term ParsecT String () Identity (CalExpr -> CalExpr)
-> Parser CalExpr -> Parser CalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
spaceChar Char
'+' Parser Char -> Parser CalExpr -> Parser CalExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CalExpr
expr)

mul :: P.Parser CalExpr
mul :: Parser CalExpr
mul = CalExpr -> CalExpr -> CalExpr
ProductCal (CalExpr -> CalExpr -> CalExpr)
-> Parser CalExpr
-> ParsecT String () Identity (CalExpr -> CalExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CalExpr
factor ParsecT String () Identity (CalExpr -> CalExpr)
-> Parser CalExpr -> Parser CalExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
spaceChar Char
'*' Parser Char -> Parser CalExpr -> Parser CalExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser CalExpr
term)

parens :: P.Parser CalExpr
parens :: Parser CalExpr
parens = Parser Char -> Parser Char -> Parser CalExpr -> Parser CalExpr
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (Char -> Parser Char
spaceChar Char
'(') (Char -> Parser Char
spaceChar Char
')') Parser CalExpr
expr

factor :: P.Parser CalExpr
factor :: Parser CalExpr
factor = Parser CalExpr
parens Parser CalExpr -> Parser CalExpr -> Parser CalExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> (UncalC14 -> CalExpr
UnCalDate (UncalC14 -> CalExpr)
-> ParsecT String () Identity UncalC14 -> Parser CalExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity UncalC14
parseUncalC14)

term :: P.Parser CalExpr
term :: Parser CalExpr
term = Parser CalExpr -> Parser CalExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
mul Parser CalExpr -> Parser CalExpr -> Parser CalExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser CalExpr
factor

expr :: P.Parser CalExpr
expr :: Parser CalExpr
expr = Parser CalExpr -> Parser CalExpr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser CalExpr
add Parser CalExpr -> Parser CalExpr -> Parser CalExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser CalExpr
term -- <* P.eof

readCalExpr :: String -> Either String [CalExpr]
readCalExpr :: String -> Either String [CalExpr]
readCalExpr String
s =
    case Parsec String () [CalExpr]
-> () -> String -> String -> Either ParseError [CalExpr]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () [CalExpr]
parseCalExprSepBySemicolon () String
"" String
s of
        Left ParseError
err -> String -> Either String [CalExpr]
forall a b. a -> Either a b
Left (String -> Either String [CalExpr])
-> String -> Either String [CalExpr]
forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException (CurrycarbonException -> String) -> CurrycarbonException -> String
forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException (String -> CurrycarbonException) -> String -> CurrycarbonException
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right [CalExpr]
x -> [CalExpr] -> Either String [CalExpr]
forall a b. b -> Either a b
Right [CalExpr]
x
        where
        parseCalExprSepBySemicolon :: P.Parser [CalExpr]
        parseCalExprSepBySemicolon :: Parsec String () [CalExpr]
parseCalExprSepBySemicolon = Parser CalExpr -> Parser Char -> Parsec String () [CalExpr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy Parser CalExpr
expr (Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';' Parser Char -> ParsecT String () Identity () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) Parsec String () [CalExpr]
-> ParsecT String () Identity () -> Parsec String () [CalExpr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof

readCalExprFromFile :: FilePath -> IO [CalExpr]
readCalExprFromFile :: String -> IO [CalExpr]
readCalExprFromFile String
uncalFile = do
    String
s <- String -> IO String
readFile String
uncalFile
    case Parsec String () [CalExpr]
-> () -> String -> String -> Either ParseError [CalExpr]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () [CalExpr]
parseCalExprSepByNewline () String
"" String
s of
        Left ParseError
err -> CurrycarbonException -> IO [CalExpr]
forall e a. Exception e => e -> IO a
throwIO (CurrycarbonException -> IO [CalExpr])
-> CurrycarbonException -> IO [CalExpr]
forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException (String -> CurrycarbonException) -> String -> CurrycarbonException
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right [CalExpr]
x -> [CalExpr] -> IO [CalExpr]
forall (m :: * -> *) a. Monad m => a -> m a
return [CalExpr]
x
    where
        parseCalExprSepByNewline :: P.Parser [CalExpr]
        parseCalExprSepByNewline :: Parsec String () [CalExpr]
parseCalExprSepByNewline = Parser CalExpr -> Parser Char -> Parsec String () [CalExpr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.endBy Parser CalExpr
expr (Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline Parser Char -> ParsecT String () Identity () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) Parsec String () [CalExpr]
-> ParsecT String () Identity () -> Parsec String () [CalExpr]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof

-- CalC14
-- | Write 'CalC14's to the file system. The output file is a long .csv file with the following structure:
-- 
-- @
-- sample,hdrSigma,hdrStartBCAD,hdrStopBCAD
-- Sample1,1,-3797,-3709
-- Sample1,1,-3894,-3880
-- Sample1,2,-3680,-3655
-- Sample1,2,-3810,-3700
-- Sample1,2,-3941,-3864
-- Sample2,1,-1142,-1130
-- Sample2,1,-1173,-1161
-- Sample2,1,-1293,-1194
-- Sample2,1,-1368,-1356
-- Sample2,2,-1061,-1059
-- Sample2,2,-1323,-1112
-- Sample2,2,-1393,-1334
-- @
-- 
writeCalC14s :: FilePath -> [CalC14] -> IO ()
writeCalC14s :: String -> [CalC14] -> IO ()
writeCalC14s String
path [CalC14]
calC14s = String -> String -> IO ()
writeFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ 
    String
"sample,hdrSigma,hdrStartBCAD,hdrStopBCAD\n" 
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((CalC14 -> String) -> [CalC14] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CalC14 -> String
renderCalC14ForFile [CalC14]
calC14s)

writeCalC14 :: FilePath -> CalC14 -> IO ()
writeCalC14 :: String -> CalC14 -> IO ()
writeCalC14 String
path CalC14
calC14 = String -> String -> IO ()
writeFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ 
    String
"sample,hdrSigma,hdrStartBCAD,hdrStopBCAD\n" 
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalC14 -> String
renderCalC14ForFile CalC14
calC14

appendCalC14 :: FilePath -> CalC14 -> IO ()
appendCalC14 :: String -> CalC14 -> IO ()
appendCalC14 String
path CalC14
calC14 =
    String -> String -> IO ()
appendFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalC14 -> String
renderCalC14ForFile CalC14
calC14

renderCalC14ForFile :: CalC14 -> String
renderCalC14ForFile :: CalC14 -> String
renderCalC14ForFile (CalC14 String
name CalRangeSummary
_ [HDR]
hdrs68 [HDR]
hdrs95) =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ 
        ((String, String, (String, String)) -> String)
-> [(String, String, (String, String))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, (String, String)) -> String
renderRow ([(String, String, (String, String))] -> [String])
-> [(String, String, (String, String))] -> [String]
forall a b. (a -> b) -> a -> b
$
        [String]
-> [String]
-> [(String, String)]
-> [(String, String, (String, String))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (String -> [String]
forall a. a -> [a]
repeat String
name) (String -> [String]
forall a. a -> [a]
repeat String
"1") ([HDR] -> [(String, String)]
renderHDRsForFile [HDR]
hdrs68) [(String, String, (String, String))]
-> [(String, String, (String, String))]
-> [(String, String, (String, String))]
forall a. [a] -> [a] -> [a]
++
        [String]
-> [String]
-> [(String, String)]
-> [(String, String, (String, String))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (String -> [String]
forall a. a -> [a]
repeat String
name) (String -> [String]
forall a. a -> [a]
repeat String
"2") ([HDR] -> [(String, String)]
renderHDRsForFile [HDR]
hdrs95)
    where
        renderRow :: (String, String, (String, String)) -> String
        renderRow :: (String, String, (String, String)) -> String
renderRow (String
a, String
b, (String
c, String
d)) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String
a,String
b,String
c,String
d]

renderCalC14s :: [CalC14] -> String
renderCalC14s :: [CalC14] -> String
renderCalC14s [CalC14]
xs = 
    String
"Calibrated high density ranges (HDR):\n" 
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ((CalC14 -> String) -> [CalC14] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map CalC14 -> String
renderCalC14 [CalC14]
xs)

renderCalC14 :: CalC14 -> String
renderCalC14 :: CalC14 -> String
renderCalC14 (CalC14 String
_ CalRangeSummary
rangeSummary [HDR]
hdrs68 [HDR]
hdrs95) =
       String
"Calibrated: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalRangeSummary -> String
renderCalRangeSummary CalRangeSummary
rangeSummary String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"1-sigma: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [HDR] -> String
renderHDRs [HDR]
hdrs68 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"2-sigma: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [HDR] -> String
renderHDRs [HDR]
hdrs95

renderCalRangeSummary :: CalRangeSummary -> String
renderCalRangeSummary :: CalRangeSummary -> String
renderCalRangeSummary CalRangeSummary
s =
       Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStartTwoSigma CalRangeSummary
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >> "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStartOneSigma CalRangeSummary
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" > "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeMedian CalRangeSummary
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" < "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStopOneSigma CalRangeSummary
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" << "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
renderYearBCAD (CalRangeSummary -> Int
_calRangeStopTwoSigma CalRangeSummary
s)

-- BCAD
renderYearBCAD :: YearBCAD -> String
renderYearBCAD :: Int -> String
renderYearBCAD Int
x
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = Int -> String
forall a. Show a => a -> String
show (-Int
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BC"
    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"AD"
    | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"This should never happen: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x

-- HDR
renderHDRsForFile :: [HDR] -> [(String, String)]
renderHDRsForFile :: [HDR] -> [(String, String)]
renderHDRsForFile = (HDR -> (String, String)) -> [HDR] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map HDR -> (String, String)
renderHDRForFile

renderHDRForFile :: HDR -> (String, String)
renderHDRForFile :: HDR -> (String, String)
renderHDRForFile (HDR Int
start Int
stop) = (Int -> String
forall a. Show a => a -> String
show Int
start, Int -> String
forall a. Show a => a -> String
show Int
stop)

renderHDRs :: [HDR] -> String
renderHDRs :: [HDR] -> String
renderHDRs [HDR]
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((HDR -> String) -> [HDR] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map HDR -> String
renderHDR [HDR]
xs)

renderHDR :: HDR -> String
renderHDR :: HDR -> String
renderHDR (HDR Int
start Int
stop)
    | Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
stop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Int -> String
forall a. Show a => a -> String
show (-Int
start) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (-Int
stop) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BC"
    | Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
stop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   = Int -> String
forall a. Show a => a -> String
show (-Int
start) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BC-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
stop String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"AD"
    | Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
stop Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> String
forall a. Show a => a -> String
show Int
start String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
stop String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"AD"
    | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"This should never happen: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
start String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
stop

-- CalCurveMatrix
writeCalCurveMatrix :: FilePath -> CalCurveMatrix -> IO ()
writeCalCurveMatrix :: String -> CalCurveMatrix -> IO ()
writeCalCurveMatrix String
path CalCurveMatrix
calCurveMatrix = 
    String -> String -> IO ()
writeFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CalCurveMatrix -> String
renderCalCurveMatrix CalCurveMatrix
calCurveMatrix

renderCalCurveMatrix :: CalCurveMatrix -> String
renderCalCurveMatrix :: CalCurveMatrix -> String
renderCalCurveMatrix (CalCurveMatrix Vector Int
uncals Vector Int
cals Vector (Vector Float)
curveDensities) =
    let header :: String
header = String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String]) -> [Int] -> [String]
forall a b. (a -> b) -> a -> b
$ Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector Int
cals) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
        body :: [String]
body = (Int -> [Float] -> String) -> [Int] -> [[Float]] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Float] -> String
forall a a. (Show a, Show a) => a -> [a] -> String
makeRow (Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector Int
uncals) ([[Float]] -> [[Float]]
forall a. [[a]] -> [[a]]
transpose ([[Float]] -> [[Float]]) -> [[Float]] -> [[Float]]
forall a b. (a -> b) -> a -> b
$ Vector [Float] -> [[Float]]
forall a. Vector a -> [a]
V.toList ((Vector Float -> [Float])
-> Vector (Vector Float) -> Vector [Float]
forall a b. (a -> b) -> Vector a -> Vector b
V.map Vector Float -> [Float]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector (Vector Float)
curveDensities))
    in String
header String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
body
    where 
      makeRow :: a -> [a] -> String
makeRow a
uncal [a]
dens = a -> String
forall a. Show a => a -> String
show a
uncal String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
dens)

-- CalPDF
-- | Write 'CalPDF's to the file system. The output file is a long .csv file with the following structure:
-- 
-- @
-- sample,calBCAD,density
-- ...
-- Sample1,-1391,2.8917924e-4
-- Sample1,-1390,3.3285577e-4
-- Sample1,-1389,3.5674628e-4
-- Sample1,-1388,3.750703e-4
-- ...
-- Sample2,-3678,1.8128564e-3
-- Sample2,-3677,1.9512239e-3
-- Sample2,-3676,2.0227064e-3
-- Sample2,-3675,2.095691e-3
-- ...
-- @
-- 
writeCalPDFs :: FilePath -> [CalPDF] -> IO ()
writeCalPDFs :: String -> [CalPDF] -> IO ()
writeCalPDFs String
path [CalPDF]
calPDFs =
    String -> String -> IO ()
writeFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"sample,calBCAD,density\n"
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ [CalPDF] -> String
renderCalPDFs [CalPDF]
calPDFs

writeCalPDF :: FilePath -> CalPDF -> IO ()
writeCalPDF :: String -> CalPDF -> IO ()
writeCalPDF String
path CalPDF
calPDF =
    String -> String -> IO ()
writeFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"sample,calBCAD,density\n"
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ CalPDF -> String
renderCalPDF CalPDF
calPDF

appendCalPDF :: FilePath -> CalPDF -> IO ()
appendCalPDF :: String -> CalPDF -> IO ()
appendCalPDF String
path CalPDF
calPDF =
    String -> String -> IO ()
appendFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CalPDF -> String
renderCalPDF CalPDF
calPDF

renderCalPDFs :: [CalPDF] -> String
renderCalPDFs :: [CalPDF] -> String
renderCalPDFs = (CalPDF -> String) -> [CalPDF] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CalPDF -> String
renderCalPDF

renderCalPDF :: CalPDF -> String
renderCalPDF :: CalPDF -> String
renderCalPDF (CalPDF String
name Vector Int
cals Vector Float
dens) =
    ((Int, Float) -> String) -> [(Int, Float)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Float) -> String
forall a a. (Show a, Show a) => (a, a) -> String
makeRow ([(Int, Float)] -> String) -> [(Int, Float)] -> String
forall a b. (a -> b) -> a -> b
$ Vector (Int, Float) -> [(Int, Float)]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector (Int, Float) -> [(Int, Float)])
-> Vector (Int, Float) -> [(Int, Float)]
forall a b. (a -> b) -> a -> b
$ Vector Int -> Vector Float -> Vector (Int, Float)
forall a b.
(Unbox a, Unbox b) =>
Vector a -> Vector b -> Vector (a, b)
VU.zip Vector Int
cals Vector Float
dens
    where
      makeRow :: (a, a) -> String
makeRow (a
x,a
y) = String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"

data PlotSymbol = HistFill | HistTop | AxisEnd | AxisLine | AxisTick | HDRLine 

renderCLIPlotCalPDF :: Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF :: Bool -> Int -> Int -> CalPDF -> CalC14 -> String
renderCLIPlotCalPDF Bool
ascii Int
rows Int
cols (CalPDF String
_ Vector Int
cals Vector Float
dens) CalC14
c14 =
     let startYear :: Int
startYear = Vector Int -> Int
forall a. Unbox a => Vector a -> a
VU.head Vector Int
cals
         stopYear :: Int
stopYear = Vector Int -> Int
forall a. Unbox a => Vector a -> a
VU.last Vector Int
cals
         yearsPerCol :: Int
yearsPerCol = case Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot (Vector Int -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector Int
cals) Int
cols of
            Int
0 -> Int
1 -- relevant for very short PDFs
            Int
1 -> Int
2
            Int
q -> Int
q
        -- last bin will often be shorter, which renders the whole plot slightly incorrect for the last column
         meanDensPerCol :: [Int]
meanDensPerCol = Int -> Vector Float -> [Int]
calculateMeanDens Int
yearsPerCol Vector Float
dens
         effectiveCols :: Int
effectiveCols = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
meanDensPerCol
         plotRows :: [String]
plotRows = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Char
getHistSymbol Int
x) [Int]
meanDensPerCol) ([Int] -> [String]) -> [Int] -> [String]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0..Int
rows]
         xAxis :: String
xAxis = Int -> Int -> Int -> Int -> String
constructXAxis Int
startYear Int
stopYear Int
effectiveCols Int
yearsPerCol
     in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
plotRows String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
xAxis
     where
        calculateMeanDens :: Int -> VU.Vector Float -> [Int]
        calculateMeanDens :: Int -> Vector Float -> [Int]
calculateMeanDens Int
yearsPerCol Vector Float
dens_ =
            let scaling :: Float
scaling = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows
                meanDens :: [Float]
meanDens = ([Float] -> Float) -> [[Float]] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\[Float]
x -> [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
x)) ([[Float]] -> [Float]) -> [[Float]] -> [Float]
forall a b. (a -> b) -> a -> b
$ Int -> [Float] -> [[Float]]
forall a. Int -> [a] -> [[a]]
splitEvery Int
yearsPerCol ([Float] -> [[Float]]) -> [Float] -> [[Float]]
forall a b. (a -> b) -> a -> b
$ Vector Float -> [Float]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector Float
dens_
                maxDens :: Float
maxDens = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
meanDens
            in (Float -> Int) -> [Float] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Float
x -> Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxDens) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scaling) [Float]
meanDens
        splitEvery :: Int -> [a] -> [[a]] -- https://stackoverflow.com/a/8681226/3216883
        splitEvery :: Int -> [a] -> [[a]]
splitEvery Int
_ [] = []
        splitEvery Int
n [a]
list = [a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
splitEvery Int
n [a]
rest
            where ([a]
first,[a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
list
        padString :: Int -> String -> String
        padString :: Int -> String -> String
padString Int
l String
x = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
        getSymbol :: Bool -> PlotSymbol -> Char
        getSymbol :: Bool -> PlotSymbol -> Char
getSymbol Bool
True PlotSymbol
HistFill  = Char
'*'
        getSymbol Bool
False PlotSymbol
HistFill = Char
'▒'
        getSymbol Bool
True PlotSymbol
HistTop   = Char
'_'
        getSymbol Bool
False PlotSymbol
HistTop  = Char
'▁'
        getSymbol Bool
True PlotSymbol
AxisEnd   = Char
'+'
        getSymbol Bool
False PlotSymbol
AxisEnd  = Char
'┄'
        getSymbol Bool
True PlotSymbol
AxisLine  = Char
'-'
        getSymbol Bool
False PlotSymbol
AxisLine = Char
'─'
        getSymbol Bool
True PlotSymbol
AxisTick  = Char
'|'
        getSymbol Bool
False PlotSymbol
AxisTick = Char
'┬'
        getSymbol Bool
True PlotSymbol
HDRLine   = Char
'-'
        getSymbol Bool
False PlotSymbol
HDRLine  = Char
'─'
        getHistSymbol :: Int -> Int -> Char
        getHistSymbol :: Int -> Int -> Char
getHistSymbol Int
x Int
y
            | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HistTop
            | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y  = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HistFill
            | Bool
otherwise = Char
' '
        constructXAxis :: Int -> Int -> Int -> Int -> String
        constructXAxis :: Int -> Int -> Int -> Int -> String
constructXAxis Int
startYear Int
stopYear Int
effCols Int
yearsPerCol =
            let startS :: String
startS = Int -> String -> String
padString Int
6 (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Int
roundTo10 Int
startYear)
                stopS :: String
stopS = Int -> String
forall a. Show a => a -> String
show (Int -> Int
roundTo10 Int
stopYear)
                tickFreq :: Int
tickFreq = if Int -> Int
forall a. Num a => a -> a
abs (Int
startYear Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
stopYear) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1500 then Int
100 else Int
1000
                colStartYears :: [Int]
colStartYears = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
a -> Int
startYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yearsPerCol Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
a) [Int
0..(Int
effCols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
                colStopYears :: [Int]
colStopYears  = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> Int
startYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yearsPerCol Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Int
1..Int
effCols]
                axis :: String
axis        = (Int -> Int -> Char) -> [Int] -> [Int] -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> Int -> Char
getAxisSymbol Int
tickFreq)                   [Int]
colStartYears [Int]
colStopYears
                simpleRange :: String
simpleRange = (Int -> Int -> Char) -> [Int] -> [Int] -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (CalRangeSummary -> Int -> Int -> Char
getRangeSymbol (CalC14 -> CalRangeSummary
_calC14RangeSummary CalC14
c14)) [Int]
colStartYears [Int]
colStopYears
                hdrOne :: String
hdrOne      = (Int -> Int -> Char) -> [Int] -> [Int] -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([HDR] -> Int -> Int -> Char
getHDRSymbol (CalC14 -> [HDR]
_calC14HDROneSigma CalC14
c14))    [Int]
colStartYears [Int]
colStopYears
                hdrTwo :: String
hdrTwo      = (Int -> Int -> Char) -> [Int] -> [Int] -> String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([HDR] -> Int -> Int -> Char
getHDRSymbol (CalC14 -> [HDR]
_calC14HDRTwoSigma CalC14
c14))    [Int]
colStartYears [Int]
colStopYears
            in  String
startS String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisEnd]) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
axis String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisEnd] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
stopS String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
simpleRange String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hdrOne String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hdrTwo
            where
                roundTo10 :: Int -> Int
                roundTo10 :: Int -> Int
roundTo10 Int
x =
                    let (Int
dec,Int
rest) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Int -> Int
forall a. Num a => a -> a
abs Int
x) Int
10
                        roundedDec :: Int
roundedDec = if Int
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5 then Int
dec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
dec
                    in Int
roundedDec Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Num a => a -> a
signum Int
x
                getAxisSymbol :: Int -> Int -> Int -> Char
                getAxisSymbol :: Int -> Int -> Int -> Char
getAxisSymbol Int
tickFreq Int
colStartYear Int
colStopYear
                    | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Int
x -> Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
x Int
tickFreq Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [Int
colStartYear..Int
colStopYear] = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisTick
                    | Bool
otherwise = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
AxisLine
                getRangeSymbol :: CalRangeSummary -> Int -> Int -> Char
                getRangeSymbol :: CalRangeSummary -> Int -> Int -> Char
getRangeSymbol CalRangeSummary
range Int
colStartYear Int
colStopYear
                    | Int
colStartYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeMedian CalRangeSummary
range        Bool -> Bool -> Bool
&& Int
colStopYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeMedian CalRangeSummary
range        = Char
'^'
                    | Int
colStartYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStartOneSigma CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStartOneSigma CalRangeSummary
range = Char
'>'
                    | Int
colStartYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStopOneSigma CalRangeSummary
range  Bool -> Bool -> Bool
&& Int
colStopYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStopOneSigma CalRangeSummary
range  = Char
'<'
                    | Int
colStartYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStartTwoSigma CalRangeSummary
range Bool -> Bool -> Bool
&& Int
colStopYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStartTwoSigma CalRangeSummary
range = Char
'>'
                    | Int
colStartYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= CalRangeSummary -> Int
_calRangeStopTwoSigma CalRangeSummary
range  Bool -> Bool -> Bool
&& Int
colStopYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= CalRangeSummary -> Int
_calRangeStopTwoSigma CalRangeSummary
range  = Char
'<'
                    | Bool
otherwise = Char
' '
                getHDRSymbol :: [HDR] -> Int -> Int -> Char
                getHDRSymbol :: [HDR] -> Int -> Int -> Char
getHDRSymbol [HDR]
hdr Int
colStartYear Int
colStopYear
                    | (HDR -> Bool) -> [HDR] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> HDR -> Bool
doesOverlap Int
colStartYear Int
colStopYear) [HDR]
hdr = Bool -> PlotSymbol -> Char
getSymbol Bool
ascii PlotSymbol
HDRLine
                    | Bool
otherwise = Char
' '
                    where
                        doesOverlap :: Int -> Int -> HDR -> Bool
                        doesOverlap :: Int -> Int -> HDR -> Bool
doesOverlap Int
a Int
b HDR
h =
                            let ha :: Int
ha = HDR -> Int
_hdrstart HDR
h; hb :: Int
hb = HDR -> Int
_hdrstop HDR
h
                            in (Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ha Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hb) Bool -> Bool -> Bool
|| (Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ha Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hb) Bool -> Bool -> Bool
|| (Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ha Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hb)

-- UncalC14
renderUncalC14WithoutName :: UncalC14 -> String
renderUncalC14WithoutName :: UncalC14 -> String
renderUncalC14WithoutName (UncalC14 String
_ YearBP
bp YearBP
sigma) = YearBP -> String
forall a. Show a => a -> String
show YearBP
bp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"±" String -> String -> String
forall a. [a] -> [a] -> [a]
++ YearBP -> String
forall a. Show a => a -> String
show YearBP
sigma String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BP"

renderUncalC14 :: UncalC14 -> String
renderUncalC14 :: UncalC14 -> String
renderUncalC14 (UncalC14 String
name YearBP
bp YearBP
sigma) = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ YearBP -> String
forall a. Show a => a -> String
show YearBP
bp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"±" String -> String -> String
forall a. [a] -> [a] -> [a]
++ YearBP -> String
forall a. Show a => a -> String
show YearBP
sigma String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"BP"

-- | Read uncalibrated radiocarbon dates from a file. The file should feature one radiocarbon date
-- per line in the form "\<sample name\>,\<mean age BP\>,\<one sigma standard deviation\>", where 
-- \<sample name\> is optional. A valid file could look like this:
-- 
-- @
-- Sample1,5000,30
-- 6000,50
-- Sample3,4000,25
-- @
-- 
readUncalC14FromFile :: FilePath -> IO [UncalC14]
readUncalC14FromFile :: String -> IO [UncalC14]
readUncalC14FromFile String
uncalFile = do
    String
s <- String -> IO String
readFile String
uncalFile
    case Parsec String () [UncalC14]
-> () -> String -> String -> Either ParseError [UncalC14]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () [UncalC14]
uncalC14SepByNewline () String
"" String
s of
        Left ParseError
err -> CurrycarbonException -> IO [UncalC14]
forall e a. Exception e => e -> IO a
throwIO (CurrycarbonException -> IO [UncalC14])
-> CurrycarbonException -> IO [UncalC14]
forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException (String -> CurrycarbonException) -> String -> CurrycarbonException
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right [UncalC14]
x -> [UncalC14] -> IO [UncalC14]
forall (m :: * -> *) a. Monad m => a -> m a
return [UncalC14]
x
    where
        uncalC14SepByNewline :: P.Parser [UncalC14]
        uncalC14SepByNewline :: Parsec String () [UncalC14]
uncalC14SepByNewline = ParsecT String () Identity UncalC14
-> Parser Char -> Parsec String () [UncalC14]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.endBy ParsecT String () Identity UncalC14
parseUncalC14 (Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline Parser Char -> ParsecT String () Identity () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) Parsec String () [UncalC14]
-> ParsecT String () Identity () -> Parsec String () [UncalC14]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof

readUncalC14 :: String -> Either String [UncalC14]
readUncalC14 :: String -> Either String [UncalC14]
readUncalC14 String
s = 
    case Parsec String () [UncalC14]
-> () -> String -> String -> Either ParseError [UncalC14]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () [UncalC14]
uncalC14SepBySemicolon () String
"" String
s of
        Left ParseError
err -> String -> Either String [UncalC14]
forall a b. a -> Either a b
Left (String -> Either String [UncalC14])
-> String -> Either String [UncalC14]
forall a b. (a -> b) -> a -> b
$ CurrycarbonException -> String
renderCurrycarbonException (CurrycarbonException -> String) -> CurrycarbonException -> String
forall a b. (a -> b) -> a -> b
$ String -> CurrycarbonException
CurrycarbonCLIParsingException (String -> CurrycarbonException) -> String -> CurrycarbonException
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right [UncalC14]
x -> [UncalC14] -> Either String [UncalC14]
forall a b. b -> Either a b
Right [UncalC14]
x
    where 
        uncalC14SepBySemicolon :: P.Parser [UncalC14]
        uncalC14SepBySemicolon :: Parsec String () [UncalC14]
uncalC14SepBySemicolon = ParsecT String () Identity UncalC14
-> Parser Char -> Parsec String () [UncalC14]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy ParsecT String () Identity UncalC14
parseUncalC14 (Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
';' Parser Char -> ParsecT String () Identity () -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces) Parsec String () [UncalC14]
-> ParsecT String () Identity () -> Parsec String () [UncalC14]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof

parseUncalC14 :: P.Parser UncalC14
parseUncalC14 :: ParsecT String () Identity UncalC14
parseUncalC14 = do
    ParsecT String () Identity UncalC14
-> ParsecT String () Identity UncalC14
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try ParsecT String () Identity UncalC14
forall u. ParsecT String u Identity UncalC14
long ParsecT String () Identity UncalC14
-> ParsecT String () Identity UncalC14
-> ParsecT String () Identity UncalC14
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> ParsecT String () Identity UncalC14
forall u. ParsecT String u Identity UncalC14
short
    where
        long :: ParsecT String u Identity UncalC14
long = do
            String
name <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
",")
            Char
_ <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
            YearBP
mean <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String u Identity String
-> ParsecT String u Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
            Char
_ <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
            YearBP
std <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String u Identity String
-> ParsecT String u Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
            UncalC14 -> ParsecT String u Identity UncalC14
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> YearBP -> YearBP -> UncalC14
UncalC14 String
name YearBP
mean YearBP
std)
        short :: ParsecT String u Identity UncalC14
short = do
            YearBP
mean <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String u Identity String
-> ParsecT String u Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
            Char
_ <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
            YearBP
std <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String u Identity String
-> ParsecT String u Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String u Identity Char -> ParsecT String u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
            UncalC14 -> ParsecT String u Identity UncalC14
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> YearBP -> YearBP -> UncalC14
UncalC14 String
"unknownSampleName" YearBP
mean YearBP
std)

-- CalCurve
writeCalCurve :: FilePath -> CalCurveBCAD -> IO ()
writeCalCurve :: String -> CalCurveBCAD -> IO ()
writeCalCurve String
path CalCurveBCAD
calCurve = 
    String -> String -> IO ()
writeFile String
path (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ CalCurveBCAD -> String
renderCalCurve CalCurveBCAD
calCurve

renderCalCurve :: CalCurveBCAD -> String
renderCalCurve :: CalCurveBCAD -> String
renderCalCurve (CalCurveBCAD Vector Int
cals Vector Int
uncals Vector YearBP
sigmas) =
    let header :: String
header = String
"calBCAD,uncalBCAD,Sigma\n"
        body :: [String]
body = ((Int, Int, YearBP) -> String) -> [(Int, Int, YearBP)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, YearBP) -> String
forall a a a. (Show a, Show a, Show a) => (a, a, a) -> String
makeRow ([(Int, Int, YearBP)] -> [String])
-> [(Int, Int, YearBP)] -> [String]
forall a b. (a -> b) -> a -> b
$ Vector (Int, Int, YearBP) -> [(Int, Int, YearBP)]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector (Int, Int, YearBP) -> [(Int, Int, YearBP)])
-> Vector (Int, Int, YearBP) -> [(Int, Int, YearBP)]
forall a b. (a -> b) -> a -> b
$ Vector Int
-> Vector Int -> Vector YearBP -> Vector (Int, Int, YearBP)
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
Vector a -> Vector b -> Vector c -> Vector (a, b, c)
VU.zip3 Vector Int
cals Vector Int
uncals Vector YearBP
sigmas
    in String
header String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
body
    where
      makeRow :: (a, a, a) -> String
makeRow (a
x,a
y,a
z) = a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
z

-- | Read a calibration curve file. The file must adhere to the current version of the 
-- .c14 file format (e.g. [here](http://intcal.org/curves/intcal20.14c)). Look
-- [here](http://intcal.org/blurb.html) for other calibration curves
readCalCurveFromFile :: FilePath -> IO CalCurveBP
readCalCurveFromFile :: String -> IO CalCurveBP
readCalCurveFromFile String
calCurveFile = do
    String
calCurve <- String -> IO String
readFile String
calCurveFile
    CalCurveBP -> IO CalCurveBP
forall (m :: * -> *) a. Monad m => a -> m a
return (CalCurveBP -> IO CalCurveBP) -> CalCurveBP -> IO CalCurveBP
forall a b. (a -> b) -> a -> b
$ String -> CalCurveBP
readCalCurve String
calCurve

readCalCurve :: String -> CalCurveBP
readCalCurve :: String -> CalCurveBP
readCalCurve String
calCurveString = do
    case Parsec String () [(YearBP, YearBP, YearBP)]
-> ()
-> String
-> String
-> Either ParseError [(YearBP, YearBP, YearBP)]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
P.runParser Parsec String () [(YearBP, YearBP, YearBP)]
parseCalCurve () String
"" String
calCurveString of
        Left ParseError
p  -> String -> CalCurveBP
forall a. HasCallStack => String -> a
error (String -> CalCurveBP) -> String -> CalCurveBP
forall a b. (a -> b) -> a -> b
$ String
"This should never happen." String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
p
        Right [(YearBP, YearBP, YearBP)]
x -> Vector YearBP -> Vector YearBP -> Vector YearBP -> CalCurveBP
CalCurveBP 
            ([YearBP] -> Vector YearBP
forall a. Unbox a => [a] -> Vector a
VU.fromList ([YearBP] -> Vector YearBP) -> [YearBP] -> Vector YearBP
forall a b. (a -> b) -> a -> b
$ ((YearBP, YearBP, YearBP) -> YearBP)
-> [(YearBP, YearBP, YearBP)] -> [YearBP]
forall a b. (a -> b) -> [a] -> [b]
map (\(YearBP
a,YearBP
_,YearBP
_) -> YearBP
a) [(YearBP, YearBP, YearBP)]
x)
            ([YearBP] -> Vector YearBP
forall a. Unbox a => [a] -> Vector a
VU.fromList ([YearBP] -> Vector YearBP) -> [YearBP] -> Vector YearBP
forall a b. (a -> b) -> a -> b
$ ((YearBP, YearBP, YearBP) -> YearBP)
-> [(YearBP, YearBP, YearBP)] -> [YearBP]
forall a b. (a -> b) -> [a] -> [b]
map (\(YearBP
_,YearBP
b,YearBP
_) -> YearBP
b) [(YearBP, YearBP, YearBP)]
x)
            ([YearBP] -> Vector YearBP
forall a. Unbox a => [a] -> Vector a
VU.fromList ([YearBP] -> Vector YearBP) -> [YearBP] -> Vector YearBP
forall a b. (a -> b) -> a -> b
$ ((YearBP, YearBP, YearBP) -> YearBP)
-> [(YearBP, YearBP, YearBP)] -> [YearBP]
forall a b. (a -> b) -> [a] -> [b]
map (\(YearBP
_,YearBP
_,YearBP
c) -> YearBP
c) [(YearBP, YearBP, YearBP)]
x)

parseCalCurve :: P.Parser [(YearBP, YearBP, YearRange)]
parseCalCurve :: Parsec String () [(YearBP, YearBP, YearBP)]
parseCalCurve = do
    ParsecT String () Identity String -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT String () Identity String
comments
    ParsecT String () Identity (YearBP, YearBP, YearBP)
-> ParsecT String () Identity String
-> Parsec String () [(YearBP, YearBP, YearBP)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepEndBy ParsecT String () Identity (YearBP, YearBP, YearBP)
parseCalCurveLine (Parser Char -> Parser Char -> ParsecT String () Identity String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.manyTill Parser Char
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
P.anyToken (Parser Char -> Parser Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline))

parseCalCurveLine :: P.Parser (YearBP, YearBP, YearRange) 
parseCalCurveLine :: ParsecT String () Identity (YearBP, YearBP, YearBP)
parseCalCurveLine = do
  YearBP
calBP <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String () Identity String
-> ParsecT String () Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  Char
_ <- String -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
  YearBP
bp <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String () Identity String
-> ParsecT String () Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  Char
_ <- String -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
","
  YearBP
sigma <- String -> YearBP
forall a. Read a => String -> a
read (String -> YearBP)
-> ParsecT String () Identity String
-> ParsecT String () Identity YearBP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit
  (YearBP, YearBP, YearBP)
-> ParsecT String () Identity (YearBP, YearBP, YearBP)
forall (m :: * -> *) a. Monad m => a -> m a
return (YearBP
calBP, YearBP
bp, YearBP
sigma)

comments :: P.Parser String
comments :: ParsecT String () Identity String
comments = do 
    String
_ <- String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
"#"
    String
_ <- Parser Char -> Parser Char -> ParsecT String () Identity String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.manyTill Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline
    String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""