{-# LANGUAGE OverloadedStrings #-}
module ELynx.Import.Nexus
( Block (..),
nexusBlock,
)
where
import Control.Applicative
import Data.Attoparsec.ByteString.Char8
import Data.Attoparsec.Combinator
import qualified Data.ByteString.Char8 as BS
data Block a = Block
{ forall a. Block a -> ByteString
name :: BS.ByteString,
forall a. Block a -> Parser a
parser :: Parser a
}
nexusBlock :: Block a -> Parser a
nexusBlock :: forall a. Block a -> Parser a
nexusBlock Block a
b = do
Parser ()
start
[Char]
_ <- forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (forall i a. Parser i a -> Parser i a
lookAhead forall a b. (a -> b) -> a -> b
$ forall a. Block a -> Parser ()
beginB Block a
b) forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"nexusBlockSkipUntilBlock"
a
r <- forall a. Block a -> Parser a
block Block a
b forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"nexusBlock"
[Char]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char
anyChar forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"nexusBlockSkipUntilEnd"
()
_ <- forall t. Chunk t => Parser t ()
endOfInput
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
start :: Parser ()
start :: Parser ()
start = do
ByteString
_ <- ByteString -> Parser ByteString ByteString
stringCI ByteString
"#nexus" forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"nexusStart"
(Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
forall (m :: * -> *) a. Monad m => a -> m a
return ()
block :: Block a -> Parser a
block :: forall a. Block a -> Parser a
block Block a
b = do
forall a. Block a -> Parser ()
beginB Block a
b
a
r <- forall a. Block a -> Parser a
parser Block a
b forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"blockParser"
Parser ()
endB
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
beginB :: Block a -> Parser ()
beginB :: forall a. Block a -> Parser ()
beginB (Block ByteString
n Parser a
_) = do
ByteString
_ <- ByteString -> Parser ByteString ByteString
stringCI ByteString
"begin" forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"blockBegin"
(Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
ByteString
_ <- ByteString -> Parser ByteString ByteString
stringCI ByteString
n forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"blockName"
Char
_ <- Char -> Parser Char
char Char
';' forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"blockEnd"
(Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
forall (m :: * -> *) a. Monad m => a -> m a
return ()
endB :: Parser ()
endB :: Parser ()
endB = do
ByteString
_ <- ByteString -> Parser ByteString ByteString
stringCI ByteString
"end;" forall i a. Parser i a -> [Char] -> Parser i a
<?> [Char]
"nexusEnd"
(Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace
forall (m :: * -> *) a. Monad m => a -> m a
return ()