{-# LANGUAGE OverloadedStrings #-}

{-| A module to read and write allele sharing histograms, as defined here:
<https://rarecoal-docs.readthedocs.io/en/latest/rarecoal.html#histogram-files>
-}

module SequenceFormats.RareAlleleHistogram (RareAlleleHistogram(..), readHistogramFromHandle,
                            SitePattern, readHistogram, writeHistogramStdOut, writeHistogramFile, showSitePattern) where

import SequenceFormats.Utils (SeqFormatException(..))

import Control.Applicative (optional)
import Control.Error (assertErr)
import Control.Exception (throw)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.State.Strict (evalStateT)
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Char (isAlphaNum)
import Data.Int (Int64)
import Data.List (intercalate, sortBy)
import qualified Data.Map.Strict as Map
import qualified Data.ByteString.Char8 as B
import Pipes.Attoparsec (parse)
import qualified Pipes.ByteString as PB
import System.IO (Handle, IOMode(..), withFile)

-- |A datatype to represent an Allele Sharing Histogram:
data RareAlleleHistogram = RareAlleleHistogram {
    RareAlleleHistogram -> [String]
raNames :: [String], -- ^A list of branch names
    RareAlleleHistogram -> [Int]
raNVec :: [Int], -- ^A list of haploid sample sizes.
    RareAlleleHistogram -> Int
raMinAf :: Int, -- ^The minimum allele count
    RareAlleleHistogram -> Int
raMaxAf :: Int, -- ^The maximum allele count
    RareAlleleHistogram -> [Int]
raConditionOn :: [Int], -- ^A list of branch indices that were used to condition the allele 
                            --sharing pattern
    RareAlleleHistogram -> [[Int]]
raExcludePatterns :: [SitePattern], -- ^A list of patterns that are excluded.
    RareAlleleHistogram -> Int64
raTotalNrSites :: Int64, -- ^The total number of non-missing sites in the genome.
    RareAlleleHistogram -> Map [Int] Int64
raCounts :: Map.Map SitePattern Int64, -- ^The actual data, a dictionary from allele sharing patterns to observed numbers.
    RareAlleleHistogram -> Maybe (Map [Int] (Double, Double))
raJackknifeEstimates :: Maybe (Map.Map SitePattern (Double, Double)) -- ^An optional dictionary that contains Jackknife estimates and standard deviations for each pattern frequency.
} deriving (RareAlleleHistogram -> RareAlleleHistogram -> Bool
(RareAlleleHistogram -> RareAlleleHistogram -> Bool)
-> (RareAlleleHistogram -> RareAlleleHistogram -> Bool)
-> Eq RareAlleleHistogram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RareAlleleHistogram -> RareAlleleHistogram -> Bool
$c/= :: RareAlleleHistogram -> RareAlleleHistogram -> Bool
== :: RareAlleleHistogram -> RareAlleleHistogram -> Bool
$c== :: RareAlleleHistogram -> RareAlleleHistogram -> Bool
Eq, Int -> RareAlleleHistogram -> ShowS
[RareAlleleHistogram] -> ShowS
RareAlleleHistogram -> String
(Int -> RareAlleleHistogram -> ShowS)
-> (RareAlleleHistogram -> String)
-> ([RareAlleleHistogram] -> ShowS)
-> Show RareAlleleHistogram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RareAlleleHistogram] -> ShowS
$cshowList :: [RareAlleleHistogram] -> ShowS
show :: RareAlleleHistogram -> String
$cshow :: RareAlleleHistogram -> String
showsPrec :: Int -> RareAlleleHistogram -> ShowS
$cshowsPrec :: Int -> RareAlleleHistogram -> ShowS
Show)

-- |A simple type synonym for the SitePattern, represented as a list of Integers that represents 
-- each pattern across the branches.
type SitePattern = [Int]

-- |A simple function to convert a pattern into a String.
showSitePattern :: SitePattern -> String
showSitePattern :: [Int] -> String
showSitePattern = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String) -> ([Int] -> [String]) -> [Int] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show

-- |Function to convert a Rare Allele Histogram to text. Returns an error if attempting to print a 
-- histogram with non-standard settings. Many settings, such as minAf>1, are only meant for 
-- in-memory representations, but are not compatible with the file format itself.
showHistogram :: RareAlleleHistogram -> Either String B.ByteString
showHistogram :: RareAlleleHistogram -> Either String ByteString
showHistogram RareAlleleHistogram
hist = do
    String -> Bool -> Either String ()
forall e. e -> Bool -> Either e ()
assertErr String
"can only print histogram with minAf=1 due to format-legacy" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$ RareAlleleHistogram -> Int
raMinAf RareAlleleHistogram
hist Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    String -> Bool -> Either String ()
forall e. e -> Bool -> Either e ()
assertErr String
"can only print histogram with no conditioning due to format-legacy" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$
        [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RareAlleleHistogram -> [Int]
raConditionOn RareAlleleHistogram
hist)
    String -> Bool -> Either String ()
forall e. e -> Bool -> Either e ()
assertErr String
"can only print histogram with no exclude pattern due to format-legacy" (Bool -> Either String ()) -> Bool -> Either String ()
forall a b. (a -> b) -> a -> b
$
        [[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RareAlleleHistogram -> [[Int]]
raExcludePatterns RareAlleleHistogram
hist)
    let head0 :: ByteString
head0 = ByteString
"NAMES=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," ([ByteString] -> ByteString)
-> (RareAlleleHistogram -> [ByteString])
-> RareAlleleHistogram
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ByteString) -> [String] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ByteString
B.pack ([String] -> [ByteString])
-> (RareAlleleHistogram -> [String])
-> RareAlleleHistogram
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RareAlleleHistogram -> [String]
raNames (RareAlleleHistogram -> ByteString)
-> RareAlleleHistogram -> ByteString
forall a b. (a -> b) -> a -> b
$ RareAlleleHistogram
hist)
        head1 :: ByteString
head1 = ByteString
"N=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
B.pack (String -> ByteString)
-> (RareAlleleHistogram -> String)
-> RareAlleleHistogram
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String)
-> (RareAlleleHistogram -> [String])
-> RareAlleleHistogram
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String])
-> (RareAlleleHistogram -> [Int])
-> RareAlleleHistogram
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RareAlleleHistogram -> [Int]
raNVec (RareAlleleHistogram -> ByteString)
-> RareAlleleHistogram -> ByteString
forall a b. (a -> b) -> a -> b
$ RareAlleleHistogram
hist)
        head2 :: ByteString
head2 = ByteString
"MAX_M=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
B.pack (String -> ByteString)
-> (RareAlleleHistogram -> String)
-> RareAlleleHistogram
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> (RareAlleleHistogram -> Int) -> RareAlleleHistogram -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RareAlleleHistogram -> Int
raMaxAf (RareAlleleHistogram -> ByteString)
-> RareAlleleHistogram -> ByteString
forall a b. (a -> b) -> a -> b
$ RareAlleleHistogram
hist)
        head3 :: ByteString
head3 = ByteString
"TOTAL_SITES=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
B.pack (String -> ByteString)
-> (RareAlleleHistogram -> String)
-> RareAlleleHistogram
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String)
-> (RareAlleleHistogram -> Int64) -> RareAlleleHistogram -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RareAlleleHistogram -> Int64
raTotalNrSites (RareAlleleHistogram -> ByteString)
-> RareAlleleHistogram -> ByteString
forall a b. (a -> b) -> a -> b
$ RareAlleleHistogram
hist)
        body :: [ByteString]
body = do
            ([Int]
k, Int64
v) <- [([Int], Int64)]
sorted
            case RareAlleleHistogram -> Maybe (Map [Int] (Double, Double))
raJackknifeEstimates RareAlleleHistogram
hist of
                Maybe (Map [Int] (Double, Double))
Nothing -> [ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" " [String -> ByteString
B.pack (String -> ByteString) -> ([Int] -> String) -> [Int] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String
showSitePattern ([Int] -> ByteString) -> [Int] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Int]
k, String -> ByteString
B.pack (String -> ByteString) -> (Int64 -> String) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> ByteString) -> Int64 -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64
v]]
                Just Map [Int] (Double, Double)
jkHist -> do
                    let Just (Double
jkMean, Double
jkSE) = [Int]
k [Int] -> Map [Int] (Double, Double) -> Maybe (Double, Double)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map [Int] (Double, Double)
jkHist
                    ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
" " [String -> ByteString
B.pack (String -> ByteString) -> ([Int] -> String) -> [Int] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String
showSitePattern ([Int] -> ByteString) -> [Int] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Int]
k, String -> ByteString
B.pack (String -> ByteString) -> (Int64 -> String) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> ByteString) -> Int64 -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64
v,
                                                String -> ByteString
B.pack (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
jkMean, String -> ByteString
B.pack (String -> ByteString)
-> (Double -> String) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
jkSE]
    ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.unlines (ByteString
head0ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString
head1ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString
head2ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString
head3ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
body)
  where
    sorted :: [([Int], Int64)]
sorted = (([Int], Int64) -> ([Int], Int64) -> Ordering)
-> [([Int], Int64)] -> [([Int], Int64)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\([Int]
_, Int64
v1) ([Int]
_, Int64
v2)  -> Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
v2 Int64
v1) ([([Int], Int64)] -> [([Int], Int64)])
-> [([Int], Int64)] -> [([Int], Int64)]
forall a b. (a -> b) -> a -> b
$ Map [Int] Int64 -> [([Int], Int64)]
forall k a. Map k a -> [(k, a)]
Map.toList (RareAlleleHistogram -> Map [Int] Int64
raCounts RareAlleleHistogram
hist)

-- |Write a histogram to the stdout
writeHistogramStdOut :: (MonadIO m) => RareAlleleHistogram -> m ()
writeHistogramStdOut :: RareAlleleHistogram -> m ()
writeHistogramStdOut RareAlleleHistogram
hist =
    case RareAlleleHistogram -> Either String ByteString
showHistogram RareAlleleHistogram
hist of
        Left String
err -> SeqFormatException -> m ()
forall a e. Exception e => e -> a
throw (String -> SeqFormatException
SeqFormatException String
err)
        Right ByteString
outStr -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
B.putStrLn ByteString
outStr

-- |Write a histogram to a file
writeHistogramFile :: (MonadIO m) => FilePath -> RareAlleleHistogram -> m ()
writeHistogramFile :: String -> RareAlleleHistogram -> m ()
writeHistogramFile String
outF RareAlleleHistogram
hist =
    case RareAlleleHistogram -> Either String ByteString
showHistogram RareAlleleHistogram
hist of
        Left String
err -> SeqFormatException -> m ()
forall a e. Exception e => e -> a
throw (String -> SeqFormatException
SeqFormatException String
err)
        Right ByteString
outStr -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
B.writeFile String
outF ByteString
outStr
    
-- |Read a histogram from a FilePath
readHistogram :: (MonadIO m) => FilePath -> m RareAlleleHistogram
readHistogram :: String -> m RareAlleleHistogram
readHistogram String
path = IO RareAlleleHistogram -> m RareAlleleHistogram
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RareAlleleHistogram -> m RareAlleleHistogram)
-> IO RareAlleleHistogram -> m RareAlleleHistogram
forall a b. (a -> b) -> a -> b
$ String
-> IOMode
-> (Handle -> IO RareAlleleHistogram)
-> IO RareAlleleHistogram
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
ReadMode Handle -> IO RareAlleleHistogram
forall (m :: * -> *). MonadIO m => Handle -> m RareAlleleHistogram
readHistogramFromHandle

-- |Read a histogram from a File Handle.
readHistogramFromHandle :: (MonadIO m) => Handle -> m RareAlleleHistogram
readHistogramFromHandle :: Handle -> m RareAlleleHistogram
readHistogramFromHandle Handle
handle = do
    Maybe (Either ParsingError RareAlleleHistogram)
res <- StateT
  (Producer ByteString m ())
  m
  (Maybe (Either ParsingError RareAlleleHistogram))
-> Producer ByteString m ()
-> m (Maybe (Either ParsingError RareAlleleHistogram))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Parser ByteString RareAlleleHistogram
-> Parser
     ByteString m (Maybe (Either ParsingError RareAlleleHistogram))
forall (m :: * -> *) a b.
(Monad m, ParserInput a) =>
Parser a b -> Parser a m (Maybe (Either ParsingError b))
parse Parser ByteString RareAlleleHistogram
parseHistogram) (Handle -> Producer' ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Handle -> Producer' ByteString m ()
PB.fromHandle Handle
handle)
    case Maybe (Either ParsingError RareAlleleHistogram)
res of
        Maybe (Either ParsingError RareAlleleHistogram)
Nothing -> SeqFormatException -> m RareAlleleHistogram
forall a e. Exception e => e -> a
throw (String -> SeqFormatException
SeqFormatException String
"histogram file exhausted too early")
        Just (Left ParsingError
err) -> SeqFormatException -> m RareAlleleHistogram
forall a e. Exception e => e -> a
throw (String -> SeqFormatException
SeqFormatException (String
"Histogram parsing error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParsingError -> String
forall a. Show a => a -> String
show ParsingError
err))
        Just (Right RareAlleleHistogram
hist) -> RareAlleleHistogram -> m RareAlleleHistogram
forall (m :: * -> *) a. Monad m => a -> m a
return RareAlleleHistogram
hist

parseHistogram :: A.Parser RareAlleleHistogram
parseHistogram :: Parser ByteString RareAlleleHistogram
parseHistogram = do
    [ByteString]
names <- Parser ByteString [ByteString]
parseNames
    [Int]
nVec <- Parser ByteString [Int]
parseNVec
    Int
maxM <- Parser ByteString Int
parseMaxM
    Int64
totalNrSites <- Parser ByteString Int64
parseTotalNrSites
    [([Int], Int64, Maybe (Double, Double))]
body <- Parser [([Int], Int64, Maybe (Double, Double))]
parseBody
    let countHist :: Map [Int] Int64
countHist = [([Int], Int64)] -> Map [Int] Int64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Int], Int64)] -> Map [Int] Int64)
-> [([Int], Int64)] -> Map [Int] Int64
forall a b. (a -> b) -> a -> b
$ [([Int]
k, Int64
c) | ([Int]
k, Int64
c, Maybe (Double, Double)
_) <- [([Int], Int64, Maybe (Double, Double))]
body]
        jkHist :: Maybe (Map [Int] (Double, Double))
jkHist = case [([Int], Int64, Maybe (Double, Double))]
-> ([Int], Int64, Maybe (Double, Double))
forall a. [a] -> a
head [([Int], Int64, Maybe (Double, Double))]
body of
            ([Int]
_, Int64
_, Just (Double, Double)
_) -> Map [Int] (Double, Double) -> Maybe (Map [Int] (Double, Double))
forall a. a -> Maybe a
Just (Map [Int] (Double, Double) -> Maybe (Map [Int] (Double, Double)))
-> ([([Int], (Double, Double))] -> Map [Int] (Double, Double))
-> [([Int], (Double, Double))]
-> Maybe (Map [Int] (Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Int], (Double, Double))] -> Map [Int] (Double, Double)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Int], (Double, Double))] -> Maybe (Map [Int] (Double, Double)))
-> [([Int], (Double, Double))]
-> Maybe (Map [Int] (Double, Double))
forall a b. (a -> b) -> a -> b
$ [([Int]
k, (Double
jkMean, Double
jkSE)) |
                                                     ([Int]
k, Int64
_, Just (Double
jkMean, Double
jkSE)) <- [([Int], Int64, Maybe (Double, Double))]
body]
            ([Int], Int64, Maybe (Double, Double))
_ -> Maybe (Map [Int] (Double, Double))
forall a. Maybe a
Nothing
    RareAlleleHistogram -> Parser ByteString RareAlleleHistogram
forall (m :: * -> *) a. Monad m => a -> m a
return (RareAlleleHistogram -> Parser ByteString RareAlleleHistogram)
-> RareAlleleHistogram -> Parser ByteString RareAlleleHistogram
forall a b. (a -> b) -> a -> b
$ [String]
-> [Int]
-> Int
-> Int
-> [Int]
-> [[Int]]
-> Int64
-> Map [Int] Int64
-> Maybe (Map [Int] (Double, Double))
-> RareAlleleHistogram
RareAlleleHistogram ((ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
B.unpack [ByteString]
names) [Int]
nVec Int
1 Int
maxM [][] Int64
totalNrSites Map [Int] Int64
countHist Maybe (Map [Int] (Double, Double))
jkHist
  where
    parseNames :: Parser ByteString [ByteString]
parseNames = ByteString -> Parser ByteString
A.string ByteString
"NAMES=" Parser ByteString
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
name Parser ByteString
-> Parser ByteString Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
',' Parser ByteString [ByteString]
-> Parser ByteString () -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
A.endOfLine
    name :: Parser ByteString
name = (Char -> Bool) -> Parser ByteString
A.takeWhile1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
    parseNVec :: Parser ByteString [Int]
parseNVec = ByteString -> Parser ByteString
A.string ByteString
"N=" Parser ByteString
-> Parser ByteString [Int] -> Parser ByteString [Int]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser ByteString Int
-> Parser ByteString Char -> Parser ByteString [Int]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
',' Parser ByteString [Int]
-> Parser ByteString () -> Parser ByteString [Int]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
A.endOfLine
    parseMaxM :: Parser ByteString Int
parseMaxM = ByteString -> Parser ByteString
A.string ByteString
"MAX_M=" Parser ByteString -> Parser ByteString Int -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser ByteString Int
-> Parser ByteString () -> Parser ByteString Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
A.endOfLine
    parseTotalNrSites :: Parser ByteString Int64
parseTotalNrSites = ByteString -> Parser ByteString
A.string ByteString
"TOTAL_SITES=" Parser ByteString
-> Parser ByteString Int64 -> Parser ByteString Int64
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Int64
forall a. Integral a => Parser a
A.decimal Parser ByteString Int64
-> Parser ByteString () -> Parser ByteString Int64
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
A.endOfLine

parseBody :: A.Parser [(SitePattern, Int64, Maybe (Double, Double))]
parseBody :: Parser [([Int], Int64, Maybe (Double, Double))]
parseBody = Parser ByteString ([Int], Int64, Maybe (Double, Double))
-> Parser [([Int], Int64, Maybe (Double, Double))]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser ByteString ([Int], Int64, Maybe (Double, Double))
patternLine
  where
    patternLine :: Parser ByteString ([Int], Int64, Maybe (Double, Double))
patternLine = (,,) ([Int]
 -> Int64
 -> Maybe (Double, Double)
 -> ([Int], Int64, Maybe (Double, Double)))
-> Parser ByteString [Int]
-> Parser
     ByteString
     (Int64
      -> Maybe (Double, Double)
      -> ([Int], Int64, Maybe (Double, Double)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [Int]
parsePattern Parser
  ByteString
  (Int64
   -> Maybe (Double, Double)
   -> ([Int], Int64, Maybe (Double, Double)))
-> Parser ByteString Char
-> Parser
     ByteString
     (Int64
      -> Maybe (Double, Double)
      -> ([Int], Int64, Maybe (Double, Double)))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser
  ByteString
  (Int64
   -> Maybe (Double, Double)
   -> ([Int], Int64, Maybe (Double, Double)))
-> Parser ByteString Int64
-> Parser
     ByteString
     (Maybe (Double, Double) -> ([Int], Int64, Maybe (Double, Double)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int64
parseLargeInt Parser
  ByteString
  (Maybe (Double, Double) -> ([Int], Int64, Maybe (Double, Double)))
-> Parser ByteString (Maybe (Double, Double))
-> Parser ByteString ([Int], Int64, Maybe (Double, Double))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (Double, Double)
-> Parser ByteString (Maybe (Double, Double))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString (Double, Double)
parseJackknife Parser ByteString ([Int], Int64, Maybe (Double, Double))
-> Parser ByteString ()
-> Parser ByteString ([Int], Int64, Maybe (Double, Double))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
        Parser ByteString ()
A.endOfLine
    parsePattern :: Parser ByteString [Int]
parsePattern = Parser ByteString Int
forall a. Integral a => Parser a
A.decimal Parser ByteString Int
-> Parser ByteString Char -> Parser ByteString [Int]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy1` Char -> Parser ByteString Char
A.char Char
','
    parseLargeInt :: Parser ByteString Int64
parseLargeInt = String -> Int64
forall a. Read a => String -> a
read (String -> Int64)
-> Parser ByteString String -> Parser ByteString Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser ByteString Char
A.digit
    parseJackknife :: Parser ByteString (Double, Double)
parseJackknife = (,) (Double -> Double -> (Double, Double))
-> Parser ByteString Double
-> Parser ByteString (Double -> (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Char
A.space Parser ByteString Char
-> Parser ByteString Double -> Parser ByteString Double
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Double
A.double) Parser ByteString (Double -> (Double, Double))
-> Parser ByteString Char
-> Parser ByteString (Double -> (Double, Double))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString Char
A.space Parser ByteString (Double -> (Double, Double))
-> Parser ByteString Double -> Parser ByteString (Double, Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Double
A.double