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