module TLynx.Parsers
(
parseTree,
parseTrees,
NewickFormat,
newickFormat,
newickHelp,
)
where
import qualified Data.ByteString.Char8 as BS
import Data.List
import ELynx.Tools
import ELynx.Tree
import Options.Applicative
printError :: String -> String -> String -> IO a
printError fn new nex = do
putStrLn $ "Error of Newick parser: " <> new <> "."
putStrLn $ "Error of Nexus parser: " <> nex <> "."
error $ "Could not read tree file: " <> fn <> "."
parseTree :: NewickFormat -> FilePath -> IO (Tree Phylo BS.ByteString)
parseTree fmt fn = do
parseResultNewick <- runParserOnFile (oneNewick fmt) fn
case parseResultNewick of
Right r -> return r
Left eNewick -> do
parseResultNexus <- runParserOnFile (nexusTrees fmt) fn
case parseResultNexus of
Right [] -> error $ "No tree found in Nexus file " <> fn <> "."
Right [(_, t)] -> return t
Right _ -> error $ "More than one tree found in Nexus file " <> fn <> "."
Left eNexus -> printError fn eNewick eNexus
parseTrees :: NewickFormat -> FilePath -> IO (Forest Phylo BS.ByteString)
parseTrees fmt fn = do
parseResultNewick <- runParserOnFile (someNewick fmt) fn
case parseResultNewick of
Right r -> return r
Left eNewick -> do
parseResultNexus <- runParserOnFile (nexusTrees fmt) fn
case parseResultNexus of
Right r -> return $ map snd r
Left eNexus -> printError fn eNewick eNexus
newickFormat :: Parser NewickFormat
newickFormat =
option auto $
long "newick-format"
<> short 'f'
<> metavar "FORMAT"
<> value Standard
<> help ("Newick tree format: " ++ nwlist ++ "; default: Standard; for detailed help, see 'tlynx --help'")
where
nwfs = map show (allValues :: [NewickFormat])
nwlist = intercalate ", " (init nwfs) <> ", or " <> last nwfs
newickHelp :: [String]
newickHelp = map (toListItem . description) (allValues :: [NewickFormat]) ++ ["- Nexus file including Newick trees"]
where
toListItem = ("- Newick " ++)