{-# OPTIONS_GHC -fno-warn-orphans #-}

module Bio.FASTA.Parser
  ( fastaP
  , fastaLine
  , parseOnly
  , modificationP
  , fastaPGeneric
  , Parser
  ) where

import           Bio.FASTA.Type             (Fasta, FastaItem (..),
                                             ModItem (..), Modification (..),
                                             ParsableFastaToken (..))
import           Bio.Sequence               (BareSequence, bareSequence)
import           Data.Bifunctor             (first)
import           Data.Char                  (isLetter)
import           Data.Functor               (void, ($>))
import           Data.Text                  (Text, pack, strip)
import           Data.Void                  (Void)
import           Text.Megaparsec
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L

instance ParsableFastaToken Char where
  parseToken :: (Char -> Bool) -> Parsec Void Text Char
parseToken Char -> Bool
p = (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
p Parsec Void Text Char -> String -> Parsec Void Text Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"letter"

instance ParsableFastaToken ModItem where
  parseToken :: (Char -> Bool) -> Parsec Void Text ModItem
parseToken Char -> Bool
p = (Modification -> ModItem
Mod (Modification -> ModItem)
-> ParsecT Void Text Identity Modification
-> Parsec Void Text ModItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Modification
modificationP Parsec Void Text ModItem -> String -> Parsec Void Text ModItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"fasta item modification") Parsec Void Text ModItem
-> Parsec Void Text ModItem -> Parsec Void Text ModItem
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> ModItem
Letter (Char -> ModItem)
-> Parsec Void Text Char -> Parsec Void Text ModItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
p Parsec Void Text ModItem -> String -> Parsec Void Text ModItem
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"letter")

type Parser = Parsec Void Text

-- | Parser of .fasta file.
--

parseOnly :: Parsec Void Text a -> Text -> Either String a
parseOnly :: forall a. Parsec Void Text a -> Text -> Either String a
parseOnly Parsec Void Text a
p Text
s = (ParseErrorBundle Text Void -> String)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty (Either (ParseErrorBundle Text Void) a -> Either String a)
-> Either (ParseErrorBundle Text Void) a -> Either String a
forall a b. (a -> b) -> a -> b
$ Parsec Void Text a
-> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parsec Void Text a
p String
"input.fasta" Text
s

-- Using 'hspace1' instead of just 'space1' because our 'fastaLine' parser
-- expects each line to end with line-ending or end of file. But if 'sc' consumes end-of-line,
-- 'lexeme' in 'unknownP' also will and 'fastaLine' will not know that line has ended and will
-- expect more symbols.
--
-- 'hspace1' consumes only "horizontal" space, leaving line-ending for 'fastaLine'.
sc :: Parser ()
sc :: Parser ()
sc = Parser () -> Parser () -> Parser () -> Parser ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty Parser ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

lexeme :: Parser a -> Parser a
lexeme :: forall a. Parser a -> Parser a
lexeme = Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme Parser ()
sc

symbol :: Text -> Parser Text
symbol :: Text -> Parser Text
symbol = Parser ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parser ()
sc

fastaP :: ParsableFastaToken a => Parser (Fasta a)
fastaP :: forall a. ParsableFastaToken a => Parser (Fasta a)
fastaP = ParsecT Void Text Identity (FastaItem a)
-> ParsecT Void Text Identity [FastaItem a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Char -> Bool) -> ParsecT Void Text Identity (FastaItem a)
forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parser (FastaItem a)
item Char -> Bool
isLetter) ParsecT Void Text Identity [FastaItem a]
-> Parser () -> ParsecT Void Text Identity [FastaItem a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity [FastaItem a]
-> Parser () -> ParsecT Void Text Identity [FastaItem a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

fastaPGeneric :: ParsableFastaToken a => (Char -> Bool) -> Parser (Fasta a)
fastaPGeneric :: forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parser (Fasta a)
fastaPGeneric Char -> Bool
p  = ParsecT Void Text Identity (FastaItem a)
-> ParsecT Void Text Identity [FastaItem a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Char -> Bool) -> ParsecT Void Text Identity (FastaItem a)
forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parser (FastaItem a)
item Char -> Bool
p) ParsecT Void Text Identity [FastaItem a]
-> Parser () -> ParsecT Void Text Identity [FastaItem a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity [FastaItem a]
-> Parser () -> ParsecT Void Text Identity [FastaItem a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

item :: ParsableFastaToken a => (Char -> Bool) -> Parser (FastaItem a)
item :: forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parser (FastaItem a)
item Char -> Bool
p =
  Text -> BareSequence a -> FastaItem a
forall a. Text -> BareSequence a -> FastaItem a
FastaItem
    (Text -> BareSequence a -> FastaItem a)
-> Parser Text
-> ParsecT Void Text Identity (BareSequence a -> FastaItem a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
seqName
    ParsecT Void Text Identity (BareSequence a -> FastaItem a)
-> ParsecT Void Text Identity (BareSequence a)
-> ParsecT Void Text Identity (FastaItem a)
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Char -> Bool) -> ParsecT Void Text Identity (BareSequence a)
forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parser (BareSequence a)
fastaSeq Char -> Bool
p ParsecT Void Text Identity (BareSequence a)
-> String -> ParsecT Void Text Identity (BareSequence a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sequence")

seqName :: Parser Text
seqName :: Parser Text
seqName = Text -> Text
strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> ParsecT Void Text Identity String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
">" Parser Text
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parsec Void Text Char
-> Parser () -> ParsecT Void Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill Parsec Void Text Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle Parser ()
myEnd ParsecT Void Text Identity String
-> String -> ParsecT Void Text Identity String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sequence name"))

fastaSeq :: ParsableFastaToken a => (Char -> Bool) -> Parser (BareSequence a)
fastaSeq :: forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parser (BareSequence a)
fastaSeq Char -> Bool
p = [a] -> BareSequence a
[Element (BareSequence a)] -> BareSequence a
forall s. IsBareSequence s => [Element s] -> s
bareSequence ([a] -> BareSequence a)
-> ([[a]] -> [a]) -> [[a]] -> BareSequence a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> BareSequence a)
-> ParsecT Void Text Identity [[a]]
-> ParsecT Void Text Identity (BareSequence a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [a] -> ParsecT Void Text Identity [[a]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ((Char -> Bool) -> ParsecT Void Text Identity [a]
forall a. ParsableFastaToken a => (Char -> Bool) -> Parser [a]
fastaLine Char -> Bool
p) ParsecT Void Text Identity (BareSequence a)
-> Parser () -> ParsecT Void Text Identity (BareSequence a)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space

fastaLine :: ParsableFastaToken a => (Char -> Bool) -> Parser [a]
fastaLine :: forall a. ParsableFastaToken a => (Char -> Bool) -> Parser [a]
fastaLine Char -> Bool
p = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a])
-> ParsecT Void Text Identity [[a]]
-> ParsecT Void Text Identity [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [a] -> ParsecT Void Text Identity [[a]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((Char -> Bool) -> ParsecT Void Text Identity a
forall a.
ParsableFastaToken a =>
(Char -> Bool) -> Parsec Void Text a
parseToken Char -> Bool
p) ParsecT Void Text Identity [a]
-> Parser () -> ParsecT Void Text Identity [a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser () -> Parser ()
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden Parser ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace) ParsecT Void Text Identity [a]
-> Parser () -> ParsecT Void Text Identity [a]
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
myEnd

myEnd :: Parser ()
myEnd :: Parser ()
myEnd = ParsecT Void Text Identity [Tokens Text] -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Tokens Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol) Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

modificationP :: Parser Modification
modificationP :: ParsecT Void Text Identity Modification
modificationP
  = [ParsecT Void Text Identity Modification]
-> ParsecT Void Text Identity Modification
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[A*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_A_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[C*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_C_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[G*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_G_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[T*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_T_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rU]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rU
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[+A]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_Plus_A
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[+C]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_Plus_C
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[+G]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_Plus_G
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[+T]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_Plus_T
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rAf]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rAf
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rCf]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rCf
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rGf]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rGf
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[rUf]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_rUf
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mU]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mU
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mA*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mA_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mC*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mC_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mG*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mG_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[mU*]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_mU_Star
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[dU]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_dU
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5Bio]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5Bio
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[iBio]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_iBio
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[56FAM]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_56FAM
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[36FAM]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_36FAM
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5HEX]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5HEX
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5TMR]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5TMR
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3BHQ1]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3BHQ1
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3BHQ2]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3BHQ2
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5NH2]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5NH2
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3NH2]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3NH2
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5PO4]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5PO4
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3PO4]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3PO4
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3BioTEG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3BioTEG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[C12]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_C12
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[NHSdT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_NHSdT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5Mal]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5Mal
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5thio]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5thio
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3thio]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3thio
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3azide]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3azide
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3alkine]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3alkine
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5CholTEG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5CholTEG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[3CholTEG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_3CholTEG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5C10]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5C10
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5Alk]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5Alk
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[5ROX]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_5ROX
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AAA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AAA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AAC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AAC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[ACT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_ACT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[ATC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_ATC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[ATG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_ATG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CAG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CAG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[AGA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_AGA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CAT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CAT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CCG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CCG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CGT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CGT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[CTG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_CTG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GAA]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GAA
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GAC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GAC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GCT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GCT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GGT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GGT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[GTT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_GTT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TAC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TAC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TCT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TCT
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TGC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TGC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TGG]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TGG
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TTC]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TTC
  , Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[TTT]" ParsecT Void Text Identity (Tokens Text)
-> Modification -> ParsecT Void Text Identity Modification
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Modification
Mod_TTT
  , ParsecT Void Text Identity Modification
unknownP
  ]

unknownP :: Parser Modification
unknownP :: ParsecT Void Text Identity Modification
unknownP = do
  String
res <- Parser Text
-> Parser Text
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Text -> Parser Text
symbol Text
"[") (Text -> Parser Text
symbol Text
"]")
    (ParsecT Void Text Identity String
-> ParsecT Void Text Identity String
forall a. Parser a -> Parser a
lexeme (Parsec Void Text Char -> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (Parsec Void Text Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar Parsec Void Text Char
-> Parsec Void Text Char -> Parsec Void Text Char
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Parsec Void Text Char] -> Parsec Void Text Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (Char -> Parsec Void Text Char
Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (Char -> Parsec Void Text Char)
-> String -> [Parsec Void Text Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'+', Char
'-', Char
'*', Char
'_'])) ParsecT Void Text Identity String
-> String -> ParsecT Void Text Identity String
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"modification name"))
  Modification -> ParsecT Void Text Identity Modification
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Modification -> ParsecT Void Text Identity Modification)
-> Modification -> ParsecT Void Text Identity Modification
forall a b. (a -> b) -> a -> b
$ String -> Modification
Unknown (String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
res String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]")